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