home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / Perl Mode / perlMenu.tcl < prev    next >
Encoding:
Text File  |  1998-04-14  |  10.2 KB  |  378 lines  |  [TEXT/ALFA]
  1. # ◊◊◊◊ file loading dummy ◊◊◊◊ #
  2. proc perlMenu.tcl {} {}
  3.  
  4. #############################################################################
  5. # ◊◊◊◊ Build the perl menu ◊◊◊◊ #
  6. #            
  7.  
  8. menu::buildProc perlMenu menu::buildPerl
  9. menu::buildProc generalOptions menu::buildgeneralOptions
  10. menu::buildProc filterOptions menu::buildfilterOptions
  11. menu::buildProc perlFilterMenu rebuildFilterMenu
  12.  
  13. set perlFilterMenu "textFilters"
  14.  
  15. proc menu::buildPerl {} {
  16.     global PerlmodeVars perlFilterMenu perlMenu 
  17.     set ma {
  18.         "/'<Umacperl"
  19.         {Menu -m -n "tellMacperl..." -p perlTellProc {
  20.            "/O<UOpen This File"
  21.            "Save As Droplet"
  22.            "Save As Runtime"
  23.            "Save As CGI"
  24.             "(-"
  25.            "Get Output Window"
  26.            "Close Output Window"
  27.            "Quit"
  28.            }
  29.         } 
  30.         {Menu -m -n "Quick Save As..." -p perlSaveProc {
  31.            "Droplet"
  32.            "Runtime"
  33.            "CGI"
  34.            }
  35.         } 
  36.         {Menu -m -n help -p perlHelpProc {
  37.             "MacPerl Mode"
  38.             "Mac Specifics"
  39.             "Perl4 Manual"
  40.             "Perl5 Manual"
  41.         }}
  42.         "(-"
  43.         "runTheSelection"
  44.         "/R<UrunTheBuffer"
  45.         "/R<B<OsaveAndRun"
  46.         "runAFile"
  47.         "(-"
  48.     }
  49.     lappend ma [list Menu -n $perlFilterMenu {}] \
  50.       "selectBufferAsFilter" "selectFileAsFilter"
  51.     if {$PerlmodeVars(perlPrevScript) == {} || $PerlmodeVars(perlPrevScript) == {*startup*}} {
  52.         lappend ma "/F<U(repeatLastFilter"
  53.     } else {
  54.         lappend ma "/F<UrepeatLastFilter"
  55.     }
  56.     lappend ma "(-" \
  57.       [list Menu -n generalOptions {}] \
  58.       [list Menu -n filterOptions {}]
  59.  
  60.     return [list build $ma -1 \
  61.       {generalOptions filterOptions perlFilterMenu} $perlMenu]
  62. }
  63.  
  64. # General Perl-menu options menu
  65. #
  66. proc menu::buildgeneralOptions {} {
  67.     global PerlmodeVars
  68.     foreach i {"retrieveOutput" "autoSwitch" "promptForArgs" "useDebugger"} {
  69.         if [set PerlmodeVars(perl$i)] {
  70.             lappend ma "!•$i"
  71.         } else {
  72.             lappend ma $i
  73.         }
  74.     }
  75.     return [list build $ma]
  76. }
  77.  
  78. # Text Filter options menu
  79. #
  80. proc menu::buildfilterOptions {} {
  81.     global PerlmodeVars
  82.     Menu -n filterOptions {
  83.         "applyToBuffer"
  84.         "overwriteSelection"
  85.         "(-"
  86.         "rebuildFilterMenu"
  87.     }    
  88.     markMenuItem filterOptions overwriteSelection $PerlmodeVars(perloverwriteSelection)
  89.     markMenuItem filterOptions applyToBuffer $PerlmodeVars(perlapplyToBuffer)
  90. }
  91.  
  92. #############################################################################
  93. # ◊◊◊◊ filter menu builder ◊◊◊◊ #
  94. #  Build a submenu of "preattached" Perl filters using the names of the 
  95. #  scripts in the Text Filters directory.  Called whenever Text Filters
  96. # folder is reassigned.
  97. #
  98. proc rebuildFilterMenu {{args}} {
  99.     global PerlmodeVars perlFilters perlFilterMenu perlFilterPath
  100.     global PerlmodeVars $perlFilterMenu
  101.     
  102.     eval [menu::buildHierarchy [list $PerlmodeVars(perlFilterPath)] $perlFilterMenu textFiltersProc perlFilters]
  103. }
  104.  
  105. menu::buildSome perlMenu
  106.  
  107. # ◊◊◊◊ var & menu updater ◊◊◊◊ #
  108. # ShadowPerl sets the global PerlmodeVars vars when the mode vars are modified and
  109. # keeps the menu checkmarked correctly.
  110. #
  111. proc shadowPerl {name} {
  112.     global PerlmodeVars HOME perlMenu
  113.     switch $name {
  114.         "perluseDebugger"    {
  115.             markMenuItem generalOptions useDebugger $PerlmodeVars(perluseDebugger)
  116.          }
  117.         "perloverwriteSelection"    {
  118.             markMenuItem filterOptions overwriteSelection $PerlmodeVars(perloverwriteSelection)
  119.          }
  120.         "perlapplyToBuffer"    {
  121.             markMenuItem filterOptions applyToBuffer $PerlmodeVars(perlapplyToBuffer)
  122.          }
  123.         "perlretrieveOutput"    {
  124.             markMenuItem generalOptions retrieveOutput $PerlmodeVars(perlretrieveOutput) 
  125.         }
  126.         "perlautoSwitch" {    
  127.             markMenuItem generalOptions autoSwitch $PerlmodeVars(perlautoSwitch) 
  128.         }
  129.         "perlpromptForArgs" {    
  130.             markMenuItem generalOptions promptForArgs $PerlmodeVars(perlpromptForArgs) 
  131.         }
  132.         "perlVersion" {    
  133.             set modeCode "perl${perlVersion}.tcl"
  134.             if {[catch "$modeCode"]} {
  135.                 alertnote "Couldn't load the Perl-mode colorization file \"$modeCode\".  Contact the maintainer."
  136.             }
  137.         }
  138.         "perlLastFilter" {    
  139.             # Don't allow perlPrevScript to be changed from the flags menu
  140.             if {$PerlmodeVars(perlPrevScript) == "*startup*"} {
  141.                 set PerlmodeVars(perlPrevScript) $perlLastFilter
  142.                 enableMenuItem $perlMenu repeatLastFilter 1
  143.             } else {
  144.                 set perlLastFilter $PerlmodeVars(perlPrevScript) 
  145.             }
  146.         }
  147.     }
  148. }
  149.  
  150. #############################################################################
  151. # ◊◊◊◊ •Menu commands ◊◊◊◊ #
  152. #############################################################################
  153.  
  154. ###########################################################################
  155. #
  156. proc perlHelpProc {menu item} {
  157.     global PerlmodeVars HOME
  158.     switch $item {
  159.         "MacPerl Mode"    {
  160.                 if {[catch {openFileQuietly "$HOME:Help:MacPerl Help"}]} {
  161.                     alertnote "File not found:\r$HOME:Help:MacPerl Help"
  162.                 }
  163.             }
  164.         "Mac Specifics"    {
  165.                 if {[catch {openFileQuietly "$HOME:Help:MacPerl.Specifics"}]} {
  166.                     alertnote "File not found:\r$HOME:Help:MacPerl.Specifics"
  167.                 }
  168.             }
  169.         "Perl4 Manual"    {
  170.                 if {[catch {openFileQuietly "$HOME:Help:Perl Commands"}]} {
  171.                     alertnote "File not found:\r$HOME:Help:Perl Commands"
  172.                 }
  173.             }
  174.         "Perl5 Manual"    {
  175.                 catch {editMark "$HOME:Help:Perl Commands" Perl5 -r}
  176.             }
  177.     }
  178. }
  179.  
  180. ############################################################################
  181. # ◊◊◊◊ toggle flags ◊◊◊◊ #
  182. # Toggle the perl menu flags
  183. #
  184. proc retrieveOutput {} {
  185.     perlFlip perlretrieveOutput
  186. }
  187.  
  188. proc useDebugger {} {
  189.     perlFlip perluseDebugger
  190. }
  191.  
  192. proc autoSwitch {} {
  193.     perlFlip perlautoSwitch
  194. }
  195.  
  196. proc perlFlip {var} {
  197.     global PerlmodeVars
  198.     set PerlmodeVars($var) [expr [set PerlmodeVars($var)] ? 0 : 1]
  199.     synchroniseModeVar $var $PerlmodeVars($var)
  200.     shadowPerl $var
  201. }
  202.  
  203. proc overwriteSelection {} {
  204.     perlFlip perloverwriteSelection
  205. }
  206.  
  207. proc applyToBuffer {} {
  208.     perlFlip perlapplyToBuffer
  209. }
  210.  
  211. proc promptForArgs {} {
  212.     perlFlip perlpromptForArgs
  213. }
  214.  
  215. #############################################################################
  216. # ◊◊◊◊ Switch to MacPerl ◊◊◊◊ #
  217. # 
  218. proc macperl {} {
  219.     app::launchFore McPL
  220. }
  221.  
  222. #############################################################################
  223. # ◊◊◊◊ other MacPerl interactions ◊◊◊◊ #
  224. # Interact with MacPerl in some other way besides executing a script
  225. #
  226. #DTH: note addition of two lines for auto-save
  227. proc perlTellProc {menu name} {
  228.     switch -exact $name {
  229.     "Open This File"        { openInMacperl }
  230.     
  231.     "Save As Droplet"        { saveThruMacperl "droplet" }
  232.     
  233.     "Save As Runtime"        { saveThruMacperl "runtime" }
  234.     
  235.     "Save As CGI"            { saveThruMacperl "cgi" }
  236.     
  237.     "Get Output Window"        { openPerlOutput }
  238.     
  239.     "Close Output Window"    { sendCloseWinName MacPerl $perlName ;
  240.                               sendCloseWinName MacPerl "Perl Debug" }
  241.                             
  242.     "Quit"                    { quitMacperl }
  243.     }
  244. }
  245.  
  246. proc perlSaveProc {menu name} {
  247.     switch -exact $name {
  248.     "Droplet"    { saveThruMacperl "auto-droplet" }
  249.     
  250.     "Runtime"    { saveThruMacperl "auto-runtime" }
  251.  
  252.     "CGI"        { saveThruMacperl "auto-cgi" }
  253.     }
  254. }
  255.  
  256. #############################################################################
  257. # ◊◊◊◊ open curr file in MacPerl ◊◊◊◊ #
  258. # Open the current file under MacPerl.  This used to useful for saving files 
  259. # as droplets or runtime scripts.  Maybe it's still useful for something...?
  260. #
  261. proc openInMacperl {} {
  262.     if {[winDirty]} {
  263.         case [askyesno -c "Save '[lindex [winNames] 0]'?"] in {
  264.             "yes" {save}
  265.             "no" {}
  266.             "cancel" {return}
  267.         }
  268.     }
  269.     set name [app::launchFore McPL]
  270.     sendOpenEvent -n [file tail $name] [win::Current]
  271. }
  272.  
  273. #############################################################################
  274. # ◊◊◊◊ save as droplet or runtime ◊◊◊◊ #
  275. # Save the script in the current window as a MacPerl droplet or 
  276. # runtime script.  
  277. #
  278. proc saveThruMacperl {type} {
  279.     global PerlmodeVars ALPHA
  280.  
  281.     set name [file tail [app::launchBack McPL]]
  282.     getWinInfo arr
  283.     if {$arr(dirty) == 1} {
  284.         case [askyesno -c "Save '[lindex [winNames] 0]' source file also?"] in {
  285.             "yes" {save}
  286.             "no" {}
  287.             "cancel" {return}
  288.         }
  289.     }
  290.     #DTH note the following "if" block which replaced what is in the new "else" block
  291.     set myName [lindex [winNames -f] 0]
  292.     if {$type == "auto-droplet" || $type == "auto-runtime"} {
  293.         if {[file extension $myName] == ".pl"} {
  294.             set destfile [AEFilename [file rootname $myName]]
  295.         } else {
  296.             set destfile [AEFilename [file rootname $myName]]
  297.         }
  298.     } elseif {$type == "auto-cgi"} {
  299.         set destfile [AEFilename "[file rootname $myName].cgi"]
  300.     } else {
  301.         set destfile [AEFilename [putfile {Save droplet as} [lindex [winNames] 0]]]
  302.     }
  303.  
  304.     set script [curlyq [getText [minPos] [maxPos]]]
  305.     #DTH note addition of "auto-xxx" in two lines below
  306.     if {$type == "droplet" || $type == "auto-droplet"} {
  307.         set saveType "SCPT"
  308.     } elseif {$type == "runtime" || $type == "auto-runtime"} {
  309.         set saveType "MrP7"
  310.     } elseif {$type == "cgi" || $type == "auto-cgi"} {
  311.         set saveType "'WWWΩ'"
  312.     } elseif {$type == "text"} {
  313.         set saveType "TEXT"
  314.     }
  315.     
  316.     set err [catch {eval "AEBuild -t 36000 -r \"$name\"" core save {----} [list $script] {dest:} [list $destfile] {fltp:} $saveType } reply ]
  317.     if {$err} { message "AEBuild error code $err in saveThruMacperl" }
  318.     
  319. # The following lines could be used to tell MacPerl to take the script file 
  320. # from an existing disk file and then re-save it in the desired form.
  321. #
  322. #    set srcfile "\[ [AEFilename [win::Current]] \]"
  323. #    set reply [eval "AEBuild -t 36000 -r \"$name\"" core save {----} [list $srcfile] {dest:} [list $destfile] {fltp:} $saveType ]
  324. #
  325. }
  326.  
  327. #############################################################################
  328. # ◊◊◊◊ Quit a running MacPerl app ◊◊◊◊ #
  329. # 
  330. proc quitMacperl {} {
  331.     foreach proc [processes] {
  332.         set sig [lindex $proc 1]
  333.         if {$sig == "McPL"} {
  334.             sendQuitEvent [lindex $proc 0]
  335.             # switchTo is necessary to keep MacPerl from blinking
  336.             switchTo [lindex $proc 0]    
  337.         }
  338.     }
  339. }
  340.  
  341. #############################################################################
  342. # ◊◊◊◊ run something via MacPerl ◊◊◊◊ #
  343. # (No special arrangements are made to provide input or capture the output)
  344. # 
  345. proc runTheSelection {} {
  346.     global PerlmodeVars scriptFile scriptStart
  347.     set scriptFile [win::Current]
  348.     set scriptStart [lindex [posToRowCol [getPos]] 0]
  349.     perlExecuteScript [getSelect]
  350. }
  351.  
  352. proc runTheBuffer {} {
  353.     global PerlmodeVars scriptFile scriptStart
  354.     set scriptFile [win::Current]
  355.     set scriptStart 1
  356.     perlExecuteScript [getText [minPos] [maxPos]]
  357. }
  358.  
  359. proc runAFile {} {
  360.     global PerlmodeVars scriptFile scriptStart
  361.     if {! [catch {getfile "Select a Perl script"} path]} {
  362.         set scriptFile $path
  363.         set scriptStart 1
  364.         perlExecuteFile $path
  365.     }
  366. }
  367.  
  368. proc saveAndRun {} {
  369.     global PerlmodeVars scriptFile scriptStart
  370.     save
  371.     set path [win::Current]   
  372.     set scriptFile $path
  373.     set scriptStart 1
  374.     perlExecuteFile $path
  375. }
  376.  
  377.  
  378.