#
# $Log: not supported by cvs2svn $
# Revision 1.8  2006/04/04 18:46:31  shang
# customized the alert tone which now is different for sr, linac, booster, par and default
# type applications and made it optional to announce the workstation name.
#
# Revision 1.7  2006/03/10 21:49:05  shang
# added beep and type arguments to APSMultipleChoice to be able to change the frame sub-title color and have beep feature; added "silent" button if "continuous" beep is requested.
#
# Revision 1.6  2001/02/06 19:44:23  soliday
# Fixed some tcl warning messages found with procheck
#
# Revision 1.5  1997/05/28 21:53:29  borland
# Removed focus and grab from APSMultipleChoice.  They aren't necessary
# and can cause problems when another app has the grab.
#
# Revision 1.4  1996/10/10 21:14:32  borland
# Added APSQueryToProceed procedure.
#
# Revision 1.3  1996/08/23 15:54:15  borland
# No longer appending a question mark to the end of the question that is
# passed.
#
# Revision 1.2  1996/03/22  20:31:57  borland
# Removed debugging statements.
#
# Revision 1.1  1996/03/22  20:15:38  borland
# First version.
#
#

proc APSQueryToProceedHelp {} {
    return "Usage: APSQueryToProceed -message <string>\n\
Returns 1 if the user elects to proceed, otherwise returns 0."
}

proc APSQueryToProceed {args} {
    set message "What do you want to do?"
    APSStrictParseArguments {message}

    return [APSMultipleChoice [APSUniqueName .] -question \
              $message -name "Proceed/Abort Dialog" \
              -labelList {Proceed Abort} -returnList {1 0} \
              -contextHelp \
              "Choose whether to proceed with the next step or abort." \
            ]
}

proc APSMultipleChoiceHelp {} {
    return "Usage: APSMultipleChoice widget \n-question <string>\t\n-labelList <list>\t\n-returnList <list>\t\n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-name <string\]\t\n\[-announceWorkstation <0|1>\]\t\n\[-toneType <default|sr|linac|booster|par>\]\t\n\[-contextHelp <string>\]\n\nCreates\t\$parent\$widget.\n\tmsg\n\tbuttonRow.*.button\nReturns a string value"
}

proc APSMultipleChoice {widget args} {
    global apsContextHelp apsMultipleChoiceValue apsttk
    set parent ""
    set noPack 0
    set packOption "-side top -fill x"
    set name "UntitledChoice"
    set question "Undefined question"
    set contextHelp ""
    set width 20
    set returnList {}
    set labelList {}
    set beep no
    set type ""
    set announceWorkstation 0
    set toneType default
    set imageFile ""
    set modal 0
    APSParseArguments {parent noPack packOption name contextHelp width \
                     question labelList returnList type beep announceWorkstation toneType imageFile modal}
    append name " [clock format [clock seconds] -format {%H:%M:%S}]"

    if {[info exists apsttk] && ($apsttk != 0)} {
        set ttkPrefix ttk::
    } else {
        set ttkPrefix ""
    }
    if {$contextHelp != ""} {
        set apsContextHelp($parent$widget) $contextHelp
    }
    set color grey
    if [string length $type] {
        switch [string tolower $type] {
            error {
                set color red
            }
            warning {
                set color yellow
            }
            done {
                set color green
            }
        }
    }
    
    set windowExists [winfo exists $parent$widget]
    if {$parent == ""} {
        if {$windowExists} {
            raise $widget  
        } else {
            toplevel $widget 
            wm title $widget $name
        }
    } else {
        ${ttkPrefix}frame $parent$widget
        if {!$noPack} {
            eval pack $parent$widget $packOption
        }
    }
    
    if {$windowExists} {
        destroy $parent$widget
    }
    if {[string length $imageFile] && [file exist $imageFile]} {
        ${ttkPrefix}label $parent$widget.image -relief ridge -image [image create photo -file $imageFile]
        pack $parent$widget.image -side top -fill x
    }
    
    message $parent$widget.msg -relief raised -justify center -bd 2 \
      -text "[string range $question 0 2000]\n                            "
    pack $parent$widget.msg -side top -fill both -expand 1

    
    if [string length $type] {
        label $parent$widget.label -relief ridge -text $type -bg $color -fg black -width $width
        pack $parent$widget.label -side top -fill x
    }
    ${ttkPrefix}frame $parent$widget.buttonRow -relief raised -borderwidth 2
    pack $parent$widget.buttonRow -side bottom -fill x

    set length [llength $returnList]
    if {[llength $labelList]<$length} {
        set length [llength $labelList]
    }
    
    if {!$length} {
        return -code error -errorinfo "No items supplied" ""
    }
    set beep [string tolower $beep]
    
    for {set i 0} {$i<$length} {incr i} {
        set labelValue [lindex $labelList $i]
        set returnValue [lindex $returnList $i]
        APSButton .button$i -parent $parent$widget.buttonRow -text "$labelValue" \
            -command "set apsMultipleChoiceValue $returnValue" -width ""
    }
    if {$beep!="no"} {
        global apsAlertStopBeep
        set apsAlertStopBeep($parent$widget) 0
        set apsAlertStopBeep($parent$widget.count) 0
        if {$beep=="continuous"} {
            set stopBeep "global apsAlertStopBeep; set apsAlertStopBeep($parent$widget) 1"
            APSButton .silent -parent $parent$widget.buttonRow -text "Silent" \
                -command $stopBeep -size small -packOption "-side right" -width ""
        }
        APSAlertBeep -beep $beep -widget $parent$widget \
            -announceWorkstation $announceWorkstation -toneType $toneType
        update
    }
    if {$modal == 1} {
        update idletasks
        catch {exec wmctrl -R $name -t -1}
    }
    tkwait variable apsMultipleChoiceValue
    destroy $parent$widget
    return $apsMultipleChoiceValue
}
