#
# $Log: not supported by cvs2svn $
# Revision 1.40  2008/11/10 19:37:00  soliday
# Modified so that APSLogStart and APSLogFinish do not run logMessage on
# solaris-x86 systems because logMessage does not work on those systems
# yet and causes a log timeout.
#
# Revision 1.39  2008/11/04 17:40:02  soliday
# Moved the de_atexit commands from APSApplication to APSStandardSetup
# because they need to be run before we load the CA package on Linux.
# Linux now runs 'pv exit' when Tcl exits to cleanly close the CA connections.
#
# Revision 1.38  2007/01/18 15:38:38  soliday
# Updated to work with the new domain names.
#
# Revision 1.37  2006/08/10 20:23:31  soliday
# Added the contextHelpImage to display a PNG image for all the basic APS widgets.
#
# Revision 1.36  2005/12/09 20:15:33  soliday
# Removed package require dp command because it is no longer required.
#
# Revision 1.35  2005/08/19 22:53:31  soliday
# Updated to work on systems were the image files may not exist. In this
# case it will simply run as it did before.
#
# Revision 1.34  2005/08/19 22:18:36  soliday
# Added context help for the busy indicator and the stop sign.
#
# Revision 1.33  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.32  2005/08/15 20:22:21  soliday
# Modified the Overview, Version, and Information screens so that the text
# can be copied.
#
# Revision 1.31  2003/12/17 21:27:08  soliday
# Fixed the Restart menu button on Windows.
#
# Revision 1.30  2003/01/23 19:33:26  soliday
# The accelerator subnet changed to accel.ntw0rk
#
# Revision 1.29  2002/05/28 20:55:56  soliday
# The dp_atexit function is now included in our distribution.
#
# Revision 1.28  2001/07/23 17:27:59  soliday
# Added ability to create popup windows for entry boxes where the contents
# exceeded the length of the entry box.
#
# Revision 1.27  2001/02/06 19:44:20  soliday
# Fixed some tcl warning messages found with procheck
#
# Revision 1.26  2000/09/13 23:04:36  soliday
# Added dummy functions if dp is not available.
#
# Revision 1.25  1998/11/18 21:25:57  soliday
# Modified APSMenubar by removeing a exec timeconvert command and replacing
# it with a clock format command.  This improved execution speed.
#
# Revision 1.24  1998/10/28 16:07:20  soliday
# Fixed bug so that if the window manager exits, the dp_atexit still works.
#
# Revision 1.23  1998/03/25 23:18:09  borland
# Information selection under Help entry on menu bar now shows the Tcl/Tk/DP
# version numbers.
#
# Revision 1.22  1997/06/09 18:27:28  borland
# Checks for existence of $apsScriptCommand before trying to find its modification
# time.
#
# Revision 1.21  1997/05/20 15:35:33  borland
# Added use of apsOagwishInstance variable in making informational
# message for application menu.
#
# Revision 1.20  1997/05/03 18:32:48  borland
# Removed some unneeded comments about apsTmpStringCount.
# Added script modification time to information dialog for applications.
#
# Revision 1.19  1996/09/30 21:22:27  saunders
# Changed logMessage command so multi-word info is quoted.
#
# Revision 1.18  1996/09/30 20:56:54  saunders
# Modified APSApplication to log start and finish to logDaemon on
# aps4.anl.gov subnet.
#
# Revision 1.17  1996/09/30 20:05:52  saunders
# Moved APSDebugPath to its own file, otherwise you can't use a debug
# path to pick up private version of APSStandardSetup.
# Also, made new globals apsScriptCommand, apsScriptHost, apsScriptUser,
# and apsScriptDate. Modified code in APSMenubar to use globals.
#
# Revision 1.16  1996/09/03 16:38:06  borland
# Added code to insert the full pathname of the executable into the Restart
# command, so that a locally-existing version that changes directories will
# Restart itself and not another version.
#
# Revision 1.15  1996/07/17 19:08:34  saunders
# Bug fix in APSSetContextHelp.
#
# Revision 1.14  1996/07/17 19:01:44  saunders
# Added APSSetContextHelp procedure.
#
# Revision 1.13  1996/07/05 23:10:15  borland
# Changed Restart item on File menu to invoke command _with_
# arguments.
#
# Revision 1.12  1996/06/10  17:54:54  borland
# Added executable name to information message.
#
# Revision 1.11  1996/06/06  22:01:33  borland
# Moved Restart above Quit on file menu.
#
# Revision 1.10  1996/06/06  22:00:05  borland
# Added Restart entry to file menu.
#
# Revision 1.9  1996/06/06  19:43:10  borland
# Added -width option for APSInfoWindow (overrides automatic method of
# setting window width).  Added Information item to Help menu for APSApplication,
# to give host, OS, start time, and username of any application.
#
# Revision 1.8  1996/02/27  22:55:22  saunders
# Strip $ chars out of given version message.
#
# Revision 1.7  1996/02/14  16:40:07  saunders
# Removed APSMp dummy routines from APSMisc.tcl. This will fix the problem
# with using APSUniqueName from within a machine procedure.
#
# Revision 1.6  1996/01/16  21:19:54  saunders
# Added Log for CVS. Should have done this a long time ago.
#
#


proc APSApplicationHelp {} {
    return "Usage: APSApplication widget \n\[-name <string>\]\t\n\[-version <string>\]\t\n\[-overview <string>\]\t\n\[-contextHelp <string>\]\t\n\[-contextHelpImage <filename>\]\t\n\nCreates\t\$widget.\n\tuserFrame\n\tmenu.file.menu\n\tmenu.help.menu"
}

proc APSApplication {widget args} {
    APSStandardSetup
    global apsContextHelp apsContextHelpImage apsttk apsMenuBackground 

    set name "Untitled"
    set version " Revision: 1.0 Author: unknown"
    set overview "None"
    set contextHelp "No context help available."
    set contextHelpImage ""
    set menuBackground $apsMenuBackground
    APSStrictParseArguments {name version overview contextHelp contextHelpImage menuBackground}
    set apsMenuBackground $menuBackground

    global env
    set name "$name ($env(HOSTNAME))"
    if {[info exists apsttk] && ($apsttk != 0)} {
        set ttkPrefix ttk::
    } else {
        set ttkPrefix ""
    }
    # Log script startup to logDaemon
    APSLogStart
    regsub -all {[$]} $version " " version
    set apsContextHelp(.) $contextHelp
    set apsContextHelpImage(.) $contextHelpImage
    tk useinputmethods 0
    if {$widget == "."} {
	wm title . $name
	APSMenubar menu -parent . -name $name -version $version \
	    -overview $overview -busyWidget 0
	${ttkPrefix}frame .userFrame -width 200 -height 100
	pack .userFrame -side top -fill both -expand 1

	toplevel .infoBalloon -class InfoBalloon \
	    -background black -borderwidth 1 -relief flat
	${ttkPrefix}label .infoBalloon.info -background "\#DDDD22" -foreground black
	pack .infoBalloon.info -side left -fill y
	wm overrideredirect .infoBalloon 1
	wm withdraw .infoBalloon
    } else {
	toplevel $widget
	wm title $widget $name
	APSMenubar .menu -parent $widget -name $name -version $version \
	    -overview $overview
	${ttkPrefix}frame $widget.userFrame -width 200 -height 100
	pack $widget.userFrame -side top -fill both -expand 1
    }
    focus $widget
    after 1000 "APSSyncGeometryWithGrid"
}

proc APSSyncGeometryWithGrid {} {
    global env
    #As far as I know, the geometry needs to only be fixed on KDE.
    #On apparently random occasions, widgets will be hidden
    #because the height and width of the main window are too small.
    
    #On RHEL running KDE I have:
    #XDG_CURRENT_DESKTOP=KDE
    #GDMSESSION=1-kde-plasma-standard
    #DESKTOP_SESSION=1-kde-plasma-standard
    #wmctrl -m | fgrep Name | cut -f 2 -d ":" =  KWin

    #On RHEL running GNOME I have:
    #XDG_CURRENT_DESKTOP=GNOME
    #GDMSESSION=gnome
    #DESKTOP_SESSION=gnome
    #wmctrl -m | fgrep Name | cut -f 2 -d ":" =  GNOME Shell

    set kde 0
    if {[info exists env(XDG_CURRENT_DESKTOP)]} {
        if {$env(XDG_CURRENT_DESKTOP) == "KDE"} {
            set kde 1
        }
    } else {
        if {[catch {exec wmctrl -m | fgrep Name | cut -f 2 -d ":"} results]} {
        } else {
            if {[string trim $results] == "KWin"} {
                set kde 1
            }
        }
    }
    if {$kde} {
        set gridInfo [wm grid .]
        if {[llength $gridInfo]} {
            wm geometry . [lindex $gridInfo 0]x[lindex $gridInfo 1]
        }
    }
}

proc APSMenubarHelp {} {
    return "Usage: APSMenubar widget \n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-name <string>\]\t\n\[-version <string>\]\t\n\[-overview <string>\]\t\n\[-contextHelp <string>\]\t\n\nCreates\t\$parent\$widget.\n\tfile.menu\n\thelp.menu"
}

proc APSMenubar {widget args} {
    global apsMenuForeground apsMenuBackground apsBackground
    global apsContextHelp apsWidgetCursorType apsContextHelpEnable
    global apsContextHelpExcludeList
    global apsScriptCommand apsScriptHost apsScriptUser apsScriptDate apsOagwishInstance
    global tcl_version tk_version
    set parent ""
    set noPack 0
    set packOption "-side top -fill x"
    set name "Untitled"
    set version "1.0"
    set overview "None"
    set contextHelp ""
    set busyWidget 0
    APSStrictParseArguments {parent noPack packOption name version overview \
			 contextHelp busyWidget}

    if {$contextHelp != ""} {
	set apsContextHelp($parent$widget) $contextHelp
    }
    if {$parent == ""} {
        toplevel $widget -relief raised -bd 2 -bg $apsMenuBackground
	wm title $widget $name
    } else {
        if {$apsScriptUser == "soliday"} {
            canvas $parent$widget -relief flat -bd 0 \
              -selectborderwidth 0 -highlightthickness 0 -bg $apsMenuBackground
            APSDrawGradient $parent$widget $apsMenuBackground $apsBackground
        } else {
            frame $parent$widget -relief raised -bd 2 -bg $apsMenuBackground
        }
	if {!$noPack} {
	    eval pack $parent$widget $packOption
	}
    }
    menubutton $parent$widget.file -text File -underline 0 \
      -menu $parent$widget.file.menu  \
      -bg $apsMenuBackground -fg $apsMenuForeground
    menu $parent$widget.file.menu -bg $apsMenuBackground \
      -fg $apsMenuForeground

    global argv0 argv
    global tcl_platform
    if {[string range $tcl_platform(os) 0 6] == "Windows"} {
        $parent$widget.file.menu add command -label Restart -underline 0 -command "exec oagwish \"[file normalize $argv0]\" $argv &; exit"
    } else {
        $parent$widget.file.menu add command -label Restart -underline 0 -command "exec $argv0 $argv &; exit"
    }
    $parent$widget.file.menu add command -label Quit -underline 0 -command exit
    pack $parent$widget.file -side left

    menubutton $parent$widget.help -text Help -underline 0 \
      -menu $parent$widget.help.menu \
      -bg $apsMenuBackground -fg $apsMenuForeground
    menu $parent$widget.help.menu -bg $apsMenuBackground \
      -fg $apsMenuForeground 

    $parent$widget.help.menu add command -label Overview -underline 0 -command\
      [list APSInfoWindow $parent$widget.overview -name Overview -copyable 1 \
	 -infoMessage $overview]
    $parent$widget.help.menu add command -label Version -underline 0 -command \
      [list APSInfoWindow $parent$widget.version -name Version -copyable 1 \
	 -infoMessage $version]

    set scriptFile [lindex [split $apsScriptCommand] 0]
    if {![file exists $scriptFile]} {
        set modTime ?
    } else {
	set modTime [clock format [file mtime $scriptFile] -format "%a %b %d %T %Y"]
    }

    lappend labelList "Host: $apsScriptHost" "Started: $apsScriptDate" "Account: $apsScriptUser" "Exec: $apsScriptCommand" "Modified: $modTime" "Interpreter: $apsOagwishInstance" "Tcl/Tk versions: $tcl_version/$tk_version" "Start dir: [pwd]"
    set width [expr {[APSMaxStringLength $labelList]+1}]
    $parent$widget.help.menu add command -label Information -underline 0 -command \
      [list APSInfoWindow $parent$widget.information -name Information -copyable 1 \
         -infoMessage "[join $labelList \n]" -width $width ]

    set apsContextHelpExcludeList \
      [lappend apsContextHelpExcludeList $parent$widget.help]
    bind contextHelpTag <Button-1> { 
	APSInfoWindow .contextHelp -name "Context Help" \
	  -infoMessage [APSNearestContextHelp %W] 
	break 
    }
    # Make <Btn-3> be help in all windows
    bind all <Double-Button-3> { 
	APSInfoWindow .contextHelp -name "Context Help" \
	  -infoMessage [APSNearestContextHelp %W] -infoImage [APSNearestContextHelpImage %W]
    }
    bind all <KeyPress-Help> {
	if {$apsContextHelpEnable == 0} {
	    set apsContextHelpEnable 1
	} else {
	    set apsContextHelpEnable 0
	}
	if {$apsContextHelpEnable} { 
	    APSPushHeadBindList . contextHelpTag
	    foreach x [APSListAllWidgets .] {
		set apsWidgetCursorType($x) \
		  [lindex [$x configure -cursor] end] 
		$x configure -cursor question_arrow 
	    } 
	} else { 
	    APSPopHeadBindList .
	    foreach x [APSListAllWidgets .] {
		if {[info exists apsWidgetCursorType($x)]} {
		    $x configure -cursor $apsWidgetCursorType($x) 
		}
	    }
	    if {[winfo exists .contextHelp]} {
		destroy .contextHelp
	    }
	} 
    }
    $parent$widget.help.menu add check -label "Context Help" \
      -variable apsContextHelpEnable -command {
	  if {$apsContextHelpEnable} { 
	      APSPushHeadBindList . contextHelpTag
	      foreach x [APSListAllWidgets .] {
		  set apsWidgetCursorType($x) \
		    [lindex [$x configure -cursor] end] 
	      } 
	      foreach x [APSListAllWidgets .] {
		  $x configure -cursor question_arrow 
	      } 
	  } else { 
	      APSPopHeadBindList .
	      foreach x [APSListAllWidgets .] {
		  if {[info exists apsWidgetCursorType($x)]} {
		      $x configure -cursor $apsWidgetCursorType($x) 
		  }
	      } 
	      if {[winfo exists .contextHelp]} {
		  destroy .contextHelp
	      }
	  } 
      }
    pack $parent$widget.help -side right

    if {$busyWidget} {
        global env
        if {[catch {
            image create photo stopsign -file /usr/local/oag/apps/lib/$env(HOST_ARCH)/stopsign.ppm
            image create photo working -file /usr/local/oag/apps/lib/$env(HOST_ARCH)/working.ppm
            image create photo nostopsign -file /usr/local/oag/apps/lib/$env(HOST_ARCH)/nostopsign.ppm
            for {set i 1} {$i <= 4} {incr i} {
                image create photo working$i -file /usr/local/oag/apps/lib/$env(HOST_ARCH)/working${i}.ppm
            }
        } result]} {
            #Cannot find images
        } else {
            label .menu.working -image working -bd 0 -padx 0 -pady 0 -highlightthickness 0
            pack .menu.working -side right -padx 0 -pady 0
            button .menu.stop -image nostopsign -bd 0 -padx 0 -pady 0 -highlightthickness 0
            pack .menu.stop -side right -padx 4 -pady 0
        }
        set apsContextHelp(.menu.working) "This is a busy indicator that is used to indicate to the user that the program has not locked up."
        set apsContextHelp(.menu.stop) "This is a button that appears as a stop sign when the user is allowed to kill a hung program and attempt to free up the user interface."

    }

    focus $parent$widget
}

proc APSDrawGradient {win col1Str col2Str} {
    if {[winfo class $win] != "Canvas"} {
        return -code error "$win must be a canvas widget"
    }

    $win delete gradient

    set width  [winfo width $win]
    set height [winfo height $win]
    set leftOffset 50
    set rightOffset 50
    if {$width < 30} {
        set centerArea 0
    } else {
        set centerArea [expr ($width - $leftOffset - $rightOffset ) / 4]
    }
    set width  [expr ($width - $leftOffset - $centerArea - $rightOffset) / 2]
    set max $width

    if {[catch {winfo rgb $win $col1Str} color1]} {
        return -code error "Invalid color $col1Str"
    }

    if {[catch {winfo rgb $win $col2Str} color2]} {
        return -code error "Invalid color $col2Str"
    }

    foreach {r1 g1 b1} $color1 break
    foreach {r2 g2 b2} $color2 break
    set rRange [expr $r2.0 - $r1]
    set gRange [expr $g2.0 - $g1]
    set bRange [expr $b2.0 - $b1]

    set rRatio [expr $rRange / $max]
    set gRatio [expr $gRange / $max]
    set bRatio [expr $bRange / $max]

    set j $leftOffset
    for {set i 0} {$i < $max} {incr i} {
        set nR [expr int( $r1 + ($rRatio * $i) )]
        set nG [expr int( $g1 + ($gRatio * $i) )]
        set nB [expr int( $b1 + ($bRatio * $i) )]

        set col [format {%4.4x} $nR]
        append col [format {%4.4x} $nG]
        append col [format {%4.4x} $nB]
        $win create line $j 0 $j $height -tags gradient -fill \#${col}
        incr j
    }
    for {set i 0} {$i < $centerArea} {incr i} {
        $win create line $j 0 $j $height -tags gradient -fill $col2Str
        incr j
    }

    for {set i 0} {$i < $max} {incr i} {
        set ii [expr $max - $i]
        set nR [expr int( $r1 + ($rRatio * $ii) )]
        set nG [expr int( $g1 + ($gRatio * $ii) )]
        set nB [expr int( $b1 + ($bRatio * $ii) )]

        set col [format {%4.4x} $nR]
        append col [format {%4.4x} $nG]
        append col [format {%4.4x} $nB]
        $win create line $j 0 $j $height -tags gradient -fill \#${col}
        incr j
    }
    bind $win <Configure> [list APSDrawGradient $win $col1Str $col2Str]
    return $win
}

proc APSMenubarAddMenuHelp {} {
    return "Usage: APSMenubarAddMenu widget \n\[-parent <string>\]\t\n\[-text <string>\]\t\n\[-packOption <list>\]\t\n\[-underline 1\]\t\n\[-contextHelp <string>\]\t\n\nCreates\t\$parent\$widget.\n\tmenu"
}

proc APSMenubarAddMenu {widget args} {
    global apsMenuForeground apsMenuBackground apsContextHelp
    set parent ""
    set packOption "-side left"
    set text "noentry"
    set underline 0
    set contextHelp ""
    APSStrictParseArguments {parent text underline packOption contextHelp}

    if {$contextHelp != ""} {
	set apsContextHelp($parent$widget) $contextHelp
    }
    menubutton $parent$widget -text $text -underline $underline \
      -menu $parent$widget.menu  \
      -bg $apsMenuBackground -fg $apsMenuForeground
    menu $parent$widget.menu -bg $apsMenuBackground \
      -fg $apsMenuForeground 
    eval pack $parent$widget $packOption

}

proc APSListAllWidgets {root} {
    set list {}
    set childlist [winfo children $root]
    foreach x $childlist {
	set list [concat $list [APSListAllWidgets $x]]
    }
    return [concat $root $list]
}

proc APSPushHeadBindList {widget tag} {
    global apsContextHelpExcludeList
    set childList [winfo children $widget]
    foreach x $childList {
	if {[lsearch -exact $apsContextHelpExcludeList $x] == -1} {
	    bindtags $x "$tag [bindtags $x]"
	    APSPushHeadBindList $x $tag
	}
    }
}

proc APSPopHeadBindList {widget} {
    global apsContextHelpExcludeList
    set childList [winfo children $widget]
    foreach x $childList {
	if {[lsearch -exact $apsContextHelpExcludeList $x] == -1} {
	    bindtags $x [lrange [bindtags $x] 1 end]
	    APSPopHeadBindList $x
	}
    }
}

proc APSNearestContextHelp {widget} {
    global apsContextHelp

    while {$widget != "" &&
	   ![info exists apsContextHelp($widget)]} {
	set splitWidget [split $widget .]
	set widget [join [lrange $splitWidget 0 \
			      [expr {[llength $splitWidget]-2}]] .]
    }
    if {$widget != ""} {
	return $apsContextHelp($widget)
    } elseif {[info exists apsContextHelp(.)]} {
	return $apsContextHelp(.)
    } else {
	return ""
    }
}

proc APSNearestContextHelpImage {widget} {
    global apsContextHelpImage

    while {$widget != "" &&
	   ![info exists apsContextHelpImage($widget)]} {
	set splitWidget [split $widget .]
	set widget [join [lrange $splitWidget 0 \
			      [expr {[llength $splitWidget]-2}]] .]
    }
    if {$widget != ""} {
	return $apsContextHelpImage($widget)
    } elseif {[info exists apsContextHelpImage(.)]} {
	return $apsContextHelpImage(.)
    } else {
	return ""
    }
}

proc APSSetContextHelpHelp {} {
     return "Usage: APSSetContextHelp widget \n\[-contextHelp <string>\]\t\n\nSets or resets context help string for given widget."

}
proc APSSetContextHelp {widget args} {
    global apsContextHelp
    set contextHelp ""

    APSStrictParseArguments {contextHelp}

    set apsContextHelp(${widget}) $contextHelp
}

# Standard APS application exit callback
proc APSExit {} {
    APSLogFinish
}

proc APSLogStart {} {
    global apsScriptCommand apsScriptHost apsScriptUser apsNetworkDomain tcl_platform

    if {(![string compare $apsNetworkDomain "accel.ntw0rk"]) || (![string compare $apsNetworkDomain "aps4.anl.gov"])} {
	if {($tcl_platform(os) == "SunOS") && ($tcl_platform(machine) == "i86pc")} {return}
	set logCmd "logMessage -sourceId=appExecAudit -tag=applicationName $apsScriptCommand -tag=user $apsScriptUser -tag=host \"$apsScriptHost\" -tag=action Start"
	catch {eval exec $logCmd &}
    }
}

proc APSLogFinish {} {
    global apsScriptCommand apsScriptHost apsScriptUser apsNetworkDomain tcl_platform

    if {(![string compare $apsNetworkDomain "accel.ntw0rk"]) || (![string compare $apsNetworkDomain "aps4.anl.gov"])} {
	if {($tcl_platform(os) == "SunOS") && ($tcl_platform(machine) == "i86pc")} {return}
	set logCmd "logMessage -sourceId=appExecAudit -tag=applicationName $apsScriptCommand -tag=user $apsScriptUser -tag=host \"$apsScriptHost\" -tag=action Finish"
	catch {eval exec $logCmd &}
    }
}

