#!/usr/bin/sh
# The next line restarts using tclsh since sh ignores the backslash \
exec oagwish "$0" "$@"

#$Log: not supported by cvs2svn $
#Revision 1.9  2004/04/21 20:25:57  soliday
#Changed so that it does not try to define the SCR variables.
#
#Revision 1.8  2001/12/18 19:12:57  soliday
#Made it more generic
#
#Revision 1.7  2001/09/10 18:15:07  soliday
#Added the ability to filter procedures.
#
#Revision 1.6  1998/10/26 19:15:02  soliday
#Fixed the packing order so that the buttons don't disappear.
#
#Revision 1.5  1996/03/04 20:14:16  saunders
#Added revision/author to Version menu.
#
#Revision 1.4  1996/02/29 21:00:30  evans
#Added -nocomplain to glob in apsHelp.
#
#Revision 1.3  1996/02/28  16:56:15  evans
#

set auto_path [linsert $auto_path 0 /usr/local/oag/apps/lib/$env(HOST_ARCH)]
set auto_path [linsert $auto_path 0 /usr/local/oag/lib_patch/$env(HOST_ARCH)]
APSDebugPath

if [info exists env(OAG_TOP_DIR)] {
    set auto_path [linsert $auto_path 0 $env(OAG_TOP_DIR)/oag/apps/lib/$env(HOST_ARCH)]
}

set library /usr/local/oag/apps/lib/$env(HOST_ARCH)
set librarypatch /usr/local/oag/lib_patch/$env(HOST_ARCH)
if {(![file exists $library]) && ([info exists env(TCLLIBPATH)])} {
    set library $env(TCLLIBPATH)
    set librarypatch ""
#    set librarypatch $env(TCLLIBPATH)
}
set apsttk 1
set CVSRevisionAuthor "\$Revision: 1.10 $ \$Author: borland $"

# set auto_path [linsert $auto_path 0 .]
# showwidgetnameswithmouse

# **************************** getnewproc ******************************
proc getnewproc {mode} {
    global pb

    # Check if there is a selection
    if {[llength [$pb tag ranges sel]] == 0} {
	APSAlertBox .alert -errorMessage \
	  "There is no selection."
	return
    }
    # Get the selection
    set newproc [$pb get sel.first sel.last]
    # Check if it is loaded
    if {[llength [info procs $newproc]] == 0} {
	APSAlertBox .alert -errorMessage \
	  "This procedure is not loaded."
	return
    }
    if {![string compare $mode replace]} {
	$pb delete 1.0  end
    } else {
	$pb yview moveto 1.0
	$pb insert end \
	  "\n\# *********************************************************\n\n"
    }
    $pb insert end "$newproc \{ [info args $newproc] \} {"
    $pb insert end [info body $newproc]
    $pb insert end "}\n"
}
# **************************** listproc ********************************
proc listproc {item doubleclick} {
    global procs tb pb

    $tb delete 1.0  end
    catch ${item}Help message
    $tb insert end $message
    $pb delete 1.0  end
    $pb insert end "$item \{ [info args $item] \} {"
    $pb insert end [info body $item]
    $pb insert end "}\n"
}
# **************************** overviewtext ****************************
proc overviewtext {} {
    global name library librarypatch

    return "\
     $name

     This programs displays help for APS standard procedures.

     Each APS Tcl/Tk standard procedure should have an accompanying procedure\
     with the same name except that Help is appended.  This program goes to\
     $library first and then to $librarypatch and looks in all the\
     .tcl files for procedures whose names\
     end in Help.  (The newer patch files overwrite the standard files).  The\
     output from these help procedures, which display the help message\
     for the associated procedure, may be displayed by choosing the desired\
     procedure from the scrolled list.  The procedure itself is displayed\
     below.  The Procedure window may be searched and new procedures may be
     displayed or appended to the window contents."
}
# **************************** setup ***********************************
proc setup {} {
    global library librarypatch lb procs
    set pwd [pwd]
    # Find the .tcl files in $library and source them
    foreach d $library {
	if ![catch {cd $d} result] {
	    set files [glob -nocomplain *.tcl ]
	    set lenf [llength $files]
	    set apsSkipSCRDefineVariables 1
	    for {set i 0} {$i < $lenf} {incr i} {
		catch "source [lindex $files $i]"
	    }
	}
    }
    # Find the .tcl files in $librarypatch  and source them
    #  (These versions will overwrite the others)
    if ![catch {cd $librarypatch} result] {
        set files [glob -nocomplain *.tcl ]
        set lenf [llength $files]
        for {set i 0} {$i < $lenf} {incr i} {
            catch "source [lindex $files $i]"
        }
    }
    # Find the help procs
    set procs [info procs *Help]
    set procs [lsort $procs]
    # Set the ones not to use
    set notused {APSContextHelp APSNearestContextHelp}
    set lennu [llength $notused]
    for {set i 0} {$i < $lennu} {incr i} {
	set index [lsearch -exact $procs [lindex $notused $i]]
	if {$index >= 0} {
	    set procs [lreplace $procs $index $index]
	}
    }
    # Add the names to the listbox
    set lenp [llength $procs]
    for {set i 0} {$i < $lenp} {incr i} {
	regsub "Help$" [lindex $procs $i] {} name
	$lb insert end $name
    }
    cd $pwd
}
# **************************** textSearch ******************************
proc textSearch {{widget {}} {textbox {}}} {
# Brings up the dialog box if widget is given
#   (If the widget doesn't exist, the textbox must be specified)
# Otherwise searches
    global textSearch
    
    # Search
    if {![string compare $widget ""]} {
	set len [string length $textSearch(string)]
	if {!$len} {
	    APSAlertBox .alert -errorMessage \
	      "No string given."
	    return
	}
	# Build command
	set tb $textSearch(textbox)
	set cmd "$tb search"
	if {![string compare $textSearch(direction) forward]} {
	    set cmd "$cmd -for"
	} else {
	    set cmd "$cmd -back"
	}
	if {![string compare $textSearch(match) exact]} {
	    set cmd "$cmd -exact"
	} else {
	    set cmd "$cmd -regexp"
	}
	if {![string compare $textSearch(case) nocase]} {
	    set cmd "$cmd -nocase"
	}
	set cmd "$cmd -- \"$textSearch(string)\" insert"
	# Search
	set index [eval $cmd]
	if {![string compare $index ""]} {
	    APSAlertBox .alert -errorMessage \
	      "Not found."
	    return
	} else {
	    $tb tag remove sel 1.0 end
	    $tb see $index
	    $tb tag add sel $index "$index + $len chars"
	    if {![string compare $textSearch(direction) forward]} {
		$tb mark set insert "$index + $len chars"
	    } else {
		$tb mark set insert $index
	    }
	}
	return
    }

    # Make search dialog box
    if {![winfo exists $widget]} {
	if {![string compare $textbox ""]} {
	    APSAlertBox .alert -errorMessage \
	      "No textbox argument given to textSearch."
	    return
	} else {
	    set textSearch(textbox) $textbox
	}

	if {![info exists textSearch(direction)]} \
	  {set textSearch(direction) forward}
	if {![info exists textSearch(match)]} \
	  {set textSearch(match) exact}
	if {![info exists textSearch(case)]} \
	  {set textSearch(case) nocase}
	
	APSDialogBox $widget -name "Search" \
	  -contextHelp "General purpose dialog box for text searches."
	set frame $widget.userFrame

	APSLabeledEntry .stringentry -parent $frame -label "String:" \
	  -textVariable textSearch(string) -width 50 -contextHelp \
	  "Name of string for which to search."
	
	APSFrameGrid .framegrid -parent $frame -xList {dir match case}
	
	APSRadioButtonFrame .dirframe -parent $frame.framegrid.dir \
	  -variable textSearch(direction) \
	  -label "Search Direction" -buttonList {Forward Backward} \
	  -valueList {forward backward} -contextHelp \
	  "Specifies the direction of the search."
	
	APSRadioButtonFrame .matchframe -parent $frame.framegrid.match \
	  -variable textSearch(match) \
	  -label "Match Type" -buttonList {Exact "Reg Exp"} \
	  -valueList {exact reg} -contextHelp \
	  "Specifies whether the match is to be exact or by a regular\
           expression."
	
	APSRadioButtonFrame .caseframe -parent $frame.framegrid.case \
	  -variable textSearch(case) \
	  -label "Case" -buttonList {"Case Insensitive" "Case Sensitive"} \
	  -valueList {nocase case} -contextHelp \
	  "Specifies whether case differences are ignored or not."
	
	$widget.buttonRow.ok.button configure -text Search -command textSearch
	set apsContextHelp($widget.buttonRow.ok.button) \
	  "Push this button to search for the string."
	APSEnableButton $widget.buttonRow.ok.button

	return
    } else {
	raise $widget
	return
    }
}

proc FilterProcedures {args} {
    global lblist
    set lblist(current) ""
    foreach procedure $lblist(full) {
	catch {    
	    if {[lsearch -glob $procedure $lblist(filter)] != -1} {
		lappend lblist(current) $procedure
	    }
	}
    }
}

# **********************************************************************
# **************************** main ************************************
# **********************************************************************

global textSearch

set name "Help on APS Procedures"
set overview [overviewtext]

APSApplication . -name $name -version $CVSRevisionAuthor -overview $overview \
  -contextHelp "Sorry, there is no context help available for this widget."
set w .userFrame

APSFrame .frame0 -parent .userFrame -relief flat
set w .userFrame.frame0
eval pack $w [pack info $w] -expand 1 -fill both
set w .userFrame.frame0.frame
eval pack $w [pack info $w] -expand 1 -fill both
set w1 $w

APSFrame .lbframe -parent $w1 -label Procedures
set w $w1.lbframe
eval pack $w [pack info $w] -expand 1 -fill both -side left
set w $w1.lbframe.frame
eval pack $w [pack info $w] -expand 1 -fill both

APSScrolledList .lb -parent $w -callback listproc \
  -contextHelp \
  "Click on a procedure name to display its help."
set lb $w.lb.listbox
$lb configure -width 0
$lb configure -listvar lblist(current)
set lblist(filter) "*"
pack [ttk::entry $w.e -textvariable lblist(filter)] -fill x
bindtags $w.e "TEntry . all $w.e"
bind $w.e <Return> "FilterProcedures"
set apsContextHelp($w.e) "Enter a filter string for searching procedures. Press <Return> to start search."


APSFrame .tbframe -parent $w1 -label Help
set w $w1.tbframe
eval pack $w [pack info $w] -expand 1 -fill both -side left
set w $w1.tbframe.frame
eval pack $w [pack info $w] -expand 1 -fill both

APSScrolledText .tb -parent $w \
  -contextHelp \
  "The help message for the selected procedure is displayed here."
set tb $w.tb.text

APSFrame .frame1 -parent .userFrame -relief flat
set w .userFrame.frame1
eval pack $w [pack info $w] -expand 1 -fill both
set w .userFrame.frame1.frame
eval pack $w [pack info $w] -expand 1 -fill both
set w1 $w

APSFrame .pbframe -parent $w1 -label Procedure
set w $w1.pbframe
eval pack $w [pack info $w] -expand 1 -fill both -side left
set w $w1.pbframe.frame
eval pack $w [pack info $w] -expand 1 -fill both

set pb $w.pb.text
set wb $w.bf
ttk::frame $wb
pack $wb -side bottom -fill x
APSButton .newprocbutton -parent $wb -text "Replace Procedure" \
  -command {getnewproc replace} -contextHelp \
  "If you select the name of another procedure in the body of\
   the displayed one, this button will display it instead.  Double\
   clicking is one way to select a name.  You may also write a\
   name into the text and select it." -width ""

APSButton .appendprocbutton -parent $wb -text "Append Procedure" \
  -command {getnewproc append} -contextHelp \
  "If you select the name of another procedure in the body of\
   the displayed one, this button will append it.  Double\
   clicking is one way to select a name.  You may also write a\
   name into the text and select it." -width ""

APSButton .searchbutton -parent $wb -text "Search..." \
  -command "textSearch .ts $pb" -contextHelp \
  "Bring up a search dialog box to search for text in the procedure." -width ""

APSScrolledText .pb -parent $w \
  -contextHelp \
  "The selected procedure is displayed here."

# Setup
setup
set lblist(full) $lblist(current)
