home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / modes.tcl < prev    next >
Encoding:
Text File  |  1999-04-20  |  16.8 KB  |  611 lines  |  [TEXT/ALFA]
  1. # (nowrap)
  2.  
  3. namespace eval mode {}
  4. namespace eval win {}
  5. namespace eval menu {}
  6.  
  7. # ◊◊◊◊ Declare Alpha packages ◊◊◊◊ #
  8.  
  9. proc alpha::feature {name version modes {initialise ""} {activate ""} {deactivate ""} args} {
  10.     global alpha::rebuilding
  11.     if {!${alpha::rebuilding}} {return}
  12.     global index::feature rebuild_cmd_count
  13.     if {[string trim "$initialise$activate$deactivate"] == ""} {
  14.     set index::feature($name) [list $version $modes -1]
  15.     } else {
  16.     set index::feature($name) [list $version $modes 0 $initialise $activate $deactivate]
  17.     }
  18.     
  19.     if {[llength $args]} {
  20.     eval alpha::package [lindex $args 0] $name $version [lrange $args 1 end]
  21.     return
  22.     }
  23.     if {[info exists rebuild_cmd_count] && [incr rebuild_cmd_count -1] == 0} {
  24.     return -code 11
  25.     }
  26. }
  27.  
  28. proc alpha::flag {name version modes args} {
  29.     uplevel 1 alpha::feature [list $name $version $modes \
  30.       "set $name 0" "set $name 1" "set $name 0"] $args
  31. }
  32.  
  33. proc alpha::menu {name version modes {value ""} {initialise ""} {activate ""} {deactivate ""} args} {
  34.     global alpha::rebuilding
  35.     if {!${alpha::rebuilding}} {return}
  36.     if {[string index $modes 0] == "•"} {
  37.     # it's in the old format
  38.     set tmp $modes
  39.     set modes $value
  40.     if {$modes == "in_menu"} { set modes "global" }
  41.     set value $tmp
  42.     # perhaps there's a better way of collapsing these arguments
  43.     if {[llength $args]} {
  44.         set args [concat [list $activate $deactivate] $args]
  45.     } else {
  46.         if {$deactivate != ""} {
  47.         lappend activate $deactivate
  48.         set args $activate
  49.         } else {
  50.         set args $activate
  51.         }
  52.     }    
  53.     set activate "$name"
  54.     set deactivate ""
  55.     }
  56.     global index::feature rebuild_cmd_count
  57.     if {[info exists index::feature($name)]} {
  58.     eval lappend modes [lindex [set index::feature($name)] 1]
  59.     }
  60.     set index::feature($name) [list $version $modes 1 \
  61.       "ensureset $name $value\n$initialise" \
  62.       "$activate\ninsertMenu \$$name" \
  63.       "$deactivate\nremoveMenu \$$name"]
  64.     
  65.     if {[llength $args]} {
  66.     eval alpha::package [lindex $args 0] $name $version [lrange $args 1 end]
  67.     return
  68.     }
  69.     if {[info exists rebuild_cmd_count] && [incr rebuild_cmd_count -1] == 0} {
  70.     return -code 11
  71.     }        
  72. }
  73.  
  74. proc alpha::extension {name version {script ""} args} {
  75.     uplevel 1 [list alpha::feature $name $version "global-only" "" $script ""] $args
  76. }
  77.  
  78. proc alpha::mode {name version dummyProc {ext ""} {menus ""} {script ""} args} {
  79.     global alpha::rebuilding alpha::requirements
  80.     if {!${alpha::rebuilding}} {return}
  81.     namespace eval ::$name {}
  82.     global index::mode rebuild_cmd_count index::oldmode
  83.     set index::mode($name) [list $version $dummyProc [join $ext " "] $menus $script]
  84.     if {[info exists index::oldmode($name)]} {
  85.     if {[set omenus [lindex [set index::oldmode($name)] 3]] != $menus} {
  86.         global alpha::noMenusYet mode::features modifiedArrayElements
  87.         foreach m $menus {
  88.         # Store all version number requirements
  89.         if {[lindex $m 2] != ""} {
  90.             lappend alpha::requirements [list $name $m]
  91.         }
  92.         set mm [lindex $m 0]
  93.         if {([lsearch -exact $omenus $mm] == -1) \
  94.           && ([lsearch -glob $omenus "$mm *"] == -1)} {
  95.             # it's new
  96.             package::addRelevantMode $mm $name
  97.             if {[lindex $m 1] == 0} {continue}
  98.             if {[info exists alpha::noMenusYet]} {
  99.             # we added a feature 
  100.             hook::register startupHook "lunion mode::features($name) $mm"
  101.             } else {
  102.             lunion mode::features($name) $mm
  103.             lappend modifiedArrayElements [list $name mode::features]
  104.             }
  105.         }
  106.           
  107.         }
  108.         foreach om $omenus {
  109.         set omm [lindex $om 0]
  110.         if {([lsearch -exact $menus $omm] == -1) \
  111.           && ([lsearch -glob $menus "$omm *"] == -1)} {
  112.             # it has been removed from the default list
  113.             package::removeRelevantMode $omm $name
  114.             set mode::features($name) [lremove $mode::features($name) $omm]
  115.             lappend modifiedArrayElements [list $name mode::features]
  116.         }
  117.         }
  118.     }
  119.     }
  120.     if {[llength $args]} {
  121.     eval alpha::package [lindex $args 0] $name $version [lrange $args 1 end]
  122.     return
  123.     }
  124.     if {[info exists rebuild_cmd_count] && [incr rebuild_cmd_count -1] == 0} {
  125.     return -code 11
  126.     }        
  127. }
  128.  
  129. ## 
  130.  # -------------------------------------------------------------------------
  131.  # 
  132.  # "addMode" -- you probably won't call this proc yourself
  133.  # 
  134.  # -------------------------------------------------------------------------
  135.  ##
  136. proc addMode {m dummy suffs _features} {
  137.     global mode::features filepats dummyProc index::feature
  138.     namespace eval ::$m {}
  139.     if {[string length $dummy]} {set dummyProc($m) $dummy}
  140.     ensureset mode::features($m) $_features
  141.     foreach f $_features {
  142.     package::addRelevantMode $f $m
  143.     }
  144.     ensureset filepats($m) $suffs
  145. }
  146.  
  147. proc addMenu {name {val ""} {modes ""}} {
  148.     global menus index::feature
  149.     lunion menus $name
  150.     if {$val != ""} {
  151.     global $name
  152.     if {![info exists $name]} { set $name $val }
  153.     }
  154.     if {[info exists index::feature($name)]} {
  155.     eval lappend modes [lindex [set index::feature($name)] 1]
  156.     }
  157.     set index::feature($name) \
  158.       [list [list "mode" [lindex $modes 0]] $modes 1 "" "$name ; insertMenu \$$name" "removeMenu \$$name"]
  159. }
  160.  
  161.  
  162. # ◊◊◊◊ Procs Alpha calls directly ◊◊◊◊ #
  163. proc getModeValuesAlpha {} {
  164.     global showInvisibles
  165.     
  166.     getWinInfo blah
  167.     lappend m "Mac" [expr {$blah(platform) == "mac"}]
  168.     lappend m "UNIX" [expr {$blah(platform) == "unix"}]
  169.     lappend m "IBM" [expr {$blah(platform) == "ibm"}] {(-} 0
  170.     lappend m "MPW" [expr {$blah(state) == "mpw"}]
  171.     lappend m "Think" [expr {$blah(state) == "think"}]
  172.     lappend m "None" [expr {$blah(state) == "none"}] {(-} 0
  173.     lappend m "Read Only" $blah(read-only)
  174.     lappend m "Show Invisibles" $showInvisibles {(-} 0
  175.     lappend m "Tab Size" 0
  176.     return $m
  177. }
  178.  
  179.  
  180. proc setModeVarAlpha {var} {
  181.     global mode allFlags modeVars
  182.     global ${mode}modeVars
  183.     
  184.     set var [string tolower $var]
  185.     switch -- $var {
  186.         "unix"      -
  187.         "mac"       -
  188.         "ibm"       { setWinInfo platform $var ; setWinInfo dirty 1 }
  189.         "mpw"       -
  190.         "think"     -
  191.         "none"      { setWinInfo state $var }
  192.         "tab size"  {
  193.             getWinInfo arr
  194.             if {![catch {prompt "New tab size?" $arr(tabsize)} res]} {
  195.                 setWinInfo tabsize $res
  196.             }
  197.         }
  198.         "read only" { 
  199.             getWinInfo b
  200.             setWinInfo read-only [expr {-1 * ($b(read-only) - 1)}]}
  201.         "show invisibles" { 
  202.             global showInvisibles
  203.             set showInvisibles [expr {1 - $showInvisibles}]
  204.         }
  205.     }
  206.     return
  207. }
  208.  
  209. ## 
  210.  # -------------------------------------------------------------------------
  211.  # 
  212.  # "modes" --
  213.  # 
  214.  #  Called to get the list of modes for the modes popup
  215.  # -------------------------------------------------------------------------
  216.  ##
  217. proc modes {args} { 
  218.     global mode::features
  219.     return [lsort -ignore [array names mode::features]]
  220. }
  221.  
  222. # Called from alpha in response to the mode popup.
  223. proc newMode {mode} {
  224.     if {[package::helpOrDescribe $mode]} { return }
  225.     global win::Modes
  226.     changeMode $mode
  227.     if {[catch {win::Current} name]} return
  228.     set win::Modes($name) $mode
  229.     refresh
  230. }
  231.  
  232. # ◊◊◊◊ Mode specific items ◊◊◊◊ #
  233.  
  234. proc mode::menuProc {menu item} {
  235.     if {![llength [winNames]]} {
  236.         alertnote "No window!"
  237.         return
  238.     }
  239.     switch -- $item {
  240.         "preferences"       dialog::modifyModeFlags
  241.         "loadPrefsFile"     mode::sourcePrefsFile
  242.         "describeMode"      mode::describe
  243.         "changeMode"            mode::changeDialog
  244.     default {
  245.         mode::$item
  246.     }        
  247.     }
  248. }
  249.  
  250. ## 
  251.  # -------------------------------------------------------------------------
  252.  #     
  253.  # "win::setMode"    --
  254.  #    
  255.  #    Copes with endings like    '.orig'
  256.  #    or the backup ending '~' or ' copy', and checks a smart-mode line
  257.  #    like emacs, and handles a few Alpha-specific windows (trace dumps).
  258.  #
  259.  # -------------------------------------------------------------------------
  260.  ##
  261. proc win::setMode name {
  262.     global win::Modes
  263.     set win::Modes($name) [file::whichModeForWin $name]
  264. }
  265.  
  266.  
  267. ## 
  268.  # -------------------------------------------------------------------------
  269.  # 
  270.  # "win::addToMenu" --
  271.  # 
  272.  #  Adds a window name to the window menu.  This new version adds a 
  273.  #  binding, to work-around a bug in Alpha, so that using cmd-0-9
  274.  #  works if the window name contains square brackets.  The problem
  275.  #  is that the 'addMenuItem' line creates a binding of the form
  276.  #  'menu::winProc •263 namewith[square]brackets' which when evaluated
  277.  #  causes an error.  We force a separate binding to
  278.  #  'menu::winProc •263 {namewith[square]brackets}' which does work.
  279.  # -------------------------------------------------------------------------
  280.  ##
  281. proc win::addToMenu {name} {
  282.     global winNameToNum winMenu winNumToName
  283.     if {[info tclversion] < 8.0} {
  284.     set name [subst $name]
  285.     }
  286.     
  287.     for {set i 0} {$i<100} {incr i} {
  288.     if {![info exists winNumToName($i)]} {
  289.         regsub { <[0-9]+>$} $name {} nm
  290.         if {[file exists $nm]} {
  291.         set nm [file tail $name]
  292.         } else {
  293.         set nm $name
  294.         }
  295.         if {$i < 10} {
  296.         addMenuItem -m -l "/$i" $winMenu "$nm"
  297.         if {[info tclversion] < 8.0} {
  298.             Bind '$i' <c> [list menu::winProc $winMenu $nm]
  299.         }
  300.         } else {
  301.         addMenuItem -m -l "" $winMenu "$nm"
  302.         }
  303.         set winNumToName($i) $name
  304.         set winNameToNum($name) $i
  305.         return
  306.     }
  307.     }
  308. }
  309.  
  310. proc win::removeFromMenu {name} {
  311.     global winNameToNum winNumToName winMenu
  312.     if {[info tclversion] < 8.0} {
  313.     set name [subst $name]
  314.     }
  315.     set num $winNameToNum($name)
  316.     unset winNumToName($num)
  317.     unset winNameToNum($name)
  318.     regsub { <[0-9]+>$} $name {} nm
  319.     if {[file exists $nm]} {
  320.     set nm [file tail $name]
  321.     } else {
  322.     # in case it was a file but the file was actually moved!
  323.     if {[regexp {[^:]*$} $name nm]} {
  324.         if {![catch {deleteMenuItem -m $winMenu $nm}]} { return } 
  325.     }
  326.     set nm $name
  327.     }
  328.     # to handle alpha problem with rebuilding the menu
  329.     if {[catch {deleteMenuItem -m $winMenu $nm}]} { deleteMenuItem $winMenu $nm }
  330. }
  331.  
  332. proc mode::changeDialog {} {
  333.     global mode mode::features
  334.  
  335.     set nmode [listpick -p "Mode:" -L $mode \
  336.       [lsort -ignore [array names mode::features]]]
  337.     newMode $nmode
  338. }
  339.  
  340. proc mode::describe {} {
  341.     global mode ModeSuffixes mode::features
  342.     global ${mode}modeVars
  343.     
  344.     set text "\r\tMODE $mode\r\r"
  345.     if {![catch {package::describe $mode 1} res]} {
  346.     append text $res "\r\r"
  347.     }
  348.  
  349.     set tmp ""
  350.     catch {set tmp [package::helpFile $mode 1]}
  351.     append text "$tmp\r\r"
  352.  
  353.     set suffs ""
  354.     set first 1
  355.     foreach suf $ModeSuffixes {
  356.         if {([llength $suf] == 3) && ([lindex $suf 1] == "winMode") \
  357.       && ([lindex $suf 2] == $mode)} {
  358.         if {$first} {
  359.         append suffs $last
  360.         set first 0
  361.         } else {
  362.                 append suffs ", $last"
  363.             }
  364.         }
  365.         set last $suf
  366.     }
  367.     append text "Mode filepats: " $suffs "\r\r"
  368.     
  369.     set first 1
  370.     append text "Mode menus and features: "
  371.     if {[info exists mode::features($mode)]} {
  372.         foreach m [set mode::features($mode)] {
  373.             if {$first} {
  374.                 set first 0
  375.                 append text $m
  376.             } else {
  377.                 append text ", " $m
  378.             }
  379.         }
  380.      }
  381.     append text "\r\r"
  382.     append text [mode::describeVars $mode]
  383.     
  384.     set etext "\rMode-independent bindings:\r"
  385.     append text "\rMode-specific bindings:\r"
  386.     foreach b [split [bindingList] "\r"] {
  387.     set lst [lindex [split $b  " "] end]
  388.         if {$lst == $mode} {
  389.             append text "\t$b\r"
  390.         }
  391.     }
  392.     append text "\rTo list mode-independent bindings, select\
  393.       'List Global/All Bindings'\rfrom the Config menu.\r"
  394.     new -n "* <$mode> MODE *" -m Tcl -text $text -shell 1 -read-only 1
  395. }
  396.  
  397. proc mode::describeVars {pkg {pkgpref ""}} {
  398.     cache::read index::prefshelp
  399.     if {$pkgpref == ""} {set pkgpref $pkg}
  400.     global ${pkgpref}modeVars
  401.     append text "Package-specific variables:\r"
  402.     if {[array exists ${pkgpref}modeVars]} {
  403.     foreach v [lsort [array names ${pkgpref}modeVars]] {
  404.         set val [set ${pkgpref}modeVars($v)]
  405.         global flag::type
  406.         set description ""
  407.         if {[info exists prefshelp(${pkg},$v)]} {
  408.         set description [dialog::helpdescription $prefshelp(${pkg},$v)]
  409.         } elseif {[info exists prefshelp(${pkgpref},$v)]} {
  410.         set description [dialog::helpdescription $prefshelp(${pkgpref},$v)]
  411.         } elseif {[info exists prefshelp($v)]} {
  412.         set description [dialog::helpdescription $prefshelp($v)]
  413.         }
  414.         
  415.         if {$description != ""} {
  416.         regsub -all "\[\r\n\]" [breakIntoLines $description] "&  \# " description
  417.         append text "  # " $description "\r"
  418.         }
  419.         if {[info exists flag::type($v)] \
  420.           && [regexp {binding$} [set flag::type($v)]]} {
  421.         set val [dialog::specialView_binding $val]
  422.         }
  423.         append text [format "  %-20s: \"%s\"\r" $v $val]
  424.     }
  425.     }
  426.     
  427.     return $text
  428. }
  429.  
  430. # Now calls the new proc dialog::pickMenus
  431. proc mode::menusAndFeatures {} {
  432.     global mode mode::features modifiedArrayElements global::features
  433.  
  434.     set newFeatures [dialog::pickMenusAndFeatures $mode]
  435.     set offon [package::onOrOff $newFeatures $mode]
  436.     
  437.     set mode::features($mode) $newFeatures
  438.     lappend modifiedArrayElements [list $mode mode::features]
  439.     # deactivate removed items
  440.     foreach m [lindex $offon 0] {
  441.     package::deactivate $m
  442.     }
  443.     foreach m [lindex $offon 1] {
  444.     package::activate $m
  445.     }
  446. }
  447.  
  448. if {[info tclversion] < 8.0} {
  449. proc mode::proc {name args} {
  450.     global mode
  451.     if {[info commands ${mode}::$name] != ""} {
  452.     eval ${mode}::$name $args
  453.     } else {
  454.     eval ::$name $args
  455.     }
  456. }
  457. proc mode::getProc {name} {
  458.     global mode
  459.     if {[info commands ${mode}::$name] != ""} {
  460.     return ${mode}::$name
  461.     } else {
  462.     return ""
  463.     }
  464. }
  465. proc mode::getVar {var} {
  466.     uplevel \#0 "
  467.     if \[info exists \${mode}::$var\] { 
  468.     return \[set \${mode}::$var\]
  469.     } else {
  470.     return \[set $var\]
  471.     } \
  472.       "
  473. }
  474.  
  475. } else {
  476.     proc mode::proc {name args} {
  477.     global ::mode
  478.     namespace eval ::$mode "$name $args"
  479.     }
  480.     proc mode::getProc {name} {
  481.     global ::mode
  482.     namespace eval ::$mode "namespace which $name"
  483.     }
  484.     proc mode::getVar {var} {
  485.     uplevel \#0 "
  486.     if \[info exists ::\${mode}::$var\] { 
  487.         return \[set ::\${mode}::$var\]
  488.     } else {
  489.         return \[set ::$var\]
  490.     } \
  491.       "
  492.     }
  493. }
  494.  
  495. # Suffixes used to determine mode for new windows.
  496. proc mode::updateSuffixes {} {
  497.     global ModeSuffixes mode::features filepats
  498.  
  499.     set ModeSuffixes { default { set winMode Text } }
  500.     foreach m [lsort -ignore [array names mode::features]] {
  501.         if {[info exists filepats($m)]} {
  502.         lappend ModeSuffixes $filepats($m) "set winMode $m"
  503.         }
  504.     }
  505. }
  506.  
  507. proc synchroniseModeVar {var args} {
  508.     global mode $var
  509.     if {[llength $args] > 0} {
  510.     set $var [lindex $args 0]
  511.     }
  512.     global ${mode}ModeVars modifiedArrayElements
  513.     lappend modifiedArrayElements [list $var ${mode}modeVars]
  514.     set ${mode}modeVars($var) [set $var]
  515. }
  516.  
  517. # ◊◊◊◊ Miscellaneous ◊◊◊◊ #
  518.  
  519. proc alpha::tryToLoad {msg args} {
  520.     message "${msg}…"
  521.     set i -1
  522.     set ok 1
  523.     while 1 {
  524.     set do [lindex $args [incr i]]
  525.     set say [lindex $args [incr i]]
  526.     if {$say == ""} {
  527.         set say "Loading $do"
  528.     }
  529.     if {$do == ""} {
  530.         if {$ok} {
  531.         message "${msg}…Complete."
  532.         } else {
  533.         alertnote "${msg}…Failed."
  534.         }
  535.         return $ok
  536.     }
  537.     message "${say}…"
  538.     if {[catch $do]} {
  539.         alertnote "$say failed!"
  540.     }
  541.     
  542.     }
  543. }
  544.  
  545. # ◊◊◊◊ Read in all the packages ◊◊◊◊ #
  546.  
  547. proc alpha::getBasicModes {} {
  548.     global PSwords
  549.     addMode PS {} {*.ps *.eps *.epsf} {}
  550.     newPref v prefixString {% } PS
  551.     set PSKeyWords {
  552.     def begin end dict load exec if ifelse for repeat loop exit 
  553.     stop stopped countexecstack execstack quit start gsave 
  554.     grestore grestoreall initgraphics newpath erasepage fill 
  555.     eofill stroke image imagemask showpage copypage
  556.     }
  557.     if {[info exists PSwords]} {set PSKeyWords [concat $PSKeyWords $PSwords]}
  558.     regModeKeywords -e {%} -m {/}  -c red -k blue PS $PSKeyWords -i "\}" -i "\{" -i {[} -i {]} -I green
  559.     
  560.     addMode Inst "" [list "*Install" "*INSTALL"] {installMenu}
  561.     addMenu installMenu "Install"
  562.     hook::register openHook install::openHook Inst
  563.     
  564.     addMode Text {} {default} {}
  565.     newPref v leftFillColumn {0} Text
  566.     newPref v suffixString { <--} Text
  567.     newPref v prefixString {> } Text
  568.     newPref v fillColumn {75} Text
  569.     newPref f wordWrap {1} Text
  570.     newPref v wordBreak {\w+} Text
  571.     newPref v wordBreakPreface {(\W)} Text
  572.     newPref v wrapBreak {[\w_]+} Text
  573.     newPref v wrapBreakPreface {([^\w_])} Text
  574.     newPref f autoMark 0 Text
  575.     newPref flag quietlyClearMarks 0 Text
  576.     namespace eval Text {}
  577.     proc Text::DblClick {args} {
  578.     eval Tcl::DblClick $args
  579.     }
  580. }
  581.  
  582. proc alpha::findAllPlugins {} {
  583.     alpha::findAllModes
  584.     global skipPrefs
  585.     if {!$skipPrefs} {
  586.     alpha::findAllExtensions
  587.     }
  588. }
  589.  
  590. proc alpha::findAllModes {} {
  591.     alpha::getBasicModes
  592.     rename alpha::getBasicModes {}
  593.     cache::read index::mode
  594.     foreach f [array names index::mode] {
  595.     eval addMode $f [lrange [set index::mode($f)] 1 3]
  596.     if {[set script [lindex [set index::mode($f)] 4]] != ""} {
  597.         if {[catch {uplevel #0 $script} err]} {
  598.         lappend problems "$f"
  599.         }
  600.     }
  601.     }
  602.     if {[info exists problems]} {
  603.     alertnote "Problems loading modes: $problems"
  604.     }
  605.     mode::updateSuffixes
  606. }
  607.  
  608.  
  609.  
  610.  
  611.