home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / globals.tcl < prev    next >
Encoding:
Text File  |  1997-12-14  |  9.1 KB  |  304 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "globals.tcl"
  6.  #                                    created: 13/6/94 {9:39:12 pm} 
  7.  #                                last update: 14/12/97 {2:17:12 pm} 
  8.  #  
  9.  # Reorganisation carried out by Vince Darley with much help from Tom 
  10.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  11.  # Alpha is shareware; please register with the author using the register 
  12.  # button in the about box.
  13.  #  
  14.  # ###################################################################
  15.  ##
  16.  
  17. namespace eval flag {}
  18. namespace eval global {}
  19.  
  20. proc alpha::getGlobalPreferences {} {}
  21.  
  22. set tileWidth [expr $screenWidth - 10]
  23. if {$tileWidth > 510} {set defWidth 510} else {set defWidth $tileWidth }
  24. set tileHeight [expr $screenHeight - 60]
  25. set defHeight $tileHeight
  26.  
  27. set tclvars {}
  28. set allFlags {}
  29. set allVars {}
  30. set invisibleModeVars(wordWrap) 1
  31.  
  32. # The following three procs, together w/ the initialization 
  33. # for the flags below, allow Tcl to control Alpha's internal
  34. # variables.  We use semi-colons so they are not exported to
  35. # tclIndex files.
  36. ;proc initFlag {var args} {
  37.     linkAlpha $var [lindex $args 0]
  38.     eval newPref flag $var $args
  39. }
  40. ;proc initVar {var args} {
  41.     linkAlpha $var [lindex $args 0]
  42.     eval newPref variable $var $args
  43. }
  44. # The internal vars over-ride differently to other prefs
  45. ;proc linkAlpha {var val} {
  46.     linkVar $var
  47.     if {$val != ""} { global $var ; set $var $val }
  48. }
  49.  
  50. proc flag::options {v} {
  51.     global flag::list
  52.     set thelist [set flag::list($v)]
  53.     set litems [lindex $thelist 1]
  54.     switch -- [lindex $thelist 0] {
  55.         "varitem" {
  56.             return [uplevel \#0 "set $litems"]
  57.         }
  58.         "varindex" {
  59.             return [uplevel \#0 "set $litems"]
  60.         }
  61.         "array" {
  62.             global $litems
  63.             return [lsort [array names $litems]]
  64.         }
  65.     }
  66.     return $litems
  67. }
  68.  
  69. catch {initFlag lockStatus 1}
  70. initFlag autoHScroll 1
  71. initFlag autoSave 0
  72. initFlag blinkingCursor 1
  73. initFlag blockCursor 0
  74. initFlag coloring 1
  75. initFlag dragAndDrop 1
  76. initFlag horScrollBar 0
  77. initFlag hyperText 1
  78. initFlag indentOnCR 1
  79. initFlag moveInsertion
  80. initFlag openAllFiles
  81. initFlag powerThumb 1
  82. initFlag projectorAware
  83. initFlag showInvisibles 0
  84. initFlag smallMenuFont 1
  85. initFlag sortedIsDefault
  86. initFlag tearoffMenus 1
  87. initFlag tempMem 1
  88. initFlag undoOn 1
  89. initFlag wordWrap
  90. newPref flag askDeleteSelection 0
  91. newPref flag backup 0
  92. newPref flag forceMainScreen 1
  93. newPref flag electricTab 0
  94. newPref flag iconifyOnSwitch 0
  95. newPref flag infoWindowsDirty 0
  96. newPref flag intelCutPaste 1
  97. newPref flag sortFuncsMenu 1
  98. newPref flag doubleSpaces 1
  99. newPref flag printHeader 1
  100. newPref flag printHeaderFullPath 0
  101. newPref flag printHeaderTime 1
  102. ## 
  103.  # If you try and complete a command for which no unique
  104.  # suffix exists, the choice is    to cancel or present the
  105.  # user    with a list    of options from    which to pick.
  106.  ##
  107. newPref flag listPickIfMultCmps 1
  108. # if we have a choice between, say \left, \leftRight, \leftMore,
  109. # then we don't get stuck on '\left' with this option.
  110. newPref flag listPickIfNonUniqueStuckCmp 1
  111. newPref flag quietlyClearMarks 1
  112.  
  113. newPref var backupFolder ""
  114. newPref var backupExtension "~"
  115. newPref var backupAgeRequirementInHours 0.0
  116. newPref var createFtpType unix global "" "mac unix ibm"
  117. newPref var horMargin 4
  118. newPref var indentationAmount 4
  119. newPref var minItemsInTitlePopup 5
  120. newPref var numWinsToTile 2
  121. newPref var tileHeight
  122. newPref var tileLeft 2
  123. newPref var tileMargin 22
  124. newPref var tileProportion .60
  125. newPref var tileTop 40
  126. newPref var tileWidth
  127. newPref var batchListWindowFraction 0.25 global win::SetProportions
  128.  
  129. newPref variable keyboard US global keys::keyboardChanged keyboards array
  130.  
  131. newPref var spelling 0 global "" "American British" index
  132. newPref var reportErrors 1 global "" \
  133.   [list "Log startup errors" "Report errors immediately"] index
  134. newPref flag synchroniseWithInternetConfig 0
  135. initVar    printerFont "" global "" "system monaco courier geneva helvetica profont times {new york}"
  136. initVar    printerFontSize "" global "" "9 10 12 14 18"
  137. initVar defaultFont "monaco" global "" "system monaco courier geneva helvetica profont times {new york}"
  138. initVar fontSize 9 global "" "9 10 12 14 18"
  139. initVar savedState "" global "" "none think mpw"
  140. initVar tabSize 4
  141. initVar    wrapBreak {[\w_]+}
  142. initVar    wrapBreakPreface {([^\w_])}
  143. initVar    wrapHigh
  144. initVar    wrapLow
  145. initVar bottomMargin
  146. initVar changesLim
  147. initVar defHeight
  148. initVar defLeft     2
  149. initVar defTop         40
  150. initVar defWidth
  151. initVar fillColumn 75
  152. initVar funcExpr {^[^ \t\(#\r/@].*\(.*\)$}
  153. initVar funcPar 1
  154. initVar leftFillColumn
  155. initVar leftMargin
  156. initVar paraColumn 180
  157. initVar sortColumn
  158. initVar tagFile "$HOME:cTAGS"
  159. set flag::type(tagFile) io-file
  160. initVar topMargin
  161. initVar wordBreak {\w+}
  162. initVar wordBreakPreface {(\W)}
  163. # Flags that won't appear in the menu.
  164. linkVar numLock
  165. newPref var defaultAlphaDownloadSite "" global "" remote::site array
  166. # bug in alpha-ic interaction
  167. if ![catch "icGetPref DownloadFolder" res] {
  168.     newPref var downloadFolder $res
  169. } else {
  170.     newPref var downloadFolder $HOME
  171. }
  172.  
  173. lunion flagPrefs(Backups)         backup undoOn autoSave
  174. lunion varPrefs(Backups)         backupFolder backupExtension changesLim \
  175.   backupAgeRequirementInHours
  176. lunion flagPrefs(Gui)             blinkingCursor blockCursor coloring \
  177.   dragAndDrop iconifyOnSwitch intelCutPaste lockStatus showInvisibles \
  178.   smallMenuFont sortFuncsMenu tearoffMenus doubleSpaces hyperText
  179. lunion varPrefs(Gui)              defaultFont fontSize tabSize sortColumn
  180. lunion flagPrefs(Printer)         printHeader printHeaderFullPath printHeaderTime
  181. lunion varPrefs(Printer)         bottomMargin printerFont printerFontSize \
  182.   topMargin leftMargin
  183. lunion flagPrefs(Tags)         
  184. lunion varPrefs(Tags)             funcPar tagFile
  185. lunion flagPrefs(Window)         autoHScroll forceMainScreen horScrollBar \
  186.   moveInsertion powerThumb sortedIsDefault
  187. lunion varPrefs(Window)         defHeight defLeft defTop defWidth \
  188.   minItemsInTitlePopup savedState
  189. lunion flagPrefs(Tiling)         
  190. lunion varPrefs(Tiling)         numWinsToTile batchListWindowFraction horMargin \
  191.   tileHeight tileProportion tileLeft tileMargin tileTop tileWidth 
  192. lunion flagPrefs(Wrapping)     
  193. lunion varPrefs(Wrapping)         fillColumn leftFillColumn paraColumn wrapLow \
  194.   wrapHigh
  195. lunion flagPrefs(Electrics)     listPickIfMultCmps listPickIfNonUniqueStuckCmp \
  196.   askDeleteSelection electricTab indentOnCR
  197. lunion varPrefs(Electrics)     indentationAmount
  198. lunion flagPrefs(Miscellaneous) 
  199. lunion flagPrefs(Helpers) 
  200. lunion varPrefs(Miscellaneous) 
  201. lunion varPrefs(Helpers) 
  202. lunion flagPrefs(WWW) synchroniseWithInternetConfig
  203. lunion varPrefs(WWW) defaultAlphaDownloadSite createFtpType downloadFolder \
  204.   browserSig ftpSig httpDownloadSig
  205. lunion flagPrefs(International)
  206. lunion varPrefs(International) keyboard spelling 
  207. lunion flagPrefs(Packages)
  208. lunion varPrefs(Packages) reportErrors
  209.  
  210. proc alpha::addToPreferencePage {page args} {
  211.     global varPrefs flagPrefs allFlags
  212.     set vars [lremove -l $args $allFlags]
  213.     set flags [lremove -l $args $vars]
  214.     eval lunion varPrefs($page) $vars
  215.     eval lunion flagPrefs($page) $flags
  216. }
  217.  
  218. namespace eval indent {}
  219.  
  220. set indent::amounts [list "nothing" "half-tab" "tab"]
  221.  
  222. proc indent::setup {args} {
  223.     global indent_amounts indentationAmount
  224.     set indent_amounts(0) 0
  225.     set indent_amounts(1) [expr $indentationAmount/2]
  226.     set indent_amounts(2) $indentationAmount
  227.     set indent_amounts(-1) [expr -$indentationAmount/2]
  228.     set indent_amounts(-2) [expr -$indentationAmount]
  229. }
  230. indent::setup
  231. trace variable indentationAmount w indent::setup
  232.  
  233. proc getFileSig {f} {
  234.     getFileInfo $f arr
  235.     return $arr(creator)
  236. }
  237.  
  238. proc getFileType {f} {
  239.     getFileInfo $f arr
  240.     return $arr(type)
  241. }
  242.  
  243. # get defaults from internet config
  244. if $synchroniseWithInternetConfig {
  245.     catch {set browserSig [getFileSig [icGetPref -t 1 Helper•http]]}
  246.     catch {set ftpSig [getFileSig [icGetPref -t 1 Helper•ftp]]}
  247. } else {
  248.     catch {ensureset browserSig [getFileSig [icGetPref -t 1 Helper•http]]}
  249.     catch {ensureset ftpSig [getFileSig [icGetPref -t 1 Helper•ftp]]}
  250. }
  251.  
  252. # now set them
  253. newPref v browserSig MOSS
  254. newPref v ftpSig Arch
  255. newPref v httpDownloadSig $browserSig
  256.  
  257. namespace eval win {}
  258.  
  259. proc win::SetProportions {} {
  260.     global tileHeight tileWidth tileTop tileLeft tileHeight \
  261.         errorHeight errorDisp tileMargin batchListWindowFraction
  262.     set errorHeight [expr int ($batchListWindowFraction * ($tileHeight - $tileMargin))]
  263.     set errorDisp [expr int ((1- $batchListWindowFraction) * ($tileHeight - $tileMargin))]
  264. }
  265.  
  266. proc wordWrapProc {val} { 
  267.     global mode wordWrap modifiedArrayElements 
  268.     global ${mode}modeVars
  269.     set wordWrap $val
  270.     set ${mode}modeVars(wordWrap) $val
  271.     lappend modifiedArrayElements [list wordWrap ${mode}modeVars]
  272. }
  273.  
  274.  
  275. proc toggleNumLock {} {
  276.     global numLock modifiedVars
  277.     
  278.     set numLock [expr -1 * ($numLock - 1)]
  279.     lappend modifiedVars numLock
  280. }
  281.  
  282. #============================================================================
  283. # declare these as modeVars in advance.  I'm not sure it is necessary (Vince)
  284. lunion modeVars funcExpr wrapBreakPreface wrapBreak wordBreakPreface wordBreak
  285.  
  286. # 'mode' is nothing when we start up.
  287. set mode                 {}
  288. set lastMode            0
  289. set reverting             {}
  290.  
  291. ##############################
  292. #                             #
  293. #    Things done    at startup     #
  294. #                             #
  295. ##############################
  296.  
  297. # For quithook
  298. set modifiedVars        {}
  299. set modifiedArrVars     {}
  300. set modifiedModeVars    {}
  301. set modifiedModeMenus   {}
  302. set modifiedArrayElements {}
  303.  
  304.