home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / dialogs.tcl < prev    next >
Encoding:
Text File  |  1997-12-13  |  42.8 KB  |  1,463 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "dialogs.tcl"
  6.  #                                    created: 12/1/96 {5:36:49 pm} 
  7.  #                                last update: 13/12/97 {1:13:17 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Much copyright (c) 1997  Vince Darley, rest Pete Keleher.
  15.  # 
  16.  # Reorganisation carried out by Vince Darley with much help from Tom 
  17.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  18.  # Alpha is shareware; please register with the author using the register 
  19.  # button in the about box.
  20.  #  
  21.  #  Description: 
  22.  # 
  23.  # Much more flexible dialogs for querying the user about flags and
  24.  # vars.  These may be global, mode-dependent, or package-dependent.
  25.  # 
  26.  # Things you may wish to do:
  27.  # 
  28.  #  dialog::pkg_options Pkg
  29.  #  
  30.  # creates a dialog for all array entries 'PkgmodeVars'.  These
  31.  # must have been previously declared using 'newPref'.  These
  32.  # variables are _not_ copied into the global scope; only
  33.  # existing as array entries.
  34.  # 
  35.  # Note that rather than setting up traces on variables, you are
  36.  # often better off using the optional proc argument to newPref;
  37.  # the name of a procedure to call if that element is changed by
  38.  # the user.
  39.  # 
  40.  # The old procedure 'newModeVar' is obsolete.  Use the
  41.  # new procedure 'newPref'.  Why?  It has optional arguments
  42.  # which allow you to declare:
  43.  # 
  44.  #  lists
  45.  #  indexed lists
  46.  #  folders
  47.  #  files
  48.  #  bindings
  49.  #  menu-bindings
  50.  #  applications
  51.  #  variable-list elements
  52.  #  array elements
  53.  #  
  54.  # all of which can be set using the same central mode/global
  55.  # dialogs.
  56.  #  
  57.  # It also lets you add an optional procedure to call when an
  58.  # item changes...  Also if Alpha upgrades to Tcl 8 and namespaces, 
  59.  # it is easy to modify that central procedure to fit everything 
  60.  # with the new scheme.
  61.  # 
  62.  # Most modes will just want to declare their vars using newPref.  
  63.  # There is usually no need to do _anything_ else.
  64.  # 
  65.  # ---
  66.  # 
  67.  # The prefs dialog procs below were based upon Pete Keleher's 
  68.  # originals.
  69.  # ###################################################################
  70.  ##
  71.  
  72. namespace eval dialog {}
  73. namespace eval global {}
  74. namespace eval flag {}
  75.  
  76.  
  77.     
  78. # ◊◊◊◊ Toplevel dialog procedures ◊◊◊◊ #
  79.  
  80. ## 
  81.  # -------------------------------------------------------------------------
  82.  # 
  83.  # "dialog::pkg_options" --
  84.  # 
  85.  #  Make a dialog for the given package, with 'title' for the dialog box.
  86.  #  'not_global' indicates the variables are never copied into the global
  87.  #  scope, remaining in their array ${pkg}modeVars (or '$var' if it is given)
  88.  # 
  89.  # Results:
  90.  #  Nothing
  91.  # 
  92.  # Side effects:
  93.  #  May modify any of the given package's variables.
  94.  # 
  95.  # --Version--Author------------------Changes-------------------------------
  96.  #    1.0     <darley@fas.harvard.edu> original
  97.  # -------------------------------------------------------------------------
  98.  ##
  99. proc dialog::pkg_options {pkg {title ""} {not_global 1} {var ""}} {
  100.     if {!$not_global} {
  101.         # make sure the package variables are global
  102.         global ${pkg}modeVars
  103.         if {[info exists ${pkg}modeVars]} {
  104.             foreach v [array names ${pkg}modeVars] {
  105.                 global $v
  106.                 set $v [set ${pkg}modeVars($v)]
  107.             }
  108.         }
  109.     }
  110.     if {$title == ""} { set title "Preferences for the '[quote::Prettify $pkg]' package" }
  111.     if {$not_global} {
  112.         global dialog::_not_global_flag
  113.         if {$var == ""} {
  114.             set dialog::_not_global_flag ${pkg}modeVars
  115.         } else {
  116.             set dialog::_not_global_flag $var
  117.         }
  118.     }
  119.     catch {dialog::modifyModeFlags $title $not_global $pkg} result
  120.     if {$not_global} {
  121.         global dialog::_not_global_flag
  122.         set dialog::_not_global_flag ""
  123.     }
  124. }
  125. proc dialog::edit_array {var {title ""}} {
  126.     if {$title == ""} {set title "Contents of '$var' array"}
  127.     dialog::pkg_options "" $title 1 $var
  128. }
  129. ## 
  130.  # -------------------------------------------------------------------------
  131.  # 
  132.  # "dialog::variable" --
  133.  # 
  134.  #  Ask for a value, with default given by the given variable, and using
  135.  #  that variable's type (list, file, ...) as a constraint.
  136.  #  
  137.  #  Currently assumes the variable is a list var, but this will change.
  138.  # -------------------------------------------------------------------------
  139.  ##
  140. proc dialog::variable {var {title ""}} {
  141.     if {$title == ""} { set title [quote::Prettify $var] }
  142.     return [dialog::optionMenu $title [flag::options $var] \
  143.       [uplevel [list set $var]]]
  144. }
  145.  
  146. proc suffixMappings {} {
  147.     global filepats
  148.     
  149.     set l1 5
  150.     set w1 38
  151.     set l2 [expr $l1 + $w1 + 5]
  152.     set w2 200
  153.     set h 18
  154.     set top 5
  155.     set mar 5
  156.  
  157.     set modes [lsort -ignore [array names filepats]]
  158.     set len [expr [llength $modes] + 1]
  159.     set modes1 [lrange $modes 0 [expr $len/2 - 1]]
  160.     set modes2 [lrange $modes [expr $len/2] end]
  161.     
  162.     foreach m $modes1 {
  163.         lappend items -t $m $l1 $top [expr $l1 + $w1] [expr $top + $h]
  164.         lappend items -e $filepats($m) $l2 $top [expr $l2 + $w2] [expr $top + $h - 2]
  165.         incr top [expr $h + $mar]
  166.     }
  167.  
  168.     set top2 5
  169.     set l1 [expr $l2 + $w2 + 20]
  170.     set l2 [expr $l1 + $w1 + 5]
  171.     foreach m $modes2 {
  172.         lappend items -t $m $l1 $top2 [expr $l1 + $w1] [expr $top2 + $h]
  173.         lappend items -e $filepats($m) $l2 $top2 [expr $l2 + $w2] [expr $top2 + $h - 2]
  174.         incr top2 [expr $h + $mar]
  175.     }
  176.     
  177.     if {$top2 > $top} {
  178.         set top $top2
  179.     }
  180.     incr top $mar
  181.     
  182.     set l1 5
  183.     lappend buts -b OK $l1 $top [expr $l1 + 60] [expr $top + 20]
  184.     lappend buts -b Cancel [expr $l1 + 100] $top [expr $l1 + 160] [expr $top + 20]
  185.     
  186.     set res [eval "dialog -w [expr $l2 + $w2 + 10] -h [expr $top + 27]" \
  187.       $buts $items]
  188.     
  189.     if {[car $res]} {
  190.         set res [cddr $res]
  191.  
  192.         foreach m [lsort -ignore [array names filepats]] {
  193.             if {$filepats($m) != [car $res]} {
  194.                 lappend changed [list $m [car $res]]
  195.             }
  196.             set res [cdr $res]
  197.         }
  198.  
  199.         foreach pair $changed {
  200.             addArrDef filepats [car $pair] [cadr $pair]
  201.             set filepats([car $pair]) [cadr $pair]
  202.         }
  203.     }
  204.     mode::updateSuffixes
  205. }
  206. proc dialog::mode {flags vars {title ""}} {
  207.     set lim [expr 10 - [llength $flags]/4]
  208.     if {[llength $vars] > $lim } {
  209.         set args {}
  210.         set nvars [llength $vars]
  211.         set j 0
  212.         for {set i 0} {$i < $nvars} {incr i $lim ; set lim 10} {
  213.             lappend args [list "Page [incr j] of ${title}" $flags [lrange $vars $i [expr $i+$lim -1]]]
  214.             set flags ""
  215.         }
  216.         dialog::multipage $args
  217.     } else {
  218.         dialog::onepage $flags $vars $title
  219.     }
  220. }
  221. ## 
  222.  # -------------------------------------------------------------------------
  223.  # 
  224.  # "dialog::modifyModeFlags" --
  225.  # 
  226.  #  Currently 'not_global == 0' implies this is a mode, or at least that
  227.  #  the variables are stored in ${mm}modeVars(...)
  228.  #  
  229.  #  'not_global == 1' implies that the variables are stored in the
  230.  #  array given by the value of the variable 'dialog::_not_global_flag'
  231.  #  
  232.  #  Recently removed a call to mode::updateSuffixes which is not necessary
  233.  # -------------------------------------------------------------------------
  234.  ##
  235. proc dialog::modifyModeFlags {{title ""} {not_global 0} {mm ""}} {
  236.     global mode invisibleModeVars modifiedArrayElements dialog::_not_global_flag \
  237.         allFlags flag::procs
  238.     # Check whether this is a mode or package, and where variable values
  239.     # are stored, and whether that's at the global level as well as in
  240.     # an array...
  241.     if {$not_global} {
  242.         set storage ${dialog::_not_global_flag}
  243.         if {$title == ""} {
  244.             set title "Preferences for '${mm}' package"
  245.         }
  246.     } else {
  247.         if {$mm == ""} { 
  248.             set mm $mode 
  249.             if {$mm == ""} {
  250.                 alertnote "No mode set!"
  251.                 return
  252.             }
  253.         }
  254.         set storage ${mm}modeVars
  255.         if {$title == ""} {
  256.             set title "Preferences for '${mm}' mode"
  257.         }
  258.     }
  259.     # check for mode specific proc
  260.     if {[info commands ${mm}modifyFlags] != ""} {${mm}modifyFlags; return}
  261.     if {[info tclversion] >= 8.0} { set storage ::$storage }
  262.     set flags {}
  263.     set vars {}
  264.     global $storage ${storage}Invisible
  265.     if {[info exists $storage]} {
  266.         set unsortedNames [array names $storage]
  267.         set colors {}
  268.         set rest {}
  269.         foreach i $unsortedNames {
  270.             if {[regexp {Colou?r$} $i]} {
  271.                 lappend colors $i
  272.             } else {
  273.                 lappend rest $i
  274.             }
  275.         }
  276.         
  277.         foreach v [concat [lsort $rest] [lsort $colors]] {
  278.             if {[info exists invisibleModeVars($v)] \
  279.               || [info exists ${storage}Invisible($v)]} continue
  280.             
  281.             if {[lsearch $allFlags $v] >= 0} {
  282.                 lappend flags $v
  283.             } else {
  284.                 lappend vars $v
  285.             }
  286.         }
  287.         
  288.         set values_items [dialog::mode $flags $vars $title]
  289.         set res [lindex $values_items 0]
  290.         set editItems [lindex $values_items 1]
  291.         unset values_items
  292.         
  293.         foreach fset $editItems {
  294.             if {[llength $fset] > 1} {
  295.                 set fset [lrange $fset 1 end]
  296.             }
  297.             foreach flag $fset {
  298.                 set val [lindex $res 0]
  299.                 set res [lrange $res 1 end]
  300.                 dialog::postManipulate
  301.                 if {$not_global} {
  302.                     # it's a package which keeps its vars in the array
  303.                     if {[set ${storage}($flag)] != $val} {
  304.                         set ${storage}($flag) $val
  305.                         lappend modifiedArrayElements [list $flag $storage]
  306.                         if {[info exists flag::procs($flag)]} {
  307.                             [set flag::procs($flag)] $flag
  308.                         }
  309.                     }
  310.                 } else {
  311.                     # modes keep a copy of their vars at the global level when active
  312.                     global $flag
  313.                     if {[set $flag] != $val} {
  314.                         set $flag $val
  315.                         set ${storage}($flag) $val
  316.                         lappend modifiedArrayElements [list $flag $storage]
  317.         
  318.                         if {[info exists flag::procs($flag)]} {
  319.                             [set flag::procs($flag)] $flag
  320.                         }
  321.                     }
  322.                 }
  323.             }
  324.         }
  325.     } else {
  326.         alertnote "The '$mm' mode/package has no preference settings."
  327.     }
  328.     
  329.     hook::callAll dialog::modifyModeFlags $mm $title
  330.  
  331. }
  332.  
  333. ## 
  334.  # -------------------------------------------------------------------------
  335.  # 
  336.  # "dialog::getAKey" --
  337.  # 
  338.  #  Returns a keystring to be used for binding a key in a menu, 
  339.  #  using a nice dialog box to ask the user.
  340.  # 
  341.  #  Possible improvements: we could replace the dialog
  342.  #  box with a status-line prompt (which would allow the use of
  343.  #  getModifiers to check what keys the user pressed).
  344.  #  
  345.  #  Now handles 'prefixChar' bindings for non-menu items.
  346.  #  i.e. you can use this dialog to bind something to 'ctrl-x ctrl-s',
  347.  #  for instance.
  348.  # 
  349.  #  If the name contains '/' it is considered to be two items,
  350.  #  separated by that '/', which are to take the same binding,
  351.  #  except that one of them will use the option key.
  352.  #  
  353.  #  Similarly '//' means use shift, '///' means shift-option,
  354.  #  For instance 'dialog::getAKey close/closeAll//closeFloat /W<O'
  355.  #  would give you the menu-item for 'close' in the file menu. 
  356.  #  except these last two aren't implemented yet ;-)
  357.  # --Version--Author------------------Changes-------------------------------
  358.  #    1.0     Johan Linde         original
  359.  #    1.1     <darley@fas.harvard.edu> can do non-menu bindings too
  360.  #    1.2     <darley@fas.harvard.edu> handles arrow keys
  361.  # -------------------------------------------------------------------------
  362.  ##
  363. proc dialog::getAKey {{name {}} {keystr {}} {for_menu 1}} {
  364.     global keys::func
  365.     # two lists for any other keys which look better with a text description
  366.     set otherKeys {"<No binding>" "-" Space}
  367.     set otherKeyChars [list "" "" " "]
  368.     if {!$for_menu} {
  369.         lappend otherKeys Left Right Up Down
  370.         lappend otherKeyChars "" "" "\x10" ""
  371.     }
  372.     set nname $name
  373.     set shift-opt [expr ![regsub {///} $nname { so-} $nname]]
  374.     set shift  [expr ![regsub {//} $nname { s-} $nname]]
  375.     set option [expr ![regsub {/} $nname { o-} $nname]]
  376.     if {[string length $keystr]} {
  377.         set values "0 0"
  378.         set mkey [keys::verboseKey $keystr normal]
  379.         if $normal {
  380.             lappend values "Normal Key"
  381.         } else {
  382.             lappend values $mkey
  383.             set mkey {}
  384.         }
  385.         lappend values [regexp {<U} $keystr]
  386.         lappend values [regexp {<B} $keystr]
  387.         if !$for_menu {
  388.             if [regexp "«(.*)»" $keystr "" i] {
  389.                 if {$i == "e"} {
  390.                     lappend values "escape"
  391.                 } else {
  392.                     lappend values "ctrl-$i"
  393.                 }
  394.             } else {
  395.                 lappend values "<none>"
  396.             }
  397.         }
  398.         if {$option} {lappend values [regexp {<I} $keystr]}
  399.         lappend values [regexp {<O} $keystr]
  400.         lappend values $mkey
  401.     } else {
  402.         set values {0 0 "" 0 0}
  403.         if !$for_menu { lappend values <none> }
  404.         if {$option} {lappend values 0}
  405.         lappend values 0 ""
  406.     }
  407.     if $for_menu {
  408.         set title "Menu key binding"
  409.     } else {
  410.         set title "Key binding"
  411.         set prefixes [keys::findPrefixChars]
  412.         foreach i $prefixes {
  413.             lappend prefix "ctrl-$i"
  414.         }
  415.         lappend prefixes e
  416.         lappend prefix "escape"
  417.     }
  418.     if {$name != ""} { append title " for '$name'" }
  419.     set usep [info exists prefix]
  420.     while {1} {
  421.         # Build box
  422.         set box "-t [list $title] 10 10 315 25  -t Key 10 40 40 55  -m [list [concat [list [lindex $values 2]]  [list "Normal key"] $otherKeys ${keys::func}]] 80 40 180 55  -c Shift [list [lindex $values 3]] 10 70 60 85  -c Control [list [lindex $values 4]] 80 70 150 85"
  423.         if $usep {
  424.             lappend box -t Prefix 190 40 230 55  -m [concat [list [lindex $values 5]]  "<none>" "-" $prefix]  235 40 315 55
  425.         }
  426.         if {$option} {lappend box -c Option [lindex $values [expr 5 + $usep]] 160 70 220 85}
  427.         lappend box -c Command [lindex $values [expr 5 + $option +$usep]] 230 70 315 85
  428.         lappend box -n "Normal key" -e [lindex $values [expr 6 + $option +$usep]] 50 40 70 55
  429.         set values [eval [concat dialog -w 330 -h 130  -b OK 20 100 85 120 -b Cancel 105 100 170 120 $box]]
  430.         # Interpret result
  431.         if {[lindex $values 1]} {error "Cancel"}
  432.         # work around a little Tcl problem
  433.         regsub "\{\{\}" $values "\\\{" values
  434.         set elemKey [string toupper [string trim [lindex $values [expr 6 + $option +$usep]]]]
  435.         set special [lindex $values 2]
  436.         set keyStr ""
  437.         if {[lindex $values 3]} {append keyStr "<U"}
  438.         if {[lindex $values 4]} {append keyStr "<B"}
  439.         if {$option && [lindex $values [expr 5 + $usep]]} {append keyStr "<I"}
  440.         if {[lindex $values [expr 5 + $option +$usep]]} {append keyStr "<O"}
  441.         if $usep {
  442.             set pref [lindex $values 5]
  443.             if {$pref != "<none>"} {
  444.                 set i [lsearch -exact $prefix $pref]
  445.                 append keyStr "«[lindex $prefixes $i]»"
  446.             }
  447.         }
  448.         if {[string length $elemKey] > 1 && $special == "Normal key"} {
  449.             alertnote "You should only give one character for key binding."
  450.         } else {
  451.             if $for_menu {
  452.                 if {$special == "Normal key" && [text::Ascii $elemKey] > 126} {
  453.                     alertnote "Sorry, can't define a key binding with $elemKey."
  454.                 } elseif {$elemKey != "" && $special == "Normal key" && ($keyStr == "" || $keyStr == "<U")} {
  455.                     alertnote "You must choose at least one of the modifiers control, option and command."
  456.                 } elseif {![regexp {F[0-9]} $special] && $special != "Tab" && $special != "Normal key" && $keyStr == ""} {
  457.                     alertnote "You must choose at least one modifier."
  458.                 } else {
  459.                     break
  460.                 }
  461.             } else {
  462.                 break
  463.             }
  464.         }
  465.     }
  466.     if {$special == "<No binding>"} {set elemKey ""}
  467.     if {$special != "Normal key" && $special != "<No binding>"} {
  468.         if {[set i [lsearch -exact $otherKeys $special]] != -1} {
  469.             set elemKey [lindex $otherKeyChars $i]
  470.         } else {
  471.             set elemKey [text::Ascii [expr [lsearch -exact ${keys::func} $special] + 97] 1]
  472.         }
  473.     }
  474.     if {![string length $elemKey]} {
  475.         set keyStr ""
  476.     } else {
  477.         append keyStr "/$elemKey"
  478.     }    
  479.     return $keyStr
  480. }
  481.  
  482. ## 
  483.  # -------------------------------------------------------------------------
  484.  # 
  485.  # "dialog::optionMenu" --
  486.  # 
  487.  #  names is the list of items.  An item '-' is a divider, and empty items
  488.  #  are not allowed.
  489.  # -------------------------------------------------------------------------
  490.  ##
  491. proc dialog::optionMenu {prompt names {default ""} {index 0}} {
  492.     if {$default == ""} {set default [lindex $names 0]}
  493.     
  494.     set y 5
  495.     set w [expr [string length $prompt] > 20 ? 350 : 200]
  496.     if {[string length $prompt] > 60} { set w 500 }
  497.     
  498.     # in case we need a wide pop-up area that needs more room
  499.     set popUpWidth [expr 7 * [maxListItemLength $names]]
  500.     set altWidth [expr $popUpWidth + 60]
  501.     set w [expr $altWidth > $w ? $altWidth : $w]
  502.     
  503.     set dialog [dialog::text $prompt 5 y [expr $w /6]]
  504.     incr y 10
  505.     eval lappend dialog [dialog::menu 30 y $names $default $popUpWidth]
  506.     incr y 20
  507.     eval lappend dialog [dialog::okcancel [expr $w - 160] y 0]
  508.     set res [eval dialog -w $w -h $y $dialog]
  509.  
  510.     if [lindex $res 2] { error "Cancel" } 
  511.     # cancel was pressed
  512.     if $index {
  513.         # we have to take out the entries correponding to pop-up 
  514.         # menu separator lines -trf
  515.         set possibilities [lremove -all $names "-"]
  516.         return [lsearch -exact $possibilities [lindex $res 0]]
  517.     } else {
  518.         return [lindex $res 0]
  519.     }
  520. }
  521.  
  522. proc dialog::yesno {args} {
  523.     switch -- [eval askyesno $args] {
  524.         "yes" {return 1}
  525.         "no" {return 0}
  526.         "cancel" {error "cancelled"}
  527.     }
  528. }
  529.  
  530. proc global::allPrefs {{which "AllPreferences"}} {
  531.     dialog::resetModified
  532.     global flagPrefs varPrefs
  533.     global::updateHelperFlags
  534.     global::updateMiscFlags
  535.     set AllPreferences [array names flagPrefs]
  536.     set InterfacePreferences {Tiling Window Wrapping Gui}
  537.     set StandardPreferences {Backups Electrics Miscellaneous Printer Tags WWW}
  538.     set OtherPreferences [lremove -l $AllPreferences \
  539.       $InterfacePreferences $StandardPreferences]
  540.     foreach nm [set [join ${which} ""]] {
  541.         lappend args [list $nm $flagPrefs($nm) $varPrefs($nm)]
  542.     }
  543.     dialog::is_global {
  544.         dialog::global_adjust_flags [dialog::multipage $args]
  545.     }
  546. }
  547.  
  548. proc dialog::preferences {menu nm} {
  549.     global flagPrefs varPrefs
  550.     if ![info exists flagPrefs($nm)] { 
  551.         set nm "[string toupper [string index $nm 0]][string range $nm 1 end]" 
  552.     }
  553.     if [string match "*Preferences" $nm] { return [global::allPrefs $nm] }
  554.     if {$nm == "Miscellaneous"} { global::updateMiscFlags }
  555.     if {$nm == "Helpers"} { global::updateHelperFlags }
  556.     dialog::is_global {
  557.         dialog::global_adjust_flags [dialog::onepage $flagPrefs($nm) $varPrefs($nm) "$nm preferences…"]
  558.     }
  559. }
  560.  
  561.  
  562. # ◊◊◊◊ Global/mode menus ◊◊◊◊ #
  563.  
  564. proc dialog::pickMenus {mode} {
  565.     global modeMenus menus globalMenus_curr
  566.     set w 20
  567.     set h 45
  568.     set endw [expr [llength [set all [lsort -ignore $menus]]] > 26 ? 560 : 380]
  569.     if {$mode == "global"} {
  570.         set current $globalMenus_curr
  571.         set box "-t {Select global menus} [expr ($endw - 150)/2] 10 $endw 30"
  572.     } else {
  573.         set current $modeMenus($mode)
  574.         set box "-t {Select menus for mode '$mode'} [expr ($endw - 180)/2] 10 $endw 30"
  575.     }
  576.     append box " -t {General menus:} 10 $h [expr $w +160] [expr $h +15]"
  577.     incr h 20
  578.     global alpha::package_menus
  579.     set nonpkgs [lremove -l $all ${alpha::package_menus}]
  580.     set npl [llength $nonpkgs]
  581.     foreach m [set all [concat $nonpkgs ${alpha::package_menus}]] {
  582.         if {[incr npl -1] == -1} {
  583.             if {$w != 20} {
  584.                 incr h 30
  585.             }
  586.             append box " -t {Package menus:} 10 $h 180 [expr $h +15]"
  587.             incr h 20
  588.             set w 20
  589.         }
  590.         # Trying to be userfriendly
  591.         switch -- $m {
  592.             MATLMenu {set name "Matlab menu"}
  593.             htmlUtilsMenu {set name "Html utilities menu"}
  594.             default {
  595.                 set name $m
  596.                 regexp {(.*)Menu$} $name blah name
  597.                 set name "[string toupper [string index $name 0]][string tolower [string range $name 1 end]] menu"
  598.             }
  599.         }
  600.         append box " -c [list $name] [expr ([lsearch -exact $current $m] >= 0)] $w $h \
  601.             [expr $w + 160] [expr $h + 15]"
  602.         incr w 180
  603.         if {$w == $endw} {set w 20; incr h 20}
  604.     }
  605.     if {$w > 20} {set w 20; incr h 20}
  606.     incr h 20
  607.     set values [eval [concat dialog -w $endw -h [expr $h + 30] -b OK 20 $h 85 [expr $h + 20] \
  608.         -b Cancel 105 $h 170 [expr $h + 20] $box]]
  609.     if {[lindex $values 1]} {return $current}
  610.     set newmenus ""
  611.     for {set i 0} {$i < [llength $all]} {incr i} {
  612.         if {[lindex $values [expr $i + 2]]} {lappend newmenus [lindex $all $i]}
  613.     }
  614.     return $newmenus
  615. }
  616.  
  617.  
  618. # ◊◊◊◊ Dialog sub-panes ◊◊◊◊ #
  619.  
  620. set dialog::_not_global_flag ""
  621.  
  622. ## 
  623.  # -------------------------------------------------------------------------
  624.  # 
  625.  # "dialog::flag" --
  626.  # 
  627.  #  Builds a dialog-box page to be used for setting global/mode/package
  628.  #  preferences.  It can contain preferences for flags (on/off), variables,
  629.  #  list items, mode items, files, folders, apps,...
  630.  # 
  631.  # Results:
  632.  #  part of a script to generate the dialog
  633.  # 
  634.  # Side effects:
  635.  #  sets maxT to the maximum height desired by the dialog
  636.  # 
  637.  # --Version--Author------------------Changes-------------------------------
  638.  #    1.0     Pete Keleher             original
  639.  #    2.0     <darley@fas.harvard.edu> much more sophisticated (and complex!)
  640.  # -------------------------------------------------------------------------
  641.  ##
  642. proc dialog::flag {flags vars {left 20} {top 40} {title {}}} {
  643.     global maxT spelling alpha::prefNames
  644.     
  645.     if {$title != ""} {
  646.         lappend args "-t" $title 30 10 400 25
  647.         incr top 25
  648.     }
  649.     # if variable names are very long, switch to 2 columns
  650.     if {[maxListItemLength $flags] > 18} {
  651.         set perRow 2
  652.         set width 225
  653.     } else {
  654.         set perRow 3
  655.         set width 150
  656.     }
  657.     set height    15
  658.     
  659.     set ind 0
  660.     set l $left
  661.     foreach f $flags {
  662.         set fname [quote::Prettify $f]
  663.         if $spelling {text::british fname}
  664.         lappend args "-c" $fname [dialog::getFlag $f] \
  665.           $l $top [incr l $width] [expr $top + $height]
  666.         if {[incr ind] % $perRow == 0} { set l $left ; incr top $height }
  667.     }
  668.     
  669.     if {$ind} {
  670.         set top [expr $top + 20]
  671.         lappend args -p 100 [expr $top + 27] 300 [expr $top + 28]
  672.     } 
  673.     
  674.     dialog::buildSection $vars top 440 $left args alpha::prefNames
  675.     incr top 30
  676.     
  677.     if {$top > $maxT} {set maxT $top}
  678.     return $args
  679. }
  680.  
  681. ## 
  682.  # -------------------------------------------------------------------------
  683.  # 
  684.  # "dialog::buildSection" --
  685.  # 
  686.  #  Build a dialog box section for a bunch of preferences.  If 'flag_check'
  687.  #  is set the prefs can be flags or vars, else just vars.
  688.  #  
  689.  #  'yvar' is a variable which contains the current y-pos in the box,
  690.  #  and should be incremented as appropriate by this procedure.
  691.  #  'width' is the width of the dialog box (default 420)
  692.  #  'l' is the left indent of all the items (default 20)
  693.  #  'dialogvar' is the variable onto which all the construction code
  694.  #  should be lappended.  If it is not given, then this proc will
  695.  #  return the items.
  696.  #  'names', if given, is an array containing textual replacements for
  697.  #  the names of the variables to be used in the box.
  698.  #  
  699.  #  A minimal call would be:
  700.  #  
  701.  #  set y 20
  702.  #  set build [dialog::buildSection [list fillColumn] y]
  703.  #  eval lappend build [dialog::okcancel 20 y]
  704.  #  set res [eval dialog -w 480 -h $y $build]
  705.  #  
  706.  # -------------------------------------------------------------------------
  707.  ##
  708. proc dialog::buildSection {vars yvar {width 420} {l 20} {dialogvar ""} {names ""} {flag_check 1}} {
  709.     global flag::list flag::type allFlags spelling alpha::colors modeMenus
  710.     upvar $yvar t
  711.     if {$dialogvar != ""} {upvar $dialogvar args}
  712.     if {$names != ""} { upvar $names name }
  713.     set height 17
  714.     set lf 135
  715.     set r [expr $l + $width]
  716.     set rb [expr $r -45]
  717.     foreach vset $vars {
  718.         if {[llength $vset] > 1} {
  719.             incr t 5
  720.             if {[lindex $vset 0] != ""} {
  721.                 lappend args "-t" "[lindex $vset 0]" [expr $l -10] $t $r [expr $t +15]
  722.                 incr t 20
  723.             }
  724.             set vset [lrange $vset 1 end]
  725.         }
  726.         foreach v $vset {
  727.             set vv [dialog::getFlag $v]
  728.             if [info exists name($v)] {
  729.                 set vname $name($v)
  730.             } else {
  731.                 set vname [quote::Prettify $v]
  732.             }
  733.             if $spelling {
  734.                 text::british vname
  735.             }
  736.             if {$flag_check && [lcontains allFlags $v]} {
  737.                 lappend args "-c" $vname $vv $l $t $r [expr $t + 15]
  738.                 incr t 15
  739.                 continue
  740.             }
  741.             # attempt to indent correctly
  742.             set len [string length $vname] 
  743.             if {$len > 40} {
  744.                 lappend args "-t" "$vname:" $l $t [expr $r -30] [expr $t + $height]
  745.                 incr t 15
  746.                 set indent 100
  747.                 set tle ""
  748.             } elseif {$len > 17} {
  749.                 set indent [expr 31 + 7 * $len]
  750.                 set tle {"-t" "$vname:" $l $t [expr $l + $indent] [expr $t + $height]}
  751.             } else {
  752.                 set indent $lf
  753.                 set tle {"-t" "$vname:" $l $t [expr $l + $indent] [expr $t + $height]}
  754.             }
  755.     
  756.             if {[info exists flag::list($v)]} {
  757.                 incr t 5
  758.                 eval lappend args $tle
  759.                 set litems [flag::options $v]
  760.                 if [regexp "index" [lindex [set flag::list($v)] 0]] {
  761.                     # set item to index, making sure bad values don't error
  762.                     if [catch {lindex $litems $vv} vv] { set vv [lindex $litems 0] }
  763.                 }
  764.                 lappend args "-m" [concat [list $vv] $litems] [expr $l + $indent -2] [expr $t -2] [expr $r - 14] [expr $t + $height +1]
  765.                 incr t 17
  766.             } elseif {[regexp "Colou?r$" $v]} {
  767.                 incr t 5
  768.                 eval lappend args $tle
  769.                 lappend args "-m" [concat [list $vv] ${alpha::colors}] [expr $l + $indent -2] [expr $t -2] [expr $r - 14] [expr $t + $height +1]
  770.                 incr t 17
  771.             } elseif {[regexp "Mode$" $v]} {
  772.                 incr t 5
  773.                 eval lappend args $tle
  774.                 if {$vv == ""} { set vv "<none>" }
  775.                 lappend args "-m" [concat [list $vv] [concat "<none>" [lsort [array names modeMenus]]]] [expr $l + $indent -2] $t [expr $r - 14] [expr $t + $height +1]
  776.                 incr t 17
  777.             } elseif {[regexp "Sig$" $v]} {
  778.                 eval lappend args $tle
  779.                 set vv [dialog::specialView_Sig $vv]
  780.                 lappend args "-t" $vv [expr $l + $indent] $t $rb [expr $t + $height +1]
  781.                 eval lappend args [dialog::buttonSet $rb $t]
  782.                 incr t 17
  783.             } elseif {[regexp "SearchPath$" $v]} {
  784.                 eval lappend args $tle
  785.                 if {$vv == ""} {
  786.                     lappend args "-t" "No search paths currently set." \
  787.                       [expr $l + $indent] $t $rb [expr $t + $height +1]
  788.                     eval lappend args [dialog::buttonSet $rb $t]
  789.                     incr t 17
  790.                 } else {
  791.                     eval lappend args [dialog::buttonSet $rb $t]
  792.                     foreach ppath $vv {
  793.                         lappend args "-t" [dialog::specialView_file $ppath] \
  794.                           [expr $l + $indent] $t $rb [expr $t + $height +1]
  795.                         incr t 17
  796.                     }
  797.                 }
  798.             } elseif {[regexp "(Path|Folder)$" $v]} {
  799.                 eval lappend args $tle
  800.                 set vv [dialog::specialView_file $vv]
  801.                 lappend args "-t" $vv [expr $l + $indent] $t $rb [expr $t + $height +1]
  802.                 eval lappend args [dialog::buttonSet $rb $t]
  803.                 incr t 17
  804.             } elseif {[info exists flag::type($v)]} {
  805.                 eval lappend args $tle
  806.                 set vv [dialog::specialView_[set flag::type($v)] $vv]
  807.                 lappend args "-t" $vv [expr $l + $indent] $t $rb [expr $t + $height +1]
  808.                 eval lappend args [dialog::buttonSet $rb $t]            
  809.                 incr t 17
  810.             } else {
  811.                 set eh [expr 1 + [string length $vv] / 60]
  812.                 incr t [expr 7 * $eh]
  813.                 eval lappend args $tle
  814.                 incr t [expr 5 -7 * $eh]
  815.                 lappend args "-e" $vv [expr $l + $indent] $t $r [expr $t + $eh * $height]
  816.                 incr t [expr 5 + 17 * $eh]
  817.             }
  818.         }
  819.     }
  820.     if {$dialogvar == ""} {return $args}
  821. }
  822. proc dialog::multipage {data} {
  823.     dialog::resetModified
  824.     global maxT
  825.     # in case internal 'command-buttons' are used in the dialog
  826.     while 1 {
  827.         
  828.     set left 20   
  829.  
  830.     set names {}
  831.     set editItems {}
  832.     set cmd ""
  833.     set maxT 0
  834.     foreach arg [lsort $data] {
  835.         if {[llength $arg] != 3} {error "Bad structure"}
  836.         lappend names [lindex $arg 0]
  837.         set flags [lindex $arg 1]
  838.         set vars [lindex $arg 2]
  839.         eval lappend editItems $flags $vars
  840.         append cmd " -n \{[lindex $arg 0]\} " [dialog::flag $flags $vars]
  841.     }
  842.  
  843.     set buttons [dialog::okcancel $left maxT]
  844.     set height $maxT
  845.     set res [eval [concat dialog -w 480 -h $height \
  846.       -t "Preferences:" 60 10 140 30 $buttons \
  847.       [list -m [concat [list [lindex $names 0]] $names] 150 10 405 30]  $cmd]]
  848.  
  849.     if {[lindex $res 0]} {
  850.         return [list [lrange $res 3 end] $editItems]
  851.     } else {
  852.         if [lindex $res 1] {
  853.             error "Cancel chosen"
  854.         }
  855.         # a 'set…' button was pressed
  856.         dialog::handleSet [lrange $res 3 end] $editItems
  857.     }
  858.     # end of large while loop
  859.     }
  860.  
  861. }
  862.  
  863. proc dialog::onepage {flags vars {title ""}} {
  864.     dialog::resetModified
  865.     global maxT
  866.     while 1 {
  867.         set left 20
  868.         set maxT 0
  869.         
  870.         set args [dialog::flag $flags $vars 20 10 $title]
  871.         set height [expr $maxT + 30]
  872.         set buttons [dialog::okcancel $left maxT]
  873.         set height $maxT
  874.         set res [eval [concat dialog -w 480 -h $height $buttons $args]]
  875.         
  876.         if [lindex $res 0] {
  877.             return [list [lrange $res 2 end] [concat $flags $vars]]
  878.         } else {
  879.             if [lindex $res 1] {
  880.                 error "Cancel chosen"
  881.             }
  882.             dialog::handleSet [lrange $res 2 end] [concat $flags $vars]
  883.         }
  884.         # big while loop end
  885.     }
  886.  
  887. }
  888.  
  889.  
  890. # ◊◊◊◊ Dialog utilities ◊◊◊◊ #
  891. proc dialog::handleSet {res names} {
  892.     global flag::type
  893.     # a 'set…' button was pressed
  894.     for {set i 0} {$i < [llength $names]} {incr i} {
  895.         if {[lindex $res $i] == 1} {
  896.             set v [lindex $names $i]
  897.             if {[regexp "SearchPath$" $v]} {
  898.                 set res [buttonAlert "Perform what action to one of the [quote::Prettify $v]s" "Add" "Remove" "Change" "Cancel"]
  899.                 switch -- $res {
  900.                     "Add" {
  901.                         # this set… pressed
  902.                         set newval [get_directory -p "New [quote::Prettify $v]:"]
  903.                         if {$newval != ""} {
  904.                             set newval [concat [dialog::getFlag $v] [list $newval]] 
  905.                             dialog::modified $v $newval
  906.                         }
  907.                     }
  908.                     "Remove" {
  909.                         if ![catch {set remove [listpick -p "Remove which items from [quote::Prettify $v]:" -l [dialog::getFlag $v]]}] {
  910.                             # remove them
  911.                             set newval [lremove -l [dialog::getFlag $v] $remove] 
  912.                             dialog::modified $v $newval
  913.                         }
  914.                     }
  915.                     "Change" {
  916.                         if ![catch {set change [listpick -p "Change which item from [quote::Prettify $v]:" [dialog::getFlag $v]]}] {
  917.                             # change it
  918.                             set newval [get_directory -p "Replacement [quote::Prettify $v]:"]
  919.                             if {$newval != ""} {
  920.                                 set old [dialog::getFlag $v]
  921.                                 set i [lsearch -exact $old $change]
  922.                                 set old [lreplace $old $i $i $newval]
  923.                                 dialog::modified $v $old
  924.                             }
  925.                         }
  926.                     }
  927.                 }
  928.                 break
  929.             } elseif {[regexp "(Path|Folder)$" $v]} {
  930.                 # this set… pressed
  931.                 set newval [get_directory -p "New [quote::Prettify $v]:"]
  932.                 if {$newval != ""} {
  933.                     dialog::modified $v $newval
  934.                 }
  935.                 break
  936.             } elseif {[info exists flag::type($v)]} {
  937.                 dialog::specialSet_[set flag::type($v)] $v
  938.                 break
  939.             } elseif {[regexp "Sig$" $v]} {
  940.                 global $v
  941.                 set newval [dialog::findApp $v [set $v]]
  942.                 if {$newval != ""} {
  943.                     dialog::modified $v $newval
  944.                 }
  945.                 break
  946.             }  
  947.         }
  948.     }
  949. }
  950.  
  951. proc dialog::setFlag {name val} {
  952.     global dialog::_not_global_flag
  953.     if {${dialog::_not_global_flag} != ""} {
  954.         global ${dialog::_not_global_flag}
  955.         set ${dialog::_not_global_flag}($name) $val
  956.     } else {
  957.         global $name
  958.         set $name $val
  959.     }    
  960. }
  961.  
  962. proc dialog::getFlag {name} {
  963.     global dialog::_modified
  964.     if [info exists dialog::_modified($name)] { 
  965.         return [set dialog::_modified($name)] 
  966.     } else {
  967.         return [dialog::getOldFlag $name]
  968.     }
  969. }
  970. proc dialog::getOldFlag {name} {
  971.     global dialog::_not_global_flag
  972.     if {${dialog::_not_global_flag} != ""} {
  973.         global ${dialog::_not_global_flag}
  974.         return [set ${dialog::_not_global_flag}($name)]
  975.     } else {
  976.         global dialog::_is_global
  977.         if [info exists dialog::_is_global] {
  978.             global global::_vars
  979.             if {[info exists global::_vars] \
  980.                 && [set i [lsearch ${global::_vars} $name]] != -1} {
  981.                 return [lindex ${global::_vars} [incr i]]
  982.             } 
  983.         }
  984.     }    
  985.     global $name
  986.     if [info exists $name] { 
  987.         return [set $name]
  988.     } else { 
  989.         alertnote "Global variable '$name' in the dialog isn't set.\r\
  990.           I'll try to fix that."
  991.         return [set $name ""]
  992.     }
  993. }
  994.  
  995. proc dialog::is_global {script} {
  996.     global dialog::_is_global
  997.     set dialog::_is_global 1
  998.     catch "[list uplevel $script]"
  999.     unset dialog::_is_global
  1000. }
  1001. proc dialog::resetModified {} {
  1002.     global dialog::_modified
  1003.     catch {unset dialog::_modified}
  1004. }
  1005.  
  1006. proc dialog::global_adjust_flags {values_items} {
  1007.     global flag::procs modifiedVars global::_vars
  1008.     set res [lindex $values_items 0]
  1009.     set editItems [lindex $values_items 1]
  1010.     unset values_items
  1011.     foreach fset $editItems {
  1012.         if {[llength $fset] > 1} {
  1013.             set fset [lrange $fset 1 end]
  1014.         }
  1015.         foreach flag $fset {
  1016.             set val [lindex $res 0]
  1017.             set res [lrange $res 1 end]
  1018.             dialog::postManipulate
  1019.             if {[info exists global::_vars] \
  1020.                 && [set i [lsearch ${global::_vars} $flag]] != -1} {
  1021.                 set orig [lindex ${global::_vars} [incr i]]
  1022.                 if {$orig != $val} {
  1023.                     set global::_vars [lreplace ${global::_vars} $i $i $val]
  1024.                     lappend warn_global $flag
  1025.                 }
  1026.             } else {
  1027.                 global $flag
  1028.                 set orig [set $flag]
  1029.                 if {$orig != $val} {
  1030.                     set $flag $val
  1031.                 }
  1032.             }
  1033.             if {$orig != $val} {
  1034.                 if {[info exists flag::procs($flag)]} {
  1035.                     [set flag::procs($flag)] $flag
  1036.                 }
  1037.                 lappend modifiedVars $flag
  1038.             }
  1039.         }
  1040.     }
  1041.     if [info exists warn_global] {
  1042.         if {[llength $warn_global] == 1} {
  1043.             set msg "is a global pref"
  1044.         } else {
  1045.             set msg "are global prefs"
  1046.         }
  1047.         alertnote "You modified [join $warn_global {, }] which $msg,\
  1048.           but currently over-ridden by mode-specific values.  If you meant to\
  1049.           modify the latter values, use the mode prefs dialog."
  1050.     }
  1051. }
  1052.  
  1053. proc dialog::postManipulate {} {
  1054.     global flag::list flag::type
  1055.     upvar flag f
  1056.     upvar val v
  1057.  
  1058.     if [info exists flag::list($f)] {
  1059.         switch -- [lindex [set l [set flag::list($f)]] 0] {
  1060.             "index" {
  1061.                 set v [lsearch -exact [lindex $l 1] $v]
  1062.             }
  1063.             "varindex" {
  1064.                 set itemv [lindex $l 1]
  1065.                 global $itemv
  1066.                 set v [lsearch -exact [set $itemv] $v]
  1067.             }
  1068.         }
  1069.     }
  1070.     if {$v == "<none>" && [regexp "Mode$" $f]} { set v "" }
  1071.     # This check also captures any 'dialog::modified items
  1072.     # This allows flags which are somehow already set by the
  1073.     # dialog (for instance if called recursively, or if set by embedded
  1074.     # 'Set…' buttons) to be registered as modifed by our calling procedure.
  1075.     if {[regexp "(Path|Folder|Sig)$" $f]} {
  1076.         set v [dialog::getFlag $f]
  1077.     } elseif {[info exists flag::type($f)]} {
  1078.         switch -- [set flag::type($f)] {
  1079.             "binding" {
  1080.                 # setup the changed binding
  1081.                 set old [dialog::getOldFlag $f]
  1082.                 set v [dialog::getFlag $f]
  1083.                 if {$old != $v} {
  1084.                     global flag::binding
  1085.                     if [info exists flag::binding($f)] {
  1086.                         set m [lindex [set flag::binding($f)] 0]
  1087.                         if {[set proc [lindex [set flag::binding($f)] 1]] == 1} {
  1088.                             set proc $f
  1089.                         }
  1090.                         namespace eval ::alpha [list catch "unbind [keys::toBind $old] [list $proc] $m"]
  1091.                         namespace eval ::alpha [list catch "bind [keys::toBind $v] [list $proc] $m"]
  1092.                     }
  1093.                 }
  1094.             }
  1095.             default {
  1096.                 set v [dialog::getFlag $f]
  1097.             }
  1098.         }
  1099.     }
  1100. }
  1101.  
  1102. proc dialog::modified {name val} {
  1103.     global dialog::_modified
  1104.     set dialog::_modified($name) $val
  1105. }
  1106.  
  1107. # Used on modified mode flags.
  1108. set flag::procs(stringColor) "stringColorProc"
  1109. set flag::procs(commentColor) "stringColorProc"
  1110. set flag::procs(keywordColor) "stringColorProc"
  1111. set flag::procs(funcColor) "stringColorProc"
  1112. set flag::procs(sectionColor) "stringColorProc"
  1113. set flag::procs(bracesColor) "stringColorProc"
  1114.  
  1115. proc global::updateHelperFlags {} {
  1116.     uplevel #0 {
  1117.         set flagPrefs(Helpers) {}
  1118.         set varPrefs(Helpers) [info globals *Sig]
  1119.     }
  1120. }
  1121.  
  1122. proc global::updateMiscFlags {} {
  1123.     global flagPrefs varPrefs allFlags modeVars allVars
  1124.     # flags can be in either flagPrefs or varPrefs if we're grouping
  1125.     # preferences according to function
  1126.     set all {}
  1127.     set flagPrefs(Miscellaneous) {}
  1128.     set varPrefs(Miscellaneous) {}
  1129.     foreach v [array names flagPrefs] {
  1130.         eval lappend all $flagPrefs($v)
  1131.         if [regexp {[{}]} $varPrefs($v)] {
  1132.             # we're grouping
  1133.             foreach i $varPrefs($v) {
  1134.                 if {[llength $i] > 1} {
  1135.                     eval lappend all [lrange $i 1 end]
  1136.                 } else {
  1137.                     lappend all $i
  1138.                 }
  1139.             }
  1140.         } else {
  1141.             eval lappend all $varPrefs($v)
  1142.         }
  1143.     }
  1144.     foreach f $allFlags {
  1145.         if {([lsearch $modeVars $f] < 0)} {
  1146.             if {[lsearch -exact $all $f] == -1} {
  1147.                 lappend flagPrefs(Miscellaneous) $f
  1148.             }
  1149.         }
  1150.     }
  1151.     
  1152.     foreach f $allVars {
  1153.         if {([lsearch $modeVars $f] < 0)} {
  1154.             if {[lsearch -exact $all $f] == -1} {
  1155.                 if [regexp {Sig$} $f] {
  1156.                     lappend varPrefs(Helpers) $f
  1157.                 } else {
  1158.                     lappend varPrefs(Miscellaneous) $f
  1159.                 }
  1160.             }
  1161.         }
  1162.     }
  1163. }
  1164.  
  1165. #================================================================================
  1166.  
  1167. proc maxListItemLength {l} {
  1168.     set m 0
  1169.     foreach item $l {
  1170.         if {[set mm [string length $item]] > $m} { set m $mm }
  1171.     }
  1172.     return $m
  1173. }
  1174.  
  1175. proc stringColorProc {flag} {
  1176.     global $flag mode
  1177.     
  1178.     if {[set $flag] == "none"} {
  1179.         set $flag "foreground"
  1180.     }
  1181.     if {$flag == "stringColor"} {
  1182.         regModeKeywords -a -s $stringColor $mode
  1183.     } elseif {$flag == "commentColor"} {
  1184.         regModeKeywords -a -c $commentColor $mode
  1185.     } elseif {$flag == "funcColor"} {
  1186.         regModeKeywords -a -f $funcColor $mode
  1187.     } elseif {$flag == "bracesColor"} {
  1188.         regModeKeywords -a -I $bracesColor $mode
  1189.     } elseif {($flag == "keywordColor") || ($flag == "sectionColor")} {
  1190.         alertnote "Change in keyword color will take effect after Alpha restarts."
  1191.         return
  1192.     } else {
  1193.         alertnote "Change in $flag color will take effect after Alpha restarts."
  1194.         return
  1195.     }
  1196.     refresh
  1197. }
  1198.  
  1199. # ◊◊◊◊ Dialog sub-items ◊◊◊◊ #
  1200.  
  1201. proc dialog::buttonSet {x y} {
  1202.     return [list -b Set… $x $y [expr $x + 45] [expr $y + 15]]
  1203. }
  1204.  
  1205. proc dialog::okcancel {x yy {vertical 0}} {
  1206.     upvar $yy y
  1207.     set i [dialog::button "OK" $x y]
  1208.     if {!$vertical} {
  1209.         incr y -30
  1210.         incr x 80
  1211.     }
  1212.     eval lappend i [dialog::button "Cancel" $x y]
  1213.     return $i
  1214. }
  1215.  
  1216. proc dialog::menu {x yy item {def "def"} {requestedWidth 0}} { 
  1217.     upvar $yy y
  1218.     set m [concat [list $def] $item]
  1219.     if {$requestedWidth == 0} {
  1220.         set popUpWidth 340
  1221.     } else {
  1222.         set popUpWidth $requestedWidth 
  1223.     }
  1224.     
  1225.     set res [list -m $m  $x $y [expr $x + $popUpWidth] [expr $y +20]]
  1226.     incr y 20
  1227.     return $res
  1228. }
  1229. proc dialog::button {name x yy args} { 
  1230.     upvar $yy y
  1231.     set incr 65
  1232.     if {[set i [expr [string length $name] - 7]] > 0} { 
  1233.         incr incr [expr $i * 7]
  1234.     }
  1235.     set res [list -b $name $x $y [expr $x +$incr] [expr $y +20]]
  1236.     if [llength $args] {
  1237.         eval lappend res [eval dialog::button $args]
  1238.         return $res
  1239.     }
  1240.     incr y 30
  1241.     return $res
  1242. }
  1243. proc dialog::title {name w} {
  1244.     set l [expr ${w}/2 - 4 * [string length $name]]
  1245.     if {$l < 0} {set l 0}
  1246.     return [list -t $name $l 10 [expr $w - $l] 25]
  1247. }
  1248. proc dialog::text {name x yy {split 0}} {
  1249.     upvar $yy y
  1250.     if {!$split || $name == ""} {
  1251.         set res [list -t $name $x $y [expr $x + 7 * [string length $name]] \
  1252.             [expr $y +15]]
  1253.         incr y 18
  1254.     } else {
  1255.         global fillColumn
  1256.         set f $fillColumn
  1257.         set fillColumn $split
  1258.         # modified to handle return deliminated text as paragraphs -trf
  1259.         set paragraphList [split $name "\r"]
  1260.         foreach para $paragraphList {
  1261.             set lines [breakIntoLines $para]
  1262.             foreach line [split $lines "\r"] {
  1263.                 eval lappend res [list -t $line $x $y [expr $x + 4+ 8 * [string length $line]] \
  1264.                     [expr $y +15]]
  1265.                 incr y 18
  1266.             }
  1267.             incr y 10
  1268.         }
  1269.         set fillColumn $f
  1270.     }
  1271.     return $res
  1272. }
  1273. proc dialog::edit {name x yy chars {cols 1}} {
  1274.     upvar $yy y
  1275.     set res [list -e $name $x $y [expr $x + 10 * $chars] [expr $y + 15 * $cols]]
  1276.     incr y [expr 5 + 15*$cols]
  1277.     return $res
  1278. }
  1279. proc dialog::textedit {name default x yy chars {height 1}} {
  1280.     upvar $yy y
  1281.     set res [list -t $name $x $y [expr $x + 8 * [string length $name]]\
  1282.         [expr $y +16] \
  1283.         -e $default $x [expr $y + 20] [expr $x + 10 * $chars] \
  1284.         [expr $y +20 + 16*$height]]
  1285.     incr y [expr 24 + 16*$height]
  1286.     return $res
  1287. }
  1288. proc dialog::checkbox {name default x yy} {
  1289.     upvar $yy y
  1290.     set res [list -c $name $default $x $y]
  1291.     set c [regsub -all -nocase {[wm]} $name "" ""]
  1292.     set len [expr 10 * [string length $name] + 4 * $c]
  1293.     lappend res [expr $x + $len] [expr $y +15]
  1294.     incr y 18
  1295.     return $res
  1296. }
  1297.  
  1298. # ◊◊◊◊ Multiple bindings dialogs ◊◊◊◊ #
  1299.  
  1300. proc dialog::arrayBindings {name array {for_menu 0}} {
  1301.     upvar $array a
  1302.     foreach n [array names a] {
  1303.         lappend l [list $a($n) $n]
  1304.     }
  1305.     if [info exists l] {
  1306.         eval dialog::adjustBindings [list $name modified "" $for_menu] $l
  1307.     }
  1308.     array set a [array get modified]
  1309. }
  1310.  
  1311. ## 
  1312.  # -------------------------------------------------------------------------
  1313.  # 
  1314.  # "dialog::adjustBindings" --
  1315.  # 
  1316.  #  'args' is a list of pairs.  The first element of each pair is the 
  1317.  #  menu binding, and the second element is a descriptive name for the
  1318.  #  element. 'array' is the name of an array in the calling proc's
  1319.  #  scope which is used to return modified bindings.
  1320.  # 
  1321.  # Results:
  1322.  #  
  1323.  # 
  1324.  # 
  1325.  # CURRENTLY UNDER DEVELOPMENT.  Should eventually work for html mode,
  1326.  # any general binding set you like, in menus or outside (e.g. for
  1327.  # completion key-sets),…
  1328.  # 
  1329.  # NOTE for Johan: this proc takes 'name', the 'for_menu' flag
  1330.  # and a list of items.  It returns the modified items in 'array',
  1331.  # which can be turned into a list using 'array get'.  It returns
  1332.  # just the names of the modified items in the list 'mod', if given.
  1333.  # 
  1334.  # It doesn't use your 'array($name/$value)'
  1335.  # --Version--Author------------------Changes-------------------------------
  1336.  #    1.0     Johan Linde               original for html mode
  1337.  #    1.1     <darley@fas.harvard.edu> general purpose version
  1338.  # -------------------------------------------------------------------------
  1339.  ##
  1340. proc dialog::adjustBindings {name array {mod {}} {for_menu 1} args} {
  1341.     regsub -all {\"\(-\"} $args "" items
  1342.     upvar $array key_changes
  1343.     
  1344.     foreach it $items {
  1345.         if {[info exists key_changes([lindex $it 1])]} {
  1346.             set tmpKeys([lindex $it 1]) $key_changes([lindex $it 1])
  1347.         } else {
  1348.             set tmpKeys([lindex $it 1]) [lindex $it 0]
  1349.         }
  1350.     }
  1351.     # do we return modified stuff?
  1352.     if {$mod != ""} { upvar $mod modified }
  1353.     set modified ""
  1354.     while {1} {
  1355.         # Build dialog.
  1356.         set box ""
  1357.         set h 30
  1358.         foreach it $items {
  1359.             if {$it == "(-"} {continue}
  1360.             set w 210
  1361.             set w2 370
  1362.             set key $tmpKeys([lindex $it 1])
  1363.             set key1 [dialog::specialView_binding $key]
  1364.             set it2 [split [lindex $it 1] /]
  1365.             if {[llength $it2] == 1} {
  1366.                 lappend box -t [lindex $it2 0] 65 $h 205 [expr $h + 15] -t $key1 $w $h $w2 [expr $h + 15]
  1367.                 eval lappend box [dialog::buttonSet 10 $h]
  1368.                 incr h 17
  1369.             } else {
  1370.                 lappend box -t [lindex $it2 0] 65 $h 205 [expr $h + 15] -t $key1 $w $h $w2 [expr $h + 15]
  1371.                 eval lappend box [dialog::buttonSet 10 [expr $h +8]]
  1372.                 incr h 17
  1373.                 if {$key1 != "<no binding>"} {regsub {((ctrl-)?(shift-)?)(.*)} $key1 {\1opt-\4} key1}
  1374.                 lappend box -t [lindex $it2 1] 65 $h 205 [expr $h + 15] -t $key1 $w $h $w2 [expr $h + 15]
  1375.                 incr h 17
  1376.              }
  1377.         }
  1378.         set buttons "-b OK 20 [expr $h + 10] 85 [expr $h + 30]  -b Cancel 105 [expr $h + 10] 170 [expr $h + 30]"
  1379.         set values [eval [concat dialog -w 380 -h [expr $h + 40]  $buttons -t [list $name] 50 10 250 25 $box]]
  1380.         if {[lindex $values 1]} {
  1381.             # Cancel
  1382.             return "Cancel"
  1383.         } elseif {[lindex $values 0]} {
  1384.             # Save new key bindings
  1385.             foreach it $modified {
  1386.                 set key_changes($it) $tmpKeys($it)
  1387.             }
  1388.             return
  1389.         } else {
  1390.             # Get a new key.
  1391.             set it [lindex [lindex $items [expr [lsearch $values 1] - 2]] 1]
  1392.             if {![catch {dialog::getAKey $it $tmpKeys($it) $for_menu} newKey]  && $newKey != $tmpKeys($it)} {
  1393.                 set tmpKeys($it) $newKey
  1394.                 lappend modified $it
  1395.             }
  1396.         }
  1397.     }
  1398. }
  1399.  
  1400. # ◊◊◊◊ Manipulation of special pref types ◊◊◊◊ #
  1401.  
  1402. proc dialog::specialView_binding {key} {
  1403.     append key1 [keys::modifiersTo $key "verbose"]
  1404.     append key1 [keys::verboseKey $key]
  1405.     if {$key1 == ""} { return "<no binding>" }
  1406.     return $key1
  1407. }
  1408.  
  1409. proc dialog::specialSet_binding {v {menu 0}} {
  1410.     # Set… pressed
  1411.     set oldB [dialog::getFlag $v]
  1412.     if {![catch {dialog::getAKey [quote::Prettify $v] $oldB $menu} newKey] && $newKey != $oldB} {
  1413.         dialog::modified $v $newKey
  1414.     }
  1415. }
  1416.  
  1417. proc dialog::specialView_menubinding {key} {
  1418.     dialog::specialView_binding $key
  1419. }
  1420.  
  1421. proc dialog::specialSet_menubinding {v} {
  1422.     dialog::specialSet_binding $v 1
  1423. }
  1424. proc dialog::specialView_Sig {vv} {
  1425.     if {$vv != ""} {
  1426.         if [catch {nameFromAppl $vv} path] {
  1427.             return "Unknown application with sig '$vv'"
  1428.         } else {
  1429.             return [dialog::specialView_file $path]
  1430.         }
  1431.     }
  1432.     return ""
  1433. }
  1434.  
  1435. proc dialog::specialView_io-file {vv} {
  1436.     dialog::specialView_file $vv
  1437. }
  1438.  
  1439. proc dialog::specialView_file {vv} {
  1440.     if {[set sl [string length $vv]] > 40} {
  1441.         set vv "[string range $vv 0 14]...[string range $vv [expr $sl -22] end]"
  1442.     }
  1443.     return $vv
  1444. }
  1445. proc dialog::specialSet_file {v} {
  1446.     # Set… pressed
  1447.     set old [dialog::getFlag $v]
  1448.     if {![catch {getfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  1449.       && $ff != $old} {
  1450.         dialog::modified $v $ff
  1451.     }
  1452. }
  1453. proc dialog::specialSet_io-file {v} {
  1454.     # Set… pressed
  1455.     set old [dialog::getFlag $v]
  1456.     if {![catch {putfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  1457.       && $ff != $old} {
  1458.         dialog::modified $v $ff
  1459.     }
  1460. }
  1461.  
  1462.  
  1463.