├── .plumb
├── B
├── README
├── awd
├── build
├── dotma.tcl
├── ma
├── ma-eval
├── plumb
├── pty.c
├── utils
    ├── LR
    ├── README
    ├── archive.tcl
    ├── colors
    │   ├── acme.tcl
    │   ├── autumn-light.tcl
    │   ├── blue-sea.tcl
    │   ├── crisp.tcl
    │   ├── electric.tcl
    │   ├── faff.tcl
    │   ├── glowfish.tcl
    │   ├── goldenrod.tcl
    │   ├── gotham.tcl
    │   ├── green-screen.tcl
    │   ├── greyish.tcl
    │   ├── jazz.tcl
    │   ├── material-light.tcl
    │   ├── material.tcl
    │   ├── mistyrose.tcl
    │   ├── mono.tcl
    │   ├── organic-green.tcl
    │   ├── paper.tcl
    │   ├── pink-bliss.tcl
    │   ├── relaxed.tcl
    │   ├── solarized.tcl
    │   ├── subatomic.tcl
    │   ├── wheat.tcl
    │   └── zenburn.tcl
    ├── ctags.tcl
    ├── diff.tcl
    ├── execfile.tcl
    ├── g
    ├── gg
    ├── git-diff.tcl
    ├── git-log.tcl
    ├── git-status.tcl
    ├── git.tcl
    ├── gopher
    ├── gopher.tcl
    ├── h
    ├── hooks.tcl
    ├── ind
    ├── irc.tcl
    ├── mark.tcl
    ├── post-commit
    ├── project.tcl
    ├── savedstate.tcl
    ├── scheme-indent.tcl
    ├── snip
    ├── snippets.tcl
    ├── unquote
    └── upcase
└── win


/.plumb:
--------------------------------------------------------------------------------
  1 | # default plumbing rules
  2 | #
  3 | # rules are tried in the order given, return 0 if the rule should be
  4 | # skipped.
  5 | #
  6 | # Now, customize!
  7 | 
  8 | 
  9 | set browser firefox
 10 | set image_viewer sxiv
 11 | set pdf_viewer mupdf
 12 | set media_player mpv
 13 | 
 14 | # ZIP archives
 15 | Plumb {^.*\.zip$} {
 16 |     if {[file exists [GetArg 0]]} {
 17 |         RunOutput unzip -l [GetArg 0]
 18 |         return 1
 19 |     }
 20 |     return 0
 21 | }
 22 | 
 23 | # TAR archives
 24 | Plumb {^.*\.tar\..*$} {
 25 |     if {[file exists [GetArg 0]]} {
 26 |         RunOutput tar tf [GetArg 0]
 27 |         return 1
 28 |     }
 29 |     return 0
 30 | }
 31 | 
 32 | # CHICKEN tickets
 33 | Plumb {^#([[:digit:]]+)} {
 34 |     exec plumb "https://bugs.call-cc.org/ticket/[GetArg 1]"
 35 |     return 1
 36 | }
 37 | 
 38 | # Emails
 39 | Plumb {^<mail:(.+)>$} {
 40 |     Run Mail [GetArg 1]
 41 |     return 1
 42 | }
 43 | 
 44 | # scheme documentation "(path to manual page)"
 45 | Plumb {^\((.+)\)$} {
 46 |     set page [split [GetArg 1]]
 47 |     RunOutput chicken-doc $page
 48 |     return 1
 49 | }
 50 | 
 51 | # image files
 52 | Plumb {^(.+)(.png|.jpg|.jpeg|.gif)$} {
 53 |     set fname [GetArg 0]
 54 |     if {[file exists $fname]} {
 55 |        global image_viewer
 56 |        Run $image_viewer $fname
 57 |        return 1
 58 |     }
 59 |     return 0
 60 | }
 61 | 
 62 | # PDF files
 63 | Plumb {^(.+).pdf$} {
 64 |     set fname [GetArg 0]
 65 |     if {[file exists $fname]} {
 66 |         global pdf_viewer
 67 |         Run $pdf_viewer $fname
 68 |         return 1
 69 |     }
 70 |     return 0
 71 | }
 72 | 
 73 | # Youtube URLs
 74 | Plumb {^https://www.youtube\.com/.*$} {
 75 |     global media_player
 76 |     Run $media_player [GetArg 0]
 77 |     return 1
 78 | }
 79 | 
 80 | # <URL>
 81 | Plumb {^(http|https|ftp)://[-A-Za-z0-9_.+%/&?=#~:]+$} { 
 82 |     global browser
 83 |     Run $browser [GetArg 0] 
 84 |     return 1
 85 | }
 86 | 
 87 | # "..." / "<...>" (include file)
 88 | 
 89 | set include_path {"/usr/include"}
 90 | 
 91 | if {[info exists env(C_INCLUDE_PATH)]} {
 92 |     set include_path [concat $include_path [split $env(C_INCLUDE_PATH) ":"]]
 93 | }
 94 | 
 95 | proc FindInPath {fname path} {
 96 |     set found {}
 97 | 
 98 |     foreach x $path {
 99 |         set fn [file join $x $fname]
100 |     
101 |         if {[file exists $fn]} {
102 |             lappend found $fn
103 |         }
104 |     }
105 | 
106 |     return $found
107 | }
108 | 
109 | proc GotoIncludeFile {fname} {
110 |     global include_path
111 |     set found [FindInPath $fname $include_path]
112 | 
113 |     if {$found != ""} {
114 |         Run B [lindex $found 0]
115 |         return 1
116 |     }
117 | 
118 |     return 0
119 | }
120 | 
121 | Plumb {^"([^"]+)"$} {return [GotoIncludeFile [GetArg]]}
122 | Plumb {^<([^>]+)>$} {return [GotoIncludeFile [GetArg]]}
123 | 
124 | # <manpage>(<n>)
125 | Plumb {^(\S+)\((\d+)\)$} {
126 |     RunOutput man [GetArg 2] [GetArg 1]
127 |     return 1
128 | }
129 | 
130 | # <file>:[<addr>]
131 | Plumb {^(.*):([^:]*)$} {
132 |     set fname [GetArg 0]
133 |     if {[file exists $fname]} {
134 |         Run B $fname
135 |         return 1
136 |     }
137 | 
138 |     set fname [GetArg 1]
139 |     set address [GetArg 2]
140 |     if {[file exists $fname]} {
141 |         Run B "$fname:$address"
142 |         return 1
143 |     }
144 |     return 0
145 | }
146 | 


--------------------------------------------------------------------------------
/B:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env tclsh
 2 | #
 3 | # open one or more files with "ma", or locate already open instance
 4 | 
 5 | 
 6 | set exec_prefix ""
 7 | 
 8 | if {[info exists env(HERE)]} {
 9 |     set exec_prefix $env(HERE)/exec/
10 | }
11 | 
12 | if {$argc == 0} {
13 |     puts stderr "usage: B FILENAME[:ADDR] ..."
14 |     exit 1
15 | }
16 | 
17 | foreach x $argv {
18 |     if {[regexp {^(.*):([^:]*)$} $x whole file addr]} {
19 |         set fname [file normalize $whole]
20 |         if {[file exists $fname]} {
21 |             exec ${exec_prefix}ma-eval -async MA-registry FindFile "{$fname}" &
22 |             continue
23 |         }
24 |         set fname [file normalize $file]
25 |         if {[file exists $fname]} {
26 |             exec ${exec_prefix}ma-eval -async MA-registry FindFile "{$fname}" $addr &
27 |             continue
28 |         }
29 |     } else {
30 |         set fname [file normalize $x]
31 |         exec ${exec_prefix}ma-eval -async MA-registry FindFile "{$fname}" &
32 |     }
33 | }
34 | 


--------------------------------------------------------------------------------
/README:
--------------------------------------------------------------------------------
  1 |                          
  2 | 88,dPYba,,adPYba,  ,adPPYYba,  
  3 | 88P'   "88"    "8a ""     `Y8  
  4 | 88      88      88 ,adPPPPP88  
  5 | 88      88      88 88,    ,88  
  6 | 88      88      88 `"8bbdP"Y8  
  7 | 
  8 |      
  9 | "ma" is a minimalistic clone of the acme[1] editor used in Plan 9,
 10 | and is written in Tcl/Tk. It has been tested with Tcl/Tk 8.5, mostly
 11 | under Linux and OpenBSD. "ma" has successfully been run on Mac OS
 12 | X with XQuartz, but needs a tiling window manager to be used in a
 13 | satisfactory way.
 14 | 
 15 | I used emacs[2] for years, but got bored with the ever growing
 16 | number of extensions and key-combinations that one has to remember
 17 | when intensively using that editor. I also got fed up with the fact
 18 | that purely keyboard driven interfaces involve frantic typing,
 19 | something that appears to stress me. Acme, which is heavily
 20 | mouse-controlled, seems to produce a more relaxed, single-handed
 21 | use, especially for navigation and browsing. I'm slower now (or at
 22 | least this is my impression), but less hectic while working (it
 23 | seems).
 24 | 
 25 | Another advantage of acme is the dynamic nature of extending the
 26 | user-interface while one is using it - nearly everything is text,
 27 | and every text can be mouse-sensitive.
 28 | 
 29 | Note that this editor is single-window based - it doesn't provide
 30 | multiple windows, nor does it manage them in any way (this is
 31 | delegated to the window manager.)
 32 | 
 33 | 
 34 | Installation:
 35 | 
 36 | Invoke 
 37 | 
 38 |   ./build 
 39 | 
 40 | and put the files "ma", "awd", "win", "pty", "plumb" and "B" in your
 41 | PATH and ".plumb" into your $HOME.
 42 | 
 43 | 
 44 | Usage:
 45 | 
 46 | "ma" attempts to work as much as possible like acme, but does no
 47 | own window-management.  Configuration is done in the file "~/.ma",
 48 | holding Tcl code to modify fonts, colors, etc.  A number of
 49 | command-line options can be provided to set various of these options
 50 | and to run "ma" in special modes, or to communicate with the
 51 | "registry", a "ma" instance that allows locating files that are
 52 | already open.
 53 | 
 54 | To start the registry, run
 55 | 
 56 |   ma -registry &
 57 | 
 58 | The registry is implemented using the Tk "send" command, so
 59 | X-forwarding must be disabled (enter "xhost" to see wether this is
 60 | the case). "ma" should still run, but features related to the
 61 | registry will not be available in this case (locating already open
 62 | windows, and "Putall".)
 63 | 
 64 | The "B" program takes one ore more filenames (optionally followed
 65 | by an address) and opens the given files or activates already open
 66 | windows holding these files.
 67 | 
 68 | "pty" is a generic program running a subprocess in a pseudo terminal
 69 | and is used by "win" to have interactive windows inside a "ma"
 70 | instance. Note that this is currently very crude and does not support
 71 | escape codes of any kind.
 72 | 
 73 | "ma-eval" can be used to evaluate Tcl code in a running "ma" instance,
 74 | "awd" sets the label of the window in which the command is executed.
 75 | You can create an alias for "cd" to set the label automatically
 76 | when used inside an interactive shell window:
 77 | 
 78 | alias cd="_cd"
 79 | 
 80 | function _cd () {
 81 |     \cd "$@"
 82 |     if test -n "$MA"; then
 83 |         awd bash
 84 |     fi
 85 | }
 86 | 
 87 | When the registry is running, the window that has the current focus
 88 | is drawn with a white border around it. Executing commands in the
 89 | body of another window will then perform the execution in the context
 90 | of the focus window. Execution in the tag of a window always has
 91 | that window as context, regardless of focus.
 92 | 
 93 | When you create a new, unnamed window and want to save it, then
 94 | just edit the filename (initially "<unnamed>"). Also saving the
 95 | file under a different name can be done the same way.
 96 | 
 97 | The "plumb" program performs a very simple Plan-9 like "plumbing"
 98 | based on regular expressions, see ".plumb" for some examples on how
 99 | to define rules, which consists of Tcl code associated to regular
100 | expressions.  "plumb" takes a string as argument and runs the
101 | plumbing rules in "~/.plumb" until a rule matches and succeeds.
102 | Text sweeped or clicked with B3 will invoke "plumb" with the string
103 | as argument.
104 | 
105 | 
106 | Environment variables:
107 | 
108 | MA_HISTORY
109 |     If set, all code that is executed in "win" mode or via B2 is logged in
110 |     the file given in this variable (this includes all input, including
111 |     passwords!)
112 | 
113 | C_INCLUDE_PATH
114 |     Lists additional include-directories, separated by ":" (default:
115 |     "/usr/include")
116 | 
117 | SHELL
118 |     Shell to use for executing commands (default: "bash")
119 | 
120 | MA
121 |     Set to the name of the wish(1) instance when executing external
122 |     programs.
123 | 
124 | 
125 | Access from the command line:
126 | 
127 | Using "ma-eval", some elements from a "ma" window can be
128 | accessed by sending Tcl code to the process in which a shell command
129 | was initiated:
130 | 
131 | For example,
132 | 
133 |     ma-eval $MA GetBody
134 | 
135 | would print the contents of the window body to stdout. Here is a selection 
136 | of  some useful Tcl commands that you can use (for more intricate access,
137 | study the "ma" source code):
138 | 
139 |     GetBody
140 |     GetTag
141 |     GetLabel
142 |     SetBody TEXT
143 |     SetTag TEXT
144 |     SetLabel TEXT
145 |     ReplaceFile FILENAME
146 |     GetDot
147 |     SetDot ADDRESSS
148 |     Insert TEXT
149 |     InsertFile FILENAME
150 |     Append TEXT
151 |     AppendFile FILENAME
152 | 
153 | Note that text may have to be suitable quoted to be passed trough
154 | to the Tcl interpreter that is running in the window, like this:
155 | 
156 |     ma-eval $MA Insert "{this is a test}"
157 | 
158 | 
159 | Customization:
160 | 
161 | At the start of the "ma" script, you will find a number of global
162 | variables that hold default values for fonts, colors and other
163 | settings that are used throughtout the editor. Modify these at
164 | your convenience.
165 | 
166 | 
167 | Extending:
168 | 
169 | The easiest way to add commands is simply to put scripts or programs
170 | in your PATH. If you want more thorough integration, you can also
171 | define commands at the Tcl level, by using "DefineCommand REGEX
172 | EXPR" to define Tcl code to be executed when the command given in
173 | REGEX is executed, i.e.
174 | 
175 |     DefineCommand {^MyCommand\s+(.+)$} { ... }
176 | 
177 | Arguments (subpatterns in the regex) can be extracted with "GetArg".
178 | 
179 | "ma" is not finished, and probably never will. For more information,
180 | consult the source code or contact me[3].
181 | 
182 | 
183 | To do:
184 | 
185 | - (bug) crash of program in win-mode doesn't print any message
186 | - (bug) KeyRelease-event in .tag (getting through after invoking 
187 |   dmenu(1) in this case) results in incorrect resize of tag, even 
188 |   though only first line contains text
189 | - (bug) Automatic resizing of the tag doesn't always work
190 | - (bug) sort order in columnar listing is wrong (should be rowwise,
191 |   not columnwise)
192 | - (bug) Tk seems to clear the clipboard when exiting, so the 
193 |   contents copied from a terminated instance are not recovered
194 | - (bug) the (pseudo-)selection is sometimes retained even after 
195 |   input
196 | - (bug) "Back" should not put position on search-stack if search 
197 |   wraps around
198 | - (bug) The exit status of subprocesses in non-win mode is silently
199 |   discarded. This seems to be a Tcl limitation, see also:
200 |   https://core.tcl.tk/tips/doc/trunk/tip/462.md
201 | 
202 | Shortcomings:
203 | 
204 | - the file-registry needs to be explicitly started
205 | - the "Kill" command (Del key) is not very reliable with respect to
206 |   what processes are killed (should probably use a process group)
207 | - the width used for computing columnar directory layout seems not 
208 |   to be correct (always 80?)
209 | - autosnarf when selecting: no idea how to do this, keeping current 
210 |   selection and copying when selection gets empty doesn't work, 
211 |   since selection by mouse apparently clears it in between 
212 |   movements; perhaps detect when selection changes from non-empty 
213 |   to empty
214 | - there is no "Zerox" command
215 | - works very bad on Mac/Aqua and Windows:
216 |   - Mac: default Tcl/Tk crashes, freshly installed (Aqua) aborts 
217 |     unexpectedly, B2/B3 are swapped, slow startup (note that 
218 |     Tcl/Tk for XQuartz works surprisingly well, though)
219 |   - Windows: cursor in text widget barely visible (black, even on 
220 |     dark background), startup very slow, binding Ctrl-keys doesn't 
221 |     seem to work, UpdateTag doesn't seem to treat filename as valid
222 |     and inserts Win-style path before it (this is with Active 
223 |     State Tcl/Tk, 8.6.4)
224 | - there is no backup-file
225 | - Address syntax only supports a subset of acme/sam and is rather 
226 |   crude (see also comment in ParseAddr), "/.../"/"?...?" addresses
227 |   only select a position, not ranges
228 | - In "win" mode, "ma" tries to ignore the prompt from input lines, 
229 |   but moving the insertion point may confuse this, if possible use 
230 |   a prompt for interactively used programs that will be ignored 
231 |   by the client program (e.g. ":;" for sh(1) or ";" for rc(1))
232 | - Password-entry in "win" mode works only when the insertion cursor
233 |   is not moved by mouse or cursor-movement keys
234 | - "Putall" is implemented, but will save all files in all open 
235 |   windows, even on virtual screens not currently visible
236 | - there is no "Edit" command
237 | 
238 | Differences to the Plan 9 acme:
239 | 
240 | - There is no "move" box
241 | - Tab does not insert "\t" but whitespace
242 | - (obviously) single-window mode
243 | - no dynamic update of undo/redo commands tag (Tcl/Tk 8.6 seems 
244 |   to support access to the undo-stack, though)
245 | - auto-chmod when saving file beginning with "#!/"
246 | - missing commands: "Zerox", "Edit", "Incl"
247 | - supports Key-Up/Down movement by line
248 | - inserting with active selection doesn't snarf
249 | - indentation-setting is window-local
250 | - executing with redirection ("|...", ">...", "<...") in "win" 
251 |   mode invokes shell, and does not send the command to the process 
252 |   running in the window
253 | - executing in tag always has current window as context, executing
254 |   in body has currently focussed window as context (if registry is 
255 |   running)
256 | - double-clicking opening bracket selects forward, but quote-
257 |   scanning works backwards (in acme both bracket and quotes only 
258 |   select backwards)
259 | - indent-mode works differently
260 | - word under cursor is defined as ws-delimited (excluding 
261 |   parentheses)
262 | - win-mode: pressing RETURN before current insert point sends the 
263 |   whole line
264 | - "noscroll" mode is much weaker (does not block running process)
265 | - basic keyboard commands for mouse-less operation: 
266 |   C-1 (toggle focus), C-2 (execute selection), C-3 (acquire 
267 |   selection)
268 | - B3-search is case-insensitive, search with "Look" is not
269 | - "//.../" address means search with regex syntax disabled
270 | - Supports various emacsish keyboard sequences, as provided by the 
271 |   Tk text widget
272 | - Additional commands: 
273 |     Anchor: add address of insertion point into tag
274 |     Withdraw: hide window
275 |     Tcl CODE: execute Tcl code
276 |     Crnl: toggle between UNIX/DOS line-terminator encoding
277 |     Back: jump back to previous address after search
278 |     Interrupt: send ^C to interactive subprocess (win mode)
279 | - MA highlights matching parens/brackets/braces
280 | - Shift-B3 is equivalent to B2
281 | - Acquiring (B3) an existing window doesn't warp mouse to current 
282 |   selection
283 | - The "Local" command toggles a state whether directories are 
284 |   opened in the current window or in a new one
285 | - "Abort" terminates, like "Del", but with an exit status of 1
286 | - "Wrap" toggles between word-wrapping and char-wrapping.
287 | 
288 | Idioms:
289 | 
290 | * Remember that you have filename completion (^F) everywhere
291 | * Select command in tag and B2 to use it like a custom button, this
292 |   is especially useful in win-mode, by adding often repeated 
293 |   commands in the tag
294 | * In interactive programs running in a "win" window, any command or
295 |   line of commands can be B2-clicked to insert it when input is 
296 |   requested, this also works for B2B1 chords.
297 | * Avoid the console, a temporary guide file with commands reduces 
298 |   typing
299 | * Select and B2 "<cat FILENAME" to insert into current position
300 | * use "env ... COMMAND" to override env-vars when using B3
301 | * Command/work files can be used for other contexts 
302 |   - just ensure the target window is activated
303 | * Double-click words to quickly select them and avoid sweeping
304 | * Quote or parenthesize commands that contain whitespace
305 | * Addresses like "FILENAME:/.../" or "FILENAME:LINE" can be used 
306 |   as simple hyperlinks
307 | * B3 label in tag to select all text
308 | * The tag can also be B2'd to execute a script you're working on
309 |   (MA automatically saves as executable, if a she-bang line exists)
310 | * You can write directly into directory windows and sweep (or B2B1)
311 |   to execute commands on files, use "Get" command to refresh
312 | * You can also simply enter and B2 commands into an "+Errors" window
313 | * Double-B1 after end of line selects whole line for execution
314 | * Use unique marker to separate sections in guide files to quickly 
315 |   jump around through use of B3
316 | 
317 | All of MA's source code is hereby placed in the public domain
318 | 
319 | Acknowledgements:
320 | 
321 |     Thanks to:
322 | 
323 |         Lucas Sköldqvist for various tips and suggestions.
324 |         Kooda for fixing the completely broken implementation of 
325 |         pty.c, also fixed a problem with paren-matching in Tk 8.6.
326 |         "mujo" for adding several improvements and corrections.
327 | 
328 | Version history:
329 | 
330 | 11
331 |     - Esc selects newly typed text since last mouse button release
332 |       (not press).
333 |     - Increased scroll amount for Prior/Next keys.
334 |     - Added "-fixed" command line option.
335 |     - After tag-relayout, sensure insertion point in body remains
336 |       visible.
337 |     - The "pty" program passed the exit-status through to the
338 |       caller.
339 |     - When parsing a command line, the command may be enclosed in
340 |       single or double quotes.
341 |     - Use %K for detecting closing paren/bracket/brace instead of
342 |       %A (thanks to Kooda).
343 |     - Added "Abort" command.
344 |     - B2 on scroll bar takes center of "thumb" as reference point.
345 |     - Added "Wrap" command.
346 |     - Fixed bug in Broadcast procedure (used in "Putall")
347 | 
348 | 10
349 |     - Saving into a nonexistent directory failed with an error instead of creating
350 |        directories as needed.
351 |     - The cursor shape is now the default left-pointing arrow on all platforms
352 |       (thanks to "mujo")
353 |     - Undo/Redo always applies to window body (fixed by "mujo")
354 |     - Double-click B1B2 mousechord works now ("mujo", again)
355 | 
356 | 9
357 |     - Fixed a bug in "plumb" that caused a successful exit status even
358 |       if no rule matched.
359 |     - Separated variable and fixed font states.
360 |     - Reversed the scrollbar colors, as in acme/sam/rio.
361 |     - The "Insert" key does filename-completion, as alternative to Ctrl-F.
362 |     - B1/B3 in scrollbar has "autorepeat", using dynamically adjusted 
363 |       amount.
364 | 
365 | 8
366 |     - B2 in win mode is equivalent to "Send" command.
367 |     - Reduced some unnecessary "Flash"ing.
368 |     - Executing with redirection keeps the result selected.
369 |     - Getting the effective selection worked only when target widget had focus,
370 |       resulting in selection/pseudoselection confusion.
371 |     - In "win" mode the "Interrupt" command inserts ^C into the input stream.
372 |     - Directory view should now format columns correctly after window has been
373 |       shown for the first time.
374 |     - Fixed a problem with plumbing a string beginning with Tcl redirection
375 |       characters.
376 |     - If the result-string of a remote call via "ma-eval" is empty, no 
377 |       output is produced.
378 |     - The registry resolved symlinks before locating a file.
379 |     - Executing with "|" or "<" tries to keep visible area.
380 | 
381 | 7
382 |     - Added "Local" command (suggested by C-Keen).
383 |     - Attempt to optimize <<Selection>> event handler which seems to be slow
384 |       on ssome machines.
385 |     - B2 can now be used to abort B3-sweeping.
386 |     - When "scroll" mode is off, try to keep start of output received by every external
387 |        command at top of screen.
388 |     - Pressing <Delete> sends SIGINT instead of SIGKILL now.
389 |     - The "pty" programm catches SIGINT and propagates it to the process group.
390 |     - Location of existing windows via registry handles spaces in directory names
391 |       correctly.
392 |     - Filenames with single quote in label are correctly quoted using double quotes.
393 |     - Execution with redirection always uses body selection or whole body.
394 |     - Dropped the "Replace" command (use an external tools like sed(1) or "LR"
395 |       from ma-utils).
396 |     - Re-activation of directory window refreshes contents.
397 | 
398 | 6
399 |     - C-k on end of line just deletes the newline and doesn't overwrite the cut buffer.
400 |     - On-demand update of tag for "Put", "Back".
401 |     - added read and write hooks.
402 |     - "Look" doesn't warp mouse pointer.
403 |     - All MA windows that are not directory listings or output windows track "dirty" state.
404 |     - "Put <name>" always saves, regardless of the type of window.
405 |     - Dotfiles command for directories.
406 |     - Added several hooks for integrating the directory editor (diredit.tcl).
407 |     - New files have a default name ("<unnamed>").
408 |     - Removed tag marker, "dirty" state is indicated by tag font style (italic).
409 |     - Double-B1 on empty line does not highlight line.
410 |     - Extracted plumbing into separate tool ("plumb").
411 |     - If the label is changed and the file does not exist yet, save text even if unmodified.
412 |     - Removed "Wrap" and default to char-wrapping.
413 |     - Renaming and saving output window properly reregisters the window.
414 | 
415 | 5
416 |     - When the label is updated, set the windows' title accordingly (suggested by Lucas Sköldqvist.)
417 |     - added termination_hook.
418 |     - Always enable word-wrap in win mode.
419 |     - Computing the word under the cursor ignores the label marker character.
420 |     - Added "Back" command to move insertion mark back to old position after search.
421 |     - Replaced pty.c with a version that doesn't eat CPU time and is much simpler (thanks to
422 |       Kooda)
423 | 
424 | 4
425 |     - Corrected initial tag relayout.
426 |     - Resizing scrolls to bottom if "scroll" mode is on.
427 |     - Dropped "-noscroll" option, added "-scroll".
428 |     - Filename completion adds final "/" for directory only if it doesn't need quoting.
429 |     - Added "name_hook", moved "project" files into extension.
430 |     - Replaces some message-boxes with marked text in +Errors window.
431 |     - Revertion shows message when file is modified, similar to "Del".
432 |     - "Wrap" command is shown in tag by default.    
433 |     - "Get FNAME" checks whether the current file is modified.
434 | 
435 | 3
436 |     - "New" starts new instance in current context.
437 |     - "Send" just appends at end (as in acme).
438 |     - Added "Putall".
439 |     - final delimiter in "/.../" + "?...?" addresses is optional now.
440 |     - switching to existing window via B3 warps mouse pointer to current selection
441 |       or insertion point.
442 |     - got rid of spurious newlines in tag that where sometimes added.
443 |     - directory listing quotes with "\"", when filename includes "\''".
444 |     - text in tag window wraps correctly when the window is resized.
445 |     - ESC selects up to insertion point at last mouse click, not the clicked location.
446 |     - the "dirty" marker is filtered out in most cases of clicking the label.
447 |     - (mostly) correct handling of backspace when entering passwords in win-mode.
448 |     - B1B2B3 leaves file unmodified.
449 |     - C-k snarfs deleted text.
450 |     - B1-doubleclick in the empty space after a text line selects the complete line.
451 | 
452 | 2 
453 |     - added some improvements in built-in plumbing rules.
454 |     - the registry logs its actions inside its own text body.
455 |     - the scroll-area is grayed in "scroll" mode.
456 |     - failure to open file outputs error in "+Errors" window.
457 |     - auto-detection of line-end translation, CRNL line-temrinators are preserved.
458 |     - fixed problems in some uses of "catch" which didn't properly evaluate their arguments.
459 |     - directory listings quote filenames, when necessary.
460 |     - running subprocesses are now not killed on termination.
461 |     - added MA_LABEL environment variable for subprocesses.
462 |     - a clicked word does not include parentheses or brackets/braces now.
463 |     - the history file is now made user-accessible only when written.
464 |     - added (crude) support for password entry in win-mode.
465 |     - added "-fontstyle" option.
466 | 
467 | 1
468 |     - initial release.
469 | 
470 | 
471 | [1] http://acme.cat-v.org/
472 | [2] https://www.gnu.org/software/emacs/
473 | [3] felix@call-with-current-continuation.org
474 | [4] http://www.cs.yorku.ca/~oz/wily/
475 | [5] http://www.cs.yorku.ca/~oz/wily/python.html
476 | [6] http://www.linusakesson.net/programming/syntaxhighlighting/
477 | [7] https://www.robertmelton.com/project/syntax-highlighting-off/
478 | 


--------------------------------------------------------------------------------
/awd:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | 
 3 | label="$1"
 4 | execp=
 5 | 
 6 | if test -z "$MA"; then
 7 |     echo "no window context" 1>&2
 8 |     exit 1
 9 | fi
10 | 
11 | if test -n "$HERE"; then
12 |     execp=$HERE/exec/
13 | fi
14 | 
15 | if test -z "$1"; then
16 |     echo "usage: awd LABEL" 1>&2
17 |     exit 1
18 | fi
19 | 
20 | dir=`pwd`
21 | exec ${execp}ma-eval -async $MA "UpdateTag \"$dir/-$1\""
22 | 


--------------------------------------------------------------------------------
/build:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | 
 3 | set -e -x
 4 | 
 5 | libs=-lrt
 6 | 
 7 | case `uname -s` in
 8 |   Darwin|*BSD)
 9 |     libs=
10 | esac
11 | 
12 | gcc -std=gnu99 pty.c -o pty -lutil $libs
13 | 


--------------------------------------------------------------------------------
/dotma.tcl:
--------------------------------------------------------------------------------
 1 | set fixed_font { "Roboto Mono Medium" 9 normal }
 2 | set variable_font { "Roboto Medium" 10 normal }
 3 | set current_font $variable_font
 4 | set tag_font $variable_font
 5 | set tag_clean_font $tag_font
 6 | set tag_dirty_font { "Roboto Medium" 10 italic }
 7 | set rc_style_quoting 1
 8 | 
 9 | ## File hooks
10 | 
11 | source /my/library/code/ma/utils/hooks.tcl
12 | 
13 | proc SchemeFileHook {} {
14 |     uplevel #0 { source /my/library/code/ma/utils/scheme-indent.tcl }
15 |     SchemeIndent
16 |     ToggleFont fix
17 | }
18 | AddFileHook {\.(sc.?|meta|k|l)$} SchemeFileHook
19 | AddFileHook {\.(setup|egg)$} {SchemeFileHook}
20 | 
21 | ## Color schemes
22 | 
23 | set theme_counter 1
24 | foreach x "acme autumn-light blue-sea crisp electric faff
25 |                    glowfish goldenrod relaxed solarized subatomic zenburn" {
26 |     source /my/library/code/ma/utils/colors/$x.tcl
27 | }
28 | 
29 | source /my/library/code/ma/utils/gopher.tcl
30 | 


--------------------------------------------------------------------------------
/ma:
--------------------------------------------------------------------------------
   1 | #!/usr/bin/env wish
   2 | #### ma - a minimalistic variant of acme(1)
   3 | #
   4 | # (c)MMXV-MMXVIII Felix L. Winkelmann
   5 | #
   6 | # Version: 11
   7 | 
   8 | # customize these variables to your taste:
   9 | set rcfile "$env(HOME)/.ma"
  10 | set plumber "plumb"
  11 | set exec_path [split $env(PATH) ":"]
  12 | set include_path {"/usr/include"}
  13 | set fixed_font {Courier 12 normal}
  14 | set variable_font {Helvetica 12 normal}
  15 | set current_font $variable_font
  16 | set tag_font $variable_font
  17 | set tag_clean_font $tag_font
  18 | set tag_dirty_font {Helvetica 12 bold}
  19 | set password_char "∎"
  20 | set current_foreground black
  21 | set current_background "#FFFFEA"
  22 | set sbar_color $current_background
  23 | set sbar_background "#99994c"
  24 | set valid_match_background "#448844"
  25 | set invalid_match_background "#884444"
  26 | set tag_foreground black
  27 | set tag_background "#EAFFFF"
  28 | set selection_foreground black
  29 | set selection_background "#eeee9e"
  30 | set inactive_selection_background $selection_background
  31 | set pseudo_selection_foreground $selection_foreground
  32 | set pseudo_selection_background $selection_background
  33 | set b2sweep_foreground white
  34 | set b2sweep_background "#aa0000"
  35 | set b3sweep_foreground white
  36 | set b3sweep_background "#006600"
  37 | set focus_color white
  38 | set nonfocus_color black
  39 | set sbar_width 10
  40 | set tabwidth 4
  41 | set file_encoding utf-8
  42 | set file_translation lf
  43 | set indent_mode 0
  44 | set current_translation lf
  45 | set eot_symbol "␄"
  46 | set directory_commands {Dotfiles}
  47 | set unnamed_name UNNAMED
  48 | set initial_tag "$unnamed_name New Del Cut Paste Snarf Get Look Font | "
  49 | set interactive_shell_args {}
  50 | set scroll_repeat 100
  51 | set rc_style_quoting 0
  52 | set cursor left_ptr
  53 | set wrap_mode char
  54 | 
  55 | # global variables
  56 | set current_filename ""
  57 | set executing_pids {}
  58 | set search_string ""
  59 | set dest_address ""
  60 | set command_arguments {}
  61 | set command_input_file ""
  62 | set any_output 0
  63 | set b1_down 0
  64 | set b2_down 0
  65 | set b2_start ""
  66 | set b2_with_arg ""
  67 | set b2_abort 0
  68 | set b3_down 0
  69 | set b3_start ""
  70 | set b3_abort 0
  71 | set shell sh
  72 | set win_mode 0
  73 | set win_file ""
  74 | set flashed_range_id ""
  75 | set output_window_rx {/[-+][^/]+$}
  76 | set last_opened ""
  77 | set last_mouse_index "1.0"
  78 | set history_file ""
  79 | set withdrawn 0
  80 | set last_del_attempt 0
  81 | set exec_prefix ""
  82 | set scroll 0
  83 | set focus_window ""
  84 | set has_focus 0
  85 | set password_input ""
  86 | set cut_unmodified ""
  87 | set position_stack {}
  88 | set editable 1
  89 | set dotfiles 1
  90 | set override_attempt 0
  91 | set unnamed 0
  92 | set replace_dir 0
  93 | set pseudosel_on(.t) 0
  94 | set pseudosel_on(.tag) 0
  95 | set last_scroll_bottom 1.0
  96 | set scroll_task ""
  97 | set sbar_height 0
  98 | set remote ""
  99 | 
 100 | # hooks
 101 | set file_hook {}
 102 | set directory_hook {}
 103 | set name_hook {}
 104 | set configuration_hook {}
 105 | set termination_hook {}
 106 | set save_hook {}
 107 | set write_hook {}
 108 | set read_hook {}
 109 | set register_hook {}
 110 | set unregister_hook {}
 111 | set pre_save_hook {}
 112 | set revert_hook {}
 113 | set execute_hook {}
 114 | 
 115 | if {[info exists env(MA_INCLUDE_PATH)]} {
 116 |     set include_path [concat $include_path [split $env(MA_INCLUDE_PATH) ":"]]
 117 | }
 118 | if {[info exists env(MA_HISTORY)]} {
 119 |     set history_file $env(MA_HISTORY)
 120 | }
 121 | if {[info exists env(HERE)]} {
 122 |     set exec_prefix $env(HERE)/exec/
 123 | }
 124 | if {[info exists env(SHELL)]} {
 125 |     set shell $env(SHELL)
 126 | }
 127 | if {![regexp $output_window_rx [tk appname]]} { 
 128 |     tk appname "MA-[pid]" 
 129 | }
 130 | set env(MA) [tk appname]
 131 | fconfigure stdout -translation lf
 132 | fconfigure stderr -translation lf
 133 | 
 134 | set command_table {
 135 |     {{^New$} {Ma -cd [pwd]}}
 136 |     {{^New\s+(.+)$} { Ma [CanonicalFilename [GetArg]] }}
 137 |     {{^Delete$} { Terminate 1 }}
 138 |     {{^Del$} Terminate}
 139 |     {{^Get$} RevertFile}
 140 |     {{^Get\s+(.+)$} {OpenNewFile [GetArg]}}
 141 |     {{^Cut$} { tk_textCut .t }}
 142 |     {{^Paste$} { PasteSelection .t }}
 143 |     {{^Snarf$} { tk_textCopy .t }}
 144 |     {{^Put$} SaveChanges}
 145 |     {{^Put\s+(.+)$} { SaveFile [GetArg] 1}}
 146 |     {{^Look$} {Search [GetSelection .t] "" 1 0}}
 147 |     {{^Look\s+(.+)$} {Search [GetArg] "" 1 0}}
 148 |     {{^Indent$} { 
 149 |         global indent_mode
 150 |         set indent_mode [expr !$indent_mode]
 151 |         Flash blue 
 152 |     }}
 153 |     {{^Kill$} { KillExecuting SIGKILL 1}}
 154 |     {{^Send$} SendToProcess}
 155 |     {{^Send\s+(\S.*)$} {SendToProcess [GetArg]}}
 156 |     {{^Tab$} { global tabwidth; LogInWindow "Tab width is $tabwidth\n" }}
 157 |     {{^Tab\s+(\d+)$} { global tabwidth; set tabwidth [GetArg]; Flash blue }}
 158 |     {{^Font$} {ToggleFont}}
 159 |     {{^Font\s+(fix|var)$} {ToggleFont [GetArg]}}
 160 |     {{^Tcl$} { Evaluate [GetSelection .t] }}
 161 |     {{^Tcl\s+(.+)$} { Evaluate [GetArg] }}
 162 |     {{^Abort$} {Terminate 0 1}}
 163 |     {{^Undo$} { .t edit undo }}
 164 |     {{^Redo$} { .t edit redo }}
 165 |     {{^Scroll$} {ToggleScroll; Flash blue}}
 166 |     {{^Anchor$} InsertAnchor}
 167 |     {{^Withdraw$} WithdrawWindow}
 168 |     {{^Dotfiles$} {global dotfiles; set dotfiles [expr !$dotfiles]; RevertFile}}
 169 |     {{^Putall$} {SaveAllModified 0}}
 170 |     {{^Back$} PopMoveInsert}
 171 |     {{^Wrap$} {ToggleWrap}}
 172 |     {{^Local$} {
 173 |         global replace_dir
 174 |         set replace_dir [expr !$replace_dir]
 175 |         Flash blue
 176 |     }}
 177 |     {{^Crnl$} {
 178 |         global current_translation
 179 |         set current_translation "crnl"
 180 |         Flash blue
 181 |     }}
 182 | }
 183 | 
 184 | set plumbing_rules {
 185 |     {{^:(.+)} { GotoBodyAddress [GetArg 1] }}
 186 |     {{^([^:]+):((\d+|/[^/]+/|\?[^?]+\?|\$|#\d+|\.)(,(\d+|/[^/]+/|\?[^?]+\?|\$|#\d+|\.))?)} {
 187 |         GotoFileAddress [file normalize [GetArg 1]] [GetArg 2]
 188 |     }}
 189 |     {{^([^:]+):} { GotoFileAddress [file normalize [GetArg 1]] }}
 190 | }
 191 | 
 192 | tk_focusFollowsMouse
 193 | . configure -highlightthickness 2
 194 | 
 195 | proc Register {id fname} {
 196 |     global app_registry fname_registry 
 197 |     set app_registry($fname) $id
 198 |     set fname [CanonicalFilename $fname]
 199 |     set fname_registry($id) $fname
 200 |     RunHook register_hook $fname
 201 |     .t insert end "register: $id -> $fname\n"
 202 |     Bottom
 203 | }
 204 | 
 205 | proc Unregister {id} {
 206 |     global fname_registry focus_window
 207 |     if {[info exists fname_registry($id)]} {
 208 |         set fname $fname_registry($id)
 209 |         RunHook unregister_hook  $fname
 210 |     }
 211 |     set fname_registry($id) ""
 212 |     if {$focus_window == $id} {
 213 |         .t insert end "unregister: $id\n"
 214 |         Bottom
 215 |         set focus_window ""
 216 |     }
 217 | }
 218 | 
 219 | proc StartRegistry {} {
 220 |     global withdrawn editable
 221 |     set editable 0
 222 |     if {![catch {send MA-registry #}]} {
 223 |         puts stderr "registry already active"
 224 |         exit 1
 225 |     }
 226 |     tk appname MA-registry
 227 |     set withdrawn 1
 228 | }
 229 | 
 230 | proc SetFocusWindow {id} {
 231 |     global focus_window
 232 |     if {$focus_window != ""} {
 233 |         .t insert end "drop focus: $focus_window\n"
 234 |         catch [list send -async $focus_window DropFocus]
 235 |     }
 236 |     set focus_window $id
 237 | }
 238 | 
 239 | proc TakeFocus {} {
 240 |     global has_focus focus_color
 241 |     if {!$has_focus} {
 242 |         set has_focus 1
 243 |         if {![catch [list send -async MA-registry SetFocusWindow [tk appname]]]} {
 244 |             . configure -highlightcolor $focus_color -highlightbackground \
 245 |                 $focus_color
 246 |         }
 247 |     }
 248 | }
 249 | 
 250 | proc DropFocus {} {
 251 |     global has_focus nonfocus_color
 252 |     set has_focus 0
 253 |     . configure -highlightcolor $nonfocus_color -highlightbackground \
 254 |         $nonfocus_color
 255 | }
 256 | 
 257 | proc Locate {fname {addr ""}} {
 258 |     global app_registry fname_registry
 259 |     set fname [CanonicalFilename [FollowLink $fname]]
 260 |     if {[info exists app_registry($fname)]} {
 261 |         set id $app_registry($fname)
 262 |         if {$id != "" && $fname_registry($id) == $fname} {
 263 |             if {$addr == ""} {
 264 |                 if {![catch [list send $id ActivateWindow]]} {
 265 |                     return $id
 266 |                 }
 267 |             } else {
 268 |                 if {![catch [list send $id GotoBodyAddress "{$addr}"]]} {
 269 |                     return $id
 270 |                 }
 271 |             }
 272 |         }
 273 |     }
 274 |     return ""
 275 | }
 276 | 
 277 | proc Broadcast {code} {
 278 |     global app_registry fname_registry
 279 |     .t insert end "broadcast: $code\n"
 280 |     foreach fname [array names app_registry] {
 281 |         set id $app_registry($fname)
 282 |         if {$id != "" && $fname_registry($id) == $fname} {
 283 |             catch [list send -async $id $code]
 284 |         }
 285 |     }
 286 | }
 287 | 
 288 | proc SaveAllModified {regmode} {
 289 |     global app_registry fname_registry
 290 |     if {$regmode} {
 291 |         Broadcast SaveIfModified
 292 |     } else {       
 293 |         if {[catch {send -async MA-registry SaveAllModified 1}]} {
 294 |             SaveIfModified
 295 |         }
 296 |     }
 297 | }
 298 | 
 299 | proc SaveChanges {} {
 300 |     SaveFile [GetFilename]
 301 | }
 302 | 
 303 | proc ActivateWindow {} {
 304 |     .t see insert
 305 |     WarpToIndex .t insert
 306 |     RefreshDirectory
 307 | }
 308 | 
 309 | proc FindFile {fname {addr ""}} {
 310 |     set id [Locate $fname $addr]
 311 |     if {$id == ""} {
 312 |         Ma $fname -address $addr
 313 |     }
 314 | }
 315 | 
 316 | proc ListWindows {} {
 317 |     global fname_registry app_registry
 318 |     set wins {}
 319 |     foreach fname [array names app_registry] {
 320 |         if {$fname_registry($app_registry($fname)) == $fname} {
 321 |             lappend wins $app_registry($fname)
 322 |         }
 323 |     }
 324 |     return $wins
 325 | }
 326 | 
 327 | proc ToggleScroll {{m ""}} {
 328 |     global scroll
 329 |     if {$m == ""} {set m [expr !$scroll]}
 330 |     set scroll $m
 331 |     if {$scroll} Bottom
 332 | }
 333 | 
 334 | proc ToggleWrap {{mode ""}} {
 335 |     global wrap_mode
 336 |     if {$mode != ""} {
 337 |         set wrap_mode $mode
 338 |     } elseif {$wrap_mode == "char"} {
 339 |          set wrap_mode word
 340 |     } else {set wrap_mode char}
 341 |     .t configure -wrap $wrap_mode
 342 | }
 343 | 
 344 | proc Ma {args} {
 345 |     global exec_prefix
 346 |     eval exec ${exec_prefix}ma $args &
 347 | }
 348 | 
 349 | proc GotoFileAddress {fname {addr ""}} {
 350 |     global replace_dir
 351 |     set addr [string trim $addr]
 352 |     if {![regexp {^/} $fname]} {
 353 |         set dir [GetFileDir]
 354 |         set fname "$dir/$fname"
 355 |     } 
 356 |     if {[file exists $fname]} {
 357 |         set addr [regsub -all {[{}"]} $addr {\\&}]
 358 |         if {[catch [list send MA-registry Locate "{$fname}" "{$addr}"] result] || $result == ""} {
 359 |             if {$replace_dir && [file type $fname] == "directory"} {
 360 |                 OpenDirectory $fname
 361 |             } else {
 362 |                  Ma $fname -address $addr
 363 |             }
 364 |         }
 365 |         return 1
 366 |     }
 367 |     return 0
 368 | }
 369 | 
 370 | proc SimpleRegex {str} {
 371 |     return [regsub -all -- {\(|\)|\||\+|\*|\.|\?|\[|\]} $str {\\\0}]
 372 | }
 373 | 
 374 | proc ParseAddr {addr} {
 375 |     # returns index + whole-line flag
 376 |     # this is silly - addresses should enclose ranges as in sam, and
 377 |     # explicit ranges as in "," should combine these.
 378 |     if {$addr == "0"} { return {1.0 0} }
 379 |     if {$addr == "\$"} { return {end 0} }
 380 |     if {$addr == "."} { return {insert 0} }
 381 |     if {[regexp {^/(/?[^/]+)/?$} $addr _ rx]} {
 382 |         # hack for ctags: we need "simple" regexes, apparently...
 383 |         if {[regexp {^/} $rx]} {
 384 |             set rx [SimpleRegex [string range $rx 1 end]]
 385 |         }
 386 |         return [list [.t search -regexp $rx 1.0] 0]
 387 |     }
 388 |     if {[regexp {^\?([^?]+)\??$} $addr _ rx]} { 
 389 |         return [list [.t search -regexp -backwards $rx end] 0] 
 390 |     }
 391 |     if {[regexp {^#(\d+)$} $addr _ pos]} { 
 392 |         return [list "1.0 + $pos chars" 0] 
 393 |     }
 394 |     if {[regexp {^\d+$} $addr]} { return [list "$addr.0" 1] }
 395 |     return ""
 396 | }
 397 | 
 398 | proc AddrIndices {addr} {
 399 |     # validate by parsing the whole addr instead of doing this
 400 |     if {![regexp {^(\d+|//?[^/]+/?|\?[^?]+\??|\$|#\d+|\.)(,(\d+|/[^/]+/?|\?[^?]+\??|\$|#\d+|\.))?$} $addr _ from rng to]} {
 401 |         return ""
 402 |     }
 403 |     set p1 [ParseAddr $from]
 404 |     set p2 ""
 405 |     if {$rng != ""} {
 406 |         set p2 [ParseAddr $to]
 407 |         set p2i [lindex $p2 0]
 408 |         # if range of lines: select the latter fully
 409 |         if {[lindex $p2 1]} {
 410 |             set p2 "$p2i lineend + 1 chars"
 411 |         } else {
 412 |             set p2 $p2i
 413 |         }
 414 |     } elseif {[lindex $p1 1]} {
 415 |         # if only a line is given, select it fully
 416 |         set p2 "[lindex $p1 0] lineend + 1 chars"
 417 |     }
 418 |     return [list [lindex $p1 0] $p2]
 419 | }
 420 | 
 421 | proc GotoBodyAddress {addr {flash 0}} {
 422 |     RemoveSelection .t
 423 |     lassign [AddrIndices $addr] p1 p2
 424 |     if {$p1 == ""} {return 0}
 425 |     if {$p2 != ""} {
 426 |         set seltag sel
 427 |         if {[focus -displayof .] != ".t"} {
 428 |             set seltag pseudosel
 429 |         }
 430 |         .t tag add $seltag $p1 $p2
 431 |     }
 432 |     MoveInsert $p1
 433 |     WarpToIndex .t insert
 434 |     return 1
 435 | }
 436 | 
 437 | proc MoveInsert {pos {see 1}} {
 438 |     global position_stack
 439 |     if {$position_stack == ""} {
 440 |         UpdateCommand Back
 441 |     }
 442 |     lappend position_stack [.t index insert]
 443 |     .t mark set insert $pos
 444 |     if {$see} {.t see insert}
 445 | }
 446 | 
 447 | proc PopMoveInsert {{see 1}} {
 448 |     global position_stack
 449 |     if {$position_stack != ""} {
 450 |         RemoveSelection .t
 451 |         .t mark set insert [lindex $position_stack end]
 452 |         set position_stack [lrange $position_stack 0 end-1]
 453 |         if {$position_stack == ""} {
 454 |             UpdateCommand "" "Back"
 455 |         }
 456 |         if {$see} {.t see insert}
 457 |     }
 458 | }
 459 | 
 460 | proc PasteSelection {w} {
 461 |     set rng [$w tag ranges sel]
 462 |     if {$rng != ""} {
 463 |         set sel ""
 464 |         eval $w delete $rng
 465 |     } elseif {[catch {selection get -type UTF8_STRING} sel]} {
 466 |         set sel ""
 467 |     }
 468 |     if {$sel == ""} {
 469 |         tk_textPaste $w
 470 |     } else {
 471 |         $w insert insert $sel
 472 |     }
 473 | }
 474 | 
 475 | proc FindInPath {fname path} {
 476 |     set found {}
 477 |     foreach x $path {
 478 |         set fn [file join $x $fname]
 479 |         if {[file exists $fn]} {
 480 |             lappend found $fn
 481 |         }
 482 |     }
 483 |     return $found
 484 | }
 485 | 
 486 | proc FindExecutable {cmd} {
 487 |     global exec_path
 488 |     if {![regexp {^\s*"([^"]+)"\s*(.*)$} $cmd _ prg rest]} {
 489 |         if {![regexp {^\s*'([^']+)'\s*(.*)$} $cmd _ prg rest]} {
 490 |             if {![regexp {^\s*(\S+)\s*(.*)$} $cmd _ prg rest]} {
 491 |                 set cmd $prg
 492 |                 set rest ""
 493 |             }
 494 |         }
 495 |     }
 496 |     set found [FindInPath $prg $exec_path]
 497 |     foreach x $found {
 498 |         if {[file type $x] != "directory" && [file executable $x]} {
 499 |             set x [file normalize $x]
 500 |             if {$rest != ""} {
 501 |                 return "$x $rest"
 502 |             } else {
 503 |                 return $x
 504 |             }
 505 |         }
 506 |     }
 507 |     return ""
 508 | }
 509 | 
 510 | proc GotoIncludeFile {fname} {
 511 |     global include_path
 512 |     set found [FindInPath $fname $include_path]
 513 |     if {$found != ""} {
 514 |         GotoFileAddress [lindex $found 0]
 515 |         return 1
 516 |     }
 517 |     return 0
 518 | }
 519 | 
 520 | proc InsertAnchor {} {
 521 |     set sel [.t tag ranges sel]
 522 |     if {$sel == ""} {
 523 |         set a "#[.t count -chars 1.0 insert]"
 524 |     } else {
 525 |         set p1 [.t count -chars 1.0 [lindex $sel 0]]
 526 |         set p2 [.t count -chars 1.0 [lindex $sel 1]]
 527 |         set a "#$p1,#$p2"
 528 |     }
 529 |     .tag insert "1.0 lineend" " :$a"
 530 | }
 531 | 
 532 | proc ToggleFont {{mode ""}} {
 533 |     global current_font fixed_font variable_font
 534 |     switch $mode {
 535 |         fix { set current_font $fixed_font }
 536 |         var { set current_font $variable_font }
 537 |         default {
 538 |             if {$current_font == $fixed_font} {
 539 |                 set current_font $variable_font
 540 |             } else {
 541 |                 set current_font $fixed_font
 542 |             }
 543 |         }
 544 |     }
 545 |     # just for reconfiguration
 546 |     ResizeFont
 547 | }
 548 | 
 549 | proc SetFontStyle {style} {
 550 |     global current_font
 551 |     lassign $current_font x y z
 552 |     set current_font [list $x $y $style]
 553 |     ResizeFont
 554 | }
 555 | 
 556 | proc DefineCommand {pat code} {
 557 |     global command_table
 558 |     lappend command_table [list $pat $code]
 559 | }
 560 | 
 561 | proc DefinePlumbing {pat code {prepend 0}} {
 562 |     global plumbing_rules
 563 |     if {$prepend} {
 564 |         set plumbing_rules [concat [list [list $pat $code]] \
 565 |             $plumbing_rules]
 566 |     } else {
 567 |         lappend plumbing_rules [list $pat $code]
 568 |     }
 569 | }
 570 | 
 571 | proc GetArg {{i 1}} {
 572 |     global command_arguments
 573 |     return [lindex $command_arguments $i]
 574 | }
 575 | 
 576 | proc ReadFile {fname} {
 577 |     global file_translation file_encoding
 578 |     if {[catch [list open $fname r] in]} {
 579 |         LogInWindow "$in\n" 1
 580 |         return {"" ""}
 581 |     }
 582 |     fconfigure $in -translation $file_translation -encoding \
 583 |         $file_encoding
 584 |     set text [read $in]
 585 |     RunHook read_hook $text
 586 |     close $in
 587 |     set tr lf
 588 |     if {[regexp "\r\n" $text] && \
 589 |         ![regexp "\[^\r]\n" $text]} {
 590 |         set tr crnl
 591 |     }
 592 |     set result [list $text $tr]
 593 |     return $result
 594 | }
 595 | 
 596 | proc Top {} {.t see 1.0}
 597 | proc Bottom {} {.t see end}
 598 | 
 599 | proc Unmodified {} {
 600 |     # hack, somehow just setting modified to 0 is sometimes not enough
 601 |     after 100 {
 602 |         .t edit modified 0
 603 |         MarkDirty 0
 604 |         UpdateCommand "" Put
 605 |     }
 606 | }
 607 | 
 608 | proc MarkDirty {on} {
 609 |     global tag_clean_font tag_dirty_font
 610 |     if {$on} {
 611 |         set tag_font $tag_dirty_font
 612 |     } else {
 613 |         set tag_font $tag_clean_font
 614 |     }
 615 |     .tag configure -font $tag_font
 616 | }
 617 | 
 618 | proc AddToHook {hook cmd} {
 619 |     global $hook
 620 |     lappend $hook $cmd
 621 | }
 622 | 
 623 | proc RunHook {hook args} {
 624 |     global $hook
 625 |     set ret ""
 626 |     set qargs {}
 627 |     foreach a $args {
 628 |         lappend qargs "{$a}"
 629 |     }
 630 |     foreach h [set $hook] {
 631 |         set ret2 [eval $h {*}$qargs]
 632 |         if {$ret == ""} {set ret $ret2}
 633 |     }
 634 |     return $ret
 635 | }
 636 | 
 637 | proc DeconsTag {} {
 638 |     set text [.tag get 1.0 end]
 639 |     if {[regexp {^\s*'([^']*)'\s*([^|]*)\|(.*)$} $text _ fname cmds rest]} {
 640 |         return [list $fname $cmds $rest]
 641 |     }
 642 |     if {[regexp {^\s*"([^"]*)"\s*([^|]*)\|(.*)$} $text _ fname cmds rest]} {
 643 |         return [list $fname $cmds $rest]
 644 |     }
 645 |     if {[regexp {^([^ ]+)\s+([^|]*)\|(.*)$} $text _ fname cmds rest]} {
 646 |         return [list $fname $cmds $rest]
 647 |     } 
 648 |     if {[regexp {^([^|]*)\|(.*)$} $text _ cmds rest]} {
 649 |         return [list "" $cmds $rest]
 650 |     }
 651 |     return [list "" text ""]
 652 | }
 653 | 
 654 | proc MakeTag {fname {c ""} {r ""}} {
 655 |     lassign [DeconsTag] old cmds rest
 656 |     .tag delete 1.0 end
 657 |     if {[regexp {\s} $fname]} {
 658 |         if {[string first "'" $fname] != -1} {
 659 |             set fname2 "\"$fname\""
 660 |         } else {
 661 |             set fname2 "'$fname'"
 662 |         }
 663 |     } else {
 664 |         set fname2 $fname
 665 |     }
 666 |     if {$c != ""} {set cmds $c}
 667 |     if {$r != ""} {set rest $r}
 668 |     set cmds [string trimright $cmds]
 669 |     .tag insert 1.0 "$fname2 $cmds |[string trimright $rest] "
 670 |     if {$old != $fname} {
 671 |         RunHook name_hook
 672 |     }
 673 | }
 674 | 
 675 | proc UpdateCommand {new {old ""}} {
 676 |     lassign [DeconsTag] fname cmds rest
 677 |     set cmds2 ""
 678 |     if {$new == "" || [string first $new $cmds] == -1} {
 679 |         if {$old == "" || [regsub -- $old $cmds $new cmds2] == 0} {
 680 |             set cmds "[string trim $cmds] $new"
 681 |         }
 682 |     } 
 683 |     if {$cmds2 == ""} {set cmds2 $cmds}
 684 |     MakeTag $fname $cmds2 $rest
 685 | }
 686 | 
 687 | proc GetTag {} {return [.tag get 1.0 end]}
 688 | proc GetBody {} {return [.t get 1.0 end]}
 689 |  
 690 | proc SetTag {text} {
 691 |     .tag delete 1.0 end
 692 |     .tag insert 1.0 $text
 693 | }
 694 | 
 695 | proc SetLabel {str} {MakeTag $str}
 696 | 
 697 | proc GetLabel {} {
 698 |     lassign [DeconsTag] label
 699 |     return $label
 700 | }
 701 | 
 702 | proc UpdateTag {{fname ""}} {
 703 |     global current_filename output_window_rx editable
 704 |     if {$fname != ""} {
 705 |         set fname [CanonicalFilename $fname]
 706 |         if {![regexp $output_window_rx $fname]} {
 707 |             set current_filename $fname
 708 |             set env(MA_LABEL) $current_filename
 709 |         }
 710 |         if {[regexp {/$} $fname]} {
 711 |             set dir $fname
 712 |         } else {
 713 |             set dir [file dirname $fname]
 714 |         }
 715 |         if {[file exists $dir]} {cd $dir}
 716 |     } else {
 717 |         set fname $current_filename
 718 |     }
 719 |     wm title . $fname
 720 |     MakeTag $fname
 721 |     .tag mark set insert "1.0 lineend"
 722 |     set aname [tk appname]
 723 | 
 724 |     # if this was an output window, reregister under a new name
 725 |     if {[regexp $output_window_rx $aname]} {
 726 |         catch [list send MA-registry Unregister "$aname"]
 727 |         tk appname MA-[pid]
 728 |         set editable 1
 729 |     }
 730 |     catch [list send -async MA-registry Register $aname "{$fname}"]
 731 | }
 732 | 
 733 | proc GetFilename {} {
 734 |     global current_filename output_window_rx unnamed
 735 |     global unnamed_name
 736 |     lassign [DeconsTag] name
 737 |     if {$name == $unnamed_name} {
 738 |         set unnamed 1
 739 |         return ""
 740 |     }
 741 |     if {![regexp $output_window_rx $name] && !$unnamed} {
 742 |         set current_filename $name
 743 |     }
 744 |     set unnamed 0
 745 |     return $current_filename
 746 | }
 747 | 
 748 | proc GetFileDir {} {
 749 |     lassign [DeconsTag] name
 750 |     set name2 [FollowLink $name]
 751 |     if {[file exists $name2] && [file type $name2] == "directory"} {
 752 |         return [file normalize $name]
 753 |     } else {
 754 |         return [file normalize [file dirname $name]] 
 755 |     }
 756 |     return [pwd]
 757 | }
 758 | 
 759 | proc OpenNewFile {fname} {
 760 |     if {[CheckIfModified]} {
 761 |         if {[ConfirmModified]} return
 762 |     }
 763 |     OpenFile $fname
 764 | }
 765 | 
 766 | proc OpenFile {name {replace 1}} {
 767 |     global current_filename last_opened current_translation
 768 |     global position_stack
 769 |     if {[file exists $name]} {
 770 |         set t [file type [FollowLink $name]]
 771 |         if {[file type $name] == "file"} {
 772 |             set last_opened [list $name [file mtime $name]]
 773 |             lassign [ReadFile $name] text tr
 774 |             UpdateTag $name
 775 |             if {$replace} {
 776 |                 SetBody $text
 777 |                 .t mark set insert 1.0
 778 |                 .t see insert
 779 |             } else {
 780 |                 Insert $text
 781 |             }
 782 |             set position_stack {}
 783 |             set current_translation $tr
 784 |             Unmodified
 785 |             RunHook file_hook
 786 |             return
 787 |         }
 788 |         LogInWindow "$name is not a regular file" 1
 789 |         return
 790 |     }
 791 |     LogInWindow "no such file: $name" 1
 792 | }
 793 | 
 794 | proc ReplaceFile {fname} {
 795 |     global current_translation position_stack
 796 |     lassign [ReadFile $fname] text tr
 797 |     SetBody $text
 798 |     .t mark set insert 1.0
 799 |     .t see insert
 800 |     Unmodified
 801 | }
 802 | 
 803 | proc SetBody {text} {
 804 |     global position_stack
 805 |     .t delete 1.0 end
 806 |     .t insert 1.0 $text
 807 |     set position_stack {}
 808 |     set ip "end - 1 chars"
 809 |     if {$text == ""} {set ip end}
 810 |     .t mark set win_insert_point $ip
 811 | }
 812 | 
 813 | proc SetDot {addr} {
 814 |     lassign [AddrIndices $addr] from to
 815 |     RemoveSelection
 816 |     .t tag add sel $from $to
 817 | }
 818 | 
 819 | proc GetDot {} {
 820 |     set range [.t tag ranges sel]
 821 |     if {$range == ""} {
 822 |         return "#[.t count -chars 1.0 insert]"
 823 |     }
 824 |     set p1 [.t count -chars 1.0 [lindex $range 0]]
 825 |     set p2 [.t count -chars 1.0 [lindex $range 1]]
 826 |     return "#$p1,#$p2"
 827 | }
 828 | 
 829 | proc AppendFile {fname} {
 830 |     global scroll eot_symbol last_scroll_bottom
 831 |     set f [open $fname]
 832 |     set p [.t index end]
 833 |     Append [read $f]
 834 |     close $f
 835 |     Append "$eot_symbol\n"
 836 |     if {!$scroll} {
 837 |         .t yview [expr max(0.0, $p - 1)]
 838 |         set last_scroll_bottom [.t index end]
 839 |     }
 840 | }
 841 | 
 842 | proc InsertFile {fname} {
 843 |     set f [open $fname]
 844 |     Insert [read $f]
 845 |     close $f
 846 | }
 847 | 
 848 | proc FollowLink {fname} {
 849 |     if {![file exists $fname]} {return $fname}
 850 |     if {[catch [list file type $fname] result]} {return $fname}
 851 |     if {$result == "link"} {
 852 |         if {[catch [list file readlink $fname] fn2]} {
 853 |             return $fname
 854 |         }
 855 |         if {![regexp {^/} $fn2]} {
 856 |             set fn2 "[file dirname $fname]/$fn2"
 857 |         }
 858 |         return [FollowLink $fn2]
 859 |     }
 860 |     return $fname
 861 | }
 862 | 
 863 | proc NeedsQuoting {fname} {
 864 |     global rc_style_quoting
 865 |     if {![string match {*[ '()]*} $fname]} {return 0}
 866 |     set len [string length $fname]
 867 |     if {$rc_style_quoting} {
 868 |         set flen 2
 869 |         for {set i 0} {$i < $len} {incr i} {
 870 |             if {[string index $fname $i] == "\'"} {incr flen}
 871 |         }
 872 |         return $flen
 873 |     }
 874 |     return [expr $len + 2]
 875 | }
 876 | 
 877 | proc QuoteString {fname} {
 878 |     global rc_style_quoting
 879 |     set len [string length $fname]
 880 |     if {$rc_style_quoting} {
 881 |         set str "\'"
 882 |         append str [regsub -all {'} $fname "''"] "\'"
 883 |         return $str
 884 |     }
 885 |     if {[string first "\'" $fname] != -1} {
 886 |         return "\"$fname\""
 887 |     }
 888 |     return "\'$fname\'"
 889 | }
 890 | 
 891 | proc FormatColumnar {list} {
 892 |     global current_font rc_style_quoting
 893 |     set zw [font measure $current_font 0]
 894 |     set w [expr [winfo width .t] / $zw]
 895 |     set n [llength $list]
 896 |     set maxlen 0
 897 |     # compute maximal item length
 898 |     foreach x $list {
 899 |         set len [string length $x]
 900 |         incr len [NeedsQuoting $x]
 901 |         if {$len > $maxlen} {set maxlen $len}
 902 |     }
 903 |     incr maxlen 2
 904 |     set cols [expr max(1, round($w / $maxlen))]
 905 |     set rows [expr ceil(double($n) / $cols)]
 906 |     set text ""
 907 |     for {set i 0} {$i < $rows} {incr i} {
 908 |         for {set j 0} {$j < $cols} {incr j} {
 909 |             set f [lindex $list [expr $i * $cols + $j]]
 910 |             set flen [string length $f]
 911 |             set leni [NeedsQuoting $f]
 912 |             if {$leni} {
 913 |                 if {[string index $f end] == "/"} {
 914 |                     set f [QuoteString [string range $f 0 "end-1"]]/
 915 |                 } else {
 916 |                     set f [QuoteString $f]
 917 |                 }
 918 |                 incr flen $leni
 919 |             }
 920 |             if {$cols > 1} {
 921 |                 set pad [string repeat " " [expr $maxlen - $flen]]
 922 |             } else {
 923 |                 set pad ""
 924 |             }
 925 |             append text $f $pad
 926 |         }
 927 |         append text "\n"
 928 |     }
 929 |     return $text
 930 | }
 931 | 
 932 | proc OpenDirectory {name} { 
 933 |     global current_translation position_stack editable dotfiles
 934 |     global directory_commands directory_hook
 935 |     set name [file normalize $name]
 936 |     if {[catch [list glob -tails -directory $name *] files]} {
 937 |         set files {}
 938 |     }
 939 |     if {$dotfiles} {
 940 |         set files [concat $files [glob -nocomplain -tails -types hidden -directory $name *]]
 941 |     }
 942 |     set files [lsort -dictionary $files]
 943 |     set nfiles {}
 944 |     # add "/", if directory
 945 |     foreach f $files {
 946 |         if {$f != "." && $f != ".."} {
 947 |             if {[file type [FollowLink "$name/$f"]] == "directory"} {
 948 |                 append f "/"
 949 |             }
 950 |             lappend nfiles $f
 951 |         }
 952 |     }
 953 |     update
 954 |     set text [FormatColumnar $nfiles]
 955 |     UpdateTag "$name/"
 956 |     SetBody $text
 957 |     .t mark set insert 1.0
 958 |     set position_stack {}
 959 |     Top
 960 |     ToggleFont fix
 961 |     set current_translation lf
 962 |     Unmodified
 963 |     foreach cmd $directory_commands {
 964 |         UpdateCommand $cmd
 965 |     }
 966 |     set editable 0
 967 |     RunHook directory_hook $name
 968 | }
 969 | 
 970 | proc SaveFile {{name ""} {force 0}} {
 971 |     global current_filename last_opened editable override_attempt
 972 |     global unnamed
 973 |     GetFilename
 974 |     if {$name == ""} {
 975 |         set name $current_filename
 976 |     }
 977 |     if {$force} {set editable 1}
 978 |     if {[RunHook pre_save_hook $name] != ""} {
 979 |         return 1
 980 |     }
 981 |     if {$name == ""} {
 982 |         LogInWindow "file has no name\n" 1
 983 |         return 0
 984 |     }
 985 |     if {![CheckIfModified] && !$force && [file exists $name]} {
 986 |         return 1
 987 |     }
 988 |     set x [file exists $name]
 989 |     if {$last_opened != ""} {
 990 |         if {[lindex $last_opened 0] == $name && $x && \
 991 |             [lindex $last_opened 1] != [file mtime $name]} {
 992 |             LogInWindow "$name has been modified externally\n" 1
 993 |             set last_opened ""
 994 |             set override_attempt 1
 995 |             return 0
 996 |         }
 997 |     } elseif {$x} {
 998 |         if {!$override_attempt} {
 999 |             LogInWindow "$name already exists\n" 1
1000 |             set override_attempt 1
1001 |             return 0
1002 |         }
1003 |     }
1004 |     set override_attempt 0
1005 |     set name [CanonicalFilename $name]
1006 |     set dir [file dirname $name]
1007 |     if {![file exists $dir]} {
1008 |         file mkdir $dir
1009 |     }
1010 |     cd $dir
1011 |     WriteFile $name
1012 |     set last_opened [list $name [file mtime $name]]
1013 |     Unmodified
1014 |     UpdateTag $name
1015 |     RunHook save_hook
1016 |     return 1
1017 | }
1018 | 
1019 | proc WriteFile {name} {
1020 |     set out [open $name w]
1021 |     set text [.t get 1.0 "end - 1 chars"]
1022 |     RunHook write_hook $text
1023 |     puts -nonewline $out $text
1024 |     close $out
1025 |     if {[string equal -length 3 $text "#!/"]} {
1026 |         file attribute $name -permissions a+x
1027 |     }
1028 | }
1029 | 
1030 | proc Flash {{color red}} {
1031 |     global current_background
1032 |     .t configure -background $color
1033 |     update
1034 |     after 100 {.t configure -background $current_background}
1035 | }
1036 | 
1037 | proc CheckIfModified {} {
1038 |     global editable unnamed
1039 |     GetFilename
1040 |     if {[.t edit modified] && $editable && !$unnamed} {
1041 |         return 1 
1042 |     }
1043 |     return 0
1044 | }
1045 | 
1046 | proc SaveIfModified {} {
1047 |     if {[CheckIfModified]} SaveChanges
1048 | }
1049 | 
1050 | proc WithdrawWindow {} {
1051 |     global withdrawn
1052 |     if {!$withdrawn} {
1053 |         wm withdraw .
1054 |         set withdrawn 1
1055 |     }
1056 | }
1057 | 
1058 | proc DeiconifyWindow {} {
1059 |     global withdrawn
1060 |     if {$withdrawn} {
1061 |         wm deiconify .
1062 |         set withdrawn 0
1063 |     }
1064 | }
1065 | 
1066 | proc Insert {text {tags ""}} {
1067 |     DeiconifyWindow
1068 |     .t insert insert $text $tags
1069 |     .t see insert
1070 | }
1071 | 
1072 | proc Append {text {sel 0}} {
1073 |     DeiconifyWindow
1074 |     set p1 [.t index "end - 1 chars"]
1075 |     .t insert end $text
1076 |     ScrollToBottom
1077 |     if {$sel} { 
1078 |         RemoveSelection .t
1079 |         .t tag add sel $p1 "end - 1 chars"
1080 |     }
1081 | }
1082 | 
1083 | proc ScrollToBottom {} {
1084 |     global win_mode scroll
1085 |     if {!$scroll} return
1086 |     if {$win_mode} {
1087 |         if {[catch {.t dlineinfo win_insert_point} result] || \
1088 |             $result != ""} {  
1089 |             Bottom
1090 |         }
1091 |     } else Bottom
1092 | }
1093 | 
1094 | proc AppendLine {text {sel 0}} {
1095 |     Append "$text\n" $sel
1096 | }
1097 | 
1098 | proc ConfirmModified {} {
1099 |     global current_filename last_del_attempt
1100 |     set cnt [.t count -chars 1.0 end]
1101 |     if {$last_del_attempt == 0 || $cnt != $last_del_attempt} {
1102 |         LogInWindow "$current_filename is modified\n" 1
1103 |         Flash 
1104 |         set last_del_attempt $cnt
1105 |         return 1
1106 |     }
1107 |     return 0
1108 | }
1109 | 
1110 | proc Terminate {{force 0} {status 0}} {
1111 |     global current_filename last_del_attempt win_mode
1112 |     if {!$force && [CheckIfModified]} { 
1113 |         if {[ConfirmModified]} return
1114 |     }
1115 |     catch [list send -async MA-registry Unregister [tk appname]]
1116 |     RunHook termination_hook
1117 |     exit $status
1118 | }
1119 | 
1120 | proc ResizeFont {{val ""}} {
1121 |     global current_font fixed_font variable_font
1122 |     lassign $current_font name size style
1123 |     if {$val == ""} {set val $size}
1124 |     set font [list $name $val $style]
1125 |     if {$current_font == $fixed_font} {
1126 |         set fixed_font $font
1127 |     } else {
1128 |         set variable_font $font
1129 |     }
1130 |     set current_font $font
1131 |     .t configure -font $font
1132 |     RunHook configuration_hook
1133 | }
1134 | 
1135 | proc ConfigureWindow {{runhook 1}} {
1136 |     global current_background current_foreground current_font 
1137 |     global tag_foreground tag_background selection_foreground 
1138 |     global selection_background tag_font sbar_width
1139 |     global sbar_color sbar sbar_background b2sweep_foreground 
1140 |     global b2sweep_background 
1141 |     global b3sweep_foreground b3sweep_background pseudo_selection_foreground 
1142 |     global pseudo_selection_background 
1143 |     global win_mode wrap_mode
1144 |     global inactive_selection_background 
1145 |     global has_focus focus_color nonfocus_color cursor
1146 |     if {$has_focus} {
1147 |         . configure -highlightcolor $focus_color -highlightbackground \
1148 |             $focus_color
1149 |     } else {
1150 |         . configure -highlightcolor $nonfocus_color -highlightbackground \
1151 |             $nonfocus_color
1152 |     }
1153 |     .tag configure -background $tag_background -foreground $tag_foreground \
1154 | 	-selectbackground $selection_background -selectforeground $selection_foreground \
1155 | 	-inactiveselectbackground $inactive_selection_background \
1156 | 	-insertbackground $tag_foreground -font $tag_font \
1157 |         -insertofftime 0 -relief solid -highlightthickness 0 -wrap char \
1158 |         -borderwidth 1 -cursor $cursor
1159 |     .t configure -background $current_background -foreground $current_foreground  \
1160 | 	-selectbackground $selection_background -selectforeground $selection_foreground \
1161 | 	-inactiveselectbackground $inactive_selection_background \
1162 | 	-insertbackground $current_foreground -font $current_font \
1163 |         -relief flat -borderwidth 1 -highlightthickness 0 \
1164 |         -insertofftime 0 -insertwidth 3 -wrap $wrap_mode -cursor $cursor
1165 |     .s configure -background $sbar_color -relief solid -borderwidth 1 \
1166 |         -highlightthickness 0 -width $sbar_width -cursor $cursor
1167 |     .s itemconfigure $sbar -fill $sbar_background -width 0 -stipple ""
1168 |     .t tag configure pseudosel -foreground $pseudo_selection_foreground -background $pseudo_selection_background
1169 |     .tag tag configure pseudosel -foreground $pseudo_selection_foreground -background $pseudo_selection_background
1170 |     .t tag configure b2sweep -foreground $b2sweep_foreground -background $b2sweep_background
1171 |     .tag tag configure b2sweep -foreground $b2sweep_foreground -background $b2sweep_background
1172 |     .t tag configure b3sweep -foreground $b3sweep_foreground -background $b3sweep_background
1173 |     .tag tag configure b3sweep -foreground $b3sweep_foreground -background $b3sweep_background
1174 |     .t tag lower pseudosel
1175 |     .tag tag lower pseudosel
1176 |     if {$win_mode} {.t configure -insertofftime 300}
1177 |     if {$runhook} {
1178 |         RunHook configuration_hook
1179 |     }
1180 | }
1181 | 
1182 | proc DefineKey {event cmd} {
1183 |     bind .tag $event $cmd
1184 |     bind .t $event $cmd
1185 | }
1186 | 
1187 | proc DoRunCommand {cmd {inputfile ""}} {
1188 |     global command_input_file shell
1189 |     if {$inputfile != ""} {
1190 |         set command_input_file $inputfile
1191 |         return [open "| $shell -c {$cmd} < $inputfile 2>@1" r]
1192 |     } else {
1193 |         return [open "| $shell -c {$cmd} << {} 2>@1" r]
1194 |     }
1195 | }
1196 | 
1197 | proc RunExternalCommand {cmd {inputfile ""} {sender ""} {sender_label ""}} {
1198 |     global executing_pids command_input_file env scroll 
1199 |     global last_scroll_bottom
1200 |     if {!$scroll} {
1201 |         set last_scroll_bottom [.t index end]
1202 |     }
1203 |     if {$sender != ""} {
1204 |         set env(MA) $sender 
1205 |         set env(MA_LABEL) $sender_label
1206 |     }
1207 |     if {[catch [list DoRunCommand $cmd $inputfile] input]} {
1208 |         Append "\nCommand failed: $input\n"
1209 |         Bottom
1210 |         if {$command_input_file != ""} {
1211 |             file delete -force $command_input_file
1212 |         }
1213 |         return
1214 |     }
1215 |     lappend executing_pids [pid $input]
1216 |     fconfigure $input -blocking 0
1217 |     fileevent $input readable [list LogOutput $input]
1218 | }
1219 | 
1220 | proc RecordPosition {} {
1221 |     global last_mouse_index
1222 |     set last_mouse_index [.t index insert]
1223 | }
1224 | 
1225 | proc LogOutput {input} {
1226 |     global current_background command_input_file eot_symbol executing_pids 
1227 |     global any_output win_mode scroll last_scroll_bottom
1228 |     set data [read $input]
1229 |     set blocked [fblocked $input]
1230 |     if {$data != ""} {
1231 |         DeiconifyWindow
1232 |         set any_output 1
1233 |         Append "$data"
1234 |         if {$win_mode} {
1235 |             .t mark set win_insert_point "end - 1 chars"
1236 |             .t mark gravity win_insert_point left
1237 |         }
1238 |         if {!$scroll} {
1239 |             .t yview [expr max(1.0, $last_scroll_bottom - 1.0)]
1240 |         }
1241 |     } elseif {!$blocked} {
1242 |         set pid [pid $input]
1243 |         if {[catch [list close $input] result]} {
1244 |             Append "\nCommand failed: $result"
1245 |             Bottom
1246 |             set any_output 1
1247 |         } else {
1248 |             Append "$eot_symbol\n"
1249 |         }
1250 |         DropExecutingPid $pid
1251 |         if {$command_input_file != ""} {
1252 |            file delete -force $command_input_file
1253 |         }
1254 |         if {!$any_output} {Terminate 1}
1255 |         if {$executing_pids == ""} {
1256 |             set win_mode 0
1257 |         }
1258 |     }
1259 |     update idletasks
1260 | }
1261 | 
1262 | proc Evaluate {cmd} {
1263 |     if {[catch [list uplevel #0 $cmd] result]} {
1264 |         Flash red
1265 |     } else {
1266 |         Flash blue
1267 |     }
1268 | }
1269 | 
1270 | proc CanonicalFilename {str} {
1271 |     if {![regexp {^\s*[~/]} $str]} {
1272 |         set fname "[pwd]/$str"
1273 |     } else {
1274 |         set fname $str
1275 |     }
1276 |     if {[file exists $fname]} {
1277 |         set fname [file normalize $fname]
1278 |         if {[file type $fname] == "directory"} {
1279 |             append fname "/"
1280 |         }
1281 |     }
1282 |     return $fname
1283 | }
1284 | 
1285 | proc Plumb {str args} {
1286 |     global plumbing_rules command_arguments exec_prefix plumber
1287 |     foreach r $plumbing_rules {
1288 |         set command_arguments [regexp -inline -- [lindex $r 0] $str]
1289 |         if {$command_arguments != ""} {
1290 |             set r [eval [lindex $r 1]]
1291 |             if {$r != 0} {return 1}
1292 |         }
1293 |     }
1294 |     if {[catch [list exec sh -c "${exec_prefix}$plumber \"$str\" $args"]]} {
1295 |         return 0
1296 |     }
1297 |     return 1
1298 | }
1299 | 
1300 | proc Acquire {} {
1301 |     global search_string ma hash_dict 
1302 |     set fw [GetFocusWidget]
1303 |     # range: either what is swept with B3, or the selection (if the mouse is inside it)
1304 |     # or the word under the cursor:
1305 |     set range [$fw tag ranges b3sweep]
1306 |     if {$range == ""} {
1307 |         set range [$fw tag ranges sel]
1308 |         if {$range == "" || [lsearch -exact [$fw tag names current] sel] == -1} {
1309 |             set range ""
1310 |         }
1311 |     }
1312 |     if {$range == ""} {
1313 |         set dest [GetWordUnderCursor $fw]
1314 |         set start [$fw index "current + [string length $dest] chars"]
1315 |     } else {
1316 |         set start "[lindex $range 0] + 1 chars"
1317 |         set dest [$fw get [lindex $range 0] [lindex $range 1]]        
1318 |     }
1319 |     RemoveTaggedRange $fw b3sweep
1320 |     set dest [string trim $dest]
1321 |     if {$dest == ""} return
1322 |     if {[Plumb $dest]} return
1323 |     lassign [DeconsTag] name
1324 |     if {"$name" == $dest} {
1325 |         RemoveSelection .t
1326 |         .t tag add sel 1.0 end
1327 |         return
1328 |     }
1329 |     set fname $dest
1330 |     set fname [CanonicalFilename $fname]
1331 |     if {[file exists $fname]} {
1332 |         RemoveSelection
1333 |         set fname [FollowLink $fname]
1334 |         GotoFileAddress $fname
1335 |         return
1336 |     }
1337 |     # force search in body
1338 |     if {$range == "" && $fw != ".t"} {set start [.t index insert]}
1339 |     Search $dest $start
1340 | }
1341 | 
1342 | proc Search {{str ""} {start ""} {case 0} {warp 1}} {
1343 |     global search_string
1344 |     if {$str != ""} {
1345 |         set search_string $str
1346 |     } else {
1347 |         return
1348 |     }
1349 |     set range [.t tag ranges sel]
1350 |     if {$start == ""} {
1351 |         if {$range != ""} {
1352 |             set p1 [lindex $range 0]
1353 |             set start "$p1 + 1 chars"
1354 |         } else {
1355 |             set start "insert + 1 chars"
1356 |         }
1357 |     }
1358 |     if {$case} {
1359 |         set found [.t search -- $search_string $start]
1360 |     } else {
1361 |         set found [.t search -nocase -- $search_string $start]
1362 |     }
1363 |     if {$found != ""} {
1364 |         # keep selection in case it was in tag
1365 |         if {[GetFocusWidget] == ".tag"} {
1366 |             SaveSelection .tag
1367 |         }
1368 |         RemoveSelection .t
1369 |         set len [string length $search_string]
1370 |         set end "$found + $len chars"
1371 |         .t tag add sel $found $end
1372 |         MoveInsert $end
1373 |         if {$warp} {WarpToIndex .t $found}
1374 |     }
1375 | }
1376 | 
1377 | proc WarpToIndex {fw index} {
1378 |     set info [.t bbox $index]
1379 |     if {$info != ""} {
1380 |         set x [expr [lindex $info 0] + [lindex $info 2] / 2]
1381 |         set y [expr [lindex $info 1] + [lindex $info 3] / 2]
1382 |         event generate .t <Motion> -x $x -y $y -warp 1
1383 |     }
1384 | }
1385 | 
1386 | proc GetFocusWidget {} {
1387 |     set fw [focus -displayof .]
1388 |     if {$fw == ""} {
1389 |         return .t
1390 |     }
1391 |     return $fw
1392 | }
1393 | 
1394 | proc GetWordUnderCursor {{fw ""}} {
1395 |     set ixs [GetWordUnderIndex $fw current]
1396 |     if {$ixs == ""} {
1397 |         return ""
1398 |     }
1399 |     return [eval $fw get $ixs]
1400 | }
1401 | 
1402 | proc GetWordUnderIndex {fw idx} {
1403 |     set startx [$fw index "$idx linestart"]
1404 |     regexp {^(\d+)\.} $startx _ lnum
1405 |     set endx [$fw index "$idx lineend"]
1406 |     set posx [$fw index $idx]
1407 |     set start [$fw get $startx $posx]
1408 |     set end [$fw get $posx $endx]
1409 |     regexp {\.(\d+)$} $posx _ col
1410 |     if {[regexp -indices "(\[^ \t\r\"'()\\\[\\\]{}\]+)\$" $start _ pos]} {
1411 |         set w0 [lindex $pos 0]
1412 |         if {[regexp -indices "^(\[^ \t\r\"'()\\\[\\\]{}\]+)" $end _ pos]} {
1413 |             return [list "$lnum.$w0" "$lnum.[expr $col + [lindex $pos 1] + 1]"]
1414 |         }
1415 |         return [list "$lnum.$w0" "$lnum.[expr [lindex $pos 1] + 1]"]
1416 |     }
1417 |     if {[regexp -indices "^(\[^ \t\r\"'()\\\[\\\]{}\]+)" $end _ pos]} {
1418 |         return [list $posx "$lnum.[expr $col + [lindex $pos 1] + 1]"]
1419 |     }
1420 |     return ""
1421 | }
1422 | 
1423 | proc DropExecutingPid {pid} {
1424 |     global executing_pids
1425 |     set i [lsearch -exact $pid $executing_pids]
1426 |     if {$i != -1} {
1427 |         set executing_pids [lreplace $executing_pids $i $i] 
1428 |     }
1429 | }
1430 | 
1431 | proc KillExecuting {{signal SIGKILL} {parent 0}} {
1432 |     global executing_pids win_mode
1433 |     if {$executing_pids != ""} {
1434 |         if {!$win_mode} {
1435 |             foreach pid $executing_pids {
1436 |                 # shell may have exec'd or may have forked subprocesses
1437 |                 set cpids [ChildPids $pid]
1438 |                 catch [list exec kill -$signal {*}$cpids]
1439 |                 if {[catch [list exec kill -$signal $pid]]} {
1440 |                     DropExecutingPid $pid
1441 |                 }
1442 |             }
1443 |         } else {
1444 |             if {$parent} {
1445 |                 set win_mode 0
1446 |             }
1447 |             foreach pid $executing_pids {
1448 |                 if {[catch [list exec kill -$signal $pid]]} {
1449 |                     DropExecutingPid $pid
1450 |                 }
1451 |             }
1452 |         }
1453 |     }
1454 | }
1455 | 
1456 | proc InvokeExternalCommandInWindow {cmd {input ""}} {
1457 |     global current_filename
1458 |     set myname [tk appname]
1459 |     ExecuteInWindow [list RunExternalCommand $cmd $input $myname $current_filename]
1460 |     return 1
1461 | }
1462 | 
1463 | proc ExecuteInWindow {cmd {tag ""}} {
1464 |     global ma 
1465 |     set dir [GetFileDir]
1466 |     set name "$dir/+Errors"
1467 |     if {[catch [list send $name #]]} {
1468 |         if {$tag == ""} {
1469 |             set tag "$dir/+Errors New Kill Del Cut Paste Snarf Look Font Scroll | "
1470 |         }
1471 |         Ma -name $name -temporary -cd $dir -tag $tag -withdrawn -post-eval $cmd
1472 |     } else {
1473 |         catch [list send $name $cmd]
1474 |     }
1475 | }
1476 | 
1477 | proc SendToProcess {{cmd ""}} {
1478 |     global win_file win_mode
1479 |     set range [GetEffectiveSelection .t]
1480 |     if {$cmd == ""} {
1481 |         if {$range != ""} {
1482 |             set cmd [.t get [lindex $range 0] [lindex $range 1]]
1483 |         } else return
1484 |     }
1485 |     RemoveSelection .t
1486 |     Append "$cmd\n"
1487 |     .t mark set insert end
1488 |     if {$win_mode} {
1489 |         puts $win_file $cmd
1490 |         flush $win_file
1491 |         AddToHistory $cmd
1492 |     }
1493 | }
1494 | 
1495 | proc LogInWindow {msg {sel 0}} {
1496 |     ExecuteInWindow [list Append $msg $sel]
1497 | }
1498 | 
1499 | proc SmartIndent {} {
1500 |     global tabwidth indent_mode
1501 |     if {[GetFocusWidget] != ".t"} return
1502 |     set pos [.t index insert]
1503 |     regexp {(\d+)\.(\d+)} $pos all row col
1504 |     if {$row > 1 && $indent_mode} {
1505 |         set rowup [expr $row - 1]
1506 |         set above [.t get $rowup.0 "$rowup.0 lineend"]
1507 |         set uplen [string length $above]
1508 |         if {$uplen > $col} {
1509 |             set i $col
1510 |             # first skip non-ws chars
1511 |             while {$i < $uplen && [string index $above $i] != " "} {
1512 |                 incr i
1513 |             }
1514 |             while {$i < $uplen} {
1515 |                 if {[string index $above $i] != " "} {
1516 |                     Insert [string repeat " " [expr $i - $col]]
1517 |                     return
1518 |                 }
1519 |                 incr i
1520 |             }
1521 |         }
1522 |     }
1523 |     set tcol [expr (($col / $tabwidth) + 1) * $tabwidth]
1524 |     Insert [string repeat " " [expr $tcol - $col]]
1525 | }
1526 | 
1527 | proc EnterRemoteMode {win host} {
1528 |     global remote
1529 |     set remote $win
1530 |     SetFontStyle italic
1531 |     ResizeFont
1532 | }
1533 | 
1534 | proc RemoteSend {cmd} {
1535 |     global remote
1536 |     if {[catch [list send $remote SendToProcess "{$cmd}"]]} {
1537 |         set remote ""
1538 |         SetFontStyle normal
1539 |         return 0
1540 |     }
1541 |     return 1
1542 | }
1543 | 
1544 | proc TempFile {} {
1545 |     global env
1546 |     set tmpdir "/tmp"
1547 |     if {[info exists env(TMPDIR)]} {
1548 |         set tmpdir $env(TMPDIR)
1549 |     }
1550 |     return "$tmpdir/0.[pid].[expr rand()]"
1551 | }
1552 | 
1553 | proc RemoveTempFile {fname} {
1554 |     after 1000 [list file delete $fname]
1555 | }
1556 | 
1557 | proc RefreshDirectory {} {
1558 |     global current_filename
1559 |     if {[GetFilename] != ""} {
1560 |         if {[file type $current_filename] == "directory"} {
1561 |             OpenDirectory $current_filename
1562 |             cd $current_filename
1563 |         }
1564 |     }
1565 | }
1566 | 
1567 | proc RevertFile {{force 0}} {
1568 |     global current_filename
1569 |     if {[RunHook revert_hook $force] != ""} return
1570 |     if {[GetFilename] != ""} {
1571 |         if {!$force && [CheckIfModified]} {
1572 |             if {[ConfirmModified]} return
1573 |         }
1574 |         set current_filename [FollowLink $current_filename]
1575 |         if {[file type $current_filename] == "directory"} {
1576 |             OpenDirectory $current_filename
1577 |             cd $current_filename
1578 |         } else {
1579 |             OpenFile $current_filename
1580 |         }
1581 |     }
1582 | }
1583 | 
1584 | proc Execute {fw {arg ""}} {
1585 |     global has_focus 
1586 |     # range: either what is swept with B2, or the selection (if the mouse is inside it)
1587 |     # or the word under the cursor:
1588 |     set range [$fw tag ranges b2sweep]
1589 |     if {$range == ""} {
1590 |         set range [$fw tag ranges sel]
1591 |         if {$range == "" || [lsearch -exact [$fw tag names current] sel] == -1} {
1592 |             set range ""
1593 |         }
1594 |     }
1595 |     if {$range == ""} {
1596 |         set cmd [GetWordUnderCursor $fw]
1597 |     } else {
1598 |         set cmd [$fw get [lindex $range 0] [lindex $range 1]]
1599 |     }
1600 |     RemoveTaggedRange $fw b2sweep
1601 |     set cmd [string trim $cmd]
1602 |     if {$cmd == ""} return
1603 |     if {$arg != ""} {
1604 |         append cmd " $arg"
1605 |     }
1606 |     if {$fw == ".tag" || $has_focus || \
1607 |         [catch [list send MA-registry FocusExecute "{$cmd}" "{[pwd]}"] result] \
1608 |         || !$result} {
1609 |         DoExecute $cmd
1610 |     }
1611 | }
1612 | 
1613 | proc FocusExecute {cmd ctxt} {
1614 |     global focus_window
1615 |     if {$focus_window != ""} {
1616 |         .t insert end "focus execute: $focus_window : $cmd (context: $ctxt)\n"
1617 |         Bottom
1618 |         if {![catch [list send $focus_window DoExecute "{$cmd}" "{$ctxt}"]]} {
1619 |             return 1
1620 |         }
1621 |     }
1622 |     return 0
1623 | }
1624 | 
1625 | proc DoExecute {cmd {ctxt ""}} {
1626 |     global command_table command_arguments shell win_mode
1627 |     global remote
1628 |     set sel [GetEffectiveSelection .t]
1629 |     set ptop [lindex [.t yview] 0]
1630 |     switch -regexp -- $cmd {
1631 |         {^$} return
1632 |         {^\|} {
1633 |             if {$sel == ""} {
1634 |                 set start 1.0
1635 |                 set end end
1636 |             } else {
1637 |                 set start [lindex $sel 0]
1638 |                 set end [lindex $sel 1]
1639 |             }
1640 |             set input [.t get $start $end]                
1641 |             set cmd [string range $cmd 1 end]
1642 |             set outf [TempFile]
1643 |             set output ""
1644 |             if {[catch [list exec $shell -c $cmd << $input > $outf] result]} {
1645 |                 LogInWindow $result 1
1646 |                 return
1647 |             } else {
1648 |                 .t delete $start $end
1649 |                 .t mark set insert $start
1650 | 
1651 |                 if {[file exists $outf]} {
1652 |                     lassign [ReadFile $outf] output
1653 |                     file delete -force $outf
1654 |                 }
1655 |             }
1656 |             Insert $output sel
1657 |             .t yview moveto $ptop
1658 |             return
1659 |         }
1660 |         {^<} {
1661 |             set outf [TempFile]
1662 |             set cmd [string range $cmd 1 end]
1663 |             set output ""
1664 |             if {[catch [list exec $shell -c $cmd < /dev/null > $outf] result]} {
1665 |                 LogInWindow $result 1
1666 |             } else {
1667 |                 if {[file exists $outf]} {
1668 |                     lassign [ReadFile $outf] output
1669 |                     file delete -force $outf
1670 |                 }
1671 |             }
1672 |             if {$sel != ""} {eval .t delete $sel}
1673 |             Insert $output sel
1674 |             .t yview moveto $ptop
1675 |             return
1676 |         }
1677 |         {^>} {
1678 |             if {$sel == ""} {
1679 |                 set input [.t get 1.0 end]
1680 |             } else {
1681 |                 set input [.t get [lindex $sel 0] [lindex $sel 1]]
1682 |             }
1683 |             set cmd [string range $cmd 1 [string length $cmd]]
1684 |             set inf [TempFile]
1685 |             set f [open $inf w]
1686 |             puts -nonewline $f $input
1687 |             close $f
1688 |             InvokeExternalCommandInWindow $cmd $inf
1689 |             return
1690 |         }
1691 |     }
1692 |     foreach opr $command_table {
1693 |         set command_arguments [regexp -inline -- [lindex $opr 0] $cmd]
1694 |         if {$command_arguments != ""} {
1695 |             eval [lindex $opr 1]
1696 |             return
1697 |         }
1698 |     }
1699 |     if {$remote != ""} {
1700 |         if {[RemoteSend $cmd]} return
1701 |     }
1702 |     if {[RunHook execute_hook $cmd $ctxt] != ""} return
1703 |     if {$win_mode} {
1704 |         SendToProcess $cmd
1705 |         return
1706 |     }
1707 |     set cmd1 [FindExecutable $cmd]
1708 |     if {$cmd1 == ""} return
1709 |     InvokeExternalCommandInWindow $cmd1
1710 |     AddToHistory $cmd
1711 | }
1712 | 
1713 | proc AddToHistory {cmd} {
1714 |     global history_file
1715 |     if {$history_file != ""} {
1716 |         set f [open $history_file a]
1717 |         puts $f $cmd
1718 |         close $f
1719 |         file attributes $history_file -permissions go-rw
1720 |     }
1721 | }
1722 | 
1723 | proc Scrolling {start end} {
1724 |     global sbar sbar_height
1725 |     set w [winfo width .s]
1726 |     set h [winfo height .s]
1727 |     set y1 [expr $h * $start]
1728 |     set y2 [expr $h * $end]
1729 |     if {($y2 - $y1) < 3} {set y2 [expr $y1 + 3]}
1730 |     .s coords $sbar 0 $y1 $w $y2
1731 |     set sbar_height [expr $y2 - $y1]
1732 | }
1733 | 
1734 | proc ScrollUp {p {cont 0}} {
1735 |     global scroll_repeat scroll_task
1736 |     .t yview scroll [expr -$p] pixels
1737 |     if {$cont} {
1738 |         if {$scroll_task != ""} {after cancel $scroll_task}
1739 |         set p [expr [winfo pointery .s] - [winfo rooty .s]]
1740 |         set scroll_task [after $scroll_repeat [list ScrollUp $p 1]]
1741 |     }
1742 | }
1743 | 
1744 | proc EndScrolling {} {
1745 |     global scroll_task
1746 |     after cancel $scroll_task
1747 |     set scroll_task ""
1748 | }
1749 | 
1750 | proc ScrollDown {p {cont 0}} {
1751 |     global scroll_repeat scroll_task
1752 |     .t yview scroll $p pixels
1753 |     if {$cont} {
1754 |         if {$scroll_task != ""} {after cancel $scroll_task}
1755 |         set p [expr [winfo pointery .s] - [winfo rooty .s]]
1756 |         set scroll_task [after $scroll_repeat [list ScrollDown $p 1]]
1757 |     }
1758 | }
1759 | 
1760 | proc ScrollTo {p} {
1761 |     global sbar_height
1762 |      set h [winfo height .s]
1763 |      set f [expr double($p - $sbar_height / 2) / $h]
1764 |      .t yview moveto $f
1765 | }
1766 | 
1767 | proc GetSelection {{fw ""}} {
1768 |     if {$fw == ""} {
1769 |         set fw [GetFocusWidget]
1770 |     }
1771 |     set range [GetEffectiveSelection $fw]
1772 |     if {$range == ""} {
1773 |         return [$fw get {insert linestart} {insert lineend}]
1774 |     }
1775 |     return [$fw get [lindex $range 0] [lindex $range 1]]
1776 | }
1777 | 
1778 | proc GetEffectiveSelection {w} {
1779 |     set sel [$w tag ranges sel]
1780 |     if {$sel == ""} {
1781 |         return [$w tag ranges pseudosel]
1782 |     }
1783 |     return $sel
1784 | }
1785 | 
1786 | proc GetSelectedLines {} {
1787 |     set range [GetEffectiveSelection .t]
1788 |     if {$range == ""} {
1789 |         return [.t get {insert linestart} {insert lineend}]
1790 |     }
1791 |     return [.t get "[lindex $range 0] linestart" "[lindex $range 1] lineend"]
1792 | }
1793 | 
1794 | proc RemoveSelection {{fw ""}} {
1795 |     global pseudosel_on
1796 |     set rfw [focus -displayof .]
1797 |     if {$fw == ""} {
1798 |         set fw $rfw
1799 |     }
1800 |     foreach tag {sel pseudosel b2sweep b3sweep} {
1801 |         set old [$fw tag ranges $tag]
1802 |         if {$old != ""} {
1803 |             eval $fw tag remove $tag $old
1804 |         }   
1805 |     }
1806 |     set pseudosel_on($fw) 0
1807 |     return $fw
1808 | }
1809 | 
1810 | proc RemovePseudoSelection {fw} {
1811 |     global pseudosel_on
1812 |     foreach tag {pseudosel b2sweep b3sweep} {
1813 |         set old [$fw tag ranges $tag]
1814 |         if {$old != ""} {
1815 |             eval $fw tag remove $tag $old
1816 |         }
1817 |     }
1818 |     set pseudosel_on($fw) 0
1819 | }
1820 | 
1821 | proc RestoreSelection {fw} {
1822 |     global pseudosel_on 
1823 |     set old [$fw tag ranges sel]
1824 |     if {$old == ""} {
1825 |         set old [$fw tag ranges pseudosel]
1826 |         if {$old != ""} {
1827 |             eval $fw tag add sel $old
1828 |             eval $fw tag remove pseudosel $old
1829 |             set pseudosel_on($fw) 0
1830 |         }
1831 |     }
1832 | }
1833 | 
1834 | proc SaveSelection {fw} {
1835 |     global pseudosel_on
1836 |     set old [$fw tag ranges sel]
1837 |     if {$old != ""} {
1838 |         eval $fw tag add pseudosel $old
1839 |         set pseudosel_on($fw) 1
1840 |     }
1841 | }
1842 | 
1843 | proc SetTaggedRange {fw tag from to} {
1844 |     set old [$fw tag ranges $tag]
1845 |     if {$old != ""} {
1846 |         eval $fw tag remove $tag $old
1847 |     }
1848 |     if {[$fw compare $from > $to]} {
1849 |         set tmp $from
1850 |         set from $to
1851 |         set to $tmp
1852 |     }
1853 |     $fw tag add $tag $from $to
1854 | }
1855 | 
1856 | proc RemoveTaggedRange {fw tag} {
1857 |     set old [$fw tag ranges $tag]
1858 |     if {$old != ""} {
1859 |         eval $fw tag remove $tag $old
1860 |     }
1861 | }
1862 | 
1863 | proc ChildPids {ppid} {
1864 |     if {[catch [list open "| pgrep -P $ppid"] f]} {return {}}
1865 |     set cpids {}
1866 |     while {[gets $f line] > 0} {
1867 |         lappend cpids $line
1868 |     }
1869 |     catch [list close $f]
1870 |     return $cpids
1871 | }
1872 | 
1873 | proc EnterWinMode {{cmd ""}} {
1874 |     global win_mode executing_pids win_file exec_prefix env shell scroll
1875 |     if {$cmd == ""} {set cmd $shell}
1876 |     if {[catch [list open "| ${exec_prefix}pty $cmd 2>@1" \
1877 |         r+] win_file]} {
1878 |         Append "\nCommand failed: $win_file\n"
1879 |         return
1880 |     }
1881 |     set win_mode 1
1882 |     ToggleScroll 1
1883 |     eval lappend executing_pids [pid $win_file]
1884 |     fconfigure $win_file -blocking 0
1885 |     fileevent $win_file readable [list LogOutput $win_file]
1886 |     .t configure -insertofftime 300
1887 |     bind .t <Return> {
1888 |         global win_file win_mode password_input password_char
1889 |         # win-mode may be off, when process was killed
1890 |         if {$win_mode} {
1891 |             if {[catch {.t index win_insert_point} ip]} {
1892 |                 set ip 1.0
1893 |             }
1894 |             if {[.t compare [.t index insert] > $ip]} {
1895 |                 set text [.t get $ip "insert lineend"]
1896 |             } else {
1897 |                 set text [.t get "insert linestart" "insert lineend"]
1898 |             }
1899 |             .t mark set insert "end - 1 chars"
1900 |             if {$password_input != ""} {
1901 |                 regsub "$password_char+" $text $password_input rtext
1902 |                 set password_input ""
1903 |             } else {
1904 |                 set rtext $text
1905 |             }
1906 |             puts $win_file $rtext
1907 |             flush $win_file
1908 |             AddToHistory $text
1909 |             Insert "\n"
1910 |             .t mark set win_insert_point insert
1911 |             break
1912 |         }
1913 |     }
1914 |     DefineCommand {^Interrupt$} {
1915 |         global win_file
1916 |         puts $win_file "\x03"
1917 |         flush $win_file
1918 |     }
1919 |     bind .t <KeyPress> {
1920 |         global password_input password_char
1921 |         set char %A
1922 |         TakeFocus
1923 |         if {[string is print -strict $char]} {
1924 |             set txt [.t get "insert linestart" insert]
1925 |             if {[regexp -nocase {pass(word|phrase).*:} $txt]} {
1926 |                 Insert $password_char
1927 |                 append password_input $char
1928 |                 break
1929 |             }
1930 |         }
1931 |     }
1932 |     bind .t <BackSpace> {
1933 |         global password_input password_char
1934 |         TakeFocus
1935 |         set txt [.t get "insert linestart" insert]
1936 |         if {[regexp -nocase "pass(word|phrase).*:\\s*(${password_char}*)\$" \
1937 |             $txt _ _ pw]} {
1938 |             if {[string length $pw] >= 1} {
1939 |                 .t delete "insert - 1 chars"
1940 |                 set password_input [string range $password_input 0 end-1]
1941 |                 break
1942 |             } else break
1943 |         }
1944 |     }
1945 | }
1946 | 
1947 | proc PolishCompletion {file {qp ""}} {
1948 |     set slash ""
1949 |     if {[file exists $file]} {
1950 |         if {[file type $file] == "directory" && [string index $file end] != "/"} {
1951 |             set slash "/"
1952 |         }
1953 |     }
1954 |     if {$qp == "" && [string first " " $file] != -1 && [string index $file 0] != "'"} {
1955 |         set file "'$file'"
1956 |     } else {
1957 |         set file "$file$slash"
1958 |     }
1959 | 
1960 |     return $file
1961 | }
1962 | 
1963 | proc FilenameCompletion {} {
1964 |     set fw [GetFocusWidget]
1965 |     set qp1 [$fw search -backwards "'" insert "insert linestart"]
1966 |     set qp2 [$fw search "'" insert "insert lineend"]
1967 |     if {$qp1 != "" && $qp2 != ""} {
1968 |         set ixs [list [$fw index "$qp1 + 1 chars"] [$fw index "$qp2"]]
1969 |     } else {
1970 |         set ixs [GetWordUnderIndex $fw insert]
1971 |     }
1972 |     if {$ixs == ""} return
1973 |     set name [eval $fw get $ixs]
1974 |     set prefix ""
1975 |     if {[regexp {^([`"'\(\[\{<>|;:,=]+)(.+)$} $name _ prefix name2]} {
1976 |         set name $name2
1977 |     }
1978 |     set files [glob -nocomplain -- "$name*"]
1979 |     set flen [llength $files]
1980 |     set nlen [string length "$name"]
1981 |     if {$flen == 0} return
1982 |     if {$flen > 1} {
1983 |         set i [string length $name]
1984 |         set scan 1
1985 |         set f0 [lindex $files 0]
1986 |         while {$scan} {
1987 |             set c [string index $f0 $i]
1988 |             foreach f $files {
1989 |                 # includes f0, but will succeed
1990 |                 if {[string index $f $i] != $c} {
1991 |                     set scan 0
1992 |                     incr i -1
1993 |                     break
1994 |                 }
1995 |             } 
1996 |             if {$scan} { incr i }
1997 |         }
1998 |         if {$i > $nlen} {
1999 |             set name2 [PolishCompletion [string range $f0 0 $i] $qp1]
2000 |             $fw mark set insert [lindex $ixs 1]
2001 |             $fw replace [lindex $ixs 0] [lindex $ixs 1] "$prefix$name2"
2002 |             return
2003 |         }
2004 |         LogInWindow "Completions:\n[FormatColumnar $files]" 1
2005 |         return
2006 |     }
2007 |     set file [PolishCompletion [lindex $files 0] $qp1]
2008 |     $fw mark set insert [lindex $ixs 1]
2009 |     $fw replace [lindex $ixs 0] [lindex $ixs 1] "$prefix$file"
2010 | }
2011 | 
2012 | proc MatchDelimitedForward {start {fw ""}} {
2013 |     if {$fw == ""} {
2014 |         set fw [GetFocusWidget]
2015 |     }
2016 |     set i 0
2017 |     set p $start
2018 |     set done 0
2019 |     set ok 0
2020 |     set quotes ""
2021 |     set c1 [$fw get $start]
2022 |     if {$c1 == "\"" || $c1 == "'"} {
2023 |         set quotes $c1
2024 |     }
2025 |     while {!$done} {
2026 |         set p [$fw search -regexp {\[|\]|\(|\)|\{|\}|"|'} $p end]
2027 |         if {$p == ""} {
2028 |             set p end
2029 |             break
2030 |         }
2031 |         set c [$fw get $p]
2032 |         switch -glob -- $c {
2033 |             "(" { set stack($i) ")"; incr i }
2034 |             "\\[" { set stack($i) "\]"; incr i }
2035 |             "\{" { set stack($i) "\}"; incr i }
2036 |             "[\"']" {
2037 |                 while 1 {
2038 |                     set p2 [$fw search $c "$p + 1 chars" end]
2039 |                     if {$p2 == ""} {
2040 |                         set done 1
2041 |                         break                    
2042 |                     }
2043 |                     set p $p2
2044 |                     if {[$fw get "$p - 1 chars"] != "\\"} {
2045 |                         if {$quotes != ""} {
2046 |                             set done 1
2047 |                             set ok 1
2048 |                         }
2049 |                         break
2050 |                     }
2051 |                 }
2052 |             }
2053 |             default {
2054 |                 if {$c == $stack([expr $i - 1])} {
2055 |                     incr i -1
2056 |                     if {$i == 0} { 
2057 |                         set done 1 
2058 |                         set ok 1
2059 |                     }
2060 |                 } else break
2061 |             }
2062 |         }
2063 |         set p [$fw index "$p + 1 chars"]
2064 |     }
2065 |     if {$done} {
2066 |         return [list 1 $start $p]
2067 |     }
2068 |     return [list 0 $start $p]
2069 | }
2070 | 
2071 | proc MatchDelimitedBackwards {start {fw ""}} {
2072 |     if {$fw == ""} {
2073 |         set fw [GetFocusWidget]
2074 |     }
2075 |     set i 0
2076 |     set p $start
2077 |     set done 0
2078 |     set ok 0
2079 |     while {!$done} {
2080 |         set p [$fw search -regexp -backwards {\[|\]|\(|\)|\{|\}|"} $p 1.0]
2081 |         if {$p == ""} {
2082 |             set p 1.0
2083 |             break
2084 |         }
2085 |         set c [$fw get $p]
2086 |         switch -- $c {
2087 |             ")" { set stack($i) "("; incr i }
2088 |             "\]" { set stack($i) "\["; incr i }
2089 |             "\}" { set stack($i) "\{"; incr i }
2090 |             "\"" {
2091 |                 while 1 {
2092 |                     set p2 [$fw search -backwards "\"" $p 1.0]
2093 |                     if {$p2 == ""} {
2094 |                         set done 1
2095 |                         break                    
2096 |                     }
2097 |                     set p $p2
2098 |                     if {[$fw get "$p - 1 chars"] != "\\"} break
2099 |                 }
2100 |             }
2101 |             default {
2102 |                 # this is to catch a strange situation where fast typing can
2103 |                 # lead to "insert" being _before_ the currently added closing delimiter
2104 |                 # (a bug in Tcl/Tk, perhaps, or a race condition)
2105 |                 if {$i == 0} break
2106 |                 if {$c == $stack([expr $i - 1])} {
2107 |                     incr i -1
2108 |                     if {$i == 0} {
2109 |                         set done 1
2110 |                         set ok 1
2111 |                         break
2112 |                     }
2113 |                 } else break
2114 |             }
2115 |         }
2116 |     }
2117 |     if {$done} {
2118 |         return [list 1 $p $start]
2119 |     }
2120 |     return [list 0 $p $start]
2121 | }
2122 | 
2123 | proc FlashParenRange {fw ok start end} {
2124 |     global flashed_range_id valid_match_background invalid_match_background
2125 |     if {$ok} {
2126 |         set bg $valid_match_background
2127 |     } else {
2128 |         set bg $invalid_match_background
2129 |     }
2130 |     RemoveTaggedRange $fw flashed_range
2131 |     $fw tag configure flashed_range -background $bg
2132 |     $fw tag add flashed_range $start "$start + 1 chars" "$end - 1 chars" $end
2133 |     after cancel $flashed_range_id
2134 |     set flashed_range_id [after 1000 [list RemoveTaggedRange $fw flashed_range]]
2135 | }
2136 | 
2137 | proc ExecButtonRelease {} {
2138 |     global b1_down b2_abort b2_with_arg cut_unmodified
2139 |     set fw [GetFocusWidget]
2140 |     if {$b2_abort} {
2141 |         set b2_abort 0
2142 |         return
2143 |     }
2144 |     if {$b1_down} {
2145 |         if {$fw == ".t" && [.t edit modified] == 0} {
2146 |             lassign [.t tag ranges sel] cut_unmodified
2147 |         }
2148 |         tk_textCut $fw
2149 |         return
2150 |     }
2151 |     Execute $fw $b2_with_arg
2152 |     set b2_with_arg ""
2153 |     RecordPosition
2154 | }
2155 | 
2156 | proc ExecButtonPress {fw x y} {
2157 |     global b2_down b2_abort b2_start
2158 |     set b2_down 1
2159 |     set b2_abort 0
2160 |     set b2_start ""
2161 |     if {![catch [list $fw index "@$x,$y"] result]} {
2162 |         set b2_start $result
2163 |     }
2164 | }
2165 | 
2166 | proc UpdateSelectionOnClick {fw} {
2167 |     # drop selection, unless click is inside it
2168 |     if {[lsearch -exact [$fw tag names current] sel] == -1} {
2169 |         RemoveSelection $fw
2170 |     }
2171 | }
2172 | 
2173 | proc MangleFilename {fname} {
2174 |     set new ""
2175 |     set len [string length $fname]
2176 |     for {set i 0} {$i < $len} {incr i} {
2177 |         set c [string index $fname $i]
2178 |         if {![string is alnum -strict $c] && [string first $c "_-."] == -1} {
2179 |             scan $c %c u
2180 |             append new "%[format %02x $u]"
2181 |         } else {
2182 |             append new $c
2183 |         }
2184 |     }
2185 |     return $new
2186 | }
2187 |  
2188 | text .tag -wrap char -undo 1 -height 1
2189 | canvas .s -width $sbar_width
2190 | text .t -wrap $wrap_mode -undo 1 -yscrollcommand Scrolling
2191 | pack .tag -side top -fill x
2192 | pack .s -fill y -side left
2193 | pack .t -fill both -expand 1
2194 | set sbar [.s create rectangle 0 0 0 0]
2195 | wm protocol . WM_DELETE_WINDOW Terminate
2196 | 
2197 | # key events
2198 | DefineKey <KeyPress> {TakeFocus; set cut_unmodified ""}
2199 | DefineKey <Control-plus> { 
2200 |     global current_font
2201 |     lassign $current_font _ size
2202 |     ResizeFont [expr $size + 1]
2203 | }
2204 | DefineKey <Control-minus> { 
2205 |     global current_font
2206 |     lassign $current_font _ size
2207 |     ResizeFont [expr $size - 1]
2208 | }
2209 | DefineKey <Control-c> { tk_textCopy [GetFocusWidget]; break }
2210 | DefineKey <Control-x> { tk_textCut [GetFocusWidget]; break }
2211 | DefineKey <Control-v> { PasteSelection [GetFocusWidget]; break }
2212 | DefineKey <Delete> { KillExecuting SIGINT; break }
2213 | DefineKey <Control-f> { FilenameCompletion; break }
2214 | DefineKey <Insert> { FilenameCompletion; break }
2215 | DefineKey <Return> {
2216 |     TakeFocus
2217 |     set fw [GetFocusWidget]
2218 |     if {$fw == ".t" && $current_translation == "crnl"} {
2219 |         if {[.t get "insert - 1 chars"] == "\r"} {
2220 |             Insert "\n"
2221 |         } else {
2222 |             Insert "\r\n"
2223 |         }
2224 |         break
2225 |     }
2226 | }
2227 | DefineKey <Control-s> SaveChanges
2228 | DefineKey <Home> { Top; break }
2229 | DefineKey <End> { Bottom; break }
2230 | DefineKey <Control-u> {
2231 |     set fw [GetFocusWidget]
2232 |     RemoveSelection $fw
2233 |     $fw tag add sel "insert linestart" insert
2234 |     tk_textCut $fw
2235 |     break
2236 | }
2237 | DefineKey <Control-k> {
2238 |     set fw [GetFocusWidget]
2239 |     RemoveSelection $fw
2240 |     if {[.t get insert] == "\n"} {
2241 |         $fw delete insert "insert + 1 lines linestart"
2242 |     } else {
2243 |         $fw tag add sel insert "insert lineend"
2244 |         tk_textCut $fw
2245 |     }
2246 |     break
2247 | }
2248 | DefineKey <Control-w> {
2249 |     set fw [GetFocusWidget]
2250 |     set i [$fw search -regexp -backwards {\m\w*} insert 1.0]
2251 |     if {$i != ""} {
2252 |         RemoveSelection $fw
2253 |         $fw tag add sel $i insert
2254 |         tk_textCut $fw
2255 |     }
2256 |     break
2257 | }
2258 | DefineKey <Tab> { SmartIndent; break }
2259 | DefineKey <Control-Tab> { Insert "\t"; break }
2260 | DefineKey <Control-KeyPress-1> {
2261 |     if {[GetFocusWidget] == ".t"} {
2262 |         focus .tag
2263 |     } else {focus .t}
2264 | }
2265 | DefineKey <Control-KeyPress-2> {
2266 |     set fw [GetFocusWidget]
2267 |     set rng [GetEffectiveSelection $fw]
2268 |     if {$rng != ""} {
2269 |         RemoveSelection $fw
2270 |         eval SetTaggedRange $fw b2sweep $rng
2271 |         Execute $fw
2272 |     } else {
2273 |         set ixs [GetWordUnderIndex $fw insert]
2274 |         if {$ixs != ""} {
2275 |             eval SetTaggedRange $fw b2sweep $ixs
2276 |             Execute $fw
2277 |         }
2278 |     }
2279 | }
2280 | DefineKey <Control-KeyPress-3> {
2281 |     set fw [GetFocusWidget]
2282 |     set rng [GetEffectiveSelection $fw]
2283 |     if {$rng != ""} {
2284 |         RemoveSelection $fw
2285 |         eval SetTaggedRange [GetFocusWidget] b3sweep $rng
2286 |         Acquire
2287 |     } else {
2288 |         set ixs [GetWordUnderIndex $fw insert]
2289 |         if {$ixs != ""} {
2290 |             eval SetTaggedRange $fw b3sweep $ixs
2291 |             Acquire
2292 |         }
2293 |     }
2294 | }
2295 | DefineKey <KeyRelease> {
2296 |     if {[lsearch {parenright bracketright braceright} "%K"] != -1} {
2297 |         set fw [GetFocusWidget]
2298 |         set result [MatchDelimitedBackwards [$fw index insert] $fw]
2299 |         eval FlashParenRange $fw $result
2300 |     }
2301 | }
2302 | bind .t <Prior> {
2303 |     ScrollUp [expr int([winfo height .t] * 0.8)]
2304 |     break
2305 | }
2306 | bind .t <Next> {
2307 |     ScrollDown [expr int([winfo height .t] * 0.8)]
2308 |     break
2309 | }
2310 | bind .tag <KeyRelease> { 
2311 |     set old [.tag cget -height]
2312 |     set new [.tag count -displaylines 1.0 end]
2313 |     if {$old != $new} {
2314 |         .tag configure -height $new
2315 |     }
2316 |     .tag see 1.0
2317 |     set last_del_attempt 0
2318 | }
2319 | DefineKey <Escape> {
2320 |     set fw [GetFocusWidget]
2321 |     set sel [$fw tag ranges sel]
2322 |     if {$sel != ""} {
2323 |         tk_textCut $fw
2324 |     } else {
2325 |         $fw tag add sel $last_mouse_index insert
2326 |     }
2327 | }
2328 | 
2329 | # mouse events
2330 | DefineKey <Double-ButtonPress-1> {
2331 |     set b1_down 1
2332 |     set fw [GetFocusWidget]
2333 |     TakeFocus
2334 |     if {![catch [list $fw index "@%x,%y"] ind]} {
2335 |         set c [$fw get $ind]
2336 |         if {[string first $c "\{(\[\"'"] != -1} {
2337 |             set result [MatchDelimitedForward $ind $fw]
2338 |             if {[lindex $result 0]} {
2339 |                 RemoveSelection $fw
2340 |                 $fw tag add sel "[lindex $result 1] + 1 chars" "[lindex $result 2] - 1 chars"
2341 |                 $fw mark set insert "[lindex $result 1] + 1 chars"
2342 |                 break
2343 |             }
2344 |         } elseif {[string first $c "\})\]"] != -1} {
2345 |             set result [MatchDelimitedBackwards "$ind + 1 chars" $fw]
2346 |         
2347 |             if {[lindex $result 0]} {
2348 |                 RemoveSelection $fw
2349 |                 $fw tag add sel "[lindex $result 1] + 1 chars" "[lindex $result 2] - 1 chars"
2350 |                 $fw mark set insert "[lindex $result 2] - 1 chars"
2351 |                 break
2352 |             }
2353 |         }
2354 |         if {[regexp {\.0$} $ind]} {
2355 |             RemoveSelection $fw
2356 |             lassign [$fw dlineinfo $ind] _ _ w
2357 |             if {$w == "" || $w == 0} break
2358 |             $fw tag add sel $ind "$ind lineend + 1 chars"
2359 |             break
2360 |         } else {
2361 |             lassign [$fw dlineinfo "@%x,%y"] px _ pw
2362 |             if {$pw == "" || $pw == 0} break
2363 |             if {%x > [expr $px + $pw]} {
2364 |                 set p [$fw index "@%x,%y"]
2365 |                 $fw tag add sel "$p linestart" "$p lineend + 1 chars"
2366 |                 break
2367 |             }
2368 |         }
2369 |     }
2370 | }
2371 | DefineKey <ButtonPress-1> {
2372 |     set b1_down 1
2373 |     set fw [GetFocusWidget]
2374 |     TakeFocus
2375 |     if {$b2_down} {
2376 |         set fw .t
2377 |         set range [GetEffectiveSelection .t]
2378 |         if {$range == ""} {     
2379 |             set fw .tag
2380 |             set range [GetEffectiveSelection .tag]
2381 |         }
2382 |         if {$range != ""} {
2383 |             set txt [$fw get [lindex $range 0] [lindex $range 1]]
2384 |             set b2_with_arg [regsub -all {\s+} $txt " "]
2385 |             break
2386 |         }
2387 |     } else {
2388 |         RemovePseudoSelection %W
2389 |     }
2390 | }
2391 | DefineKey <ButtonRelease-1> {
2392 |     set b1_down 0
2393 |     RecordPosition
2394 | }
2395 | DefineKey <ButtonPress-2> {
2396 |     ExecButtonPress %W %x %y
2397 | }
2398 | DefineKey <ButtonRelease-2> {
2399 |     set b2_down 0
2400 |     if {$b3_down} {
2401 |         set b3_abort 1
2402 |         RemoveTaggedRange %W b3sweep
2403 |     } else {
2404 |         ExecButtonRelease
2405 |     }
2406 |     break
2407 | }
2408 | DefineKey <Shift-ButtonPress-3> {
2409 |     UpdateSelectionOnClick %W
2410 |     ExecButtonPress %W %x %y
2411 | }
2412 | DefineKey <Shift-ButtonRelease-3> {
2413 |     set b2_down 0
2414 |     ExecButtonRelease
2415 |     break
2416 | }
2417 | DefineKey <ButtonPress-3> {
2418 |     UpdateSelectionOnClick %W
2419 |     set b3_down 1
2420 |     set b3_start ""
2421 |     if {![catch {%W index "@%x,%y"} result]} {
2422 |         set b3_start $result
2423 |     }
2424 | }
2425 | DefineKey <ButtonRelease-3> {
2426 |     set b3_down 0
2427 |     RecordPosition
2428 |     if {$b1_down} {
2429 |         set fw [GetFocusWidget]
2430 |         set p [$fw index insert]
2431 |         PasteSelection $fw
2432 |         RemoveTaggedRange %W b3sweep
2433 |         if {$fw == ".t" && $p == $cut_unmodified} {
2434 |             Unmodified
2435 |         }
2436 |         break
2437 |     }
2438 |     if {$b2_down} {
2439 |         set b2_abort 1
2440 |         set b2_start ""
2441 |         RemoveTaggedRange %W b2sweep
2442 |         RemoveTaggedRange %W b3sweep
2443 |         break
2444 |     }
2445 |     if {!$b3_abort} {
2446 |         Acquire
2447 |     } else {
2448 |         set b3_abort 0
2449 |     }
2450 |     break
2451 | }
2452 | bind .s <ButtonPress-1> { ScrollUp %y 1 }
2453 | bind .s <ButtonRelease-1> EndScrolling
2454 | bind .s <ButtonPress-2> { set b2_down 1; ScrollTo %y }
2455 | bind .s <ButtonRelease-2> { set b2_down 0 }
2456 | bind .s <Shift-ButtonPress-3> { set b2_down 1; ScrollTo %y }
2457 | bind .s <Shift-ButtonRelease-3> { set b2_down 0 }
2458 | bind .s <ButtonPress-3> { ScrollDown %y 1 }
2459 | bind .s <ButtonRelease-3> EndScrolling
2460 | bind .s <Motion> {
2461 |     if {$b2_down} {
2462 |         ScrollTo %y
2463 |     }
2464 | }
2465 | DefineKey <Motion> {
2466 |     if {$b2_down} {
2467 |         set p "@%x,%y"
2468 |         if {![catch [list %W index $p] result]} {
2469 |             if {$b2_start != "" && $b2_start != $result} {
2470 |                 SetTaggedRange %W b2sweep $b2_start $result
2471 |             }
2472 |         }
2473 |         break
2474 |     } elseif {$b3_down} {
2475 |         set p "@%x,%y"
2476 |         if {![catch [list %W index $p] result]} {
2477 |             if {$b3_start != "" && $b3_start != $result} {
2478 |                 SetTaggedRange %W b3sweep $b3_start $result
2479 |             }
2480 |         }
2481 |         break
2482 |     }
2483 | }
2484 | DefineKey <<Selection>> { 
2485 |     global pseudosel_on
2486 |     set fw %W
2487 |     if {$pseudosel_on($fw)} {
2488 |         set sel [$fw tag ranges sel]
2489 |         if {$sel != ""} { 
2490 |             RemovePseudoSelection $fw
2491 |         }
2492 |     }
2493 | }
2494 | DefineKey <Enter> { RestoreSelection %W }
2495 | DefineKey <Leave> { SaveSelection %W }
2496 | bind .t <<Modified>> { 
2497 |     set f [.t edit modified]
2498 |     set last_del_attempt 0
2499 |     if {$editable} {
2500 |         MarkDirty $f
2501 |         UpdateCommand Put
2502 |     }
2503 | }
2504 | 
2505 | proc RelayoutTag {} {
2506 |     set lines [.tag count -displaylines 1.0 end]
2507 |     set p [.t index insert]
2508 |     .tag configure -height $lines
2509 |     .t see $p
2510 | }
2511 | 
2512 | bind .tag <Configure> {
2513 |     RelayoutTag
2514 |     ScrollToBottom
2515 | }
2516 | set mapped 0
2517 | # not sure about this one
2518 | bind .t <Map> {
2519 |     if {!$withdrawn && !$mapped} {
2520 |         WarpToIndex .t 1.0
2521 |     }
2522 |     set mapped 1
2523 | }
2524 | 
2525 | # initialization
2526 | if {[file exists $rcfile]} { source $rcfile }
2527 | set post_eval ""
2528 | for {set i 0} {$i < $argc} {incr i} {
2529 |     set arg [lindex $argv $i]
2530 |     switch -- $arg {
2531 |         "-cd" {
2532 |             incr i
2533 |             cd [lindex $argv $i]
2534 |         }
2535 |         "-eval" { 
2536 |             incr i
2537 |             eval [lindex $argv $i]
2538 |         }
2539 |         "-execute" {
2540 |             incr i
2541 |             source [lindex $argv $i]
2542 |         }
2543 |         "-post-eval" {
2544 |             incr i
2545 |             lappend post_eval [lindex $argv $i]
2546 |         }
2547 |         "-stdin" {
2548 |             .t insert 1.0 [read stdin]
2549 |         }
2550 |         "-directory" {
2551 |             incr i
2552 |             lappend post_eval [list OpenDirectory [lindex $argv $i]]
2553 |         }
2554 |         "-address" {
2555 |             incr i
2556 |             set dest_address [lindex $argv $i]
2557 |         }
2558 |         "-fixed" {
2559 |             ToggleFont fix
2560 |         }
2561 |         "-tag" {
2562 |             incr i
2563 |             set initial_tag [lindex $argv $i]
2564 |         }
2565 |         "-withdrawn" {set withdrawn 1}
2566 |         "-registry" StartRegistry
2567 |         "-scroll" ToggleScroll
2568 |         "-temporary" {set editable 0}
2569 |         "-win" {
2570 |             incr i
2571 | 
2572 |             if {$i >= $argc} {
2573 |                 set cmd "$shell $interactive_shell_args"
2574 |             } else {              
2575 |                 set cmd [lrange $argv $i [llength $argv]]
2576 |             }
2577 | 
2578 |             set name [file rootname [file tail [lindex $cmd 0]]]
2579 |             set dir [pwd]
2580 |             set initial_tag "$dir/-$name New Kill Del Cut Paste Snarf Send Look Font Scroll | "
2581 |             lappend post_eval [list EnterWinMode $cmd]
2582 |             set i $argc
2583 |             set editable 0
2584 |         }
2585 |         "--" {}
2586 |         default { 
2587 |             set current_filename [CanonicalFilename [lindex $argv $i]]
2588 |         }
2589 |     }
2590 | }
2591 | ConfigureWindow 0
2592 | if {$initial_tag != ""} {
2593 |     SetTag $initial_tag
2594 | }
2595 | if {$current_filename != ""} { 
2596 |     set current_filename [FollowLink $current_filename]
2597 |     if {[file exists $current_filename]} {
2598 |         if {[file type $current_filename] == "directory"} {
2599 |             OpenDirectory $current_filename
2600 |         } else {
2601 |             OpenFile $current_filename
2602 |         }
2603 |     }
2604 | } else {
2605 |     set unnamed 1
2606 | }
2607 | if {$dest_address != ""} {
2608 |     GotoBodyAddress $dest_address
2609 | } else {
2610 |     .t mark set insert 1.0
2611 | }
2612 | if {$withdrawn} {
2613 |     wm withdraw .
2614 | }
2615 | RelayoutTag
2616 | if {$post_eval != ""} {
2617 |     foreach cmd $post_eval {
2618 |         eval $cmd
2619 |     }
2620 | }
2621 | 
2622 | if {[file exists ".tag"]} {
2623 |     set fp [open ".tag" r]
2624 |     .tag insert end "\n[read $fp]"
2625 |     close $fp
2626 | }
2627 | 
2628 | set env(MA_LABEL) $current_filename
2629 | TakeFocus
2630 | 


--------------------------------------------------------------------------------
/ma-eval:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env wish
 2 | #
 3 | # evaluate code in MA-context
 4 | 
 5 | 
 6 | fconfigure stdout -translation lf
 7 | fconfigure stderr -translation lf
 8 | 
 9 | set exec_prefix ""
10 | set tmpdir "/tmp"
11 | 
12 | if {[info exists env(HERE)]} {
13 |     set exec_prefix $env(HERE)/exec/
14 | }
15 | 
16 | if {[info exists env(TMPDIR)]} {
17 |     set tmpdir $env(TMPDIR)
18 | }
19 | 
20 | set async ""
21 | 
22 | proc Usage {{code 1}} {
23 |     puts stderr {usage: ma-eval [-h] [-async] [ID] [EXP ...]}
24 |     exit $code
25 | }
26 | 
27 | set exp [lassign $argv id]
28 | 
29 | if {$id == "-h"} Usage
30 | 
31 | if {$id == "-async"} {
32 |     set exp [lassign $exp id]
33 |     set async "-async"
34 | }
35 | 
36 | if {$id == ""} {
37 |     set data [read stdin]
38 | 
39 |     if {$data == ""} exit
40 | 
41 |     set tmpfile $tmpdir/temp-[pid].[expr rand()]
42 |     set tmp [open $tmpfile w]
43 |     puts -nonewline $tmp $data
44 |     close $tmp 
45 |     set dir [pwd]
46 |     set dname "$dir/+Errors"
47 | 
48 |     if {[catch [list send $dname #]]} {
49 |         exec ${exec_prefix}ma -name $dname -temporary -tag \
50 |             "$dname New Del Cut Paste Snarf Send Look Font Scroll | " &
51 |         after 100
52 |     }
53 | 
54 |     send $dname AppendFile $tmpfile
55 |     file delete $tmpfile
56 |     exit
57 | }
58 | 
59 | if {$exp == ""} {set exp [read stdin]}
60 | 
61 | if {[catch [list eval send $async $id "$exp"] result]} {
62 |     puts stderr $result
63 |     exit 1
64 | }
65 | 
66 | if {$async != ""} exit
67 | 
68 | if {$result != ""} {
69 |     puts $result
70 | }
71 | 
72 | exit
73 | 


--------------------------------------------------------------------------------
/plumb:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env tclsh
  2 | #
  3 | # minimal "plumber"
  4 | 
  5 | 
  6 | fconfigure stdout -translation lf
  7 | fconfigure stderr -translation lf
  8 | 
  9 | set plumbfile "~/.plumb"
 10 | set plumbing_rules {}
 11 | set ws [pwd]
 12 | set attrs [dict create]
 13 | set info 0
 14 | 
 15 | 
 16 | proc Usage {{code 1}} {
 17 |     puts stderr {usage: plumb [-p FILENAME] [-h] [-a NAME=VAL] [-w DIR] [-i] [--] STRING ...}
 18 |     exit $code
 19 | }
 20 | 
 21 | 
 22 | proc Plumb {pat code} {
 23 |     global plumbing_rules
 24 |     lappend plumbing_rules [list $pat $code]
 25 | }
 26 | 
 27 | 
 28 | proc GetArg {{i 1}} {
 29 |     global command_arguments
 30 |     return [lindex $command_arguments $i]
 31 | }
 32 | 
 33 | 
 34 | proc TempFile {} {
 35 |     global env
 36 |     set tmpdir "/tmp"
 37 | 
 38 |     if {[info exists env(TMPDIR)]} {
 39 |         set tmpdir $env(TMPDIR)
 40 |     }
 41 | 
 42 |     return "$tmpdir/0.[pid].[expr rand()]"
 43 | }
 44 | 
 45 | 
 46 | proc GetAttr {name {default ""}} {
 47 |     global attrs
 48 | 
 49 |     if {[dict exists $attrs $name]} {
 50 |         return [dict get $attrs $name]
 51 |     }
 52 | 
 53 |     return $default
 54 | }
 55 | 
 56 | 
 57 | proc Run args {
 58 |     exec {*}$args 2>@ stderr < /dev/null &
 59 | }
 60 | 
 61 | 
 62 | proc RunOutput args {
 63 |     exec {*}$args 2>@ stderr < /dev/null | ma-eval &
 64 | }
 65 | 
 66 | 
 67 | if {[info exists env(HERE)] && [file exists $env(HERE)/lib/plumb]} {
 68 |     source $env(HERE)/lib/plumb
 69 | }
 70 | 
 71 | set str ""
 72 | 
 73 | for {set i 0} {$i < $argc} {incr i} {
 74 |     set arg [lindex $argv $i]
 75 | 
 76 |     switch -regex -- $arg {
 77 |         {^--?h(elp)?$} {Usage 0}
 78 |         {^-p$} {
 79 |             incr i
 80 |             set plumbfile [lindex $argv $i]
 81 |         }
 82 |         {^-w$} {
 83 |             incr i
 84 |             cd [lindex $argv $i]
 85 |         }
 86 |         {^-a$} {
 87 |             incr i
 88 |             set arg [lindex $argv $i]
 89 | 
 90 |             if {[regexp {^([^=]+)=(\S+)$} $arg _ n v]} {
 91 |                 dict set attrs $n $v
 92 |             } else Usage
 93 |         }
 94 |         {^-i$} {set info 1}
 95 |         {^--$} {
 96 |             set str [concat $str [lrange $argv [expr $i + 1] end]]
 97 |             set i $argc
 98 |         }
 99 |         {^-} Usage
100 |         default {lappend str $arg}
101 |     }
102 | }
103 | 
104 | if {[file exists $plumbfile]} {
105 |     source $plumbfile
106 | }
107 | 
108 | close stdout
109 | set str [string trim [join $str]]
110 | set mode [GetAttr mode plumb]
111 | set rules $plumbing_rules
112 | 
113 | foreach r $rules {
114 |    set command_arguments [regexp -inline -- [lindex $r 0] $str]
115 | 
116 |     if {$command_arguments != ""} {
117 |         if {$info} {puts stderr $command_arguments}
118 | 
119 |         set x [apply [list {} [lindex $r 1]]]
120 | 
121 |         if {$x != 0} exit
122 |     }
123 | }
124 | 
125 | exit 1
126 | 


--------------------------------------------------------------------------------
/pty.c:
--------------------------------------------------------------------------------
  1 | // pty
  2 | // 
  3 | // based on pty-example.c from Allen Porter <allen@thebends.org>
  4 | 
  5 | 
  6 | #include <stdio.h>
  7 | #include <errno.h>
  8 | #ifdef __linux__
  9 | # include <pty.h>
 10 | #else
 11 | # include <util.h>
 12 | #endif
 13 | #ifdef __APPLE__
 14 | # include <mach/mach.h>
 15 | # include <mach/mach_time.h>
 16 | #endif
 17 | #include <stdlib.h>
 18 | #include <unistd.h>
 19 | #include <string.h>
 20 | #include <fcntl.h>
 21 | #include <poll.h>
 22 | #include <termios.h>
 23 | #include <time.h>
 24 | #include <signal.h>
 25 | #include <sys/wait.h>
 26 | 
 27 | 
 28 | static volatile int sigint = 0;
 29 | 
 30 | 
 31 | static void usage(int code)
 32 | {
 33 |    fprintf(stderr, "usage: pty COMMAND ...\n");
 34 |    exit(code);
 35 | }
 36 | 
 37 | 
 38 | static void sighandler(int sig)
 39 | {
 40 |     sigint = 1;
 41 | }
 42 | 
 43 | 
 44 | static int exit_status(pid_t pid)
 45 | {
 46 |     int status;
 47 |     pid_t p = waitpid(pid, &status, 0);
 48 | 
 49 |     if(p == -1) perror("waitpid");
 50 | 
 51 |     if(p == 0) return 0;
 52 | 
 53 |     if(WIFEXITED(status)) 
 54 |         return WEXITSTATUS(status); 
 55 |     else if(WIFSIGNALED(status))
 56 |         return WTERMSIG(status);
 57 | 
 58 |     return 1;
 59 | }
 60 | 
 61 | 
 62 | int main(int argc, char* argv[]) 
 63 | {
 64 |   if(argc == 1) usage(1);
 65 | 
 66 |   setsid();
 67 |   int fd;
 68 |   pid_t pid = forkpty(&fd, NULL, NULL, NULL);
 69 | 
 70 |   if(pid == -1) {
 71 |     perror("forkpty");
 72 |     return 1;
 73 |   } 
 74 |   else if(pid == 0) {
 75 |     static char *args[ 256 ];
 76 |     memcpy(args, argv + 1, (argc + 1) * sizeof(char *));
 77 |  
 78 |     if(execvp(args[ 0 ], args) == -1)
 79 |       perror("execvp");
 80 | 
 81 |     return 1;
 82 |   }
 83 | 
 84 |   struct sigaction act;
 85 |   act.sa_handler = sighandler;
 86 |   act.sa_flags = 0;
 87 |   sigemptyset(&act.sa_mask);
 88 |   
 89 |   if(sigaction(SIGINT, &act, NULL) == -1)
 90 |     perror("sigaction");
 91 | 
 92 |   struct termios ti;
 93 |   tcgetattr(fd, &ti);
 94 |   ti.c_lflag &= ~(ECHO | ECHONL);
 95 |   ti.c_cc[ VMIN ] = 1;
 96 |   ti.c_cc[ VTIME ] = 0;
 97 |   tcsetattr(fd, TCSANOW, &ti);
 98 |   int flags;
 99 | 
100 |   struct pollfd pfd[ 2 ];
101 |   pfd[ 0 ].fd = STDIN_FILENO;
102 |   pfd[ 0 ].events = POLLIN;
103 |   pfd[ 1 ].fd = fd;
104 |   pfd[ 1 ].events = POLLIN;
105 |   char buf[ 1024 ];
106 | 
107 |   for(;;) {    
108 |     pfd[ 0 ].revents = pfd[ 1 ].revents = 0;
109 | 
110 |     if(sigint) {
111 |         pid_t tpgid = tcgetpgrp(fd);
112 | 
113 |         if(tpgid != -1) kill(-tpgid, SIGINT);
114 | 
115 |         sigint = 0;
116 |     }
117 | 
118 |     int r = poll(pfd, 2, -1);
119 | 
120 |     if(r == -1) {
121 |          if(errno != EINTR) {
122 |                perror("poll");
123 |                return 1;
124 |          }
125 |     }
126 | 
127 |     if(r > 0) {
128 |       if((pfd[ 0 ].revents & POLLERR) != 0
129 |          || (pfd [ 0 ].revents & POLLHUP) != 0
130 |          || (pfd [ 1 ].revents & POLLHUP) != 0) {
131 |         close(fd);
132 |         return exit_status(pid);
133 |       }
134 | 
135 |       if((pfd[ 0 ].revents & POLLIN) != 0) {
136 |         int n = read(STDIN_FILENO, buf, 1023);
137 | 
138 |         if(n == -1) {
139 |           perror("read from stdin");
140 |           return 1;
141 |         } 
142 |         else if(n == 0) {
143 |           close(fd);
144 |           return exit_status(pid);
145 |         }
146 | 
147 |         if(write(fd, buf, n) == -1) {
148 |           perror("write to subprocess");
149 |           return 1;
150 |         }
151 |       }
152 | 
153 |       if((pfd[ 1 ].revents & POLLIN) != 0) {
154 |         int n = read(fd, buf, 1023);
155 | 
156 |         if(n == -1) {
157 |           switch(errno) {
158 |           case EIO:
159 |             /* usually process finished */
160 |             return exit_status(pid);
161 | 
162 |           default:
163 |             perror("read from subprocess");
164 |             return 1;
165 |           }
166 |         } 
167 |         else if(n == 0) {
168 |           close(fd);
169 |           return exit_status(pid);
170 |         } 
171 |         else {
172 |           if(write(STDOUT_FILENO, buf, n) == -1) {
173 |             perror("write to stdout");
174 |             return 1;
175 |           }
176 |         }
177 |       }
178 |     }
179 |   }
180 | }
181 | 


--------------------------------------------------------------------------------
/utils/LR:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env tclsh
 2 | #
 3 | # line-wise replace
 4 | 
 5 | fconfigure stdout -translation lf
 6 | fconfigure stderr -translation lf
 7 | set opts {-all}
 8 | set rx {}
 9 | set subst {}
10 | 
11 | proc Usage {{code 1}} {
12 |   puts stderr {usage: LR [-h] [-1] REGEXP [SUBST]}
13 |   exit $code 
14 | }
15 | 
16 | for {set i 0} {$i < $argc} {incr i} {
17 |     set arg [lindex $argv $i]
18 | 
19 |     switch -regexp -- $arg {
20 |         {^--?h(elp)?$} {Usage 0}
21 |         {^-1$} {set opts {}}
22 |         default {
23 |             if {$rx == ""} {
24 |                 set rx $arg
25 |             } elseif {$subst != ""} {
26 |                 Usage
27 |             } else {
28 |                 set subst $arg
29 |             }
30 |         }
31 |     }
32 | }
33 | 
34 | while {[gets stdin line] >= 0} {
35 |   puts [regsub {*}$opts -- $rx $line $subst]
36 | }
37 | 
38 | 


--------------------------------------------------------------------------------
/utils/README:
--------------------------------------------------------------------------------
  1 | 
  2 |     E x t e n s i o n s   f o r   "m a"
  3 | 
  4 | 
  5 | This directory contains a number of extensions for "ma"[1], a small
  6 | "Acme"[2]  clone, written in Tcl/Tk. Note that all of this is hacked
  7 | together for personal use, sufficient to do the job, but neither polished
  8 | not perfect. Use at your own risk and modify to your liking.
  9 | 
 10 | 
 11 | • "snippets.tcl": Entering unicode characters using dmenu[3], similar
 12 |    to the compose key in Plan 9.
 13 | 
 14 |     Put the program "snip" in your PATH, and add this to ~/.ma:
 15 | 
 16 |        DefineKey <Control-q> {
 17 |           set f [open "| snip < /dev/null" r]
 18 |           Insert [string trim [read $f]]
 19 |            catch [list close $f]
 20 |        }
 21 | 
 22 |     Change the location of "snippets.tcl" in the "snip" script to
 23 |     something appropriate for your setup.
 24 | 
 25 | • "hooks.tcl": Simple hooks when loading files with a particular extension.
 26 | 
 27 |      source <path>/hooks.tcl
 28 | 
 29 |       AddFileHook {\.(c|h|cpp)$} {
 30 |          global indent_mode
 31 |          set indent_mode 1
 32 |      }
 33 | 
 34 | • "ctags.tcl": Support for locating definitions in programs for various
 35 |    languages with ctags(1)
 36 | 
 37 |       source <path>/ctags.tcl
 38 | 
 39 |     Defines a command named "Tag" that locates the selected word, or the
 40 |     word under dot.  Also works as "Tag <word>". The generated "tags"
 41 |     file must be in the current directory.
 42 | 
 43 | • "scheme-indent.tcl": (very) simple Scheme indentation.
 44 | 
 45 |       source <path>/scheme-indent.tcl
 46 | 
 47 |     Enabled with the "SchemeIndent" command, consider adding this:
 48 | 
 49 |         AddFileHook {\.(scm|ss|scheme|egg)$} SchemeIndent
 50 | 
 51 | • "mark.tcl": mark regex or address with color.
 52 | 
 53 | * "diff.tcl": mark changes in diff + patch files (needs hooks.tcl)
 54 | 
 55 | • "savedstate.tcl": save font/colors for every saved file and restore
 56 |    when reopened.
 57 | 
 58 | • "execfile.tcl": B2 on special files invokes a custom command. Currently
 59 |     runs make(1) for makefiles and extracts zip and tar files. Easy to extend.
 60 | 
 61 | • "git*.tcl": a simple git(1) interface
 62 | 
 63 |     The "Git" command opens a status window for the git repository in the current
 64 |     directory or one of the parent directories. There are various commands
 65 |     for showing log, branches, and to add diffs selectively.
 66 | 
 67 |     "git.tcl" is the main file and should be loaded in your configuration
 68 |     file.  Here is a plumbing rule to click B3 in commit-ID to show the commit 
 69 |     for the repository in which the context directory or one of it's parents is:
 70 | 
 71 |     # git commit ID
 72 |     Plumb {^[a-f0-9]{40}$} {
 73 |         set arg [GetArg 0]
 74 |         set tf [TempFile].diff
 75 |         
 76 |         if {![catch [list exec git show $arg > $tf]]} {
 77 |             Run ma $tf -temporary -post-eval "RemoveTempFile $tf"
 78 |             return 1
 79 |         }
 80 |     
 81 |         return 0
 82 |     }
 83 | 
 84 |     "post-commit" is a hook that can be installed to update the status
 85 |     window a utomatically, if it exists.
 86 | 
 87 |     To install, add this to your ~/.ma:
 88 | 
 89 |         set git_lib_dir <libpath>
 90 |         source <libpath>/git.tcl
 91 | 
 92 |     where <libpath> is the directory where git-*.tcl and post-commit
 93 |     can be found.
 94 | 
 95 |     Status + Branch view:
 96 | 
 97 |         Commands:
 98 | 
 99 |         Update      Update status/branch view
100 |         Log         Show git log ("More" in the log window extends the range)
101 |         Branch      Switch to branch view
102 |         Status      Switch to status view
103 |         Commit      Commit added changes
104 |         CommitAll   Commit all changes
105 |         Amend       Commit added changes, amending last commit
106 |         Revert      Switch to revert mode
107 |         Diff        Switch to normal (diff) mode
108 |         CO          Checkout mode
109 |         Merge       Merge mode
110 |         Push        Push branch
111 |         Pull        Pull branch
112 | 
113 |         Plumbing patterns:
114 | 
115 |         diff:...    Show diff
116 |         revert:...  Revert file
117 |         checkout:... Checkout branch
118 |         merge:...   Merge branch
119 |         add:...     Add file to staging area
120 |         unadd:...   Remove file from staging area
121 |         reset:...   Reset changes in file
122 |         
123 |     Diff view:
124 | 
125 |         Commands:
126 | 
127 |         Add         Add selected changes
128 |         Commit      Add + commit selected changes
129 |         Invert      Invert selection
130 | 
131 |         Plumbing patterns:
132 | 
133 |         hunk:...    Select/deselect hunk
134 | 
135 | • Color themes: Simple color schemes.
136 | 
137 |         set theme_counter 1
138 |         source <path>/colors/solarized.tcl
139 |         ⁝
140 | 
141 |     The functiion keys select the current color scheme.
142 | 
143 | • Tools:
144 | 
145 |     g EXPRESSION
146 | 
147 |         Invokes grep(1) with argument EXPRESSION for usual text and
148 |         source code files.
149 | 
150 |     gg EXPRESSION
151 | 
152 |         Shorthand for "git grep"
153 | 
154 |     h [EXPRESSION]
155 | 
156 |         Grep EXPRESSION in history file, or show last 30 entries.
157 | 
158 |     upcase
159 | 
160 |         Read text and convert to uppercase, copy (or symlink) this to
161 |         "downcase" to do the opposite.
162 | 
163 |     unquote
164 | 
165 |         Unquote E-mail text (remove leading "> "), copy or symlink to
166 |         "quote" to do the opposite.
167 | 
168 |     ind [N]
169 | 
170 |         Indent input by N characters (defaults to 4), copy or symlink to
171 |         "unind" to unindent.
172 | 
173 |     LR [-1] REGEX [SUBST]
174 | 
175 |         Perform line-wise string substitution, "-1" replaces only the first
176 |         I use this since I can never remember how to use sed(1).
177 | 
178 | All of this code is placed in the public domain.
179 | 
180 | 
181 | [1] http://www.call-with-current-continuation.org/ma.tar.gz
182 | [2] http://acme.cat-v.org/
183 | [3] http://tools.suckless.org/dmenu
184 | 


--------------------------------------------------------------------------------
/utils/archive.tcl:
--------------------------------------------------------------------------------
 1 | # dump archive contents
 2 | 
 3 | 
 4 | DefinePlumbing {^.+\.(zip|tgz|tar\.gz|tar\.bz2|tar)$} {
 5 |     set fname [CanonicalFilename [GetArg 0]]
 6 | 
 7 |     if {[file exists $fname]} {
 8 |         switch -exact [GetArg 1] {
 9 |             "tar" {set cmd "tar tf"}
10 |             "tar.gz" {set cmd "tar tfz"}
11 |             "tgz" {set cmd "tar tfz"}
12 |             "zip" {set cmd "unzip -l"}
13 |             "tar.bz2" {set cmd "tar tfj"}
14 |             default {error "bad extension: [GetArg 1]"}
15 |         }
16 | 
17 |         if {[catch [list eval exec $cmd $fname] lst]} {
18 |             LogInWindow "unable to read archive: $fname\n\n$lst"
19 |         } else {
20 |             LogInWindow "$lst\n"
21 |         }
22 | 
23 |         return 1
24 |     }
25 | 
26 |     return 0
27 | }
28 | 


--------------------------------------------------------------------------------
/utils/colors/acme.tcl:
--------------------------------------------------------------------------------
 1 | #
 2 | # acme color theme - same as the default colors
 3 | #
 4 | 
 5 | proc Acme {} {
 6 |     global current_foreground current_background sbar_color
 7 |     global sbar_background tag_foreground tag_background 
 8 |     global selection_foreground
 9 |     global selection_background pseudo_selection_foreground
10 |     global pseudo_selection_background inactive_selection_background
11 | 
12 |     set current_foreground black
13 |     set current_background "#FFFFEA"
14 |     set sbar_color $current_background
15 |     set sbar_background "#99994C"
16 |     set tag_foreground black
17 |     set tag_background "#EAFFFF"
18 |     set selection_foreground black
19 |     set selection_background "#eeee9e"
20 |     set pseudo_selection_foreground $selection_foreground
21 |     set pseudo_selection_background $selection_background
22 |     set inactive_selection_background $selection_background
23 |     ConfigureWindow
24 | }
25 | 
26 | DefineKey <F$theme_counter> {
27 |     Acme
28 |     break
29 | }
30 | 
31 | incr theme_counter
32 | 


--------------------------------------------------------------------------------
/utils/colors/autumn-light.tcl:
--------------------------------------------------------------------------------
 1 | #
 2 | # autumn light
 3 | # https://github.com/aalpern/emacs-color-theme-autumn-light/blob/master/autumn-light-theme.el
 4 | #
 5 | 
 6 | proc AutumnLight {} {
 7 |     global current_foreground current_background sbar_color
 8 |     global sbar_background tag_foreground tag_background 
 9 |     global selection_foreground
10 |     global selection_background
11 | 
12 |     set current_foreground black
13 |     set current_background wheat
14 |     set sbar_color white
15 |     set sbar_background grey
16 |     set tag_foreground white
17 |     set tag_background firebrick
18 |     set selection_foreground gray90
19 |     set selection_background DarkSlateBlue
20 |     ConfigureWindow
21 | }
22 | 
23 | DefineKey <F$theme_counter> {
24 |     AutumnLight
25 |     break
26 | }
27 | 
28 | incr theme_counter
29 | 


--------------------------------------------------------------------------------
/utils/colors/blue-sea.tcl:
--------------------------------------------------------------------------------
 1 | # color-theme based on BlueSea (or something like that, from emacs)
 2 | #
 3 | 
 4 | proc BlueSea {} {
 5 |     global current_foreground current_background sbar_color
 6 |     global tag_foreground tag_background 
 7 |     global selection_foreground
 8 |     global selection_background sbar_background
 9 |     global pseudo_selection_foreground
10 |     global pseudo_selection_background inactive_selection_background
11 | 
12 |     set current_foreground white
13 |     set current_background "#102e4e"
14 |     set sbar_color "#333333"
15 |     set sbar_background black
16 |     set tag_foreground white
17 |     set tag_background black
18 |     set selection_foreground black
19 |     set selection_background yellow 
20 |     set pseudo_selection_foreground $selection_foreground
21 |     set pseudo_selection_background $selection_background
22 |     set inactive_selection_background $selection_background
23 |     ConfigureWindow
24 | }
25 | 
26 | DefineKey <F$theme_counter> {
27 |     BlueSea
28 |     break
29 | }
30 | 
31 | incr theme_counter
32 | 


--------------------------------------------------------------------------------
/utils/colors/crisp.tcl:
--------------------------------------------------------------------------------
 1 | # Crisp (https://github.com/daylerees/colour-schemes)
 2 | 
 3 | proc Crisp {} {
 4 |     global current_foreground current_background sbar_color
 5 |     global sbar_background tag_foreground tag_background 
 6 |     global selection_foreground
 7 |     global selection_background pseudo_selection_foreground
 8 |     global pseudo_selection_background inactive_selection_background
 9 | 
10 |     set current_foreground "#ffffff"
11 |     set current_background "#221a22"
12 |     set sbar_color "#776377"
13 |     set sbar_background $current_background
14 |     set tag_foreground "white"
15 |     set tag_background gray25
16 |     set selection_foreground "#ffffff"
17 |     set selection_background "#FC6A0F"
18 |     set pseudo_selection_foreground $selection_foreground
19 |     set pseudo_selection_background $selection_background
20 |     set inactive_selection_background $selection_background
21 |     ConfigureWindow
22 | }
23 | 
24 | DefineKey <F$theme_counter> {
25 |     Crisp
26 |     break
27 | }
28 | 
29 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/electric.tcl:
--------------------------------------------------------------------------------
 1 | #
 2 | # variation of "relaxed"
 3 | #
 4 | 
 5 | proc Electric {} {
 6 |     global current_foreground current_background sbar_color
 7 |     global sbar_background tag_foreground tag_background 
 8 |     global selection_foreground
 9 |     global selection_background pseudo_selection_foreground
10 |     global pseudo_selection_background inactive_selection_background
11 | 
12 |     set current_foreground "Pale Green"
13 |     set current_background "#222222"
14 |     set sbar_color "#333333"
15 |     set sbar_background black
16 |     set tag_foreground $current_foreground
17 |     set tag_background black
18 |     set selection_foreground black
19 |     set selection_background yellow
20 |     set pseudo_selection_foreground $selection_foreground
21 |     set pseudo_selection_background $selection_background
22 |     set inactive_selection_background $selection_background
23 |     ConfigureWindow
24 | }
25 | 
26 | DefineKey <F$theme_counter> {
27 |     Electric
28 |     break
29 | }
30 | 
31 | incr theme_counter
32 | 


--------------------------------------------------------------------------------
/utils/colors/faff.tcl:
--------------------------------------------------------------------------------
 1 | # emacs "faff" theme
 2 | # https://github.com/WJCFerguson/emacs-faff-theme/blob/master/faff-theme.el
 3 | 
 4 | 
 5 | proc Faff {} { 
 6 |     global current_foreground current_background sbar_color
 7 |     global sbar_background tag_foreground tag_background 
 8 |     global selection_foreground
 9 |     global selection_background pseudo_selection_foreground
10 |     global pseudo_selection_background inactive_selection_background
11 | 
12 |     set current_foreground black
13 |     set current_background ivory3
14 |     set tag_foreground black
15 |     set tag_background gold
16 |     set selection_foreground white
17 |     set selection_background DarkOrange
18 |     set sbar_color white
19 |     set sbar_background lightsteelblue
20 |     set pseudo_selection_foreground $selection_foreground
21 |     set pseudo_selection_background $selection_background
22 |     set inactive_selection_background $selection_background
23 |     ConfigureWindow
24 | }
25 | 
26 | DefineKey <F$theme_counter> {
27 |     Faff
28 |     break
29 | }
30 | 
31 | incr theme_counter
32 | 


--------------------------------------------------------------------------------
/utils/colors/glowfish.tcl:
--------------------------------------------------------------------------------
 1 | # glowfish (https://github.com/daylerees/colour-schemes)
 2 | 
 3 | proc Glowfish {} {
 4 |     global current_foreground current_background sbar_color
 5 |     global sbar_background tag_foreground tag_background 
 6 |     global selection_foreground
 7 |     global selection_background pseudo_selection_foreground
 8 |     global pseudo_selection_background inactive_selection_background
 9 | 
10 |     set current_foreground "#6ea240"
11 |     set current_background "#191f13"
12 |     set sbar_color "#67854f"
13 |     set sbar_background "#191f13"
14 |     set tag_foreground "white"
15 |     set tag_background $current_background
16 |     set selection_foreground "#ffffff"
17 |     set selection_background "#DB784D"
18 |     set pseudo_selection_foreground $selection_foreground
19 |     set pseudo_selection_background $selection_background
20 |     set inactive_selection_background $selection_background
21 |     ConfigureWindow
22 | }
23 | 
24 | DefineKey <F$theme_counter> {
25 |     Glowfish
26 |     break
27 | }
28 | 
29 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/goldenrod.tcl:
--------------------------------------------------------------------------------
 1 | # goldenrod
 2 | 
 3 | proc Goldenrod {} {
 4 |     global current_foreground current_background sbar_color
 5 |     global sbar_background tag_foreground tag_background 
 6 |     global selection_foreground
 7 |     global selection_background pseudo_selection_foreground
 8 |     global pseudo_selection_background inactive_selection_background
 9 | 
10 |     set current_foreground "goldenrod"
11 |     set current_background "black"
12 |     set sbar_color "DarkSlateGray"
13 |     set sbar_background gray10
14 |     set tag_foreground "lemon chiffon"
15 |     set tag_background gray25
16 |     set selection_foreground "DarkGoldenrod"
17 |     set selection_background "dark olive green"
18 |     set pseudo_selection_foreground $selection_foreground
19 |     set pseudo_selection_background $selection_background
20 |     set inactive_selection_background $selection_background
21 |     ConfigureWindow
22 | }
23 | 
24 | DefineKey <F$theme_counter> {
25 |     Goldenrod
26 |     break
27 | }
28 | 
29 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/gotham.tcl:
--------------------------------------------------------------------------------
 1 | # gotham
 2 | # https://github.com/wasamasa/gotham-theme
 3 | 
 4 | proc Gotham {} {
 5 |     global current_foreground current_background sbar_color
 6 |     global sbar_background tag_foreground tag_background 
 7 |     global selection_foreground
 8 |     global selection_background pseudo_selection_foreground
 9 |     global pseudo_selection_background inactive_selection_background
10 | 
11 |     set current_foreground "#99d1ce"
12 |     set current_background "#0c1014"
13 |     set sbar_color "#245361"
14 |     set sbar_background "#091f2e"
15 |     set tag_foreground "#599cab"
16 |     set tag_background "#091f2e"
17 |     set selection_foreground $current_foreground
18 |     set selection_background "#0a3749"
19 |     set pseudo_selection_foreground $selection_foreground
20 |     set pseudo_selection_background $selection_background
21 |     set inactive_selection_background $selection_background
22 |     ConfigureWindow
23 | }
24 | 
25 | DefineKey <F$theme_counter> {
26 |     Gotham
27 |     break
28 | }
29 | 
30 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/green-screen.tcl:
--------------------------------------------------------------------------------
 1 | # Green Screen
 2 | # https://github.com/mkaito/base16-emacs
 3 | 
 4 | 
 5 | proc GreenScreen {} {
 6 |     global current_foreground current_background sbar_color
 7 |     global sbar_background tag_foreground tag_background 
 8 |     global selection_foreground
 9 |     global selection_background pseudo_selection_foreground
10 |     global pseudo_selection_background inactive_selection_background
11 | 
12 |     set current_foreground "#00dd00"
13 |     set current_background "#001100"
14 |     set sbar_color "#004400"
15 |     set sbar_background "#002200"
16 |     set tag_foreground "#00bb00"
17 |     set tag_background "#003300"
18 |     set selection_foreground "#00bb00"
19 |     set selection_background "#005500"
20 |     set pseudo_selection_foreground "#00bb00"
21 |     set pseudo_selection_background "#005500"
22 |     set inactive_selection_background "#005500"
23 |     ConfigureWindow
24 | }
25 | 
26 | DefineKey <F$theme_counter> {
27 |     GreenScreen
28 |     break
29 | }
30 | 
31 | incr theme_counter
32 | 


--------------------------------------------------------------------------------
/utils/colors/greyish.tcl:
--------------------------------------------------------------------------------
 1 | #
 2 | # found somewhere...
 3 | #
 4 | 
 5 | proc Greyish {} {
 6 |     global current_foreground current_background sbar_color
 7 |     global sbar_background tag_foreground tag_background 
 8 |     global selection_foreground
 9 |     global selection_background pseudo_selection_foreground
10 |     global pseudo_selection_background inactive_selection_background
11 | 
12 |     set current_foreground "black"
13 |     set current_background "#fdf6e3"
14 |     set tag_foreground "#546f76"
15 |     set tag_background "#d0d0d0"
16 |     set sbar_color $current_background
17 |     set sbar_background $tag_background
18 |     set selection_foreground $tag_background
19 |     set selection_background "#5f87af"
20 |     set pseudo_selection_foreground $selection_foreground
21 |     set pseudo_selection_background $selection_background
22 |     set inactive_selection_background $selection_background
23 |     ConfigureWindow
24 | }
25 | 
26 | DefineKey <F$theme_counter> {
27 |     Greyish
28 |     break
29 | }
30 | 
31 | incr theme_counter
32 | 


--------------------------------------------------------------------------------
/utils/colors/jazz.tcl:
--------------------------------------------------------------------------------
 1 | # jazz
 2 | # https://github.com/donderom/jazz-theme/blob/master/jazz-theme.el
 3 | 
 4 | 
 5 | proc Jazz {} {
 6 |     global current_foreground current_background sbar_color
 7 |     global sbar_background tag_foreground tag_background 
 8 |     global selection_foreground
 9 |     global selection_background pseudo_selection_foreground
10 |     global pseudo_selection_background inactive_selection_background
11 | 
12 |     set current_foreground "#c6a57b"
13 |     set current_background "#151515"
14 |     set sbar_color $current_background
15 |     set sbar_background "#303030"
16 |     set tag_foreground $current_foreground
17 |     set tag_background "#202020"
18 |     set selection_foreground "#385e6b"
19 |     set selection_background $current_foreground
20 |     set pseudo_selection_foreground $selection_foreground
21 |     set pseudo_selection_background $selection_background
22 |     set inactive_selection_background $selection_background
23 |     ConfigureWindow
24 | }
25 | 
26 | DefineKey <F$theme_counter> {
27 |     Jazz
28 |     break
29 | }
30 | 
31 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/material-light.tcl:
--------------------------------------------------------------------------------
 1 | # "material light" color scheme
 2 | #
 3 | # https://github.com/cpaulik/emacs-material-theme/
 4 | 
 5 | 
 6 | proc MaterialLight {} {
 7 |     global current_foreground current_background sbar_color
 8 |     global sbar_background tag_foreground tag_background 
 9 |     global selection_foreground
10 |     global selection_background pseudo_selection_foreground
11 |     global pseudo_selection_background inactive_selection_background
12 | 
13 |     set current_foreground "#212121"
14 |     set current_background "#FAFAFA"
15 |     set sbar_color gray50
16 |     set sbar_background $current_background
17 |     set tag_foreground $current_foreground
18 |     set tag_background "#e0f7fa"
19 |     set selection_foreground $current_foreground
20 |     set selection_background "#90A4AE"
21 |     set pseudo_selection_foreground $selection_foreground
22 |     set pseudo_selection_background $selection_background
23 |     set inactive_selection_background $selection_background
24 |     ConfigureWindow
25 | }
26 | 
27 | DefineKey <F$theme_counter> {
28 |     MaterialLight
29 |     break
30 | }
31 | 
32 | incr theme_counter
33 | 


--------------------------------------------------------------------------------
/utils/colors/material.tcl:
--------------------------------------------------------------------------------
 1 | # "material" color scheme
 2 | #
 3 | # https://github.com/cpaulik/emacs-material-theme/
 4 | 
 5 | 
 6 | proc Material {} {
 7 |     global current_foreground current_background sbar_color
 8 |     global sbar_background tag_foreground tag_background 
 9 |     global selection_foreground
10 |     global selection_background pseudo_selection_foreground
11 |     global pseudo_selection_background inactive_selection_background
12 | 
13 |     set current_foreground "#ffffff"
14 |     set current_background "#263238"
15 |     set sbar_color gray50
16 |     set sbar_background $current_background
17 |     set tag_foreground $current_foreground
18 |     set tag_background "#1c1f26"
19 |     set selection_foreground $current_foreground
20 |     set selection_background "#555555"
21 |     set pseudo_selection_foreground $selection_foreground
22 |     set pseudo_selection_background $selection_background
23 |     set inactive_selection_background $selection_background
24 |     ConfigureWindow
25 | }
26 | 
27 | DefineKey <F$theme_counter> {
28 |     Material
29 |     break
30 | }
31 | 
32 | incr theme_counter
33 | 


--------------------------------------------------------------------------------
/utils/colors/mistyrose.tcl:
--------------------------------------------------------------------------------
 1 | # mistyrose
 2 | # https://emacsthemes.com/themes/mistyrose-theme.html
 3 | 
 4 | proc Mistyrose {} {
 5 |     global current_foreground current_background sbar_color
 6 |     global sbar_background tag_foreground tag_background 
 7 |     global selection_foreground
 8 |     global selection_background pseudo_selection_foreground
 9 |     global pseudo_selection_background inactive_selection_background
10 | 
11 |     set current_foreground "black"
12 |     set current_background "mistyrose"
13 |     set sbar_color $current_background
14 |     set sbar_background $current_foreground
15 |     set tag_foreground "lawn green"
16 |     set tag_background "royalblue4"
17 |     set selection_foreground "light cyan"
18 |     set selection_background "sienna"
19 |     set pseudo_selection_foreground $selection_foreground
20 |     set pseudo_selection_background $selection_background
21 |     set inactive_selection_background $selection_background
22 |     ConfigureWindow
23 | }
24 | 
25 | DefineKey <F$theme_counter> {
26 |     Mistyrose
27 |     break
28 | }
29 | 
30 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/mono.tcl:
--------------------------------------------------------------------------------
 1 | # monochrome theme
 2 | 
 3 | proc Mono {} {
 4 |     global current_foreground current_background sbar_color
 5 |     global sbar_background tag_foreground tag_background 
 6 |     global selection_foreground
 7 |     global selection_background pseudo_selection_foreground
 8 |     global pseudo_selection_background inactive_selection_background
 9 | 
10 |     set current_foreground black
11 |     set current_background white
12 |     set sbar_color white
13 |     set sbar_background "#a0a0a0"
14 |     set tag_foreground white
15 |     set tag_background black
16 |     set selection_foreground black
17 |     set selection_background "#a0a0a0"
18 |     set pseudo_selection_foreground $selection_foreground
19 |     set pseudo_selection_background $selection_background
20 |     set inactive_selection_background $selection_background
21 |     ConfigureWindow
22 | }
23 | 
24 | DefineKey <F$theme_counter> {
25 |     Mono
26 |     break
27 | }
28 | 
29 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/organic-green.tcl:
--------------------------------------------------------------------------------
 1 | # organic-green
 2 | # https://emacsthemes.com/themes/organic-green-theme.html
 3 | 
 4 | proc OrganicGreen {} {
 5 |     global current_foreground current_background sbar_color
 6 |     global sbar_background tag_foreground tag_background 
 7 |     global selection_foreground
 8 |     global selection_background pseudo_selection_foreground
 9 |     global pseudo_selection_background inactive_selection_background
10 | 
11 |     set current_foreground "#326B6B"
12 |     set current_background "#F0FFF0"
13 |     set sbar_color $current_background
14 |     set sbar_background $current_foreground
15 |     set tag_foreground "#2e3436"
16 |     set tag_background "#d3d7cf"
17 |     set selection_foreground $current_foreground
18 |     set selection_background "#EEEEA0"
19 |     set pseudo_selection_foreground $selection_foreground
20 |     set pseudo_selection_background $selection_background
21 |     set inactive_selection_background $selection_background
22 |     ConfigureWindow
23 | }
24 | 
25 | DefineKey <F$theme_counter> {
26 |     OrganicGreen
27 |     break
28 | }
29 | 
30 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/paper.tcl:
--------------------------------------------------------------------------------
 1 | # paper
 2 | # https://github.com/cadadr/paper-theme/blob/master/paper-theme.el
 3 | 
 4 | proc Paper {} {
 5 |     global current_foreground current_background sbar_color
 6 |     global sbar_background tag_foreground tag_background 
 7 |     global selection_foreground
 8 |     global selection_background pseudo_selection_foreground
 9 |     global pseudo_selection_background inactive_selection_background
10 | 
11 |     set current_foreground "#070a01"
12 |     set current_background "#fafafa"
13 |     set sbar_color white
14 |     set sbar_background $current_background
15 |     set tag_foreground "#eeeeee"
16 |     set tag_background "#8c0d40"
17 |     set selection_foreground $tag_background
18 |     set selection_background "#eeeeee"
19 |     set pseudo_selection_foreground $selection_foreground
20 |     set pseudo_selection_background $selection_background
21 |     set inactive_selection_background $selection_background
22 |     ConfigureWindow
23 | }
24 | 
25 | DefineKey <F$theme_counter> {
26 |     Paper
27 |     break
28 | }
29 | 
30 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/pink-bliss.tcl:
--------------------------------------------------------------------------------
 1 | #
 2 | # a Port of the pink-bliss emacs color theme
 3 | #
 4 | # originally by Alex Schroeder
 5 | # http://www.emacswiki.org/emacs/PinkBliss
 6 | #
 7 | 
 8 | proc PinkBliss {} {
 9 |     global current_foreground current_background sbar_color
10 |     global sbar_background tag_foreground tag_background 
11 |     global selection_foreground
12 |     global selection_background
13 | 
14 |     set current_foreground magenta4
15 |     set current_background "misty rose"
16 |     set sbar_color pink
17 |     set sbar_background "hot pink"
18 |     set tag_foreground "violet red"
19 |     set tag_background pink
20 |     set selection_foreground magenta4
21 |     set selection_background seashell
22 |     ConfigureWindow
23 | }
24 | 
25 | DefineKey <F$theme_counter> {
26 |     PinkBliss
27 |     break
28 | }
29 | 
30 | incr theme_counter
31 | 


--------------------------------------------------------------------------------
/utils/colors/relaxed.tcl:
--------------------------------------------------------------------------------
 1 | #
 2 | # slightly more relaxed colors
 3 | #
 4 | 
 5 | proc Relaxed {} {
 6 |     global current_foreground current_background sbar_color
 7 |     global sbar_background tag_foreground tag_background 
 8 |     global selection_foreground
 9 |     global selection_background pseudo_selection_foreground
10 |     global pseudo_selection_background inactive_selection_background
11 | 
12 |     set current_foreground "#b6b6b6"
13 |     set current_background "#222222"
14 |     set sbar_color "#333333"
15 |     set sbar_background black
16 |     set tag_foreground white
17 |     set tag_background black
18 |     set selection_foreground black
19 |     set selection_background yellow
20 |     set pseudo_selection_foreground $selection_foreground
21 |     set pseudo_selection_background $selection_background
22 |     set inactive_selection_background $selection_background
23 |     ConfigureWindow
24 | }
25 | 
26 | DefineKey <F$theme_counter> {
27 |     Relaxed
28 |     break
29 | }
30 | 
31 | incr theme_counter
32 | 


--------------------------------------------------------------------------------
/utils/colors/solarized.tcl:
--------------------------------------------------------------------------------
 1 | # "solarized" color scheme
 2 | #
 3 | # http://ethanschoonover.com/solarized
 4 | 
 5 | 
 6 | set solarized(base03) "#002b36"
 7 | set solarized(base02) "#073642"
 8 | set solarized(base01) "#586e75"
 9 | set solarized(base00) "#657b83"
10 | set solarized(base0) "#839496"
11 | set solarized(base1) "#93a1a1"
12 | set solarized(base2) "#eee8d5"
13 | set solarized(base3) "#fdf6e3"
14 | set solarized(yellow) "#b58900"
15 | set solarized(orange) "#cb4b16"
16 | set solarized(red) "#dc322f"
17 | set solarized(magenta) "#d33682"
18 | set solarized(violet) "#6c71c4"
19 | set solarized(blue) "#268bd2"
20 | set solarized(cyan) "#2aa198"
21 | set solarized(green) "#859900"
22 | 
23 | 
24 | proc SolarizedLight {} {
25 |     global current_foreground current_background sbar_color
26 |     global sbar_background tag_foreground tag_background 
27 |     global selection_foreground
28 |     global solarized
29 |     global selection_background pseudo_selection_foreground
30 |     global pseudo_selection_background inactive_selection_background
31 | 
32 |     set current_foreground $solarized(base00)
33 |     set current_background $solarized(base2)
34 |     set sbar_color $solarized(base00)
35 |     set sbar_background $solarized(base1)
36 |     set tag_foreground $solarized(base2)
37 |     set tag_background $solarized(base03)
38 |     set selection_foreground black
39 |     set selection_background yellow
40 |     set pseudo_selection_foreground $selection_foreground
41 |     set pseudo_selection_background $selection_background
42 |     set inactive_selection_background $selection_background
43 |     ConfigureWindow
44 | }
45 | 
46 | proc SolarizedDark {} {
47 |     global current_foreground current_background sbar_color
48 |     global sbar_background tag_foreground tag_background 
49 |     global tag_background_dirty selection_foreground
50 |     global solarized
51 |     global selection_background pseudo_selection_foreground
52 |     global pseudo_selection_background inactive_selection_background
53 | 
54 |     set current_foreground $solarized(base1)
55 |     set current_background $solarized(base03)
56 |     set sbar_color $solarized(base02)
57 |     set sbar_background $solarized(base01)
58 |     set tag_foreground $solarized(base2)
59 |     set tag_background $solarized(base02)
60 |     set tag_background_dirty $solarized(base01)
61 |     set selection_foreground black
62 |     set selection_background yellow
63 |     set pseudo_selection_foreground $selection_foreground
64 |     set pseudo_selection_background $selection_background
65 |     set inactive_selection_background $selection_background
66 |     ConfigureWindow
67 | }
68 | 
69 | # SolarizedLight is not used
70 | 
71 | DefineKey <F$theme_counter> {
72 |     SolarizedDark
73 |     break
74 | }
75 | 
76 | incr theme_counter
77 | 


--------------------------------------------------------------------------------
/utils/colors/subatomic.tcl:
--------------------------------------------------------------------------------
 1 | # subatomic
 2 | # https://emacsthemes.com/themes/subatomic-theme.html
 3 | 
 4 | proc Subatomic {} {
 5 |     global current_foreground current_background sbar_color
 6 |     global sbar_background tag_foreground tag_background 
 7 |     global selection_foreground
 8 |     global selection_background pseudo_selection_foreground
 9 |     global pseudo_selection_background inactive_selection_background
10 | 
11 |     set current_foreground "#e5e5e5"
12 |     set current_background "#303347"
13 |     set sbar_color gray50
14 |     set sbar_background "#303347"
15 |     set tag_foreground white
16 |     set tag_background "#232533"
17 |     set selection_foreground white
18 |     set selection_background "#696e92"
19 |     set pseudo_selection_foreground $selection_foreground
20 |     set pseudo_selection_background $selection_background
21 |     set inactive_selection_background $selection_background
22 |     ConfigureWindow
23 | }
24 | 
25 | DefineKey <F$theme_counter> {
26 |     Subatomic
27 |     break
28 | }
29 | 
30 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/wheat.tcl:
--------------------------------------------------------------------------------
 1 | # wheat
 2 | # https://emacsthemes.com/themes/wheat-theme.html
 3 | 
 4 | proc Wheat {} {
 5 |     global current_foreground current_background sbar_color
 6 |     global sbar_background tag_foreground tag_background 
 7 |     global selection_foreground
 8 |     global selection_background pseudo_selection_foreground
 9 |     global pseudo_selection_background inactive_selection_background
10 | 
11 |     set current_foreground "black"
12 |     set current_background "wheat"
13 |     set sbar_color $current_background
14 |     set sbar_background $current_foreground
15 |     set tag_foreground "white"
16 |     set tag_background "black"
17 |     set selection_foreground $current_foreground
18 |     set selection_background "gray"
19 |     set pseudo_selection_foreground $selection_foreground
20 |     set pseudo_selection_background $selection_background
21 |     set inactive_selection_background $selection_background
22 |     ConfigureWindow
23 | }
24 | 
25 | DefineKey <F$theme_counter> {
26 |     Wheat
27 |     break
28 | }
29 | 
30 | incr theme_counter


--------------------------------------------------------------------------------
/utils/colors/zenburn.tcl:
--------------------------------------------------------------------------------
 1 | # zenburn
 2 | # https://github.com/bbatsov/zenburn-emacs/blob/master/zenburn-theme.el
 3 | 
 4 | proc Zenburn {} {
 5 |     global current_foreground current_background sbar_color
 6 |     global sbar_background tag_foreground tag_background 
 7 |     global selection_foreground
 8 |     global selection_background pseudo_selection_foreground
 9 |     global pseudo_selection_background inactive_selection_background
10 | 
11 |     set current_foreground "#dcdccc"
12 |     set current_background "#2b2b2b"
13 |     set sbar_color "#383838"
14 |     set sbar_background black
15 |     set tag_foreground "#8fb28f"
16 |     set tag_background black
17 |     set selection_foreground "#2b2b2b"
18 |     set selection_background "#8cd0d3"
19 |     set pseudo_selection_foreground $selection_foreground
20 |     set pseudo_selection_background $selection_background
21 |     set inactive_selection_background $selection_background
22 |     ConfigureWindow
23 | }
24 | 
25 | DefineKey <F$theme_counter> {
26 |     Zenburn
27 |     break
28 | }
29 | 
30 | incr theme_counter


--------------------------------------------------------------------------------
/utils/ctags.tcl:
--------------------------------------------------------------------------------
 1 | # use "ctags" information to locate definitions
 2 | #
 3 | # Commands: Tag [IDENTIFIER]
 4 | 
 5 | 
 6 | set tagfiletime 0
 7 | set tagfile ""
 8 | 
 9 | 
10 | proc LoadTags {} {
11 |     global tagmap tagfile tagfiletime
12 | 
13 |     if {$tagfile == ""} {
14 |         if {[file exists "tags"]} {
15 |             set tagfile [file normalize "tags"]
16 |         } else return
17 |     }
18 | 
19 |     if {$tagfiletime == 0 || [file mtime $tagfile] > $tagfiletime} {
20 |         set f [open $tagfile]
21 |         
22 |         while {[gets $f line] >= 0} {
23 |             if {[regexp {^(\S+)\s+(\S+)\s+(\d+)$} $line _ name file ln]} {
24 |                 set tagmap($name) [list $file $ln]
25 |             } elseif {[regexp {^(\S+)\s+(\S+)\s+/(\^?)([^$/]+)(\$)?/$} $line _ name file c str d]} {
26 |                 set tagmap($name) [list $file "//$c$str$d/"]
27 |                 # puts "$name:$tagmap($name)"
28 |             }
29 |         }
30 | 
31 |         close $f
32 |     }
33 | }
34 | 
35 | 
36 | proc LocateTag {str} {
37 |     global tagmap
38 |     LoadTags
39 | 
40 |     if {[info exists tagmap($str)]} {
41 |         lassign $tagmap($str) fname addr
42 |         GotoFileAddress $fname $addr
43 |     }
44 | }
45 | 
46 | 
47 | DefineCommand {^Tag\s+(\S+)$} {LocateTag [GetArg]}\
48 | 
49 | DefineCommand {^Tag$} {
50 |     set range [GetEffectiveSelection .t]
51 |     
52 |     if {$range == ""} {
53 |         set range [GetWordUnderIndex .t insert]
54 |     }
55 | 
56 |     if {$range != ""} {
57 |         LocateTag [eval .t get $range]
58 |     }
59 | }
60 | 


--------------------------------------------------------------------------------
/utils/diff.tcl:
--------------------------------------------------------------------------------
 1 | # diff marking
 2 | 
 3 | 
 4 | .t tag configure diff_added -foreground white -background darkgreen
 5 | .t tag configure diff_removed -foreground white -background darkred
 6 | .t tag lower diff_added sel
 7 | .t tag lower diff_removed sel
 8 | 
 9 | 
10 | proc MarkDiff {} {
11 |   set pos [.t search -regexp {^@@} 1.0 end]
12 | 
13 |   if {$pos == ""} return
14 | 
15 |   while 1 {
16 |     set found [.t search -regexp {^([-+]+)} $pos end]
17 | 
18 |     if {$found == ""} return
19 | 
20 |     set line [.t get $found "$found lineend"]
21 |     set pos "$found lineend + 1 chars"
22 |     
23 |     if {![regexp {^(---|\+\+\+)} $line]} {
24 |       if {[string index $line 0] == "+"} {
25 |         set tag diff_added
26 |       } else {
27 |         set tag diff_removed
28 |       }
29 | 
30 |       .t tag add $tag $found "$found lineend"
31 |     }
32 |   }
33 | }
34 | 
35 | 
36 | AddFileHook {\.(diff|patch)$} MarkDiff
37 | DefineCommand {^MarkDiff$} MarkDiff
38 | 


--------------------------------------------------------------------------------
/utils/execfile.tcl:
--------------------------------------------------------------------------------
 1 | # execute particular files specially
 2 | 
 3 | 
 4 | AddToHook execute_hook SpecialFileExecute
 5 | 
 6 | proc SpecialFileExecute {cmd ctxt} {
 7 |     set ex ""
 8 | 
 9 |     if {![file exists $cmd]} {return ""}
10 | 
11 |     switch -regexp -- $cmd {
12 |         {^(GNU)?[Mm]akefile$} {
13 |             set ex "make -f $cmd"
14 |         }
15 |         {\.zip$} {
16 |             set ex "unzip '$cmd'"
17 |         }
18 |         {\.tar$} {
19 |             set ex "tar xf '$cmd'"
20 |         }
21 |         {\.(tgz|tar.gz)$} {
22 |             set ex "tar xzf '$cmd'"
23 |         }
24 |         {\.(tbz|tar.bz)$} {
25 |             set ex "tar xjf '$cmd'"
26 |         }
27 |         {\.gz$} {
28 |             set ex "gunzip '$cmd'"
29 |         }
30 |         {\.bz$} {
31 |             set ex "bunzip '$cmd'"
32 |         }
33 |         {\.[1-8]$} {
34 |             set ex "man [file normalize $cmd]"
35 |         }
36 |         default {return ""}
37 |     }
38 | 
39 |     InvokeExternalCommandInWindow $ex
40 |     return 1
41 | }
42 | 


--------------------------------------------------------------------------------
/utils/g:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | #
 3 | # grep common files for patterns
 4 | 
 5 | if test -z "$1"; then
 6 |     echo "usage: g PATTERN [FILENAME ...]" 1>&2
 7 |     exit 1
 8 | fi
 9 | 
10 | pat="$1"
11 | shift
12 | 
13 | if test -z "$1"; then
14 |     exec grep -nH "$pat" `ls *.c *.cpp *.h *.s *.pl *.py *.tex *.css *.org *.m *.scm *.lisp *.lsp *.el *.java *.tcl *.txt *.fp *.f 2>/dev/null`
15 | else
16 |     exec grep -nH "$pat" "$@"
17 | fi
18 | 


--------------------------------------------------------------------------------
/utils/gg:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | exec git grep -nI "$@"
3 | 


--------------------------------------------------------------------------------
/utils/git-diff.tcl:
--------------------------------------------------------------------------------
  1 | # basic git(1) interface - diff window
  2 | 
  3 | 
  4 | set git_diff_fname ""
  5 | set git_enabled_hunks {}
  6 | set git_hunk_count 0
  7 | set git_mode WORKING
  8 | set git_root [Git_FindRoot]
  9 | set git_binary 0
 10 | 
 11 | 
 12 | .t tag configure git_added -foreground white -background darkgreen
 13 | .t tag configure git_removed -foreground white -background darkred
 14 | .t tag configure git_disabled -foreground gray70 -background gray10
 15 | .t tag configure git_enabled
 16 | 
 17 | 
 18 | proc Git_Diff {{fname ""} {new 0} {mode ""}} {
 19 |     global git_diff_fname git_enabled_hunks git_mode
 20 |     global git_hunk_count git_binary
 21 | 
 22 |     if {$mode != ""} {
 23 |         set git_mode $mode
 24 |     }
 25 | 
 26 |     if {$fname == ""} {
 27 |         set fname $git_diff_fname
 28 |     } else {
 29 |         set git_diff_fname $fname
 30 |     }
 31 | 
 32 |     if {$git_mode == "WORKING"} {
 33 |         set diff [exec git diff -- $fname]
 34 |     } else {
 35 |         set diff [exec git diff --cached -- $fname]
 36 |     }
 37 | 
 38 |     .t delete 1.0 end
 39 |     regexp {\* (\S+)} [exec git branch] _ b
 40 |     set rev [exec git rev-parse --short HEAD]
 41 |     Insert "\nGit diff [pwd] ($git_mode):\nbranch: $b, rev: $rev, file: $fname\n\n"
 42 |     set tag ""
 43 |     set hunk 0
 44 | 
 45 |     if {$new} {set git_enabled_hunks {}}
 46 | 
 47 |     foreach dl [split $diff "\n"] {
 48 |         if {[regexp {^(@@[-+ 0-9,]+@@)(.*)$} $dl _ head rest]} {
 49 |             if {$new || [lsearch -exact $git_enabled_hunks \
 50 |                 $hunk] != -1} {
 51 |                 set tag git_enabled
 52 |             } else {
 53 |                 set tag git_disabled
 54 |             }
 55 | 
 56 |             if {$new} {lappend git_enabled_hunks $hunk}
 57 |         
 58 |             Insert "$head hunk:$hunk $rest\n" $tag
 59 |             incr hunk
 60 |             continue
 61 |         }
 62 | 
 63 |         if {[regexp {^Binary files} $dl]} {
 64 |             Insert "$dl\n"
 65 |             set git_binary 1
 66 |             continue
 67 |         }
 68 | 
 69 |         set dltag $tag
 70 | 
 71 |         if {$tag != "git_disabled" && ![regexp {^(---|\+\+\+)} $dl]} {
 72 |             if {[regexp {^([-+])} $dl _ addrem]} {
 73 |                 if {$addrem == "+"} {
 74 |                     set dltag git_added
 75 |                 } else {
 76 |                     set dltag git_removed
 77 |                 }
 78 |             }
 79 |         }
 80 | 
 81 |         Insert "$dl\n" $dltag
 82 |     }
 83 | 
 84 |     set git_hunk_count $hunk
 85 |     .t mark set insert 1.0
 86 |     Top
 87 |     Unmodified
 88 | }
 89 | 
 90 | 
 91 | proc Git_Apply {cmd {end_if_all 1}} {
 92 |     global git_enabled_hunks git_diff_fname git_root git_binary
 93 |     set input ""
 94 |     set hunks [lsort -integer $git_enabled_hunks]
 95 |     set all 1
 96 | 
 97 |     if {!$git_binary} {
 98 |         for {set h 0} {$hunks != ""} {incr h} {
 99 |             set hd [lindex $hunks 0]
100 |     
101 |             if {$h == $hd} {
102 |                 append input "y\n"
103 |                 set hunks [lrange $hunks 1 end]
104 |             } else {
105 |                 append input "n\n"
106 |                 set all 0
107 |             }
108 |         }
109 |     
110 |         append input "q\n"
111 |         exec git $cmd -p -- $git_diff_fname > /dev/null 2> \
112 |             /dev/null << $input
113 |     } else {
114 |         exec git $cmd -- $git_diff_fname > /dev/null 2> /dev/null
115 |     }
116 | 
117 |     catch [list send $git_root/+Git Git_Update]
118 | 
119 |     if {$all && $end_if_all} {
120 |         Terminate
121 |     } else {
122 |         Git_Diff
123 |     }
124 | }
125 | 
126 | 
127 | DefineCommand {^Add$} {Git_Apply add}
128 | 
129 | 
130 | DefineCommand {^Commit$} {
131 |     global env
132 |     Git_Apply add 0
133 |     exec env GIT_EDITOR=$env(HERE)/exec/ma git commit &
134 |     Terminate
135 | }
136 | 
137 | 
138 | DefineCommand {^Invert$} {
139 |     global git_enabled_hunks git_hunk_count
140 |     set newlist {}
141 | 
142 |     for {set i 0} {$i < $git_hunk_count} {incr i} {
143 |         if {[lsearch $git_enabled_hunks $i] == -1} {
144 |             lappend newlist $i
145 |         }
146 |     }
147 | 
148 |     set git_enabled_hunks $newlist
149 |     Git_Diff
150 | }
151 | 
152 | 
153 | DefinePlumbing {^hunk:(\d+)$} {
154 |     global git_enabled_hunks
155 |     set h [GetArg 1]
156 |     set p [lsearch -exact $git_enabled_hunks $h]
157 |     
158 |     if {$p == -1} {
159 |         lappend git_enabled_hunks $h
160 |     } else {
161 |         set git_enabled_hunks [lreplace $git_enabled_hunks $p $p]
162 |     }
163 | 
164 |     Git_Diff
165 |     return 1
166 | }
167 | 


--------------------------------------------------------------------------------
/utils/git-log.tcl:
--------------------------------------------------------------------------------
 1 | # basic git(1) interface - log window
 2 | 
 3 | 
 4 | set git_log_len 25
 5 | set git_enable_stats 1
 6 | set git_root [Git_FindRoot]
 7 | 
 8 | 
 9 | if {$git_root != ""} {
10 |     tk appname $git_root+GitLog
11 | }
12 | 
13 | 
14 | proc Git_Update {} {
15 |     ActivateWindow
16 |     Git_Log
17 | }
18 | 
19 | 
20 | proc Git_Log {} {
21 |     global git_log_len git_enable_stats
22 |     .t delete 1.0 end
23 |     set rev [exec git rev-parse --short HEAD]
24 |     set args {--graph}
25 | 
26 |     if {$git_enable_stats} {lappend args "--stat"}
27 | 
28 |     regexp {\* (\S+)} [exec git branch] _ b
29 |     Insert "\nGit log [pwd]: branch: $b\n\n"
30 |     set txt [exec git log -$git_log_len {*}$args]
31 |     Insert $txt
32 |     Insert "\n\nMore\n\n"
33 |     Top
34 | }
35 | 
36 | 
37 | proc Git_UpdateLog args {
38 |     Git_Log
39 |     return 1
40 | }
41 | 
42 | AddToHook revert_hook GiutUpdateLog
43 | 
44 | DefineCommand {^More$} {
45 |     global git_log_len
46 |     incr git_log_len 50
47 |     Git_Log
48 | }
49 | 
50 | DefineCommand {^Stat$} {
51 |     global git_enable_stats
52 |     set git_enable_stats [expr !$git_enable_stats]
53 |     Git_Log
54 | }
55 | 


--------------------------------------------------------------------------------
/utils/git-status.tcl:
--------------------------------------------------------------------------------
  1 | # basic git(1) interface - status/branch window
  2 | 
  3 | 
  4 | set git_status_mode diff
  5 | set git_root [Git_FindRoot]
  6 | set git_hook ""
  7 | set git_branch_op checkout
  8 | set git_mode status
  9 | 
 10 | 
 11 | if {[info exists env(HERE)]} {
 12 |     set git_hook $git_lib_dir/post-commit
 13 | 
 14 |     if {![file exists $git_hook]} {
 15 |         set git_hook ""
 16 |     }
 17 | }
 18 | 
 19 | if {$git_root != ""} {
 20 |     tk appname $git_root/+Git
 21 | }
 22 | 
 23 | 
 24 | proc Git_UpdateBranch {} {
 25 |     global git_mode
 26 | 
 27 |     if {$git_mode == "branch"} {
 28 |         ActivateWindow
 29 |         Git_Branch
 30 |     }
 31 | }
 32 | 
 33 | 
 34 | proc Git_UpdateStatus {} {
 35 |     global git_root git_mode
 36 | 
 37 |     if {$git_mode == "status"} {
 38 |         ActivateWindow
 39 |         Git_Status
 40 |         catch [list send $git_root/+GitLog Git_Update]
 41 |     }
 42 | }
 43 | 
 44 | 
 45 | # invoked externally to update
 46 | proc Git_Update {} {
 47 |     Git_UpdateStatus
 48 |     Git_UpdateBranch
 49 | }
 50 | 
 51 | 
 52 | proc Git_Status {} {
 53 |     global git_status_mode git_root git_hook
 54 |     .t delete 1.0 end
 55 | 
 56 |     if {[catch {exec git rev-parse --short HEAD} rev]} {
 57 |         set rev "<initial>"
 58 |     }
 59 | 
 60 |     if {![regexp {\* (\S+)} [exec git branch] _ b]} {
 61 |         set b "<none>"
 62 |     }
 63 | 
 64 |     Insert "\nGit status [pwd]:\nbranch: $b, rev: $rev\n\n"
 65 |     set f [open "|git status --porcelain"]
 66 |     
 67 |     while {[gets $f line] >= 0} {
 68 |         if {[regexp {^(..)\s+(.+)$} $line _ status files]} {
 69 |             set handle " diff"
 70 |     
 71 |             if {$git_status_mode == "revert"} {
 72 |                 set handle revert
 73 |             }
 74 | 
 75 |             switch -exact $status {
 76 |                 "??" {set handle "  add"}
 77 |                 "M " {set handle "reset"}
 78 |                 "A " {set handle "unadd"}
 79 |             }
 80 | 
 81 |             Insert "$status $handle:$files\n"
 82 |         }
 83 |     }
 84 | 
 85 |     close $f
 86 |     .t mark set insert 1.0
 87 |     Top
 88 |     Unmodified
 89 | 
 90 |     if {![file exists $git_root/.git/hooks/post-commit]} {
 91 |         file link -symbolic $git_root/.git/hooks/post-commit \
 92 |             $git_hook
 93 |     }
 94 | }
 95 | 
 96 | 
 97 | proc Git_Branch {} {
 98 |     global git_branch_op 
 99 |     .t delete 1.0 end
100 |     regexp {\* (\S+)} [exec git branch] _ cb
101 | 
102 |     if {$git_branch_op == "merge"} {
103 |         set txt [exec git branch -a --no-merged $cb]
104 |     } else {
105 |         set txt [exec git branch -a]
106 |     }
107 | 
108 |     set rev [exec git rev-parse --short HEAD]
109 |     Insert "\nGit branch [pwd]: $cb, rev: $rev\n\n"
110 |     
111 |     foreach b [split $txt "\n"] {
112 |         if {[regexp {^([* ])\s(\S+)$} $b _ current name]} {
113 |             if {$current == "*"} {
114 |                 Insert "* $name\n"
115 |             } elseif {[regexp {^remotes/} $name]} {
116 |                 Insert "  checkout:$name\n"
117 |             } else {
118 |                 Insert "  $git_branch_op:$name\n"
119 |             }
120 |         }
121 |     }
122 | 
123 |     Top
124 |     Unmodified
125 | }
126 | 
127 | 
128 | proc Git_FName {str} {
129 |     if {[regexp {^"([^"]+)"$} $str _ newname]} {
130 |         return $newname
131 |     }
132 | 
133 |     return $str
134 | }
135 | 
136 | 
137 | proc Git_UpdateStatus args {
138 |     global git_status_mode git_branch_op git_mode
139 | 
140 |     if {$git_mode == "branch"} {
141 |         set git_branch_op checkout
142 |         UpdateCommand CO Merge
143 |         Git_Branch
144 |     } else {
145 |         set git_status_mode diff
146 |         Git_Status
147 |     }
148 | }
149 | 
150 | AddToHook revert_hook Git_UpdateStatus
151 | 
152 | 
153 | DefineCommand {^Log$} {
154 |     global git_root git_lib_dir
155 | 
156 |     if {[catch [list send $git_root/+GitLog Git_Update]]} {
157 |         Ma -cd $git_root -execute $git_lib_dir/git-log.tcl \
158 |             -post-eval "Git_Log" -temporary \
159 |             -tag "$git_root/+GitLog New Del Cut Paste Snarf Get Look Stat | "
160 |     }    
161 | }
162 | 
163 | 
164 | DefineCommand {^Amend$} {
165 |     global exec_prefix
166 |     exec env GIT_EDITOR=$exec_prefix/ma git commit --amend &
167 | }
168 | 
169 | 
170 | DefineCommand {^Commit$} {
171 |     global exec_prefix
172 |     exec env GIT_EDITOR=$exec_prefix/ma git commit &
173 | }
174 | 
175 | 
176 | DefineCommand {^CommitAll$} {
177 |     global exec_prefix
178 |     exec env GIT_EDITOR=$exec_prefix/ma git commit -a &
179 | }
180 | 
181 | 
182 | DefineCommand {^Branch$} {
183 |     global git_mode git_branch_op
184 |     set git_mode "branch"
185 |     set git_branch_op checkout
186 |     UpdateCommand Status Branch
187 |     UpdateCommand Merge
188 |     UpdateCommand Push
189 |     UpdateCommand Pull
190 |     Git_Branch
191 | }
192 | 
193 | 
194 | DefineCommand {^Status$} {
195 |     global env git_mode
196 |     set git_mode "status"
197 |     UpdateCommand Branch Status 
198 |     UpdateCommand "" Merge
199 |     UpdateCommand "" Push
200 |     UpdateCommand "" Pull
201 |     Git_Status
202 | }
203 | 
204 | 
205 | DefineCommand {^Revert$} {
206 |     global git_status_mode
207 |     set git_status_mode revert
208 |     UpdateCommand Diff Revert
209 |     Git_Status
210 | }
211 | 
212 | 
213 | DefineCommand {^Diff$} {
214 |     global git_status_mode
215 |     set git_status_mode diff
216 |     UpdateCommand Revert Diff
217 |     Git_Status
218 | }
219 | 
220 | 
221 | DefinePlumbing {^diff:(.*)$} {
222 |     global env
223 |     set fname [Git_FName [GetArg 1]]
224 |     set dir [GetFileDir]
225 |     Ma -cd $dir -execute $env(HERE)/lib/ma/git-diff.tcl \
226 |         -post-eval "Git_Diff {$fname} 1" -temporary \
227 |         -tag "$dir/+Diff New Del Cut Paste Snarf Look Font Commit Add Invert | " 
228 |     return 1
229 | }
230 | 
231 | 
232 | DefinePlumbing {^reset:(.*)$} {
233 |     global env
234 |     set fname [Git_FName [GetArg 1]]
235 |     exec git reset -q -- $fname
236 |     Git_Status
237 |     return 1
238 | }
239 | 
240 | 
241 | DefinePlumbing {^revert:(.*)$} {
242 |     global env
243 |     set fname [Git_FName [GetArg 1]]
244 |     exec git checkout -- $fname
245 |     Git_Status
246 |     return 1
247 | }
248 | 
249 | 
250 | DefinePlumbing {^add:(.*)$} {
251 |     global env
252 |     set fname [Git_FName [GetArg 1]]
253 |     exec git add -- $fname
254 |     Git_Status
255 |     return 1
256 | }
257 | 
258 | 
259 | DefinePlumbing {^unadd:(.*)$} {
260 |     global env
261 |     set fname [Git_FName [GetArg 1]]
262 |     exec git reset -q -- $fname
263 |     Git_Status
264 |     return 1
265 | }
266 | 
267 | 
268 | DefineCommand {^Push$} {
269 |     regexp {\* (\S+)} [exec git branch] _ b    
270 |     InvokeExternalCommandInWindow "git push origin $b" 
271 |     Flash blue
272 | }
273 | 
274 | 
275 | DefineCommand {^Pull$} {
276 |     regexp {\* (\S+)} [exec git branch] _ b    
277 |     InvokeExternalCommandInWindow "git pull origin $b"
278 |     Flash blue
279 | }
280 | 
281 | 
282 | DefineCommand {^Merge$} {
283 |     global git_branch_op
284 |     UpdateCommand CO Merge
285 |     set git_branch_op merge
286 |     Git_Branch
287 | }
288 | 
289 | 
290 | DefineCommand {^CO$} {
291 |     global git_branch_op
292 |     UpdateCommand Merge CO
293 |     set git_branch_op checkout
294 |     Git_Branch
295 | }
296 | 
297 | 
298 | DefinePlumbing {^checkout:(.*)$} {
299 |     set name [GetArg 1]
300 |     InvokeExternalCommandInWindow "git checkout $name"
301 |     after 500 Git_Branch
302 | }
303 | 
304 | 
305 | DefinePlumbing {^merge:(.*)$} {
306 |     set name [GetArg 1]
307 |     InvokeExternalCommandInWindow "git merge $name"
308 |     after 500 Git_Branch
309 | }
310 | 


--------------------------------------------------------------------------------
/utils/git.tcl:
--------------------------------------------------------------------------------
 1 | # loader for minimal git(1) interface
 2 | 
 3 | 
 4 | if {![info exists git_lib_dir]} {
 5 |     set git_lib_dir $env(HERE)/lib/ma
 6 | }
 7 | 
 8 | 
 9 | proc Git_FindRoot {} {
10 |     set dir [pwd]
11 | 
12 |     while {![file exists $dir/.git]} {
13 |         if {$dir == "/"} {return ""}
14 | 
15 |         set dir [file dirname $dir]
16 |     }
17 | 
18 |     return $dir
19 | }
20 | 
21 | 
22 | DefineCommand {^Git$} {
23 |     global git_lib_dir
24 |     set dir [Git_FindRoot]
25 | 
26 |     if {$dir == ""} return
27 | 
28 |     if {![catch [list send $dir/+Git Git_Update]]} return
29 | 
30 |     Ma -cd $dir -execute $git_lib_dir/git-status.tcl -post-eval \
31 |         Git_Status -temporary \
32 |         -tag "$dir/+Git New Del Cut Paste Snarf Get Look Log Branch Commit CommitAll Amend Revert | "
33 | }
34 | 


--------------------------------------------------------------------------------
/utils/gopher:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env wish
  2 | #
  3 | # gopher client for MA
  4 | 
  5 | 
  6 | set download_loc $env(HOME)/tmp
  7 | set image_viewer I
  8 | set html_viewer viewhtml
  9 | set document_viewer P
 10 | set gopher_history $env(HOME)/.gopher_history
 11 | 
 12 | 
 13 | fconfigure stdout -translation lf
 14 | fconfigure stderr -translation lf
 15 | 
 16 | set ma ""
 17 | 
 18 | if {[info exists env(MA)]} {
 19 |     set ma $env(MA)
 20 | }
 21 | 
 22 | if {[info exists env(TMPDIR)]} {
 23 |     set tmpdir $env(TMPDIR)/
 24 | } else {
 25 |     set tmpdir "/tmp"
 26 | }
 27 | 
 28 | 
 29 | proc Usage {{code 1}} {
 30 |     puts stderr {usage: gopher [-h] [-type TYPE] [-sel SELECTOR] HOST [-port PORT] [-stdout] [-replace FLAG]}
 31 |     exit $code
 32 | }
 33 | 
 34 | 
 35 | set sel "/"
 36 | set host ""
 37 | set port 70
 38 | set type 1
 39 | set from ""
 40 | set replace 0
 41 | 
 42 | for {set i 0} {$i < $argc} {incr i} {
 43 |     set arg [lindex $argv $i]
 44 | 
 45 |     switch -regexp -- $arg {
 46 |         {^--?h(elp)?$} {Usage 0}
 47 |         {^-sel$} {
 48 |             incr i
 49 |             set sel [lindex $argv $i]
 50 |         }
 51 |         {^-port$} {
 52 |             incr i
 53 |             set port [lindex $argv $i]
 54 |         }
 55 |         {^-type$} {
 56 |             incr i
 57 |             set type [lindex $argv $i]
 58 |         }
 59 |         {^-from$} {
 60 |             incr i
 61 |             set from [lindex $argv $i]
 62 |         }
 63 |         {^-replace$} {
 64 |             incr i
 65 |             set replace [lindex $argv $i]
 66 |         }
 67 |         {^-stdout$} {set ma ""}
 68 |         {^-} Usage
 69 |         default {
 70 |             if {$host != ""} Usage
 71 | 
 72 |             set host $arg
 73 |         }
 74 |     }
 75 | }
 76 | 
 77 | if {[catch [list socket $host $port] io]} {
 78 |     exec echo "unable to connect to $host:$port" | ma-eval
 79 |     exit
 80 | }
 81 | 
 82 | set f [open $gopher_history a]
 83 | puts $f "⊳$host:$port=$type/$sel⊲"
 84 | close $f
 85 | 
 86 | fconfigure $io -translation crlf
 87 | puts $io $sel
 88 | flush $io
 89 | set processed "$tmpdir/[expr rand()].[clock seconds]"
 90 | 
 91 | 
 92 | proc ReadFile {{dec ""}} {
 93 |     global io processed
 94 |     set data [read $io]
 95 |     close $io
 96 |     
 97 |     if {$dec != ""} {
 98 |         exec $dec << $data > $processed
 99 |     } else {
100 |         set f [open $processed w]
101 |         puts $f $data
102 |         close $f
103 |     }
104 | 
105 |     OpenFile $processed
106 | }
107 | 
108 | 
109 | proc OpenFile {fname} {
110 |     global ma sel host port type from replace
111 | 
112 |     if {$ma != ""} {
113 |         set title "⊳$host:$port/$sel⊲"
114 | 
115 |         if {[string first " " $title] != -1} {
116 |             set title "'$title'"
117 |         }
118 | 
119 |         if {$replace && $from != ""} {
120 |             send $from UpdatePage "{$title}" "{$fname}"
121 |             after 250
122 |         } else {
123 |             exec ma -post-eval "UpdatePage \"$title\" \"$fname\"" &
124 |             after 250
125 |         }
126 |     } else {
127 |         exec cat $fname >@ stdout
128 |     }
129 | }
130 | 
131 | 
132 | proc SaveFile {prg} {
133 |     global io processed
134 |     fconfigure $io -translation binary -encoding binary
135 |     set f [open $processed w]
136 |     fconfigure $f -translation binary -encoding binary
137 |     fcopy $io $f
138 |     close $io
139 |     close $f
140 |     exec $prg $processed &
141 |     after 250
142 | }
143 | 
144 | 
145 | proc DownloadFile {{conv ""}} {
146 |     global io processed download_loc sel
147 |     fconfigure $io -translation binary -encoding binary
148 |     set f [open $processed w]
149 |     fconfigure $f -translation binary -encoding binary
150 |     fcopy $io $f
151 |     close $io
152 |     close $f
153 |     set fname "$download_loc/[file tail $sel]"
154 | 
155 |     if {$conv != ""} {
156 |         exec $conv < $processed > $fname
157 |     } else {
158 |         file rename $processed $fname
159 |     }
160 | 
161 |     exec echo "downloaded file to $fname" | ma-eval
162 | }
163 | 
164 | 
165 | proc ProcessFile {} {
166 |     global io processed
167 |     set data [read $io]
168 |     close $io
169 |     set f [open $processed w]
170 | 
171 |     foreach line [split $data "\n"] {
172 |         if {[regexp "^(.)(\[^\t\]*)\t(\[^\t\]*)\t(\[^\t\]+)\t(\\d+).*" $line _ type \
173 |             str sel host port]} {
174 |             if {$type == "i"} {
175 |                 puts $f $str
176 |             } elseif {$type == "3"} {
177 |                 puts $f "ERROR: $str"
178 |             } else {
179 |                 if {$port != 70} {
180 |                     set port ":$port"
181 |                 } else {
182 |                     set port ""
183 |                 }
184 | 
185 |                 if {$type == 7} {
186 |                     puts $f "⊳$host$port?$sel?…⊲\t$str"
187 |                 } else {
188 |                     if {$type != 1} {
189 |                         set type "=$type"
190 |                     } else {
191 |                         set type ""
192 |                     }
193 |     
194 |                     if {$sel != ""} {
195 |                         set sel "/$sel"
196 |                     } else {
197 |                         set sel ""
198 |                     }
199 |     
200 |                     puts $f "⊳$host$port$type$sel⊲\t$str"
201 |                 }
202 |             }
203 |         }
204 |     }
205 | 
206 |     close $f
207 |     OpenFile $processed
208 | }
209 | 
210 | 
211 | switch -exact -- $type {
212 |     g {SaveFile $image_viewer}
213 |     p {SaveFile $image_viewer}
214 |     P {SaveFile $image_viewer}
215 |     d {SaveFile $document_viewer}
216 |     6 {DownloadFile uudecode}
217 |     9 {DownloadFile}
218 |     5 {DownloadFile}
219 |     h {SaveFile $html_viewer}
220 |     1 ProcessFile
221 |     I {SaveFile $image_viewer}
222 |     default ReadFile
223 | }
224 | 
225 | file delete $processed
226 | exit
227 | 


--------------------------------------------------------------------------------
/utils/gopher.tcl:
--------------------------------------------------------------------------------
 1 | # gopher links and search
 2 | 
 3 | set gopher_history $env(HOME)/.gopher_history
 4 | 
 5 | proc GopherExecute {cmd ctxt} {
 6 |     if {[regexp {^⊳([^⊲]+)⊲$} $cmd]} {
 7 |         Plumb $cmd -a replace=1
 8 |         return 1
 9 |     }
10 | 
11 |     return ""
12 | }
13 | 
14 | AddToHook execute_hook GopherExecute
15 | 
16 | DefineCommand {^History$} {
17 |     global gopher_history
18 |     Ma $gopher_history -post-eval ReverseLines
19 | }
20 | 
21 | 
22 | proc UpdatePage {title fname} {
23 |     lassign [DeconsTag] old cmds rest
24 |     MakeTag "[pwd]/+Gopher" $cmds " $title"
25 |     Acme
26 |     ReplaceText $fname
27 |     UpdateCommand "History"
28 |     ToggleFont fix
29 | }
30 | 
31 | 
32 | proc ReverseLines {} {
33 |     set txt [.t get 1.0 end]
34 |     .t delete 1.0 end
35 |     set prev ""
36 |     
37 |     foreach ln [lreverse [split $txt "\n"]] {
38 |         if {$ln != "" && $ln != $prev} {
39 |             .t insert end "$ln\n"
40 |             set prev $ln
41 |         }
42 |     }
43 | 
44 |     Unmodified
45 |     .t mark set insert 1.0
46 |     .t see 1.0
47 | }
48 | 


--------------------------------------------------------------------------------
/utils/h:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | #
 3 | # grep in history
 4 | 
 5 | if test -z "$MA_HISTORY"; then
 6 |     exit
 7 | fi
 8 | 
 9 | keep="tail -n40"
10 | 
11 | case "$1" in
12 |     -a)
13 |         shift
14 |         keep=cat;;
15 |     -h)
16 |         echo "h [-h] [-a] [STRING]" >&2
17 |         exit;;
18 | esac
19 | 
20 | if test -z "$1"; then
21 |     exec tail -n30 $MA_HISTORY | sort | uniq
22 | else
23 |     exec grep -a "$@" $MA_HISTORY | sort | uniq | $keep
24 | fi
25 | 


--------------------------------------------------------------------------------
/utils/hooks.tcl:
--------------------------------------------------------------------------------
 1 | # run file-hook on matching name
 2 | 
 3 | 
 4 | set file_hooks {}
 5 | 
 6 | 
 7 | proc MatchFileHook {} {
 8 |     global file_hooks current_filename
 9 | 
10 |     foreach hook $file_hooks {
11 |         lassign $hook rx code
12 | 
13 |         if {[regexp $rx [file tail $current_filename]]} {
14 |             eval $code
15 |             return
16 |         }
17 |     }
18 | }
19 | 
20 | 
21 | AddToHook file_hook MatchFileHook
22 | 
23 | 
24 | proc AddFileHook {rx code {before 0}} {
25 |     global file_hooks
26 |     set item [list $rx $code]
27 | 
28 |     if {$before} {
29 |         set file_hooks [concat [list $item $file_hooks]]
30 |     } else {
31 |         lappend file_hooks $item
32 |     }
33 | }
34 | 


--------------------------------------------------------------------------------
/utils/ind:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/tclsh
 2 | #
 3 | # indent/unindent
 4 | #
 5 | # usage: ind [COLUMNS [TEXT]]
 6 | 
 7 | set c 4
 8 | set prefix ""
 9 | 
10 | if {$argc > 0} {
11 |     set c [lindex $argv 0]
12 | 
13 |     if {$argc > 1} {
14 |         set prefix [lindex $argv 1]
15 |     }
16 | }
17 | 
18 | if {[regexp {unind$} $argv0]} {
19 |     set c [expr -$c]
20 | }
21 | 
22 | if {$c > 0} {
23 |     append prefix [string repeat " " [expr $c - [string length $prefix]]]
24 | }
25 | 
26 | while {[gets stdin line] >= 0} {
27 |     if {$line == "" && [eof stdin]} break
28 | 
29 |     if {$c > 0} {
30 |         puts "$prefix$line"
31 |     } else {
32 |         puts [string range $line [expr -$c] end]
33 |     }
34 | }
35 | 
36 | 
37 | # TODO
38 | #
39 | # - tabs are not expanded, yet
40 | 


--------------------------------------------------------------------------------
/utils/irc.tcl:
--------------------------------------------------------------------------------
 1 | set irc_input_file [open in w]
 2 | 
 3 | source ~/code/ma/utils/colors/mono.tcl
 4 | Mono
 5 | 
 6 | wm title . [file tail [pwd]]
 7 | text .e -height 1
 8 | pack .e -fill x
 9 | 
10 | bind .e <Return> {
11 |     set input [.e get "insert linestart" "insert lineend"]
12 | 
13 |     if {[regexp {^/me (.*)} "$input" _ text]} {
14 |         puts $irc_input_file "\x01ACTION $text\x01"
15 |     } else {
16 |         puts $irc_input_file "$input"
17 |     }
18 | 
19 |     flush $irc_input_file
20 |     .e delete 1.0 end
21 | }
22 | 


--------------------------------------------------------------------------------
/utils/mark.tcl:
--------------------------------------------------------------------------------
 1 | # support for marks
 2 | #
 3 | # Command: Mark [:ADDR|REGEX]
 4 | #
 5 | # TODO: add unmarking
 6 | 
 7 | 
 8 | proc MarkConfiguration {conf} {
 9 |     eval .t tag configure mark $conf
10 | }
11 | 
12 | 
13 | MarkConfiguration "-background magenta -foreground black"
14 | .t tag lower mark
15 | 
16 | 
17 | proc MarkRegexp {rx} {
18 |     set pos 1.0
19 | 
20 |     while 1 {
21 |         set pos2 [.t search -regexp -- $rx $pos end]
22 | 
23 |         if {$pos2 == ""} return
24 |         
25 |         # XXX currently only considers whole line
26 |         if {[regexp -indices -- $rx [.t get $pos2 "$pos2 lineend"] all]} {
27 |             set len [expr 1 + [lindex $all 1]]
28 |             set fin "$pos2 + $len chars"
29 |             .t tag add mark $pos2 $fin
30 |             set pos $fin
31 |         } else return
32 |     }
33 | }
34 | 
35 | 
36 | proc MarkAt {{addr "."}} {
37 |     set sel [GetEffectiveSelection .t]
38 | 
39 |     if {$sel != ""} {
40 |         eval .t tag add mark $sel
41 |         RemoveSelection .t
42 |     } else {
43 |         lassign [AddrIndices $addr] p1 p2
44 | 
45 |         if {$p1 != ""} {
46 |             if {$p2 == ""} {
47 |                 set p2 "$p1 lineend"
48 |             }
49 | 
50 |             .t tag add mark $p1 $p2
51 |         }
52 |     }
53 | }
54 | 
55 | 
56 | proc Unmark {} {
57 |     .t tag remove mark 1.0 end
58 | }
59 | 
60 | 
61 | DefineCommand {^Mark\s+([^:].+)$} {MarkRegexp [GetArg]}
62 | DefineCommand {^Mark\s+:(.+)$} {MarkAt [GetArg]}
63 | DefineCommand {^Mark$} MarkAt
64 | DefineCommand {^Unmark$} Unmark
65 | 


--------------------------------------------------------------------------------
/utils/post-commit:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env wish
 2 | #
 3 | # git commit hook to update status view
 4 | 
 5 | 
 6 | set root [pwd]
 7 | 
 8 | while {![file exists $root/.git]} {
 9 |   if {$root == "/"} {
10 |      error "not in git repository"
11 |      exit 1
12 |   }
13 | 
14 |   set root [file dirname $root]
15 | }
16 | 
17 | if {$root == ""} {
18 |    error "not in git repository"
19 |    exit 1
20 | }
21 | 
22 | catch [list send $root/+Git Git_Update]
23 | exit
24 | 


--------------------------------------------------------------------------------
/utils/project.tcl:
--------------------------------------------------------------------------------
 1 | # "project" files
 2 | 
 3 | 
 4 | set project_file_name ".ma.p"
 5 | set project 0
 6 | 
 7 | 
 8 | proc SourceProjectFile {} {  
 9 |     global project project_file_name
10 |     set fname [GetFilename]
11 | 
12 |     if {$fname == ""} return
13 | 
14 |     if {[file exists $fname]} {
15 |         if {[file type $fname] == "directory"} {
16 |             set dir $fname
17 |         } else {
18 |             set dir [file dirname $fname]
19 |         }
20 | 
21 |         if {!$project} {
22 |             while {$dir != "/"} {
23 |                 set pfile "$dir/$project_file_name"
24 |     
25 |                 if {[file exists $pfile]} {
26 |                     set project 1
27 |     
28 |                     if {[catch [list uplevel #0 source $pfile]]} {
29 |                         Flash red
30 |                     }
31 |     
32 |                     return
33 |                 }
34 |     
35 |                 set dir [file dirname $dir]
36 |             }
37 |         }
38 |     }
39 | }
40 | 
41 | 
42 | AddToHook name_hook SourceProjectFile
43 | 


--------------------------------------------------------------------------------
/utils/savedstate.tcl:
--------------------------------------------------------------------------------
 1 | # save current configuration when saving file and reload on open
 2 | 
 3 | 
 4 | set config_file_dir $env(HOME)/.ma_state
 5 | file mkdir $config_file_dir
 6 | 
 7 | 
 8 | proc SaveConfiguration {fname realname} {
 9 |     global current_background current_foreground current_font 
10 |     global current_variable_font current_font_size current_font_style
11 |     global tag_foreground tag_background selection_foreground 
12 |     global selection_background indent_mode
13 |     global sbar_color sbar_background pseudo_selection_foreground 
14 |     global pseudo_selection_background
15 |     global file_encoding file_translation
16 |     global inactive_selection_background current_fixed_font
17 |     global focus_color nonfocus_color tabwidth include_path
18 |     set f [open $fname w]
19 |     puts $f "# $realname"
20 |     puts $f "set current_foreground \"$current_foreground\""
21 |     puts $f "set current_background \"$current_background\""
22 |     puts $f "set current_font \"$current_font\""
23 |     puts $f "set current_variable_font \"$current_variable_font\""
24 |     puts $f "set current_fixed_font \"$current_fixed_font\""
25 |     puts $f "set current_font_size \"$current_font_size\""
26 |     puts $f "set tag_foreground \"$tag_foreground\""
27 |     puts $f "set tag_background \"$tag_background\""
28 |     puts $f "set selection_foreground \"$selection_foreground\""
29 |     puts $f "set selection_background \"$selection_background\""
30 |     puts $f "set sbar_color \"$sbar_color\""
31 |     puts $f "set sbar_background \"$sbar_background\""
32 |     puts $f "set pseudo_selection_foreground \"$pseudo_selection_foreground\""
33 |     puts $f "set pseudo_selection_background \"$pseudo_selection_background\""
34 |     puts $f "set file_encoding $file_encoding"
35 |     puts $f "set file_translation $file_translation"
36 |     puts $f "set inactive_selection_background \"$inactive_selection_background\""
37 |     puts $f "set focus_color \"$focus_color\""
38 |     puts $f "set nonfocus_color \"$nonfocus_color\""
39 |     puts $f "set tabwidth $tabwidth"
40 |     puts $f "set include_path {$include_path}"
41 |     puts $f "set indent_mode $indent_mode"
42 |     close $f
43 | }
44 | 
45 | 
46 | proc LoadConfiguration {fname} {
47 |     uplevel #0 source $fname
48 |     ConfigureWindow 0
49 | }
50 | 
51 | 
52 | proc MangleConfigFilename {fname} {
53 |     global config_file_dir
54 |     return $config_file_dir/[MangleFilename $fname]
55 | }
56 | 
57 | 
58 | proc SaveCurrentConfig {} {
59 |     global current_filename
60 | 
61 |     if {$current_filename != ""} {
62 |         SaveConfiguration [MangleConfigFilename $current_filename] $current_filename
63 |     }
64 | }
65 | 
66 | 
67 | proc LoadCurrentConfig {} {
68 |     global current_filename 
69 | 
70 |     if {$current_filename != ""} {
71 |         set fname [MangleConfigFilename $current_filename]
72 | 
73 |         if {[file exists $fname]} {
74 |             LoadConfiguration $fname
75 |         }
76 |     }
77 | }
78 | 
79 | 
80 | AddToHook save_hook SaveCurrentConfig
81 | AddToHook file_hook LoadCurrentConfig
82 | 


--------------------------------------------------------------------------------
/utils/scheme-indent.tcl:
--------------------------------------------------------------------------------
  1 | # another attempt at lisp-indentation
  2 | #
  3 | # Command: SchemeIndent
  4 | 
  5 | 
  6 | set block_forms {
  7 |     when unless let let\* letrec letrec\* for-each map case set! else
  8 |     with-input-from-file with-output-to-file call-with-\* and-let\*
  9 |     lambda  append-map match match-let match-let\* match-lambda
 10 |     with-\* handle-exceptions begin fluid-let parameterize match-lambda\*
 11 |     match-letrec define(-[a-z0-9]+)? receive syntax-rules
 12 |     er-macro-transformer ir-macro-transformer bitmatch bitconstruct
 13 |     bitpacket dotimes condition-case
 14 | }
 15 | 
 16 | set control_forms {
 17 |     cond and or if
 18 | }
 19 | 
 20 | set scheme_indent 0
 21 | 
 22 | 
 23 | proc ScanBackwards {pos} {
 24 |     set i 0
 25 | 
 26 |     while 1 {
 27 |         set c [.t get $pos]
 28 | 
 29 |         switch -exact -- $c {
 30 |             ")" {incr i}
 31 |             "(" {
 32 |                 if {$i == 0} {return $pos}
 33 | 
 34 |                 set i [expr $i - 1]
 35 |             }
 36 |         }
 37 | 
 38 |         if {$pos == "1.0"} {return $pos}
 39 | 
 40 |         set pos [.t index "$pos - 1 chars"]
 41 |     }
 42 | }
 43 | 
 44 | 
 45 | proc SchemeIndentBlock {rng} {
 46 |     lassign $rng from to
 47 |     regexp {^(\d+)\.} $from _ fromline
 48 |     regexp {^(\d+)\.} $to _ toline
 49 |     focus .t
 50 |     
 51 |     for {set line [expr $fromline + 1]} {$line <= $toline} {incr line} {
 52 |         .t mark set insert $line.0
 53 |         SchemeIndentLine
 54 |     }
 55 | }
 56 | 
 57 | 
 58 | proc SchemeIndentLine {} {
 59 |     global block_forms control_forms
 60 | 
 61 |     if {[GetFocusWidget] != ".t"} return
 62 | 
 63 |     set pos [.t index "insert linestart - 1 chars"]
 64 |     set front [ScanBackwards $pos]
 65 |     set pline [.t get "$front + 1 chars" "$front lineend"]
 66 |     set tab 0
 67 | 
 68 |     if {[regexp {^\s*(\(|\s*$)} $pline] && $front != "1.0"} {
 69 |         set tab 1
 70 |     } else {
 71 |         foreach item $block_forms {
 72 |             if {[regexp "^\\s*${item}(\\M|\\s+|\$)" $pline]} {
 73 |                 set tab 2
 74 |                 break
 75 |             }
 76 |         }
 77 | 
 78 |         foreach item $control_forms {
 79 |             if {[regexp "^\\s*${item}(\\M|\\s+|\$)" $pline]} {
 80 |                 set tab [expr 2 + [string length $item]]
 81 |                 break
 82 |             }
 83 |         }
 84 | 
 85 |         if {!$tab} {
 86 |             if {![string match "*.0" $front]} {
 87 |                 regexp {^\S*} $pline head
 88 |                 set tab [expr [string length $head] + 2]
 89 |             }
 90 |         }
 91 |     }
 92 | 
 93 |     set line [.t get "insert linestart" "insert lineend"]
 94 | 
 95 |     if {![regexp {^\s+} $line head]} {
 96 |         set head ""
 97 |     }
 98 | 
 99 |     regexp {^\d+\.(\d+)$} $front _ col
100 |     set len [string length $head]
101 |     # set nhead [string map { "        " "\t" } [string repeat " " [expr $col + $tab]]]
102 |     set nhead [string repeat " " [expr $col + $tab]]
103 |     .t replace "insert linestart" "insert linestart + $len chars" $nhead
104 | }
105 | 
106 | 
107 | proc SchemeIndent {} {
108 |     global indent_mode scheme_indent
109 | 
110 |     if {$scheme_indent} {
111 |         set range [.t tag ranges sel]
112 | 
113 |         if {$range != ""} {
114 |             SchemeIndentBlock $range
115 |         }
116 | 
117 |         return
118 |     }
119 | 
120 |     Flash blue
121 |     set scheme_indent 1
122 |     set indent_mode 1
123 |     DefineKey <Tab> {SchemeIndentLine; break}
124 |     DefineKey <Return> {    
125 |         global current_translation
126 |         set fw [GetFocusWidget]
127 | 
128 |         if {$current_translation == "crnl"} {
129 |             set nl "\r\n"
130 |         } else {
131 |             set nl "\n"
132 |         }
133 | 
134 |         if {$fw == ".t"} {
135 |             Insert $nl
136 |             SchemeIndentLine
137 |         } else {
138 |             $fw insert insert $nl
139 |         }
140 | 
141 |         break
142 |     }
143 | }
144 | 
145 | 
146 | DefineCommand {^SchemeIndent$} SchemeIndent
147 | 


--------------------------------------------------------------------------------
/utils/snip:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env tclsh
 2 | #
 3 | # output selected snippet via dmenu(1) or output unicode codepoint
 4 | 
 5 | 
 6 | # Modify as appropriate
 7 | set snippetfile $env(HERE)/lib/snippets.tcl
 8 | set menufont "-misc-fixed-bold-r-normal--18-120-100-100-c-90-iso8859-1"
 9 | 
10 | set snippets {}
11 | 
12 | source $snippetfile
13 | 
14 | set names {}
15 | 
16 | foreach s $snippets {
17 |     append names "\n" [lindex $s 0]
18 | }
19 | 
20 | if {[string length $names] > 0} {
21 |     if {![catch {exec dmenu -b -fn $menufont -nf yellow -nb brown -sb \
22 |         white -sf orange << $names} result]} {
23 |         set result [string trim $result]
24 | 
25 |         foreach s $snippets {
26 |             if {$result == [lindex $s 0]} {
27 |                 puts [lindex $s 1]
28 |                 exit
29 |             }
30 |         }
31 | 
32 |         catch {
33 |             set c [format "%c" [scan $result "%x"]]
34 |             puts $c
35 |         }
36 |     }
37 | }
38 | 


--------------------------------------------------------------------------------
/utils/snippets.tcl:
--------------------------------------------------------------------------------
  1 | # in part taken from /lib/keyboard from Plan 9
  2 | 
  3 | set snippets {
  4 |   {"apqq" "⍞"}
  5 |   {"apsq" "⌷"}
  6 |   {"apqj" "⌻"}
  7 |   {"apqd" "⍌"}
  8 |   {"[]" "⌷"}
  9 |   {"!!" "¡"}
 10 |   {"c$" "¢"}
 11 |   {"l$" "£"}
 12 |   {"g$" "¤"}
 13 |   {"y$" "¥"}
 14 |   {"||" "¦"}
 15 |   {"SS" "§"}
 16 |   {"\"" "¨"}
 17 |   {"Oc" "©"}
 18 |   {"sa" "ª"}
 19 |   {"<<" "«"}
 20 |   {"no" "¬"}
 21 |   {"--" "­"}
 22 |   {"Or" "®"}
 23 |   {"__" "¯"}
 24 |   {"de" "°"}
 25 |   {"+-" "±"}
 26 |   {"s2" "²"}
 27 |   {"s3" "³"}
 28 |   {"''" "´"}
 29 |   {"mi" "µ"}
 30 |   {"pg" "¶"}
 31 |   {".." "·"}
 32 |   {",," "¸"}
 33 |   {"s1" "¹"}
 34 |   {"so" "º"}
 35 |   {">>" "»"}
 36 |   {"14" "¼"}
 37 |   {"12" "½"}
 38 |   {"34" "¾"}
 39 |   {"??" "¿"}
 40 |   {"`A" "À"}
 41 |   {"'A" "Á"}
 42 |   {"^A" "Â"}
 43 |   {"~A" "Ã"}
 44 |   {"\"A" "Ä"}
 45 |   {"oA" "Å"}
 46 |   {"AE" "Æ"}
 47 |   {",C" "Ç"}
 48 |   {"`E" "È"}
 49 |   {"'E" "É"}
 50 |   {"^E" "Ê"}
 51 |   {"\"E" "Ë"}
 52 |   {"`I" "Ì"}
 53 |   {"'I" "Í"}
 54 |   {"^I" "Î"}
 55 |   {"\"I" "Ï"}
 56 |   {"-D" "Ð"}
 57 |   {"~N" "Ñ"}
 58 |   {"`O" "Ò"}
 59 |   {"'O" "Ó"}
 60 |   {"^O" "Ô"}
 61 |   {"~O" "Õ"}
 62 |   {"\"O" "Ö"}
 63 |   {"mu" "×"}
 64 |   {"/O" "Ø"}
 65 |   {"`U" "Ù"}
 66 |   {"'U" "Ú"}
 67 |   {"^U" "Û"}
 68 |   {"\"U" "Ü"}
 69 |   {"'Y" "Ý"}
 70 |   {"|P" "Þ"}
 71 |   {"ss" "ß"}
 72 |   {"`a" "à"}
 73 |   {"'a" "á"}
 74 |   {"^a" "â"}
 75 |   {"~a" "ã"}
 76 |   {"\"a" "ä"}
 77 |   {"oa" "å"}
 78 |   {"ae" "æ"}
 79 |   {",c" "ç"}
 80 |   {"`e" "è"}
 81 |   {"'e" "é"}
 82 |   {"^e" "ê"}
 83 |   {"\"e" "ë"}
 84 |   {"`i" "ì"}
 85 |   {"'i" "í"}
 86 |   {"^i" "î"}
 87 |   {"\"i" "ï"}
 88 |   {"-d" "ð"}
 89 |   {"~n" "ñ"}
 90 |   {"`o" "ò"}
 91 |   {"'o" "ó"}
 92 |   {"^o" "ô"}
 93 |   {"~o" "õ"}
 94 |   {"\"o" "ö"}
 95 |   {"-:" "÷"}
 96 |   {"/o" "ø"}
 97 |   {"`u" "ù"}
 98 |   {"'u" "ú"}
 99 |   {"^u" "û"}
100 |   {"\"u" "ü"}
101 |   {"'y" "ý"}
102 |   {"|p" "þ"}
103 |   {"\"y" "ÿ"}
104 |   {"_A" "Ā"}
105 |   {"_a" "ā"}
106 |   {"uA" "Ă"}
107 |   {",A" "Ą"}
108 |   {",a" "ą"}
109 |   {"'C" "Ć"}
110 |   {"'c" "ć"}
111 |   {"^C" "Ĉ"}
112 |   {"^c" "ĉ"}
113 |   {".C" "Ċ"}
114 |   {".c" "ċ"}
115 |   {"vC" "Č"}
116 |   {"vc" "č"}
117 |   {"vD" "Ď"}
118 |   {"vd" "ď"}
119 |   {"_E" "Ē"}
120 |   {"_e" "ē"}
121 |   {"uE" "Ĕ"}
122 |   {"ue" "ĕ"}
123 |   {".E" "Ė"}
124 |   {".e" "ė"}
125 |   {",E" "Ę"}
126 |   {",e" "ę"}
127 |   {"vE" "Ě"}
128 |   {"ve" "ě"}
129 |   {"^G" "Ĝ"}
130 |   {"^g" "ĝ"}
131 |   {"uG" "Ğ"}
132 |   {"ug" "ğ"}
133 |   {".G" "Ġ"}
134 |   {".g" "ġ"}
135 |   {",G" "Ģ"}
136 |   {"'g" "ģ"}
137 |   {"^H" "Ĥ"}
138 |   {"^h" "ĥ"}
139 |   {"-H" "Ħ"}
140 |   {"~I" "Ĩ"}
141 |   {"~i" "ĩ"}
142 |   {"_I" "Ī"}
143 |   {"_i" "ī"}
144 |   {"uI" "Ĭ"}
145 |   {"ui" "ĭ"}
146 |   {",I" "Į"}
147 |   {",i" "į"}
148 |   {".I" "İ"}
149 |   {"i" "ı"}
150 |   {"IJ" "IJ"}
151 |   {"ij" "ij"}
152 |   {"^J" "Ĵ"}
153 |   {"^j" "ĵ"}
154 |   {",K" "Ķ"}
155 |   {",k" "ķ"}
156 |   {"'L" "Ĺ"}
157 |   {"'l" "ĺ"}
158 |   {",L" "Ļ"}
159 |   {",l" "ļ"}
160 |   {"vL" "Ľ"}
161 |   {"vl" "ľ"}
162 |   {".L" "Ŀ"}
163 |   {".l" "ŀ"}
164 |   {"-L" "Ł"}
165 |   {"-l" "ł"}
166 |   {"'N" "Ń"}
167 |   {"'n" "ń"}
168 |   {",N" "Ņ"}
169 |   {",n" "ņ"}
170 |   {"vN" "Ň"}
171 |   {"vn" "ň"}
172 |   {"_O" "Ō"}
173 |   {"_o" "ō"}
174 |   {"uO" "Ŏ"}
175 |   {"uo" "ŏ"}
176 |   {"OE" "Œ"}
177 |   {"oe" "œ"}
178 |   {"'R" "Ŕ"}
179 |   {"'r" "ŕ"}
180 |   {",R" "Ŗ"}
181 |   {",r" "ŗ"}
182 |   {"vR" "Ř"}
183 |   {"vr" "ř"}
184 |   {"'S" "Ś"}
185 |   {"'s" "ś"}
186 |   {"^S" "Ŝ"}
187 |   {"^s" "ŝ"}
188 |   {",S" "Ş"}
189 |   {",s" "ş"}
190 |   {"vS" "Š"}
191 |   {"vs" "š"}
192 |   {",T" "Ţ"}
193 |   {",t" "ţ"}
194 |   {"vT" "Ť"}
195 |   {"vt" "ť"}
196 |   {"-T" "Ŧ"}
197 |   {"-t" "ŧ"}
198 |   {"~U" "Ũ"}
199 |   {"~u" "ũ"}
200 |   {"_U" "Ū"}
201 |   {"_u" "ū"}
202 |   {"uU" "Ŭ"}
203 |   {"uu" "ŭ"}
204 |   {"oU" "Ů"}
205 |   {"ou" "ů"}
206 |   {",U" "Ų"}
207 |   {",u" "ų"}
208 |   {"^W" "Ŵ"}
209 |   {"^w" "ŵ"}
210 |   {"^Y" "Ŷ"}
211 |   {"^y" "ŷ"}
212 |   {"\"Y" "Ÿ"}
213 |   {"'Z" "Ź"}
214 |   {"'z" "ź"}
215 |   {".Z" "Ż"}
216 |   {".z" "ż"}
217 |   {"vZ" "Ž"}
218 |   {"vz" "ž"}
219 |   {"-b" "ƀ"}
220 |   {"$f" "ƒ"}
221 |   {"hv" "ƕ"}
222 |   {"-I" "Ɨ"}
223 |   {"-*l" "ƛ"}
224 |   {"OI" "Ƣ"}
225 |   {"oi" "ƣ"}
226 |   {"YR" "Ʀ"}
227 |   {"$V" "Ʋ"}
228 |   {"-Z" "Ƶ"}
229 |   {"-z" "ƶ"}
230 |   {"-2" "ƻ"}
231 |   {"DvZ" "DŽ"}
232 |   {"Dvz" "Dž"}
233 |   {"dvz" "dž"}
234 |   {"LJ" "LJ"}
235 |   {"Lj" "Lj"}
236 |   {"lj" "lj"}
237 |   {"NJ" "NJ"}
238 |   {"Nj" "Nj"}
239 |   {"nj" "nj"}
240 |   {"vA" "Ǎ"}
241 |   {"va" "ǎ"}
242 |   {"vI" "Ǐ"}
243 |   {"vi" "ǐ"}
244 |   {"vO" "Ǒ"}
245 |   {"vo" "ǒ"}
246 |   {"vU" "Ǔ"}
247 |   {"vu" "ǔ"}
248 |   {"_\"U" "Ǖ"}
249 |   {"_\"u" "ǖ"}
250 |   {"'\"U" "Ǘ"}
251 |   {"'\"u" "ǘ"}
252 |   {"v\"U" "Ǚ"}
253 |   {"v\"u" "ǚ"}
254 |   {"`\"U" "Ǜ"}
255 |   {"`\"u" "ǜ"}
256 |   {"_\"A" "Ǟ"}
257 |   {"_\"a" "ǟ"}
258 |   {"_.A" "Ǡ"}
259 |   {"_.a" "ǡ"}
260 |   {"-G" "Ǥ"}
261 |   {"-g" "ǥ"}
262 |   {"vG" "Ǧ"}
263 |   {"vg" "ǧ"}
264 |   {"vK" "Ǩ"}
265 |   {"vk" "ǩ"}
266 |   {",O" "Ǫ"}
267 |   {",o" "ǫ"}
268 |   {"_,O" "Ǭ"}
269 |   {"_,o" "ǭ"}
270 |   {"vj" "ǰ"}
271 |   {"$a" "ɑ"}
272 |   {"-i" "ɨ"}
273 |   {"-u" "ʉ"}
274 |   {"$v" "ʋ"}
275 |   {"dz" "ʣ"}
276 |   {"*A" "Α"}
277 |   {"*B" "Β"}
278 |   {"*G" "Γ"}
279 |   {"*D" "Δ"}
280 |   {"*E" "Ε"}
281 |   {"*Z" "Ζ"}
282 |   {"*Y" "Η"}
283 |   {"*H" "Θ"}
284 |   {"*I" "Ι"}
285 |   {"*K" "Κ"}
286 |   {"*L" "Λ"}
287 |   {"*M" "Μ"}
288 |   {"*N" "Ν"}
289 |   {"*C" "Ξ"}
290 |   {"*O" "Ο"}
291 |   {"*P" "Π"}
292 |   {"*R" "Ρ"}
293 |   {"*S" "Σ"}
294 |   {"*T" "Τ"}
295 |   {"*U" "Υ"}
296 |   {"*F" "Φ"}
297 |   {"*X" "Χ"}
298 |   {"*Q" "Ψ"}
299 |   {"*W" "Ω"}
300 |   {"\"*I" "Ϊ"}
301 |   {"\"*U" "Ϋ"}
302 |   {"*a" "α"}
303 |   {"*b" "β"}
304 |   {"*g" "γ"}
305 |   {"*d" "δ"}
306 |   {"*e" "ε"}
307 |   {"*z" "ζ"}
308 |   {"*y" "η"}
309 |   {"*h" "θ"}
310 |   {"*i" "ι"}
311 |   {"*k" "κ"}
312 |   {"*l" "λ"}
313 |   {"*m" "μ"}
314 |   {"*n" "ν"}
315 |   {"*c" "ξ"}
316 |   {"*o" "ο"}
317 |   {"*p" "π"}
318 |   {"*r" "ρ"}
319 |   {"ts" "ς"}
320 |   {"*s" "σ"}
321 |   {"*t" "τ"}
322 |   {"*u" "υ"}
323 |   {"*f" "φ"}
324 |   {"*x" "χ"}
325 |   {"*q" "ψ"}
326 |   {"*w" "ω"}
327 |   {"\"*i" "ϊ"}
328 |   {"\"*u" "ϋ"}
329 |   {"$*h" "ϑ"}
330 |   {"$*f" "ϕ"}
331 |   {"$*k" "ϰ"}
332 |   {"l'" "‘"}
333 |   {"r'" "’"}
334 |   {"l\"" "“"}
335 |   {"r\"" "”"}
336 |   {"dg" "†"}
337 |   {"dd" "‡"}
338 |   {"bu" "•"}
339 |   {"1." "․"}
340 |   {"2." "‥"}
341 |   {"3." "…"}
342 |   {"!?" "‽"}
343 |   {"s0" "⁰"}
344 |   {"s4" "⁴"}
345 |   {"s5" "⁵"}
346 |   {"s6" "⁶"}
347 |   {"s7" "⁷"}
348 |   {"s8" "⁸"}
349 |   {"s9" "⁹"}
350 |   {"s+" "⁺"}
351 |   {"s-" "⁻"}
352 |   {"s=" "⁼"}
353 |   {"s(" "⁽"}
354 |   {"s)" "⁾"}
355 |   {"sn" "ⁿ"}
356 |   {"en" "–"}
357 |   {"em" "—"}
358 |   {"b0" "₀"}
359 |   {"b1" "₁"}
360 |   {"b2" "₂"}
361 |   {"b3" "₃"}
362 |   {"b4" "₄"}
363 |   {"b5" "₅"}
364 |   {"b6" "₆"}
365 |   {"b7" "₇"}
366 |   {"b8" "₈"}
367 |   {"b9" "₉"}
368 |   {"b+" "₊"}
369 |   {"b-" "₋"}
370 |   {"b=" "₌"}
371 |   {"b(" "₍"}
372 |   {"b)" "₎"}
373 |   {"e$" "€"}
374 |   {"CC" "ℂ"}
375 |   {"$g" "ℊ"}
376 |   {"$H" "ℋ"}
377 |   {"HH" "ℍ"}
378 |   {"-h" "ℏ"}
379 |   {"$I" "ℐ"}
380 |   {"$L" "ℒ"}
381 |   {"$l" "ℓ"}
382 |   {"NN" "ℕ"}
383 |   {"Op" "℗"}
384 |   {"$p" "℘"}
385 |   {"PP" "ℙ"}
386 |   {"QQ" "ℚ"}
387 |   {"$R" "ℛ"}
388 |   {"RR" "ℝ"}
389 |   {"tm" "™"}
390 |   {"ZZ" "ℤ"}
391 |   {"$B" "ℬ"}
392 |   {"$e" "ℯ"}
393 |   {"$E" "ℰ"}
394 |   {"$F" "ℱ"}
395 |   {"$M" "ℳ"}
396 |   {"$o" "ℴ"}
397 |   {"13" "⅓"}
398 |   {"23" "⅔"}
399 |   {"15" "⅕"}
400 |   {"25" "⅖"}
401 |   {"35" "⅗"}
402 |   {"45" "⅘"}
403 |   {"16" "⅙"}
404 |   {"56" "⅚"}
405 |   {"18" "⅛"}
406 |   {"38" "⅜"}
407 |   {"58" "⅝"}
408 |   {"78" "⅞"}
409 |   {"<-" "←"}
410 |   {"ua" "↑"}
411 |   {"->" "→"}
412 |   {"da" "↓"}
413 |   {"ab" "↔"}
414 |   {"V=" "⇐"}
415 |   {"=V" "⇒"}
416 |   {"fa" "∀"}
417 |   {"pd" "∂"}
418 |   {"te" "∃"}
419 |   {"es" "∅"}
420 |   {"De" "∆"}
421 |   {"gr" "∇"}
422 |   {"mo" "∈"}
423 |   {"!m" "∉"}
424 |   {"st" "∍"}
425 |   {"pr" "∏"}
426 |   {"su" "∑"}
427 |   {"-+" "∓"}
428 |   {"**" "∗"}
429 |   {"sr" "√"}
430 |   {"pt" "∝"}
431 |   {"if" "∞"}
432 |   {"an" "∠"}
433 |   {"l&" "∧"}
434 |   {"l|" "∨"}
435 |   {"ca" "∩"}
436 |   {"cu" "∪"}
437 |   {"is" "∫"}
438 |   {"tf" "∴"}
439 |   {"-~" "≂"}
440 |   {"~-" "≃"}
441 |   {"!~-" "≄"}
442 |   {"cg" "≅"}
443 |   {"~!=" "≆"}
444 |   {"!~=" "≇"}
445 |   {"~~" "≈"}
446 |   {"!~~" "≉"}
447 |   {":=" "≔"}
448 |   {"=:" "≕"}
449 |   {"!=" "≠"}
450 |   {"==" "≡"}
451 |   {"<=" "≤"}
452 |   {">=" "≥"}
453 |   {"<!=" "≨"}
454 |   {">!=" "≩"}
455 |   {"!<" "≮"}
456 |   {"!>" "≯"}
457 |   {"<~" "≲"}
458 |   {">~" "≳"}
459 |   {"<>" "≶"}
460 |   {"><" "≷"}
461 |   {"sb" "⊂"}
462 |   {"sp" "⊃"}
463 |   {"!b" "⊄"}
464 |   {"!p" "⊅"}
465 |   {"ib" "⊆"}
466 |   {"ip" "⊇"}
467 |   {"+O" "⊕"}
468 |   {"-O" "⊖"}
469 |   {"Ox" "⊗"}
470 |   {"O/" "⊘"}
471 |   {"O|" "⌽"}
472 |   {"O\\" "⍉"}
473 |   {".O" "⊙"}
474 |   {"Oo" "⊚"}
475 |   {"O*" "⊛"}
476 |   {"=O" "⊜"}
477 |   {"tu" "⊢"}
478 |   {"Tu" "⊨"}
479 |   {"L&" "⋀"}
480 |   {"L|" "⋁"}
481 |   {"CA" "⋂"}
482 |   {"CU" "⋃"}
483 |   {"lz" "⋄"}
484 |   {"=<" "⋜"}
485 |   {"=>" "⋝"}
486 |   {"<!~" "⋦"}
487 |   {">!~" "⋧"}
488 |   {"el" "⋯"}
489 |   {"b" "␣"}
490 |   {":(" "☹"}
491 |   {":)" "☺"}
492 |   {"wk" "♔"}
493 |   {"wq" "♕"}
494 |   {"wr" "♖"}
495 |   {"wb" "♗"}
496 |   {"wn" "♘"}
497 |   {"wp" "♙"}
498 |   {"bk" "♚"}
499 |   {"bq" "♛"}
500 |   {"br" "♜"}
501 |   {"bb" "♝"}
502 |   {"bn" "♞"}
503 |   {"bp" "♟"}
504 |   {"M4" "♩"}
505 |   {"a" "♪"}
506 |   {"d" "♭"}
507 |   {"e" "♮"}
508 |   {"f" "♯"}
509 |   {"q" "⎕"}
510 |   {"o" "∘"}
511 |   {"x" "×"}
512 |   {"to" "⍎"}
513 |   {"[|" "⟦"}
514 |   {"|]" "⟧"}
515 |   {"sk" "☠"}
516 |   {"+>" "⇸"}
517 |   {"<+" "⇷"}
518 |   {"bl" "∎"}
519 |   {"==>" "⇒"}
520 |   {"tup" "⊤"}
521 |   {"tdn" "⊥"}
522 | }
523 | 


--------------------------------------------------------------------------------
/utils/unquote:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env tclsh
 2 | #
 3 | # takes mail and quotes/unquotes body
 4 | 
 5 | 
 6 | set mode quote
 7 | set qchar ">"
 8 | 
 9 | if {$argc > 0} {
10 |     set qchar [lindex $argv 0]
11 | }
12 | 
13 | if {[regexp {unquote$} $argv0]} {
14 |     while {[gets stdin line] >= 0} {
15 |         if {[regexp "^$qchar\(\\s\)?" $line _ sp]} {
16 |             if {$sp != ""} {
17 |                 puts [string range $line 2 end]
18 |             } else {
19 |                 puts ""
20 |             }
21 |         } else {
22 |             puts $line
23 |         }
24 |     }
25 | 
26 |     exit
27 | }
28 | 
29 | while {[gets stdin line] >= 0} {
30 |     puts "$qchar $line"
31 | }
32 | 


--------------------------------------------------------------------------------
/utils/upcase:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | #
 3 | # convert to upper/lower case
 4 | 
 5 | case "$0" in
 6 |     *downcase)
 7 |         exec tr '[:upper:]' '[:lower:]';;
 8 |     *)
 9 |         exec tr '[:lower:]' '[:upper:]';;
10 | esac
11 | 


--------------------------------------------------------------------------------
/win:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | 
 3 | execp=
 4 | 
 5 | if test -n "$HERE"; then
 6 |     execp=$HERE/exec/
 7 | fi
 8 | 
 9 | TERM=dumb exec ${execp}ma -- -win "$@"
10 | 


--------------------------------------------------------------------------------