#
# $Log: not supported by cvs2svn $
# Revision 1.51  2009/09/17 15:42:00  soliday
# Now checks if the dots-per-inch is set in the .Xdefaults file. If
# Xft.dpi is set then we don't need to rescale the fonts.
#
# Revision 1.50  2009/09/16 21:28:23  soliday
# The 22inch Sun monitors are not being detected with the correct dots-per-inch.
# The causes super small fonts in Tcl/Tk programs. I have added code that will
# check for the bad DPI values and use a much bigger font to compensate.
#
# Revision 1.49  2009/09/02 16:24:27  soliday
# Updated the default fonts because of differences with Tcl/Tk 8.5. The
# fonts are as close to what we had in Tcl/Tk 8.4 as I could make them.
#
# Revision 1.48  2008/12/03 21:13:22  soliday
# Updated to use dnsdomainname on Linux.
#
# Revision 1.47  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.46  2007/02/07 19:30:26  soliday
# Added a procedure to redefine the puts command so that puts to stdout
# and stderr are put inside a catch command. This was needed on some
# Solaris computers so that programs started from the background menu
# can still write to stdout and stderr without locking up.
#
# Revision 1.45  2006/06/20 16:15:19  soliday
# Added support for OS X clients at APS.
#
# Revision 1.44  2006/01/06 17:01:16  soliday
# Since the upgrade to the Solaris operating system the Tcl command
# "info hostname" is causing some scripts to exit with a segmentation fault.
# This command has been replaced with "exec hostname"
#
# Revision 1.43  2004/01/15 18:17:53  borland
# Added APSSetOAGGlobal procedure. It is called by APSStandardSetup and is
# used to set global parameters like main directory names.
#
# Revision 1.42  2003/12/17 06:18:43  soliday
# Modified to work even if the enviornment variable USER is not set.
#
# Revision 1.41  2003/10/22 13:46:53  borland
# Removed call to APSSCRDefineVariables from APSStandardSetup.
# This call is now executed whenever SCRprocedures.tcl is loaded.
# Modified APSSCRDefineVariables (in SiteSpecificSCR.tcl) so that
# it doesn't do anything except on the first call.
#
# Revision 1.40  2003/10/22 03:13:49  soliday
# The APSStandardSetup routine now calls APSSCRDefineVariables to
# initialize important SCR related variables.
#
# Revision 1.39  2003/09/03 15:42:15  soliday
# Added the package require lines for ca, os, and sdds.
#
# Revision 1.38  2002/10/03 16:19:09  soliday
# Changed to work with tcl version 8.4.0
#
# Revision 1.37  2002/02/20 15:45:20  soliday
# Added missing global apsScaleUpSize
#
# Revision 1.36  2001/07/23 17:28:00  soliday
# Added ability to create popup windows for entry boxes where the contents
# exceeded the length of the entry box.
#
# Revision 1.35  2001/02/06 19:44:24  soliday
# Fixed some tcl warning messages found with procheck
#
# Revision 1.34  2000/09/14 20:47:39  soliday
# Modified apsSoundPath so that it will work on Linux.
#
# Revision 1.33  1999/12/10 18:27:39  emery
# Indented code.
#
# Revision 1.32  1998/11/19 22:46:44  soliday
# Added all the bindings that are removed when tk_strictMofif is set to 1.
#
# Revision 1.31  1998/11/18 20:37:14  soliday
# Removed 4 exec statements and replaced them with internal tcl commands.
# Removed many global commands and replaced them with one global command.
# This resulted in a speed increase from 1.04 seconds to .13 seconds.
#
# Revision 1.30  1997/05/20 15:36:08  borland
# Added setting of global variable apsOagwishInstance to indicate which
# version of oagwish is in use.
#
# Revision 1.29  1997/05/03 18:32:49  borland
# Removed some unneeded comments about apsTmpStringCount.
# Added script modification time to information dialog for applications.
#
# Revision 1.28  1997/03/06 14:55:31  borland
# apsScaleUpSize may now have negative values (-1,-2,-3,-4) to reduce font size.
#
# Revision 1.27  1996/11/15 19:34:59  saunders
# Added some missing Help routines. Moved definition of apsTempFileList
# to APSStandardSetup. Added new APSFreezeVars and APSUnfreezeVars.
#
# Revision 1.26  1996/11/12 19:39:58  saunders
# Implemented scaling up application sizes using a global variable
# apsScaleUpSize in a user's .oagwishrc file.
#
# Revision 1.25  1996/10/17 21:22:06  saunders
# Changed apsScriptHost from uname -snr to just uname -n to accomodate
# logging better.
#
# Revision 1.24  1996/10/10 20:52:05  saunders
# Added Tcl equivalent of APS Run Control C library.
#
# Revision 1.23  1996/09/30 20:56:56  saunders
# Modified APSApplication to log start and finish to logDaemon on
# aps4.anl.gov subnet.
#
# Revision 1.22  1996/09/30 20:05:49  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.21  1996/09/30 15:51:58  evans
# Fixed it to reread the tclIndex when the auto_path is changed (by deleting
# the existing auto_path).
#
# Revision 1.20  1996/03/26  19:23:41  evans
# Modified APSDebugPathHelp.
#
# Revision 1.19  1996/03/26  19:19:16  evans
# Renamed APSPathConfig to APSDebugPath.
#
# Revision 1.18  1996/03/26  18:57:49  evans
# Took setting of default paths out of APSPathConfig.
#
# Revision 1.17  1996/03/26  00:06:51  evans
# Modified APSPathConfigHelp.
#
# Revision 1.16  1996/03/26  00:01:54  evans
# Modified APSPathConfigHelp.
#
# Revision 1.15  1996/03/25  23:57:20  evans
# Modified APSPathConfigHelp.
#
# Revision 1.14  1996/03/25  23:53:54  evans
# Modified APSPathConfigHelp.
#
# Revision 1.13  1996/03/25  23:31:51  evans
# Added APSPathConfig.  Fixed APSFileSelectDialogHelp.
#
# Revision 1.12  1996/02/09  23:42:23  saunders
# Added apsMap global.
#
# Revision 1.11  1996/02/09  17:12:14  saunders
# Additions to support APSMenuFrame procedure.
#
# Revision 1.10  1996/01/16  21:20:21  saunders
# Added Log for CVS. Should have done this a long time ago.
#
#

proc APSStandardSetupHelp {} {
    return "Usage: APSStandardSetup \nInitializes a number of global variables and tcl/tk options.\n"
}

proc APSStandardSetup {} {
    global argv0 argv apsSetupInitialized apsBackground apsForeground apsEntryBackground apsMenuForeground apsMenuBackground tcl_precision apsContextHelp apsContextHelpEnable apsContextHelpExcludeList apsWidgetCursorType apsSoundPath apsUniqueNumber apsUniqueName apsTmpStringCount apsScrolledStatusVar apsMenuFrame apsMap apsScriptHost apsScriptCommand apsScriptDate apsScriptUser apsOagwishInstance apsNetworkDomain apsRunControlInitialized apsTempFileList apsFreezeVars env apsInfoBalloon apsScaleUpSize tcl_platform apsUpgrade

    if {[info exists apsSetupInitialized]} {
        return
    } else {
        APSSetOAGGlobal
        set apsSetupInitialized 1
        set apsContextHelp(init) "Test Context Help Message"
        set apsContextHelpEnable 0
        set apsContextHelpExcludeList {}
        set apsWidgetCursorType(init) "Test Cursor Type"
	if {[file exists /usr/local/oag/apps/lib/sun4]} {
	    set apsSoundPath /usr/local/oag/apps/lib/sun4
	} elseif {[file exists /usr/local/oag/apps/lib/solaris]} {
	    set apsSoundPath /usr/local/oag/apps/lib/solaris
	} elseif {[file exists /usr/local/oag/apps/lib/Linux]} {
	    set apsSoundPath /usr/local/oag/apps/lib/Linux
	} else {
	   set apsSoundPath .
	}
        set apsScrolledStatusVar(init) "init"
        set apsMenuFrame(init) "init"
        set apsMap(init) "init"
        set apsUniqueNumber 0
        set apsTmpStringCount 0
        set apsBackground Gray85
        set apsForeground Black
        set apsEntryBackground White
        set apsMenuBackground \#597EE1
	if {$tcl_platform(os) == "Darwin"} {
	    set apsMenuForeground Black
	} else {
	    set apsMenuForeground White
	}
        set apsScriptHost [exec hostname]
        set apsOagwishInstance [info nameofexecutable]
        set apsUpgrade 1
	if {![info exists env(USER)]} {
	    set env(USER) "unknown"
	}
	set apsScriptUser $env(USER)
        if {$apsScriptUser == "soliday"} {
            #set apsBackground \#ededed
            set apsBackground Gray85
        }
        set apsScriptDate [clock format [clock seconds] -format "%a %b %d %T %Z %Y"]
	if {$tcl_platform(os) == "Linux"} {
	    if {[catch {exec dnsdomainname} apsNetworkDomain]} {set apsNetworkDomain ?}
	} else {
	    if {[catch {exec domainname} apsNetworkDomain]} {set apsNetworkDomain ?}
	}

        if {[string compare [file dirname $argv0] "."]==0 || \
              [string length [file dirname $argv0]]==0} {
            set apsScriptCommand [pwd]/[file tail $argv0]
        } else {
            set apsScriptCommand $argv0
        }
        set apsRunControlInitialized 0
        set apsTempFileList ""
        set apsFreezeVars(xxxinit) -1
	set apsInfoBalloon(active) 1
	if {($tcl_platform(os) == "Darwin")} {
            if {($tcl_platform(machine) == "i386")} {
                if {[file exists /usr/local/oag/ActiveTcl/darwin-x86/Library/Tcl]} {
                    global tcl_pkgPath
                    lappend tcl_pkgPath "/usr/local/oag/ActiveTcl/darwin-x86/Library/Tcl"
                    proc sourcePath {file} {
                        foreach i $::auto_path {
                            set init [file join $i $file.tcl]
                            if {[catch {uplevel \#0 [list source $init]}] == 0} {
                                return
                            }
                        }
                        if {[catch {uplevel \#0 [list source -rsrc $file]}] == 0} {
                            return
                        }
                        rename sourcePath {}
                        set msg "Can't find $file resource or a usable $file.tcl file"
                        append msg " in the following directories:"
                        append msg " $::auto_path"
                        append msg " perhaps you need to install Tcl or set your"
                        append msg " TCL_LIBRARY environment variable?"
                        error $msg
                    }
                    sourcePath init
                    sourcePath auto
                    sourcePath package
                    sourcePath history
                    sourcePath word
                    sourcePath parray
                    rename sourcePath {}
                }
            } else {
                if {[file exists /usr/local/oag/ActiveTcl/darwin-ppc/Library/Tcl]} {
                    global tcl_pkgPath
                    lappend tcl_pkgPath "/usr/local/oag/ActiveTcl/darwin-ppc/Library/Tcl"
                    proc sourcePath {file} {
                        foreach i $::auto_path {
                            set init [file join $i $file.tcl]
                            if {[catch {uplevel \#0 [list source $init]}] == 0} {
                                return
                            }
                        }
                        if {[catch {uplevel \#0 [list source -rsrc $file]}] == 0} {
                            return
                        }
                        rename sourcePath {}
                        set msg "Can't find $file resource or a usable $file.tcl file"
                        append msg " in the following directories:"
                        append msg " $::auto_path"
                        append msg " perhaps you need to install Tcl or set your"
                        append msg " TCL_LIBRARY environment variable?"
                        error $msg
                    }
                    sourcePath init
                    sourcePath auto
                    sourcePath package
                    sourcePath history
                    sourcePath word
                    sourcePath parray
                    rename sourcePath {}
                }
            }
        }

        # Establish the interpreter "exit" callback
        global atExitList tcl_pkgPath
        dp_atexit set atExitList
        dp_atexit append APSExit

        if {[info exists tcl_pkgPath]} {
            #Loading these three packages directly without using the package require command
            #speeds things up
            set caLib [file join [lindex $tcl_pkgPath 0] ca libtclCa.so]
            if {($tcl_platform(os) == "Linux") && [file exists $caLib]} {
                if {[catch {load $caLib} results]} {
                    puts "Warning: $results"
                } else {
                    dp_atexit append "catch {pv exit}"
                }
            } else {
                if {[catch {package require ca} results]} {
                }
            }
            set osLib [file join [lindex $tcl_pkgPath 0] os libtclOS.so]
            if {($tcl_platform(os) == "Linux") && [file exists $osLib]} {
                load $osLib
            } else {
                if {[catch {package require os} results]} {
                }
            }
            set sddsLib [file join [lindex $tcl_pkgPath 0] sdds libtclSDDS.so]
            if {($tcl_platform(os) == "Linux") && [file exists $sddsLib]} {
                load $sddsLib
            } else {
                if {[catch {package require sdds} results]} {
                }
            }
        } else {
            if {[catch {package require ca} results]} {
            }
            if {[catch {package require os} results]} {
            }
            if {[catch {package require sdds} results]} {
            }
        }

        # Do this only if started by interpreter with Tk
        if {[info command frame] != ""} {
            wm protocol . WM_DELETE_WINDOW {exit}
            if {[info exists apsScaleUpSize]} {
                set apsScaleUpSizeTmp $apsScaleUpSize
            }
            if {[file exists "~/.oagwishrc"]} {
                source "~/.oagwishrc"
            }
            if {![info exists apsScaleUpSize]} {
                set apsScaleUpSize 0
            }
            if {[info exists apsScaleUpSizeTmp]} {
                set apsScaleUpSize $apsScaleUpSizeTmp
            }
	    set defaultFonts 1
	    if {($tcl_platform(os) == "SunOS") || ($tcl_platform(os) == "Linux")} {
		#The 22inch monitors get the wrong DPI so the 
		#default fonts have to change.
		if {[catch {exec xdpyinfo | fgrep resolution} results]} {
		} else {
		    if {[lindex $results 1] == "43x39"} {
			#Now check to see if the DPI is set in the .Xdefaults file
			if {[catch {exec xrdb -query | fgrep dpi} results]} {
			    set defaultFonts 0
			}
		    }
		}
	    }
	    if {$defaultFonts} {
		switch -- $apsScaleUpSize {
		    -4 { font create OAGFont -family "Courier" -size 6}
		    -3 { font create OAGFont -family "Courier" -size 7}
		    -2 { font create OAGFont -family "Courier" -size 8}
		    -1 { font create OAGFont -family "Courier" -size 10}
		    0 { font create OAGFont -family "Courier" -size 11}
		    1 { font create OAGFont -family "Courier" -size 14 -weight bold}
		    2 { font create OAGFont -family "Courier" -size 16 -weight bold}
		    3 { font create OAGFont -family "Courier" -size 18 -weight bold}
		    4 { font create OAGFont -family "Courier" -size 24 -weight bold}
		}
	    } else {
		switch -- $apsScaleUpSize {
		    -4 { font create OAGFont -family "Courier" -size 13}
		    -3 { font create OAGFont -family "Courier" -size 15}
		    -2 { font create OAGFont -family "Courier" -size 18}
		    -1 { font create OAGFont -family "Courier" -size 22}
		    0 { font create OAGFont -family "Courier" -size 24}
		    1 { font create OAGFont -family "Courier" -size 31 -weight bold}
		    2 { font create OAGFont -family "Courier" -size 35 -weight bold}
		    3 { font create OAGFont -family "Courier" -size 40 -weight bold}
		    4 { font create OAGFont -family "Courier" -size 53 -weight bold}
		}
	    }
            global apsttk
            if {[info exists apsttk] && ($apsttk != 0) && ($apsScaleUpSize == 0)} {
                #On HI-DPI screens there can be odd scaling that can result in tiny fonts.
                #This enforces a minimum font size.
                if {[font actual TkDefaultFont -size] < 9} {
                    font configure TkDefaultFont -size 9
                    font configure TkTextFont -size 9
                    font configure TkFixedFont -size 9
                    font configure TkMenuFont -size 9
                    font configure TkHeadingFont -size 9
                    font configure TkCaptionFont -size 11
                    font configure TkSmallCaptionFont -size 8
                    font configure TkIconFont -size 9
                    font configure TkTooltipFont -size 9
                }
            } else {
                set apsttk 0
                option add *font OAGFont
                
                #  Nice looking, but not fixed width
                #	option add *font -Adobe-Helvetica-Medium-R-Normal--*-120-*
                option add *background $apsBackground
                option add *foreground $apsForeground
                option add *Entry.background $apsEntryBackground
                
                option add *InfoBalloon*background white widgetDefault
                option add *InfoBalloon*foreground black widgetDefault
                option add *InfoBalloon.info.wrapLength 3i widgetDefault
                option add *InfoBalloon.info.justify left widgetDefault
                option add *InfoBalloon.info.font \
                  -*-lucida-medium-r-normal-sans-*-120-* widgetDefault
            }
        }
        set tcl_precision 17
	redef_puts
    }
}

if {[llength [info commands bell]] == 1} {
    rename bell belloriginal
}
proc bell {args} {
    global apsSoundPath tcl_platform
    if {$tcl_platform(os) == "SunOS"} {
        if {[llength [info commands belloriginal]] == 1} {
            belloriginal
        } else {
            #audioplay cannot play .oga files.
            #catch "exec audioplay -i -v 50 $apsSoundPath/bell.oga &"
        }
    } else {
        catch "exec play -q -v 1.0 $apsSoundPath/bell.oga &"
    }
}

#This is needed on some Solaris computers so that programs started from the
#background menu can still write to stdout and stderr without locking up.
proc redef_puts {} {
    if ![llength [info command ::tcl::puts]] {
        rename puts ::tcl::puts
        proc puts args {
            set la [llength $args]
            if {$la<1 || $la>3} {
                error "usage: puts ?-nonewline? ?channel? string"
            }
            set nl \n
            if {[lindex $args 0]=="-nonewline"} {
                set nl ""
                set args [lrange $args 1 end]
            }
            if {[llength $args]==1} {
                set args [list stdout [join $args]] ;
            }
            foreach {channel s} $args break
            if {$channel=="stdout" || $channel=="stderr"} {
                set cmd ::tcl::puts
                if {$nl==""} {lappend cmd -nonewline}
                lappend cmd $channel $s
                # We do not want to report errors writing to
                # stdout
                catch {eval $cmd}

            } else {
                set cmd ::tcl::puts
                if {$nl==""} {lappend cmd -nonewline}
                lappend cmd $channel $s
                eval $cmd
            }
        }
    }
}
