; Copyright (c) 1991, Research Systems, Inc.  All rights reserved.
;	Unauthorized reproduction prohibited.
;+
; NAME:
;	XDL
; PURPOSE:
;	Provides a graphical user interface to the DOC_LIBRARY user
;	library procedure.
; CATEGORY:
;	Help, documentation, widgets .
; CALLING SEQUENCE:
;	XDL [, Name]
; INPUTS:
;	Name: The name of the initial routine for which help is desired.
;		This argument should be a scalar string.
; KEYWORDS:
;	GROUP = The widget ID of the widget that calls XLoadct.  When 
;		this ID is specified, a death of the caller results in a 
;		death of XLoadct
; OUTPUTS:
;	None. A widget interface is used to allow reading the help text.
; COMMON BLOCKS:
;	None.
; RESTRICTIONS:
;	- This routine does not support many of the keywords supported
;	  by the DOC_LIBRARY procedure.
;	- This routine uses DOC_LIBRARY to do much of the actual work
;	  of finding the documentation text. The alternative would be
;	  to duplicate much of DOC_LIBRARY which is undesirable. However,
;	  the use of DOC_LIBRARY leads to messages sometimes being sent
;	  to the terminal.
; MODIFICATION HISTORY:
;	5 January 1991, AB
;	30-Jun-92 (M.Morrison) - Modification so that it would work on SGI
;	29-Jul-92 (S.Freeland) - Generalized above fix to include mips
;				 (and allow extentions to new systems)
;
;-




function xdl_list, parent
; Returns a list widget containing the names of all routines in !PATH.
; The widgets uvalue contains the array of names.

  path = strcompress(!PATH, /remove_all)
  is_vms = !version.os eq 'vms'
  if (is_vms) then SEP=',' else SEP=':'
  n = 0
  while (strlen(path) ne 0) do begin
    cpos = strpos(path, SEP)
    if (cpos eq -1) then begin
      item = path
      path = ''
    endif else begin
      item = strmid(path, 0, cpos)
      path = strmid(path, cpos+1, 32767)
    endelse
    if (is_vms) then begin
      if (strmid(item, 0, 1) eq '@') then begin
	item = strmid(item, 1, 32767)
        spawn, 'LIBRARY/LIST ' + item, tmp
        tmp = tmp(8:*)		; Skip the header. 9 is a magic #
      endif else begin
        tmp = findfile(item+'*.PRO')
	tail = STRPOS(tmp, '.PRO')
        for i = 0, n_elements(tmp)-1 do begin		; Strip path and ext
	  tmp1 = strmid(tmp(i), 0, tail(i))
	  tmp(i) = strmid(tmp1, STRPOS(tmp1, ']') + 1, 32767)
	endfor
      endelse
    endif else begin
      ;;spawn, '/bin/ls -1 ' + item + '/*.pro', tmp		;MDM removed 30-Jun-92
;
;     slf - 29-jul-1992 - generalized ls command selection logic to handle mips/sgi
;     add to no1OS if new system does not like -1 qulifier in ls
;
      no1OS=['IRIX, RISC/OS' ]
;
      thisos=strupcase(!version.os)  
      qualifiers=[' ','-1 ']					      
;
      files= item + '/*.pro'
;
      cmd='/bin/ls ' + qualifiers(strpos(no1os,thisos) eq -1)   + files
      spawn, cmd, tmp
      ;slf replaced MDM mod to generalize for additional machines
      ;MDM added above two lines since SGI does not allow -1 option for ls
      tmp = strupcase(tmp)
      tail = STRPOS(tmp, '.PRO')
      for i = 0, n_elements(tmp)-1 do begin		; Strip path and ext
	tmp1 = strmid(tmp(i), 0, tail(i))
	j = STRPOS(tmp1, '/')
        while (j ne -1) do begin
	  tmp1 = strmid(tmp1, j+1, 32767)
	  j = STRPOS(tmp1, '/')
        endwhile
	tmp(i) = tmp1
      endfor
    endelse
    if (n eq 0) then begin
      names = tmp
    endif else begin
      names = [ names, tmp]
    endelse
    n = n + 1
  endwhile
  
  names = names(uniq(names, sort(names)))

  ; Fudge time. Different list lengths work best for OPEN LOOK and Motif
  if (!version.os eq 'sunos') then n=22 else n = 35
  return, WIDGET_LIST(parent, value=names, uvalue=names, ysize=n)

end







pro xdl_update, name, ow, status
; Update the display by running DOC_LIBRARY on NAME and updating
; the text widget (ow) to reflect the results. status is the widget id
; of the status widget, and is used to keep the user informed of progress.

  WIDGET_CONTROL, status, set_value='Status: Please Wait'

  name = strlowcase(name)
  is_vms = !version.os eq 'vms

  if (is_vms) then begin
    ON_ERROR, 3
    OFILE='userlib.doc'
    DOC_LIB_VMS, NAME, /FILE, /NOFILEMSG
  endif else begin
    OFILE='/tmp/idl_xdl.tmp'
    DOC_LIB_UNIX, NAME, print='cat > /tmp/idl_xdl.tmp'
  endelse

  openr, unit, OFILE, /get_lun, /stream, /delete, err=err
  if (err eq 0) then begin
    tmp = fstat(unit)
    text = bytarr(tmp.size)
    readu, unit, text
    free_lun, unit
  endif else begin
    text = 'Unable to locate routine: ' + strupcase(name)
  endelse

  WIDGET_CONTROL, ow, set_value = string(text)
  WIDGET_CONTROL, status, set_value='Status: Ready'

end







pro xdl_event, ev

  case (tag_names(ev, /STRUCTURE_NAME)) of
  "WIDGET_BUTTON": WIDGET_CONTROL, /DESTROY, ev.top
  "WIDGET_LIST": begin
	WIDGET_CONTROL, ev.id, get_uvalue=names
	WIDGET_CONTROL, ev.top, get_uvalue=tmp
	XDL_UPDATE, NAMES(ev.index), tmp.out, tmp.status
	end
  endcase


end







pro XDL, name, group=group

  on_error, 1		; On error, return to main level

  REQ_PRESENT = N_ELEMENTS(NAME) ne 0
  if (REQ_PRESENT) then begin
    temp = size(NAME)
    if (temp(0) NE 0) then message, 'Argument must be scalar.'
    if (temp(1) NE 7) then message, 'Argument must be of type string.'
    if (STRLEN(STRCOMPRESS(NAME, /REMOVE_ALL)) eq 0) then REQ_PRESENT = 0
  endif


  base = WIDGET_BASE(title='XDL', /ROW)
  cntl1 = WIDGET_BASE(base, /FRAME, /COLUMN, space=30)
    pb_quit = WIDGET_BUTTON(value='Quit', cntl1)
    status = WIDGET_LABEL(cntl1, value='Status: Ready', /frame)
    junk = WIDGET_BASE(cntl1, /frame, /COLUMN)
      l = WIDGET_LABEL(junk, value='Library Routines')
      list = xdl_list(junk)
  bottom = WIDGET_TEXT(base, /SCROLL, xsize = 80, ysize=45)

  WIDGET_CONTROL, base, /REALIZE, $
	set_uvalue={ xdl_struct, out:bottom, status:status }

  if (REQ_PRESENT) then xdl_update, name, bottom, status

  XMANAGER, 'XDL', base, event_handler='XDL_EVENT', group=group
end