#
# $Log: not supported by cvs2svn $
# Revision 1.54  2010/06/21 19:42:15  soliday
# Changed the default font for APSScrolledText from
# -adobe-courier-medium-r-normal-*-14-*-*-*-*-*-*-* to Courier 11. They
# look the same on Solaris but the original font is not available on Linux.
#
# Revision 1.53  2006/07/07 14:49:35  shang
# added link name to the file description if the file is a link.
#
# Revision 1.52  2006/06/23 19:26:01  shang
# added aps prefix to the global variable name (selectCheck and selectCounter) and
# added distinguished arrayIndex to each scrolled list to be able to work for multiple
# list windows at the same time.
#
# Revision 1.51  2006/06/23 18:42:32  shang
# added "unset selectCheck" before appending description.
#
# Revision 1.50  2006/06/23 18:37:53  shang
# added feature of appending the Description content to the list item to APSScrolledListWindow.
#
# Revision 1.49  2006/01/18 18:46:37  borland
# Added emailButton option to APSScrolledListWindow.
#
# Revision 1.48  2005/08/19 22:12:14  soliday
# Moved the busy indicator from the scrolled text to the menu bar. I also renamed
# some of the related routines and put them in different files.
#
# Revision 1.47  2005/08/19 19:12:54  soliday
# Added the busy indicator to the APSScrolledStatus. This can be used directly
# by calling APSScrolledStatusStartWorking and APSScrolledStatusDoneWorking. It
# is also used by using APSBGExec.
#
# Revision 1.46  2004/10/28 15:45:00  soliday
# Added the option to add an x scrollbar to the scrolled list widget used by
# the APSFileSelectDialog.
#
# Revision 1.45  2004/08/20 20:40:01  shang
# added mouseClickCallback argument to APSScrolledListWindow to run a command/procedure
# associated with the chosen item in the list box when mouse is click or double
# clicked depends the command/procedure provided by mouseClickCallback
#
# Revision 1.44  2004/08/06 22:11:46  borland
# APSChooseItemFromList now adds the "Select all" button to the selection
# dialog when multi-item mode is used.
#
# Revision 1.43  2004/08/06 20:25:32  borland
# Added selectAllButton option to APSScrolledListWindow.
#
# Revision 1.42  2004/03/05 16:15:12  soliday
# Updated the listbox -listvar option to -listvariable option for Tcl 8.4 and up.
#
# Revision 1.41  2004/02/03 00:41:28  shang
# added height argument to APSChooseItemFromList proc
#
# Revision 1.40  2003/10/09 20:07:07  soliday
# Added a new expanded scrolled status button.
#
# Revision 1.39  2002/07/13 17:11:22  borland
# withButtons=1 is now the default on APSScrolledStatus.
#
# Revision 1.38  2001/11/02 17:46:59  soliday
# Added -listvar option to APSScrolledList
#
# Revision 1.37  2001/02/06 19:44:24  soliday
# Fixed some tcl warning messages found with procheck
#
# Revision 1.36  2000/11/22 22:47:09  borland
# Initialize global variables for APSChooseItemFromList.
#
# Revision 1.35  2000/10/27 01:00:48  emery
# Indented code.
#
# Revision 1.34  2000/10/25 15:38:09  borland
# Added print capability to APSScrolledListWindow
#
# Revision 1.33  1999/06/21 18:14:06  borland
# Fixed info routine for APSChooseItemFromList.
#
# Revision 1.32  1998/05/20 16:44:12  borland
# Added -clearCommand option to APSScrolledListWindow.
#
# Revision 1.31  1998/03/24 23:13:14  borland
# Added -width option to APSScrolledList.
#
# Revision 1.30  1998/02/19 23:26:02  borland
# Fixed a number of grab/focus problems that prevented proper modal operation
# of FileDisplayWindow.
#
# Revision 1.29  1997/12/18 19:49:14  borland
# Added -label option to APSScrolledStatus.
#
# Revision 1.28  1997/07/01 20:19:24  borland
# Fixed bug introdcued in APSChooseItemFromList.
#
# Revision 1.27  1997/06/27 22:49:01  borland
# Added -selectMode option to several procedures.
#
# Revision 1.26  1997/05/01 16:05:53  borland
# Changed spelling of APSScrolledTextEmail to EMail, consistent with other
# routines.
#
# Revision 1.25  1997/05/01 15:08:36  borland
# Renamed APSScrolledStatusEmail to APSScrolledTextEmail and gave it
# variable arguments.   This permits the code to be used for other
# scrolled text emailing.
#
# Revision 1.24  1997/04/25 19:48:12  borland
# APSScrolledStatus now accepts -lineLimit option to limit the amount of
# text in the scroll box.
#
# Revision 1.23  1997/04/21 23:07:04  borland
# Upgrades to APSChooseItemFromList: multi-item returns, return of item from
# parallel list, return of indices option.
#
# Revision 1.22  1997/04/21 22:16:02  borland
# Added APSChooseItemFromList.
#
# Revision 1.21  1997/02/07 14:58:52  borland
# Added items to help routine for APSScrolledListWindow.
#
# Revision 1.20  1997/01/30 15:21:04  borland
# APSScrolledListWindow modified to support automatic accept function when
# selections are changed plus options to leave off specific buttons from
# the window.  Clear button added to clear selections.
#
# Revision 1.19  1997/01/21 20:39:46  borland
# Added option for specifying the font for the scroll area.
#
# Revision 1.18  1996/11/14 17:50:49  borland
# Improved APSListSelectDialog.  Now has OK and Cancel buttons.
#
# Revision 1.17  1996/11/14 15:15:16  borland
# Added APSListSelectDialog.
#
# Revision 1.16  1996/10/04 19:53:09  saunders
# Added "print", "save as..", and "email..." buttons to APSAlertBox.
# In doing so, I removed functionally duplicate procedures, and created
# generic APSPrint and APSSaveDialog. Also addes "save as.." to APSExecLog.
# Removed "Enscript" buttons, since "Print" is adequate.
#
# Revision 1.15  1996/09/23 15:17:25  borland
# Added context help for save and email functions of scrolled status window.
#
# Revision 1.14  1996/09/18 14:52:57  saunders
# Option "-withButtons 1" added to APSScrolledStatus.
#
# Revision 1.13  1996/02/13 15:55:00  saunders
# Modified APSScrolledText to do word wrap, not char wrap.
#
# Revision 1.12  1996/01/19  20:27:30  saunders
# Fixed APSScrolledList so that multiple listboxes can have independent
# selections.
#
# Revision 1.11  1996/01/18 00:42:54  saunders
# Added "-fill x" as default to APSScrolled procedure.
#
# Revision 1.10  1996/01/16  21:20:16  saunders
# Added Log for CVS. Should have done this a long time ago.
#
#


proc APSScrolledTextHelp {} {
    return "Usage: APSScrolledText widget \n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-width <string>\]\t\n\[-height <string>\]\t\n\[-name <string>\]\t\n\[-contextHelp <string>\]\t\n\nCreates\t\$parent\$widget.\n\ttext\n\tscroll\n"
}

proc APSScrolledText {widget args} {
    global apsContextHelp apsttk
    set parent ""
    set noPack 0
    set packOption "-side top -fill both -expand 1"
    set name "Scroll Text"
    set width 40
    set height 15
    set contextHelp ""
    if {[info exists apsttk] && ($apsttk != 0)} {
        set ttkPrefix ttk::
        set ttk 1
        set font "TkFixedFont"
    } else {
        set ttkPrefix ""
        set ttk 0
        set font "Courier 11"
    }
    APSStrictParseArguments {parent noPack packOption width height name contextHelp font}
    if {$ttk} {
        if {![string length $font]} {
            set font TkFixedFont
        }
    } else {
        if {![string length $font]} {
            set font "Courier 11"
        }
    }

    if {$contextHelp != ""} {
        set apsContextHelp($parent$widget) $contextHelp
    }
    if {$parent == ""} {
        toplevel $widget -bd 1
        wm title $widget $name
    } else {
        ${ttkPrefix}frame $parent$widget -borderwidth 2 -relief ridge
        if {!$noPack} {
            eval pack $parent$widget $packOption
        }
    }

    text $parent$widget.text -width $width -height $height \
      -bd 1 -relief raised -setgrid 1 -wrap word \
      -yscrollcommand "$parent$widget.scroll set" -font $font
    ${ttkPrefix}scrollbar $parent$widget.scroll \
      -command "$parent$widget.text yview"
    pack $parent$widget.scroll -side right -fill y
    pack $parent$widget.text -side left -fill both -expand 1

    bind $parent$widget.text <Button-4> {%W yview scroll -1 unit}
    bind $parent$widget.text <Button-5> {%W yview scroll 1 unit}


}

proc APSScrolledListHelp {} {
    return "Usage: APSScrolledList widget \n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-height <string>\]\t\n\[-name <string>\]\t\n\[-itemList <list>\]\t\n\[-listvar <listvar>\]\t\n\[-callback <proc>] note: procedure must be <proc> listboxItem doubleClick\n\[-contextHelp <string>\]\t\n\[-selectMode <mode>\]\t\n\[-xscroll <1|0>]\t\n\nCreates\t\$parent\$widget.\n\tlistbox\n\tscroll\n"
}

proc APSScrolledList {widget args} {
    global apsContextHelp apsttk
    set parent ""
    set noPack 0
    set packOption "-side top -fill both -expand 1"
    set name "Scroll Text"
    set height 15
    set callback ""
    set itemList ""
    set listvar ""
    set contextHelp ""
    set selectMode extended
    set width 20
    set xscroll 0
    APSStrictParseArguments {parent noPack packOption height name \
                               callback itemList listvar contextHelp selectMode width xscroll}

    if {[info exists apsttk] && ($apsttk != 0)} {
        set ttkPrefix ttk::
        set ttk 1
    } else {
        set ttkPrefix ""
        set ttk 0
    }
    if {$contextHelp != ""} {
        set apsContextHelp($parent$widget) $contextHelp
    }
    if {$parent == ""} {
        toplevel $widget -bd 2
        wm title $widget $name
    } else {
        ${ttkPrefix}frame $parent$widget -borderwidth 2 -relief ridge
        if {!$noPack} {
            eval pack $parent$widget $packOption
        }
    }
    global tcl_version
    if {[string range $tcl_version 0 2] <= 8.3} {
        if {$xscroll} {
            listbox $parent$widget.listbox  -height $height -width $width \
              -bd 0 -setgrid 1 -exportselection 0 \
              -listvar $listvar -yscrollcommand "$parent$widget.scroll set" \
              -xscrollcommand "$parent$widget.xscroll set"
        } else {
            listbox $parent$widget.listbox  -height $height -width $width \
              -bd 0 -setgrid 1 -exportselection 0 \
              -listvar $listvar -yscrollcommand "$parent$widget.scroll set"
        }
    } else {
        if {$xscroll} {
            listbox $parent$widget.listbox  -height $height -width $width \
              -bd 0 -setgrid 1 -exportselection 0 \
              -listvariable $listvar -yscrollcommand "$parent$widget.scroll set" \
              -xscrollcommand "$parent$widget.xscroll set"
        } else {
            listbox $parent$widget.listbox  -height $height -width $width \
              -bd 0 -setgrid 1 -exportselection 0 \
              -listvariable $listvar -yscrollcommand "$parent$widget.scroll set"
        }
    }
    ${ttkPrefix}scrollbar $parent$widget.scroll \
      -command "$parent$widget.listbox yview"
    pack $parent$widget.scroll -side right -fill y
    if {$xscroll} {
        ${ttkPrefix}scrollbar $parent$widget.xscroll -orient horizontal -command "$parent$widget.listbox xview"
        pack $parent$widget.xscroll -side bottom -fill x
    }
    pack $parent$widget.listbox -side left -fill both -expand 1

    # Set listbox width so that longest item fits
    set maxWidth $width
    foreach item $itemList {
        set itemWidth [string length $item]
        if {$itemWidth > $maxWidth} {
            set maxWidth $itemWidth
        }
    }
    $parent$widget.listbox configure -width $maxWidth -selectmode $selectMode
    eval {$parent$widget.listbox insert end} $itemList

    if {$callback != ""} {
        bind $parent$widget.listbox <Button-1> \
          [subst -nocommands {
              $callback [$parent$widget.listbox get \
                           [$parent$widget.listbox nearest %y]] 0
          }]
        bind $parent$widget.listbox <Double-1> \
          [subst -nocommands {
              $callback [$parent$widget.listbox get \
                           [$parent$widget.listbox nearest %y]] 1
          }]
    }

    bind $parent$widget.listbox <Button-4> {%W yview scroll -1 unit}
    bind $parent$widget.listbox <Button-5> {%W yview scroll 1 unit}

}

proc APSUpdateScrolledSelectionVar {listbox selectionVar args} {
    global $selectionVar
    set $selectionVar ""
    foreach item [$listbox curselection] {
        lappend $selectionVar [$listbox get $item]
    }
}

proc APSScrolledListWindowHelp {} {
    return "Usage: APSScrolledListWindow widget \n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-height <string>\]\t\n\[-name <string>\]\t\n\[-label <string>\]\n\[-itemList <list>\]\n\[-listvar <listvar>\]\t\n\[-selectionVar <string>\]\n\[-callback <script>\]\t\n\[-contextHelp <string>\]\t\n\[-autoAccept 1\]\t\n\[-closeButton 0\]\t\n\[-clearButton 1\]\t\n\[-clearCommand <string>\]\t\n\[-acceptButton 0\]\t\n\[-printButton 1\]\[-emailButton 1\]\t\n\[-selectMode <mode>\]\t\n\nCreates\t\$parent\$widget.\n\tuserFrame\n\tuserFrame.sl.listbox\n\tbuttonRow.close.button\n\tbuttonRow.accept.button"
}
proc APSScrolledListWindowCb {listbox script} {
    set list ""
    foreach item [$listbox curselection] {
        lappend list [$listbox get $item]
    }
    eval $script {$list}
}

proc APSScrolledListWindow {widget args} {
    global apsContextHelp
    set parent ""
    set noPack 0
    set packOption "-side top -fill x"
    set name "NoName"
    set label ""
    set itemList ""
    set listvar ""
    set selectionVar ""
    set callback ""
    set height 15
    set contextHelp ""
    set autoAccept 0
    set closeButton 1
    set clearButton 0
    set selectAllButton 0
    set acceptButton 1
    set printButton 0
    set selectMode extended
    set clearCommand ""
    set mouseClickCallback ""
    set emailButton 0
    set descriptionName Description
    set appendDescription 0
    set directory ""
    set rootnameOnly 1
    APSStrictParseArguments {parent name label noPack packOption itemList listvar \
                                 selectionVar height callback contextHelp autoAccept \
                                 closeButton clearButton acceptButton selectMode clearCommand \
                                 printButton selectAllButton mouseClickCallback emailButton \
                                 descriptionName appendDescription directory rootnameOnly}

    if {$contextHelp != ""} {
        set apsContextHelp($parent$widget) $contextHelp
    }

    APSWindow $widget -parent $parent -noPack $noPack -packOption $packOption \
      -name $name -closeButton $closeButton

    if {$label != ""} {
        label $parent$widget.userFrame.label -text $label
        pack $parent$widget.userFrame.label -side top -fill x -padx 10 -pady 1
    }

    set list $parent$widget.userFrame.sl.listbox
    set listWidget $parent$widget.userFrame.sl
    set help "Click on selection, and drag to select a block of items. Use Ctrl-Click to pick out disjoint items from list."
    if {!$autoAccept} {
        set help "$help Press Accept to accept your selection, but keep the window open."
    }
    if {$closeButton} {
        set help "$help Press Close to accept your selection and close the window." 
    }
    if {$clearButton} {
        set help "$help Press Clear to clear your selection and start over."
    }
   
    if [string length $mouseClickCallback] {
        APSScrolledList .sl -parent $parent$widget.userFrame -itemList $itemList \
          -listvar $listvar -height $height -contextHelp $help -selectMode $selectMode \
            -callback $mouseClickCallback
    } else {
        APSScrolledList .sl -parent $parent$widget.userFrame -itemList $itemList \
           -listvar $listvar -height $height -contextHelp $help -selectMode $selectMode 
    }
    
    set acceptCmd ""
    if {$selectionVar != ""} {
        set foreachList "\[$list curselection\]"
        set foreachBody "lappend $selectionVar \[$list get \$item\]"
        set acceptCmd [subst {
            set $selectionVar ""
            foreach item $foreachList {$foreachBody}
        }]
    }

    if {$callback != ""} {
        set acceptCmd [subst {
            $acceptCmd
            APSScrolledListWindowCb $list $callback
        }]
    }
    if {$closeButton} {
        set closeCmd [subst {
            $acceptCmd
            destroy $parent$widget
        }]
        $parent$widget.buttonRow.close.button configure -command $closeCmd
    }
    if {$clearButton} {
        set clearCmd [subst {
            set $selectionVar \"\"
            $list selection clear 0 end
        }]
        APSDialogBoxAddButton .clear -parent $parent$widget -text Clear \
          -command "$clearCmd; $clearCommand" -contextHelp "Clear selections."
    }
    if {$acceptButton} {
        APSDialogBoxAddButton .accept -parent $parent$widget -text Accept \
          -command $acceptCmd -contextHelp "Accept selections, but keep this window open."
    }
    if {$selectAllButton} {
        APSDialogBoxAddButton .acceptAll -parent $parent$widget -text "Select all" \
          -command "$list selection set 0 end"
    }
    if {$printButton} {
        APSDialogBoxAddButton .print -parent $parent$widget -text Print \
          -command "APSScrolledListWindowPrint -widget $parent$widget.userFrame.sl.listbox -dialog 0"
        APSDialogBoxAddButton .printd -parent $parent$widget -text Print... \
          -command "APSScrolledListWindowPrint -widget $parent$widget.userFrame.sl.listbox -dialog 1"
    }
    if {$emailButton} {
        APSDialogBoxAddButton .email -parent $parent$widget -text Email... \
          -command "APSScrolledListWindowEMail -widget $parent$widget.userFrame.sl.listbox"
    }
    if {$autoAccept} {
        bind $list <ButtonRelease-1> "APSUpdateScrolledSelectionVar $list $selectionVar"
    }
    if {$appendDescription} {
        global apsSelectCounter apsSelectCheck 
        while {1} {
            set arrayIndex [APSUniqueNumber]
            if ![info exist apsSelectCheck($arrayIndex.none)] {
                break
            }
        }
        set apsSelectCheck($arrayIndex.none) 1
        set apsSelectCounter($arrayIndex) $height
        APSAppendFileDescriptionToScrolledList $arrayIndex $listWidget $rootnameOnly $descriptionName $directory
        bindtags $listWidget.scroll "Scrollbar $listWidget.scroll . all"
        bind $listWidget.scroll <B1-ButtonRelease> "APSAppendFileDescriptionToScrolledList $arrayIndex $listWidget $rootnameOnly $descriptionName $directory"
        if ![string length $mouseClickCallback] {
            bind $listWidget.listbox <Button-1> "APSAppendFileDescriptionToScrolledList $arrayIndex $listWidget $rootnameOnly $descriptionName $directory"
        }
    }
}

proc APSAppendFileDescriptionToScrolledList {arrayIndex listWidget rootnameOnly descriptionName descDir} {
    if ![string length $listWidget] {
        return -code error "The list widget was not provided."
    }
    if ![winfo exist $listWidget] {
        return -code error "$listWidget does not exist"
    }
    global apsSelectCounter  apsSelectCheck 
    set index [$listWidget.listbox index @0,0]
    set endseen 0
    if {[llength [$listWidget.listbox bbox end]]} {
        set endseen 1
    }
    set i 0
    set maxWidth 0
    while {([llength [$listWidget.listbox bbox $index]]) || ($i < $apsSelectCounter($arrayIndex))} {
        if {![llength [$listWidget.listbox bbox $index]]} {
            incr i
        }
        if {[info exists apsSelectCheck($arrayIndex.$index)]} {
            incr index
            continue
        }
        set apsSelectCheck($arrayIndex.$index) 1
        set item [$listWidget.listbox get $index]
        set width [string length $item]
        if {$width>$maxWidth} {
            set maxWidth $width
        }
        if {[llength $item] != 1} {
            incr index
            continue
        }
        if $rootnameOnly {
            set f ${descDir}/${item}
        } else {
            set f ${item}
        }
        if {![file exists $f]} {
            set f ${f}.gz
        }
        if {[catch {exec sdds2stream -par=$descriptionName -page=1 $f} desc]} {
            set desc ""
        }
	if {[file type $f]=="link"} {
	    set link " -> [file tail [file readlink $f]]"
	} else {
	    set link ""
	}
        $listWidget.listbox delete $index
        $listWidget.listbox insert $index "${item}$link \"[join $desc]\""
        set width [expr [string length $item] + 1 + [string length $link] + [string length \"[join $desc]\"]]
        if {$width>$maxWidth} {
            set maxWidth $width
        }
        incr index
    }
    if {$endseen == 1} {
        $listWidget.listbox see end
    }
    $listWidget.listbox configure -width $maxWidth
    update
}

proc APSScrolledListWindowPrint {args} {
    set widget ""
    set dialog 0
    set printCommand "lpr"
    APSStrictParseArguments {widget dialog}
    if {![string length $widget]} {
        return -code error "APSScrolledListWindowPrint: not widget given"
    }
    if {![winfo exists $widget]} {
        return -code error "APSScrolledListWindowPrint: widget not found: $widget"
    }
    if {$dialog} {
        set tmpFile /tmp/[APSTmpString]
        APSAddToTempFileList $tmpFile
        if {[catch {open $tmpFile w} fid]} {
            return -code error "APSScrolledListWindowPrint: unable to open file: $fid"
        }
        foreach item [$widget get 0 end] {
            puts $fid $item
        }
        flush $fid
        close $fid
        APSCustomPrint -fileName $tmpFile -modal 0 -printCommand $printCommand 
    } else {
        APSPrint -cmd $printCommand -textWidget $widget -widgetType listbox
    }
}

proc APSScrolledListWindowEMail {args} {
    set widget ""
    APSStrictParseArguments {widget}
    if {![string length $widget]} {
        return -code error "APSScrolledListWindowEMail: not widget given"
    }
    set textBuffer ""
    set maxWidth 10
    foreach item [$widget get 0 end] {
        if [set width [string length $item]]>$maxWidth {
            set maxWidth $width
        }
        append textBuffer "$item\n"
    }
    APSEMailDialog [APSUniqueName .] -message $textBuffer -width $maxWidth -modal 0
}

proc APSScrollHelp {} {
    return "Usage: APSScroll widget \n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-name <string>\]\t\n\[-contextHelp <string>\]\t\n\nCreates\t\$parent\$widget.\n\tframe.canvas\n\tframe.yscroll\n\tframe.canvas.frame\n\nReturns \$parent\$widget.frame.canvas.frame into which you pack widgets\nto be scrolled. Then call \"APSScrollAdjust \$parent\$widget\" \nto configure scrolling.\n\n"
}

proc APSScroll {widget args} {
    global apsContextHelp apsttk
    set parent ""
    set noPack 0
    set packOption "-side top -fill x"
    set name "NoName"
    set contextHelp ""
    APSStrictParseArguments {parent noPack packOption name contextHelp}

    if {[info exists apsttk] && ($apsttk != 0)} {
        set ttkPrefix ttk::
    } else {
        set ttkPrefix ""
    }
    if {$contextHelp != ""} {
        set apsContextHelp($parent$widget) $contextHelp    
    }

    APSFrame $widget -parent $parent -noPack $noPack -packOption $packOption \
      -name $name

    # Create a scrollable canvas
    canvas $parent$widget.frame.canvas -width 10 -height 10 \
      -yscrollcommand [list $parent$widget.frame.yscroll set]
    ${ttkPrefix}scrollbar $parent$widget.frame.yscroll -orient vertical \
      -command [list $parent$widget.frame.canvas yview]
    pack $parent$widget.frame.yscroll -side right -fill y
    pack $parent$widget.frame.canvas -side left -fill both -expand 1
    pack $parent$widget.frame -side top -fill both -expand 1
    
    set canvas $parent$widget.frame.canvas

    # Create one frame to hold everything
    # and position it on the canvas
    set f [frame $canvas.frame -bd 0]
    $canvas create window 0 0 -anchor nw -window $f
    return $f
}

proc APSScrollAdjustHelp {} {
    return "Usage: APSScrollAdjust widget \n\[-numVisible <string>\]\t\n\[-scrollIncrement <string>\]\t\n\nWidget given must be the base widget from APSScroll (\$parent\$widget).\nAdjusts the canvas and scrolling parameters to do something reasonable with\nthe widgets you have packed into the scrolled frame. In general, it is\nassumed you have packed homogenous widgets, in which case -numVisible\ndetermines how many you will see at a time. Scrolling is set up to jump in\nincrements of one widget.\n\n"
}
proc APSScrollAdjust {widget args} {
    global apsScrollResource
    set numVisible 4
    set scrollIncrement 0
    APSStrictParseArguments {numVisible scrollIncrement}

    set children [pack slaves $widget.frame.canvas.frame]
    set canvas $widget.frame.canvas

    # Determine width of widest widget and height of all widgets
    set maxWidth 0
    set maxHeight 0
    foreach child $children {
        set maxHeight [expr {$maxHeight + [winfo height $child]}]
        set width [winfo width $child]
        if {$width > $maxWidth} {
            set maxWidth $width
        }
    }
    if {$scrollIncrement != 0} {
        set incr $scrollIncrement
    } else {
        set incr [winfo height [lindex $children 0]]
    }
    set height [expr {$incr * $numVisible}]
    $canvas config -scrollregion "0 0 $maxWidth $maxHeight"
    $canvas config -yscrollincrement $incr
    $canvas config -width $maxWidth -height $height
}

proc APSScrolledStatusHelp {} {
    return "Usage: APSScrolledStatus widget \n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-textVariable <string>\]\t\n\[-width <string>\]\t\n\[-height <string>\]\t\n\[-withButtons 1\]\t\n\[-name <string>\]\t\n\[-contextHelp <string>\]\t\n\[-lineLimit <number>\]\t\n\[-label <string>\]\t\n\[-busyIndicator 0\]\t\n\nCreates\t\$parent\$widget.\n\tframe.text\n\tframe.scroll\n"
}
proc APSScrolledStatus {widget args} {
    global apsContextHelp apsEntryBackground
    global apsScrolledStatusVar apsScrolledStatusLineLimit
    global apsScrolledStatusLineCount apsttk
    set parent ""
    set noPack 0
    set packOption "-side top"
    set name "NoName"
    set textVariable ""
    set width 40
    set height 5
    set withButtons 1
    set contextHelp ""
    set lineLimit 0
    set label ""
    APSStrictParseArguments {parent noPack packOption name textVariable \
                               width height withButtons contextHelp lineLimit label busyIndicator}
    if {[info exists apsttk] && ($apsttk != 0)} {
        set ttkPrefix ttk::
    } else {
        set ttkPrefix ""
    }
    
    if {$contextHelp != ""} {
        set apsContextHelp($parent$widget) $contextHelp    
    }
    APSFrame $widget -parent $parent -noPack $noPack -packOption $packOption \
      -name $name -label $label \
      -contextHelp "Changes to application status are recorded here."
    set i [lsearch -exact $packOption "-expand"]
    if {$i != -1} {
        incr i
        set value [lindex $packOption $i]
        if {($value == "true") || ($value == "yes") || ($value == "1")} {
            pack configure ${parent}$widget -expand true
        }
    }

    if {$withButtons} {
        APSFrameGrid .fg -parent $parent$widget.frame -yList {top bottom} -bd 0
        set top $parent$widget.frame.fg.top
        set bottom $parent$widget.frame.fg.bottom
        pack configure $bottom -expand 0
    } else {
        APSFrameGrid .fg -parent $parent$widget.frame -yList {top} -bd 0
        set top $parent$widget.frame.fg.top
    }

    text $top.text -width $width -height $height \
      -bd 0 -relief raised -setgrid 1 -bg $apsEntryBackground \
      -yscrollcommand "$top.scroll set" \
      -highlightbackground $apsEntryBackground \
      -highlightcolor $apsEntryBackground
    
    ${ttkPrefix}scrollbar $top.scroll \
      -command "$top.text yview"
    pack $top.scroll -side right -fill y

    pack $top.text -side left -fill both -expand 1

    bind $top.text <Button-4> {%W yview scroll -1 unit}
    bind $top.text <Button-5> {%W yview scroll 1 unit}


    if {$withButtons} {
        APSButton .ensc -parent $bottom -size small -text Print -command \
          "APSPrint -textWidget $top.text -cmd enscript" -contextHelp \
          "Print contents of status window to local printer." -width ""
        APSButton .save -parent $bottom -size small -text "Save As..."\
          -command "APSSaveDialog .alertSave -textWidget $top.text" \
          -contextHelp "Save contents of status window to a file." -width ""
        APSButton .email -parent $bottom -size small -text Email... -command \
          "APSScrolledTextEMail -textWidget $top.text -width $width" \
          -contextHelp "Email contents of status window." -width ""
        APSButton .bigdialog -parent $bottom -size small \
            -text "Expand Dialog..." -command \
            "APSExpandScrolledDialog -textVariable $textVariable -textWidget $top.text -width $width" \
            -contextHelp "Expand contents of status window." -width ""
    }

    global $textVariable
    $top.text insert end [subst $$textVariable]\n

    set apsScrolledStatusVar($textVariable) $parent$widget
    set apsScrolledStatusLineLimit($textVariable) $lineLimit
    set apsScrolledStatusLineCount($textVariable) 1
    trace variable $textVariable w APSScrolledStatusUpdate
}

proc APSExpandScrolledDialog {args} {
    set textVariable ""
    set textWidget ""
    set width 40
    APSStrictParseArguments {textVariable textWidget width}
    
    global $textVariable
    if {[string range $textVariable 0 16] != "apsExpandedDialog"} {
        set textVariable apsExpandedDialog$textVariable
        global $textVariable
    }
    set $textVariable [string trim [$textWidget get 1.0 end] \n]
    if {[winfo exists .expandedDialog]} {
        trace vdelete $textVariable w APSScrolledStatusUpdate
        destroy .expandedDialog
    }
    toplevel .expandedDialog

    APSScrolledStatus .dialog \
        -parent .expandedDialog \
        -textVariable $textVariable \
        -width $width -height 20 \
        -packOption "-expand yes -fill both"

}

proc APSScrolledTextEMailHelp {} {
    return "Usage: APSScrolledTextEMail -textWidget <name> \[-width <number>\] \[-modal 1\]\n"
}

proc APSScrolledTextEMail {args} {
    set textWidget ""
    set width 80
    set modal 0
    APSStrictParseArguments {textWidget width modal}
    set message [join [split [$textWidget get 1.0 end] \}] \)]
    set message [join [split $message \{] \(]
    APSEMailDialog [APSUniqueName .] -message $message \
      -width $width -modal $modal
}

# Variable trace callback procedure
proc APSScrolledStatusUpdate {varName index op} {
    global $varName apsExpandedDialog$varName
    global apsScrolledStatusVar apsScrolledStatusLineLimit apsScrolledStatusLineCount

    set apsExpandedDialog$varName [set $varName]
    set window $apsScrolledStatusVar($varName)

    switch $op {
        w {
            if {[winfo exists $window]} {
                $window.frame.fg.top.text insert end [subst $$varName]\n
                $window.frame.fg.top.text yview moveto 1.0
                incr apsScrolledStatusLineCount($varName) 1
                set tw $window.frame.fg.top.text 
                if {$apsScrolledStatusLineLimit($varName) && \
                      $apsScrolledStatusLineCount($varName)>$apsScrolledStatusLineLimit($varName)} {
                    $window.frame.fg.top.text delete 1.0 2.0
                    incr apsScrolledStatusLineCount($varName) -1
                }
            } else {
                trace vdelete $varName w APSScrolledStatusUpdate
                unset apsScrolledStatusVar($varName)
            }
        }
        u {
            trace vdelete $varName w APSScrolledStatusUpdate
            unset apsScrolledStatusVar($varName)
        }
    }
}

proc APSListSelectDialogCallback {widget item doubleClick} {
    global APSListSelectDialogItemChoice 
    set APSListSelectDialogItemChoice $item
    if {!$doubleClick} return
    destroy $widget
}

proc APSListSelectDialogHelp {} {
    return "Usage: APSListSelectDialog widget \n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-height <string>\]\t\n\[-name <string>\]\t\n\[-itemList <list>\]\t\n\[-contextHelp <string>\]\t\n\n"
}

proc APSListSelectDialog {widget args} {
    set itemList ""
    set name ""
    set parent ""
    set height 15
    set noPack 0
    set packOption "-side top -fill both -expand 1"
    set contextHelp ""
    set selectMode extended
    APSStrictParseArguments {itemList name parent height noPack packOption contextHelp selectMode}

    global APSListSelectDialogItemChoice
    set APSListSelectDialogItemChoice ""

    APSDialogBox $widget -parent $parent -name $name -contextHelp $contextHelp  \
      -noPack $noPack -packOption $packOption
    APSScrolledList .list -parent $parent$widget.userFrame -itemList $itemList \
      -name $name -height $height -noPack 0 -selectMode $selectMode \
      -callback "APSListSelectDialogCallback $parent$widget"
    $parent$widget.buttonRow.ok.button configure \
      -command "destroy $parent$widget" -state normal
    $parent$widget.buttonRow.cancel.button configure \
      -command "set APSListSelectDialogItemChoice {}; destroy $parent$widget"

    tkwait window $parent$widget
    return $APSListSelectDialogItemChoice
}


proc APSChooseItemFromListHelp {} {
    return "Usage: APSChooseItemFromList \n\[-name <string>\]\t\n\[-itemList <list>\]\[-returnList <list>\t\n\[-returnIndices 0\]\t\n\[-multiItem 1\]\[\t\n\[-contextHelp <string>\]\t\n\n"
}

# Similar to APSListSelectDialog, but returns integer index of item.
# Also only allows single item selection and doesn't do a grab.

proc APSChooseItemFromList {args} {
    global apsChooseItemFromListSelection apsChooseItemFromListWidget
    set itemList ""
    set returnList ""
    set returnIndices 1
    set name UntitledChoiceList
    set contextHelp ""
    set multiItem 0
    set height 15
    APSStrictParseArguments {itemList name contextHelp height multiItem \
                               returnList returnIndices }

    set apsChooseItemFromListSelection ""
    set apsChooseItemFromListWidget ""

    set w [APSUniqueName .]
    set apsChooseItemFromListWidget $w
    if {!$multiItem} {
        set selectMode single
    } else {
        set selectMode extended
    }
    APSScrolledListWindow $w -autoAccept 1 -name $name -itemList $itemList \
      -contextHelp $contextHelp -acceptButton 0 -clearButton 1 -height $height \
      -selectionVar apsChooseItemFromListSelection -selectMode $selectMode \
      -selectAllButton $multiItem
    tkwait window $w
    if {[llength $returnList]} {
        set returnValues ""
        foreach item $apsChooseItemFromListSelection {
            lappend returnValues [lindex $returnList \
                                    [lsearch -exact $itemList $item]]
        }
        return $returnValues
    }
    if {$returnIndices} {
        set indexList ""
        foreach item $apsChooseItemFromListSelection {
            lappend indexList [lsearch -exact $itemList $item]
        }
        return $indexList
    }
    return $apsChooseItemFromListSelection
}

