home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / SystemCode / CorePackages / appPaths.tcl < prev    next >
Encoding:
Text File  |  1999-01-28  |  9.7 KB  |  344 lines  |  [TEXT/ALFA]
  1.  
  2. namespace eval app {}
  3.  
  4. proc app::ensureRunning {sig {in_front 0}} {
  5.     # See if a process w/ any of the acceptable 
  6.     # sigs already running.
  7.     if {[app::isRunning $sig name]} {
  8.         if {$in_front} {switchTo '$sig'}
  9.         return $name
  10.     }
  11.     if {[catch {nameFromAppl $sig} name]} {
  12.         alertnote "Can't find app w/ sig '$sig'.\
  13.           Try rebuilding your desktop or changing your helper apps."
  14.         error ""
  15.     }
  16.     if {![file exists $name]} {
  17.         alertnote "Sig '$sig' is mapped to '$name', which doesn't\
  18.           exist. Try changing your helper apps."
  19.         error ""
  20.     }
  21.     # Launch the app
  22.     if {$in_front} {
  23.         launch -f $name
  24.     } else {
  25.         launch $name
  26.     }
  27.     hook::callAll launch $sig
  28.     return $name
  29. }
  30.  
  31. # Switch to 'sig', launching if necesary
  32. proc app::launchFore {sig} {
  33.     app::ensureRunning $sig 1
  34. }
  35.  
  36. # Ensure that the app is at least running in the background.
  37. proc app::launchBack {sig} {
  38.     app::ensureRunning $sig 0
  39. }
  40.  
  41. proc app::launchAnyOfThese {sigs sig {prompt "Please locate the application:"}} {
  42.     app::launchBackSigs $sigs $sig $prompt 0
  43. }
  44. proc app::launchElseTryThese {sigs sig {prompt "Please locate the application:"}} {
  45.     app::launchBackSigs $sigs $sig $prompt 1
  46. }
  47.  
  48. # Check to see if any of the 'sigs' is running. If so, return its name.
  49. # Otherwise, attempt to launch the file named by 'sig'.
  50. proc app::launchBackSigs {sigs sig {prompt "Please locate the application:"} {running_first 1} } {
  51.     global $sig
  52.     if {$running_first || ![info exists $sig] || [catch {nameFromAppl [set $sig]}]} {        
  53.     app::setRunningSig $sigs $sig
  54.     app::getSig $prompt $sig
  55.     }
  56.     return [app::launchBack [set $sig]]
  57. }
  58.  
  59. proc app::getSig {prompt sig} {
  60.     global $sig modifiedVars
  61.     if {[catch {nameFromAppl [set $sig]}]} {
  62.     set $sig [getFileSig [getfile $prompt]]
  63.     lappend modifiedVars $sig
  64.     }
  65. }
  66.  
  67. proc app::setRunningSig {sigs sig} {
  68.     global $sig    modifiedVars
  69.     if {[app::isRunning $sigs name s]} {
  70.     if {![info exists $sig] || ($s != [set $sig])} {
  71.         set    $sig $s
  72.         lappend modifiedVars $sig
  73.     }
  74.     return 1
  75.     }
  76.     return 0
  77. }
  78.  
  79. ## 
  80.  # -------------------------------------------------------------------------
  81.  # 
  82.  # "app::runScript" --
  83.  # 
  84.  #  Generic run script handler.  Will prompt for the location of your
  85.  #  application if necessary, run in fore/background, show a log of
  86.  #  the result etc.  See latexComm.tcl or diffMode.tcl for examples
  87.  #  of the necessary array entries.
  88.  #  
  89.  #  3 variables must be defined: ${op}Sig is a variable whose
  90.  #  value is the signature of the application the user has selected
  91.  #  to carry out this operation (or the path of an executable, if
  92.  #  'exec' is possible), ${op}AppSignatures is an array of all
  93.  #  possible name/signature pairs currently known, and ${op}AppScripts
  94.  #  are the scripts for each of those signatures.
  95.  #  
  96.  #  Modified from original evalTeXScript in latex mode.
  97.  # -------------------------------------------------------------------------
  98.  ##
  99. proc app::runScript {op prompt filename {runAppInBackground 0} {showLog 0} {flags ""}} {
  100.     global ${op}Sig ${op}AppSignatures ${op}AppScripts nonInteractiveApps
  101.     
  102.     set supportedApps [array names ${op}AppSignatures]
  103.     foreach app $supportedApps { eval lappend sigs [set ${op}AppSignatures($app)] }
  104.     set longPrompt "Please locate a $prompt."
  105.     if { [catch {app::launchAnyOfThese $sigs ${op}Sig $longPrompt} appname] } {
  106.     error "bug in 'app::launchAnyOfThese' : $appname"
  107.     }
  108.     set sig [set ${op}Sig]
  109.     set quotedSig "'[string trim $sig {'}]'"
  110.     if {!$runAppInBackground} { switchTo $quotedSig }
  111.     if {[file exists $sig]} {
  112.     global tcl_platform
  113.     set stream 1
  114.     # Windows Tcl 8.0 has some fileevent bugs
  115.     if {$tcl_platform(platform) == "windows" && [info tclversion] < 8.1} {
  116.         set stream 0
  117.     }
  118.     # Some apps we never wish to capture stdout/stderr
  119.     if {[info exists nonInteractiveApps]} {
  120.         if {[lsearch -exact $nonInteractiveApps $op] != -1} {
  121.         set stream 0
  122.         set runAppInBackground 1
  123.         }
  124.     }
  125.     if {$stream && $showLog} {
  126.         global mode
  127.         set win [new -n "* $op log *" -m $mode -text "File: $filename\n" -shell 1]
  128.         if {$filename != ""} {
  129.         set olddir [pwd]
  130.         cd [file dirname $filename]
  131.         app::setupInput "$sig [file tail $filename] $flags" $win
  132.         cd $olddir
  133.         } else {
  134.         app::setupInput "$sig [file tail $filename] $flags" $win
  135.         }
  136.         set res ""
  137.     } else {
  138.         if {$filename != ""} {
  139.         set olddir [pwd]
  140.         cd [file dirname $filename]
  141.         if {$runAppInBackground} {
  142.             set err [catch {eval [list exec $sig [file tail $filename]] $flags &} res]
  143.         } else {
  144.             set err [catch {eval [list exec $sig [file tail $filename]] $flags} res]
  145.         }
  146.         cd $olddir
  147.         } else {
  148.         if {$runAppInBackground} {
  149.             set err [catch {eval exec [list $sig] $flags &} res]
  150.         } else {
  151.             set err [catch {eval exec [list $sig] $flags} res]
  152.         }
  153.         }
  154.         if {$runAppInBackground} {
  155.         message "Application running in background."
  156.         return
  157.         }
  158.         if {[expr {($showLog + $err) > 1}]} {
  159.         global mode
  160.         new -n "* $op log *" -m $mode -info "File: $filename\n$res"
  161.         }
  162.         if {$err} {
  163.         beep
  164.         message "Run completed abnormally."
  165.         } else {
  166.         message "Run completed successfully."
  167.         }
  168.     }
  169.     
  170.     return $res
  171.     } else {
  172.     foreach app $supportedApps { 
  173.         if {[lsearch -exact [set ${op}AppSignatures($app)] $sig] >= 0} {
  174.         foreach script [set ${op}AppScripts($app)] {
  175.             set res [eval $script]
  176.         }
  177.         return $res
  178.         } 
  179.     }
  180.     }
  181.     beep
  182.     alertnote "Sorry, no support for your $prompt."
  183.     return
  184. }
  185.  
  186. proc app::setupInput {cmd win} {
  187.     global catSig
  188.     app::getSig "Please find your 'cat' application" catSig
  189.     insertText -w $win $cmd "\n"
  190.     set pipe [open "| $catSig" r+]
  191.     fconfigure $pipe -buffering none
  192.     fileevent $pipe readable [list app::handleErrorInput $win $pipe 1]
  193.     set output [open "|$cmd 2>@ $pipe" r]
  194.     fileevent $output readable [list app::handleStdoutInput $win $output $pipe]
  195. }
  196.  
  197. proc app::handleErrorInput {w f {err 1}} {
  198.     set data [gets $f]
  199.     if {[string length $data] > 0} {
  200.     insertText -w $w $data "\n"
  201.     update
  202.     }
  203. }
  204.  
  205. proc app::handleStdoutInput {w output err} {
  206.     if {[eof $output]} {
  207.     fileevent $output readable ""
  208.     catch close $output
  209.     fileevent $err readable ""
  210.     #catch flush $err
  211.     catch close $err
  212.     insertText -w $w "\nDone\n"
  213.     winReadOnly $w
  214.     }
  215.     set data [gets $output]
  216.     if {[string length $data] > 0} {
  217.     insertText -w $w $data "\n"
  218.     update
  219.     }
  220. }
  221.  
  222. proc app::handleInput {w f {err 0}} {
  223.     # Delete handler if input was exhausted.
  224.     if {[eof $f]} {
  225.     fileevent $f readable {}
  226.     close $f
  227.     return
  228.     }
  229.  
  230.     set data [read $f]
  231.  
  232.     if {[string length $data] > 0} {
  233.     insertText -w $w $data
  234.     }
  235. }
  236.  
  237.  
  238. ## 
  239.  # -------------------------------------------------------------------------
  240.  # 
  241.  # "app::isRunning" --
  242.  # 
  243.  #  Is an app with one of the given sigs running.  Set the global $sig
  244.  #  to the name of that thing if it is
  245.  #  
  246.  #  {"Finder" "MACS" 978944 182209 }
  247.  #  
  248.  #  Much improved by Vince to avoid scanning the processes list one at a
  249.  #  time.
  250.  #  
  251.  # -------------------------------------------------------------------------
  252.  ##
  253. proc app::isRunning {sigs {n ""} {s ""}} {
  254.     if {$n != ""} {upvar $n name}
  255.     if {$s != ""} {upvar $s sig}
  256.     if {[regexp "\"(\[^\"\]+)\" \"([join [quote::Regfind [quote::Regfind $sigs]] |])\" " [processes] "" name sig]} {
  257.     return 1
  258.     } else {
  259.     foreach ss $sigs {
  260.         if {[string length $ss] > 4 && [file exists $ss]} {
  261.         set sig $ss
  262.         set name $ss
  263.         return 1
  264.         }
  265.     }
  266.     }
  267.     return 0
  268.     
  269. }
  270.  
  271. ## 
  272.  # -------------------------------------------------------------------------
  273.  # 
  274.  # "app::registerMultiple" --
  275.  # 
  276.  #  Does the dirty work so a mode can use different icons for its menu
  277.  #  according to which application a particular user has selected for
  278.  #  that mode.  The arguments are as follows:
  279.  #  
  280.  #  type - a prefix such as 'java' which is used to create variables
  281.  #         such as 'javaSig' 'javaMenu'
  282.  #  creators - the list of recognised creators (1st is default)
  283.  #  icons - the list of icon resources
  284.  #  menurebuild - the procedure which is used to rebuild the mode menu
  285.  #  
  286.  #  here's an example:
  287.  #  
  288.  #    app::registerMultiple java [list Javc WARZ] \
  289.  #      [list •140 •285] rebuildJavaMenu
  290.  #      
  291.  #  of course the rebuild procedure must use the correct icon like this:
  292.  #  
  293.  #    proc rebuildJavaMenu {} {
  294.  #        global javaMenu
  295.  #        menu -n $javaMenu -p javaMenuProc {
  296.  #        }
  297.  #    }
  298.  #    
  299.  #    Note: this procedure ensures the menu is created the first time it
  300.  #    is called.
  301.  # --Version--Author------------------Changes-------------------------------
  302.  #    1.0     <darley@fas.harvard.edu> original
  303.  # -------------------------------------------------------------------------
  304.  ##
  305. proc app::registerMultiple {type creators icons menurebuild} {
  306.     global ${type}Sig multiApp
  307.     if {![info exists ${type}Sig]} {
  308.     set ${type}Sig [lindex $creators 0]
  309.     }
  310.     set multiApp($type) [list $creators $icons $menurebuild]
  311.     app::multiChanged ${type}Sig
  312.     trace variable ${type}Sig w app::multiChanged
  313. }
  314.  
  315. ## 
  316.  # -------------------------------------------------------------------------
  317.  # 
  318.  # "app::multiChanged" --
  319.  # 
  320.  #  Utility procedure used by the above.  No need to call it manually.
  321.  # -------------------------------------------------------------------------
  322.  ##
  323. proc app::multiChanged {type args} {
  324.     set type [string range $type 0 [expr {[string last "Sig" $type] -1}]]
  325.     global ${type}Menu ${type}Sig multiApp
  326.     # remove old menu
  327.     catch {removeMenu [set ${type}Menu]}
  328.     # update the icon according to signature
  329.     set info $multiApp($type)
  330.     if {[set i [lsearch -exact [lindex $info 0] [set ${type}Sig]]] == -1} {
  331.     set i 0
  332.     }
  333.     set ${type}Menu [lindex [lindex $info 1] $i]
  334.     # rebuild the menu
  335.     eval [lindex $multiApp($type) 2]
  336.     # insert the new menu
  337.     insertMenu [set ${type}Menu]
  338. }
  339.  
  340.  
  341.  
  342.  
  343.  
  344.