|
0
|
1 ;;; teco.el --- Teco interpreter for Gnu Emacs, version 1.
|
|
|
2
|
|
72
|
3 ;; Author: Dale R. Worley.
|
|
|
4 ;; Keywords: emulators
|
|
|
5
|
|
|
6 ;; This file is part of XEmacs.
|
|
|
7
|
|
|
8 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
9 ;; under the terms of the GNU General Public License as published by
|
|
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
11 ;; any later version.
|
|
|
12
|
|
|
13 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
16 ;; General Public License for more details.
|
|
|
17
|
|
|
18 ;; You should have received a copy of the GNU General Public License
|
|
|
19 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
20 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
21 ;; 02111-1307, USA.
|
|
|
22
|
|
|
23 ;;; Synched up with: Not in FSF
|
|
|
24
|
|
|
25 ;;; Commentary:
|
|
|
26
|
|
0
|
27 ;; This code has been tested some, but no doubt contains a zillion bugs.
|
|
|
28 ;; You have been warned.
|
|
|
29
|
|
|
30 ;; Written by Dale R. Worley based on a C implementation by Matt Fichtenbaum.
|
|
|
31 ;; Please send comments, bug fixes, enhancements, etc. to drw@math.mit.edu.
|
|
|
32
|
|
|
33 ;; Emacs Lisp version copyright (C) 1991 by Dale R. Worley.
|
|
|
34 ;; Do what you will with it.
|
|
|
35
|
|
|
36 ;; Since much of this code is translated from the C version by
|
|
|
37 ;; Matt Fichtenbaum, I include his copyright notice:
|
|
|
38 ;; TECO for Ultrix. Copyright 1986 Matt Fichtenbaum.
|
|
|
39 ;; This program and its components belong to GenRad Inc, Concord MA 01742.
|
|
|
40 ;; They may be copied if this copyright notice is included.
|
|
|
41
|
|
|
42 ;; To invoke directly, do:
|
|
|
43 ;; (global-set-key ?\C-z 'teco-command)
|
|
|
44 ;; (autoload teco-command "teco"
|
|
|
45 ;; "Read and execute a Teco command string."
|
|
|
46 ;; t nil)
|
|
|
47
|
|
|
48 ;; Differences from other Tecos:
|
|
|
49 ;; Character positions in the buffer are numbered in the Emacs way: The first
|
|
|
50 ;; character is numbered 1 (or (point-min) if narrowing is in effect). The
|
|
|
51 ;; B command returns that number.
|
|
|
52 ;; Ends of lines are represented by a single character (newline), so C and R
|
|
|
53 ;; skip over them, rather than 2C and 2R.
|
|
|
54 ;; All file I/O is left to the underlying Emacs. Thus, almost all Ex commands
|
|
|
55 ;; are omitted.
|
|
|
56
|
|
|
57 ;; Command set:
|
|
|
58 ;; NUL Not a command.
|
|
|
59 ;; ^A Output message to terminal (argument ends with ^A)
|
|
|
60 ;; ^C Exit macro
|
|
|
61 ;; ^C^C Stop execution
|
|
|
62 ;; ^D Set radix to decimal
|
|
|
63 ;; ^EA (match char) Match alphabetics
|
|
|
64 ;; ^EC (match char) Match symbol constituents
|
|
|
65 ;; ^ED (match char) Match numerics
|
|
|
66 ;; ^EGq (match char) Match any char in q-reg
|
|
|
67 ;; ^EL (match char) Match line terminators
|
|
|
68 ;; ^EQq (string char) Use contents of q-reg
|
|
|
69 ;; ^ER (match char) Match alphanumerics
|
|
|
70 ;; ^ES (match char) Match non-null space/tab
|
|
|
71 ;; ^EV (match char) Match lower case alphabetic
|
|
|
72 ;; ^EW (match char) Match upper case alphabetic
|
|
|
73 ;; ^EX (match char) Match any char
|
|
|
74 ;; ^G^G (type-in) Kill command string
|
|
|
75 ;; ^G<sp> (type-in) Retype current command line
|
|
|
76 ;; ^G* (type-in) Retype current command input
|
|
|
77 ;; TAB Insert tab and text
|
|
|
78 ;; LF Line terminator; Ignored in commands
|
|
|
79 ;; VT Ignored in commands
|
|
|
80 ;; FF Ignored in commands
|
|
|
81 ;; CR Ignored in commands
|
|
|
82 ;; ^Nx (match char) Match all but x
|
|
|
83 ;; ^O Set radix to octal
|
|
|
84 ;; ^P Find matching parenthesis
|
|
|
85 ;; ^Q Convert line argument into character argument
|
|
|
86 ;; ^Qx (string char) Use x literally
|
|
|
87 ;; n^R Set radix to n
|
|
|
88 ;; :^R Enter recursive edit
|
|
|
89 ;; ^S -(length of last referenced string)
|
|
|
90 ;; ^S (match char) match separator char
|
|
|
91 ;; ^T Ascii value of next character typed
|
|
|
92 ;; n^T Output Ascii character with value n
|
|
|
93 ;; ^U (type-in) Kill command line
|
|
|
94 ;; ^Uq Put text argument into q-reg
|
|
|
95 ;; n^Uq Put Ascii character 'n' into q-reg
|
|
|
96 ;; :^Uq Append text argument to q-reg
|
|
|
97 ;; n:^Uq Append character 'n' to q-reg
|
|
|
98 ;; ^X Set/get search mode flag
|
|
|
99 ;; ^X (match char) Match any character
|
|
|
100 ;; ^Y Equivalent to '.+^S,.'
|
|
|
101 ;; ^Z Not a Teco command
|
|
|
102 ;; ESC String terminator; absorbs arguments
|
|
|
103 ;; ESC ESC (type-in) End command
|
|
|
104 ;; ^\ Not a Teco command
|
|
|
105 ;; ^] Not a Teco command
|
|
|
106 ;; ^^x Ascii value of the character x
|
|
|
107 ;; ^_ One's complement (logical NOT)
|
|
|
108 ;; ! Define label (argument ends with !)
|
|
|
109 ;; " Start conditional
|
|
|
110 ;; n"< Test for less than zero
|
|
|
111 ;; n"> Test for greater than zero
|
|
|
112 ;; n"= Test for equal to zero
|
|
|
113 ;; n"A Test for alphabetic
|
|
|
114 ;; n"C Test for symbol constituent
|
|
|
115 ;; n"D Test for numeric
|
|
|
116 ;; n"E Test for equal to zero
|
|
|
117 ;; n"F Test for false
|
|
|
118 ;; n"G Test for greater than zero
|
|
|
119 ;; n"L Test for less than zero
|
|
|
120 ;; n"N Test for not equal to zero
|
|
|
121 ;; n"R Test for alphanumeric
|
|
|
122 ;; n"S Test for successful
|
|
|
123 ;; n"T Test for true
|
|
|
124 ;; n"U Test for unsuccessful
|
|
|
125 ;; n"V Test for lower case
|
|
|
126 ;; n"W Test for upper case
|
|
|
127 ;; # Logical OR
|
|
|
128 ;; $ Not a Teco command
|
|
|
129 ;; n%q Add n to q-reg and return result
|
|
|
130 ;; & Logical AND
|
|
|
131 ;; ' End conditional
|
|
|
132 ;; ( Expression grouping
|
|
|
133 ;; ) Expression grouping
|
|
|
134 ;; * Multiplication
|
|
|
135 ;; + Addition
|
|
|
136 ;; , Argument separator
|
|
|
137 ;; - Subtraction or negation
|
|
|
138 ;; . Current pointer position
|
|
|
139 ;; / Division
|
|
|
140 ;; 0-9 Digit
|
|
|
141 ;; n< Iterate n times
|
|
|
142 ;; = Type in decimal
|
|
|
143 ;; := Type in decimal, no newline
|
|
|
144 ;; = Type in octal
|
|
|
145 ;; := Type in octal, no newline
|
|
|
146 ;; = Type in hexadecimal
|
|
|
147 ;; := Type in hexadecimal, no newline
|
|
|
148 ;; :: Make next search a compare
|
|
|
149 ;; > End iteration
|
|
|
150 ;; n:A Get Ascii code of character at relative position n
|
|
|
151 ;; B Character position of beginning of buffer
|
|
|
152 ;; nC Advance n characters
|
|
|
153 ;; nD Delete n characters
|
|
|
154 ;; n,mD Delete characters between n and m
|
|
|
155 ;; Gq Get string from q-reg into buffer
|
|
|
156 ;; :Gq Type out q-reg
|
|
|
157 ;; H Equivalent to 'B,Z'
|
|
|
158 ;; I Insert text argument
|
|
|
159 ;; nJ Move pointer to character n
|
|
|
160 ;; nK Kill n lines
|
|
|
161 ;; n,mK Kill characters between n and m
|
|
|
162 ;; nL Advance n lines
|
|
|
163 ;; Mq Execute string in q-reg
|
|
|
164 ;; O Goto label
|
|
|
165 ;; nO Go to n-th label in list (0-origin)
|
|
|
166 ;; Qq Number in q-reg
|
|
|
167 ;; nQq Ascii value of n-th character in q-reg
|
|
|
168 ;; :Qq Size of text in q-reg
|
|
|
169 ;; nR Back up n characters
|
|
|
170 ;; nS Search
|
|
|
171 ;; nT Type n lines
|
|
|
172 ;; n,mT Type chars from n to m
|
|
|
173 ;; nUq Put number n into q-reg
|
|
|
174 ;; nV Type n lines around pointer
|
|
|
175 ;; nXq Put n lines into q-reg
|
|
|
176 ;; n,mXq Put characters from n to m into q-reg
|
|
|
177 ;; n:Xq Append n lines to q-reg q
|
|
|
178 ;; n,m:Xq Append characters from n to m into q-reg
|
|
|
179 ;; Z Pointer position at end of buffer
|
|
|
180 ;; [q Put q-reg on stack
|
|
|
181 ;; \ Value of digit string in buffer
|
|
|
182 ;; n\ Convert n to digits and insert in buffer
|
|
|
183 ;; ]q Pop q-reg from stack
|
|
|
184 ;; :]q Test whether stack is empty and return value
|
|
|
185 ;; ` Not a Teco command
|
|
|
186 ;; a-z Treated the same as A-Z
|
|
|
187 ;; { Not a Teco command
|
|
|
188 ;; | Conditional 'else'
|
|
108
|
189 ;; } Not a Teco command
|
|
0
|
190 ;; ~ Not a Teco command
|
|
|
191 ;; DEL Delete last character typed in
|
|
|
192
|
|
|
193
|
|
72
|
194 ;;; Code:
|
|
|
195 (require 'backquote)
|
|
|
196
|
|
0
|
197 ;; set a range of elements of an array to a value
|
|
|
198 (defun teco-set-elements (array start end value)
|
|
|
199 (let ((i start))
|
|
|
200 (while (<= i end)
|
|
|
201 (aset array i value)
|
|
|
202 (setq i (1+ i)))))
|
|
|
203
|
|
|
204 ;; set a range of elements of an array to their indexes plus an offset
|
|
|
205 (defun teco-set-elements-index (array start end offset)
|
|
|
206 (let ((i start))
|
|
|
207 (while (<= i end)
|
|
|
208 (aset array i (+ i offset))
|
|
|
209 (setq i (1+ i)))))
|
|
|
210
|
|
|
211 (defvar teco-command-string ""
|
|
|
212 "The current command string being executed.")
|
|
|
213
|
|
|
214 (defvar teco-command-pointer nil
|
|
|
215 "Pointer into teco-command-string showing next character to be executed.")
|
|
|
216
|
|
|
217 (defvar teco-ctrl-r 10
|
|
|
218 "Current number radix.")
|
|
|
219
|
|
|
220 (defvar teco-digit-switch nil
|
|
|
221 "Set if we have just executed a digit.")
|
|
|
222
|
|
|
223 (defvar teco-exp-exp nil
|
|
108
|
224 "Expression value preceding operator.")
|
|
0
|
225
|
|
|
226 (defvar teco-exp-val1 nil
|
|
|
227 "Current argument value.")
|
|
|
228
|
|
|
229 (defvar teco-exp-val2 nil
|
|
|
230 "Argument before comma.")
|
|
|
231
|
|
|
232 (defvar teco-exp-flag1 nil
|
|
|
233 "t if argument is present.")
|
|
|
234
|
|
|
235 (defvar teco-exp-flag2 nil
|
|
|
236 "t if argument before comma is present.")
|
|
|
237
|
|
|
238 (defvar teco-exp-op nil
|
|
|
239 "Pending arithmetic operation on argument.")
|
|
|
240
|
|
|
241 (defvar teco-exp-stack nil
|
|
|
242 "Stack for parenthesized expressions.")
|
|
|
243
|
|
|
244 (defvar teco-macro-stack nil
|
|
|
245 "Stack for macro invocations.")
|
|
|
246
|
|
|
247 (defvar teco-mapch-l nil
|
|
|
248 "Translation table to lower-case letters.")
|
|
|
249
|
|
|
250 (setq teco-mapch-l (make-vector 256 0))
|
|
|
251 (teco-set-elements-index teco-mapch-l 0 255 0)
|
|
|
252 (teco-set-elements-index teco-mapch-l ?A ?Z (- ?a ?A))
|
|
|
253
|
|
|
254 (defvar teco-trace nil
|
|
|
255 "t if tracing is on.")
|
|
|
256
|
|
|
257 (defvar teco-at-flag nil
|
|
|
258 "t if an @ flag is pending.")
|
|
|
259
|
|
|
260 (defvar teco-colon-flag nil
|
|
|
261 "1 if a : flag is pending, 2 if a :: flag is pending.")
|
|
|
262
|
|
|
263 (defvar teco-qspec-valid nil
|
|
|
264 "Flags describing whether a character is a vaid q-register name.
|
|
|
265 3 means yes, 2 means yes but only for file and search operations.")
|
|
|
266
|
|
|
267 (setq teco-qspec-valid (make-vector 256 0))
|
|
|
268 (teco-set-elements teco-qspec-valid ?a ?z 3)
|
|
|
269 (teco-set-elements teco-qspec-valid ?0 ?9 3)
|
|
|
270 (aset teco-qspec-valid ?_ 2)
|
|
|
271 (aset teco-qspec-valid ?* 2)
|
|
|
272 (aset teco-qspec-valid ?% 2)
|
|
|
273 (aset teco-qspec-valid ?# 2)
|
|
|
274
|
|
|
275 (defvar teco-exec-flags 0
|
|
|
276 "Flags for iteration in process, ei macro, etc.")
|
|
|
277
|
|
|
278 (defvar teco-iteration-stack nil
|
|
|
279 "Iteration list.")
|
|
|
280
|
|
|
281 (defvar teco-cond-stack nil
|
|
|
282 "Conditional stack.")
|
|
|
283
|
|
|
284 (defvar teco-qreg-text (make-vector 256 "")
|
|
|
285 "The text contents of the q-registers.")
|
|
|
286
|
|
|
287 (defvar teco-qreg-number (make-vector 256 0)
|
|
|
288 "The number contents of the q-registers.")
|
|
|
289
|
|
|
290 (defvar teco-qreg-stack nil
|
|
|
291 "The stack of saved q-registers.")
|
|
|
292
|
|
|
293 (defconst teco-prompt "*"
|
|
|
294 "*Prompt to be used when inputting Teco command.")
|
|
|
295
|
|
|
296 (defconst teco-exec-1 (make-vector 256 nil)
|
|
|
297 "Names of routines handling type 1 characters (characters that are
|
|
|
298 part of expression processing).")
|
|
|
299
|
|
|
300 (defconst teco-exec-2 (make-vector 256 nil)
|
|
|
301 "Names of routines handling type 2 characters (characters that are
|
|
|
302 not part of expression processing).")
|
|
|
303
|
|
|
304 (defvar teco-last-search-string ""
|
|
|
305 "Last string searched for.")
|
|
|
306
|
|
|
307 (defvar teco-last-search-regexp ""
|
|
|
308 "Regexp version of teco-last-search-string.")
|
|
|
309
|
|
|
310 (defmacro teco-define-type-1 (char &rest body)
|
|
|
311 "Define the code to process a type 1 character.
|
|
|
312 Transforms
|
|
|
313 (teco-define-type-1 ?x
|
|
|
314 code ...)
|
|
|
315 into
|
|
|
316 (defun teco-type-1-x ()
|
|
|
317 code ...)
|
|
|
318 and does
|
|
|
319 (aset teco-exec-1 ?x 'teco-type-1-x)"
|
|
|
320 (let ((s (intern (concat "teco-type-1-" (char-to-string char)))))
|
|
|
321 (` (progn
|
|
|
322 (defun (, s) ()
|
|
|
323 (,@ body))
|
|
|
324 (aset teco-exec-1 (, char) '(, s))))))
|
|
|
325
|
|
|
326 (defmacro teco-define-type-2 (char &rest body)
|
|
|
327 "Define the code to process a type 2 character.
|
|
|
328 Transforms
|
|
|
329 (teco-define-type-2 ?x
|
|
|
330 code ...)
|
|
|
331 into
|
|
|
332 (defun teco-type-2-x ()
|
|
|
333 code ...)
|
|
|
334 and does
|
|
|
335 (aset teco-exec-2 ?x 'teco-type-2-x)"
|
|
|
336 (let ((s (intern (concat "teco-type-2-" (char-to-string char)))))
|
|
|
337 (` (progn
|
|
|
338 (defun (, s) ()
|
|
|
339 (,@ body))
|
|
|
340 (aset teco-exec-2 (, char) '(, s))))))
|
|
|
341
|
|
|
342 (defconst teco-char-types (make-vector 256 0)
|
|
|
343 "Define the characteristics of characters, as tested by \":
|
|
|
344 1 alphabetic
|
|
|
345 2 alphabetic, $, or .
|
|
|
346 4 digit
|
|
|
347 8 alphabetic or digit
|
|
|
348 16 lower-case alphabetic
|
|
|
349 32 upper-case alphabetic")
|
|
|
350
|
|
|
351 (teco-set-elements teco-char-types ?0 ?9 (+ 4 8))
|
|
|
352 (teco-set-elements teco-char-types ?A ?Z (+ 1 2 8 32))
|
|
|
353 (teco-set-elements teco-char-types ?a ?z (+ 1 2 8 16))
|
|
|
354 (aset teco-char-types ?$ 2)
|
|
|
355 (aset teco-char-types ?. 2)
|
|
|
356
|
|
|
357 (defconst teco-error-texts '(("BNI" . "> not in iteration")
|
|
|
358 ("CPQ" . "Can't pop Q register")
|
|
|
359 ("COF" . "Can't open output file ")
|
|
|
360 ("FNF" . "File not found ")
|
|
|
361 ("IEC" . "Invalid E character")
|
|
|
362 ("IFC" . "Invalid F character")
|
|
|
363 ("IIA" . "Invalid insert arg")
|
|
|
364 ("ILL" . "Invalid command")
|
|
|
365 ("ILN" . "Invalid number")
|
|
|
366 ("IPA" . "Invalid P arg")
|
|
|
367 ("IQC" . "Invalid \" character")
|
|
|
368 ("IQN" . "Invalid Q-reg name")
|
|
|
369 ("IRA" . "Invalid radix arg")
|
|
|
370 ("ISA" . "Invalid search arg")
|
|
|
371 ("ISS" . "Invalid search string")
|
|
|
372 ("IUC" . "Invalid ^ character")
|
|
|
373 ("LNF" . "Label not found")
|
|
|
374 ("MEM" . "Insufficient memory available")
|
|
|
375 ("MRP" . "Missing )")
|
|
|
376 ("NAB" . "No arg before ^_")
|
|
|
377 ("NAC" . "No arg before ,")
|
|
|
378 ("NAE" . "No arg before =")
|
|
|
379 ("NAP" . "No arg before )")
|
|
|
380 ("NAQ" . "No arg before \"")
|
|
|
381 ("NAS" . "No arg before ;")
|
|
|
382 ("NAU" . "No arg before U")
|
|
|
383 ("NFI" . "No file for input")
|
|
|
384 ("NFO" . "No file for output")
|
|
|
385 ("NYA" . "Numeric arg with Y")
|
|
|
386 ("OFO" . "Output file already open")
|
|
|
387 ("PDO" . "Pushdown list overflow")
|
|
|
388 ("POP" . "Pointer off page")
|
|
|
389 ("SNI" . "; not in iteration")
|
|
|
390 ("SRH" . "Search failure ")
|
|
|
391 ("STL" . "String too long")
|
|
|
392 ("UTC" . "Unterminated command")
|
|
|
393 ("UTM" . "Unterminated macro")
|
|
|
394 ("XAB" . "Execution interrupted")
|
|
|
395 ("YCA" . "Y command suppressed")
|
|
|
396 ("IWA" . "Invalid W arg")
|
|
|
397 ("NFR" . "Numeric arg with FR")
|
|
|
398 ("INT" . "Internal error")
|
|
|
399 ("EFI" . "EOF read from std input")
|
|
|
400 ("IAA" . "Invalid A arg")
|
|
|
401 ))
|
|
|
402
|
|
|
403 (defconst teco-spec-chars
|
|
|
404 [
|
|
|
405 0 1 0 0 ; ^@ ^A ^B ^C
|
|
|
406 0 64 0 0 ; ^D ^E ^F ^G
|
|
|
407 0 2 128 128 ; ^H ^I ^J ^K
|
|
|
408 128 0 64 0 ; ^L ^M ^N ^O
|
|
|
409 0 64 64 64 ; ^P ^Q ^R ^S
|
|
|
410 0 34 0 0 ; ^T ^U ^V ^W
|
|
|
411 64 0 0 0 ; ^X ^Y ^Z ^\[
|
|
|
412 0 0 1 0 ; ^\ ^\] ^^ ^_
|
|
|
413 0 1 16 0 ; ! \" #
|
|
|
414 0 0 0 16 ; $ % & '
|
|
|
415 0 0 0 0 ; \( \) * +
|
|
|
416 0 0 0 0 ; , - . /
|
|
|
417 0 0 0 0 ; 0 1 2 3
|
|
|
418 0 0 0 0 ; 4 5 6 7
|
|
|
419 0 0 0 0 ; 8 9 : ;
|
|
|
420 16 0 16 0 ; < = > ?
|
|
|
421 1 0 12 0 ; @ A B C
|
|
|
422 0 1 1 32 ; D E F G
|
|
|
423 0 6 0 0 ; H I J K
|
|
|
424 0 32 10 2 ; L M N O
|
|
|
425 0 32 4 10 ; P Q R S
|
|
|
426 0 32 0 4 ; T U V W
|
|
|
427 32 0 0 32 ; X Y Z \[
|
|
|
428 0 32 1 6 ; \ \] ^ _
|
|
|
429 0 0 12 0 ; ` a b c
|
|
|
430 0 1 1 32 ; d e f g
|
|
|
431 0 6 0 0 ; h i j k
|
|
|
432 0 32 10 2 ; l m n o
|
|
|
433 0 32 4 10 ; p q r s
|
|
|
434 0 32 0 4 ; t u v w
|
|
|
435 32 0 0 0 ; x y z {
|
|
|
436 16 0 0 0 ; | } ~ DEL
|
|
|
437 ]
|
|
|
438 "The special properties of characters:
|
|
|
439 1 skipto() special character
|
|
|
440 2 command with std text argument
|
|
|
441 4 E<char> takes a text argument
|
|
|
442 8 F<char> takes a text argument
|
|
|
443 16 char causes skipto() to exit
|
|
|
444 32 command with q-register argument
|
|
|
445 64 special char in search string
|
|
|
446 128 character is a line separator")
|
|
|
447
|
|
|
448
|
|
|
449 (defun teco-execute-command (string)
|
|
|
450 "Execute teco command string."
|
|
|
451 ;; Initialize everything
|
|
|
452 (let ((teco-command-string string)
|
|
|
453 (teco-command-pointer 0)
|
|
|
454 (teco-digit-switch nil)
|
|
|
455 (teco-exp-exp nil)
|
|
|
456 (teco-exp-val1 nil)
|
|
|
457 (teco-exp-val2 nil)
|
|
|
458 (teco-exp-flag1 nil)
|
|
|
459 (teco-exp-flag2 nil)
|
|
|
460 (teco-exp-op 'start)
|
|
|
461 (teco-trace nil)
|
|
|
462 (teco-at-flag nil)
|
|
|
463 (teco-colon-flag nil)
|
|
|
464 (teco-exec-flags 0)
|
|
|
465 (teco-iteration-stack nil)
|
|
|
466 (teco-cond-stack nil)
|
|
|
467 (teco-exp-stack nil)
|
|
|
468 (teco-macro-stack nil)
|
|
|
469 (teco-qreg-stack nil))
|
|
|
470 ;; initialize output
|
|
|
471 (teco-out-init)
|
|
|
472 ;; execute commands
|
|
|
473 (catch 'teco-exit
|
|
|
474 (while t
|
|
|
475 ;; get next command character
|
|
|
476 (let ((cmdc (teco-get-command0 teco-trace)))
|
|
|
477 ;; if it's ^, interpret the next character as a control character
|
|
|
478 (if (eq cmdc ?^)
|
|
|
479 (setq cmdc (logand (teco-get-command teco-trace) 31)))
|
|
|
480 (if (and (<= ?0 cmdc) (<= cmdc ?9))
|
|
|
481 ;; process a number
|
|
|
482 (progn
|
|
|
483 (setq cmdc (- cmdc ?0))
|
|
|
484 ;; check for invalid digit
|
|
|
485 (if (>= cmdc teco-ctrl-r)
|
|
|
486 (teco-error "ILN"))
|
|
|
487 (if teco-digit-switch
|
|
|
488 ;; later digits
|
|
|
489 (setq teco-exp-val1 (+ (* teco-exp-val1 teco-ctrl-r) cmdc))
|
|
|
490 ;; first digit
|
|
|
491 (setq teco-exp-val1 cmdc)
|
|
|
492 (setq teco-digit-switch t))
|
|
|
493 ;; indicate a value was read in
|
|
|
494 (setq teco-exp-flag1 t))
|
|
|
495 ;; not a digit
|
|
|
496 (setq teco-digit-switch nil)
|
|
|
497 ;; cannonicalize the case
|
|
|
498 (setq cmdc (aref teco-mapch-l cmdc))
|
|
|
499 ;; dispatch on the character, if it is a type 1 character
|
|
|
500 (let ((r (aref teco-exec-1 cmdc)))
|
|
|
501 (if r
|
|
|
502 (funcall r)
|
|
|
503 ;; if a value has been entered, process any pending operation
|
|
|
504 (if teco-exp-flag1
|
|
|
505 (cond ((eq teco-exp-op 'start)
|
|
|
506 nil)
|
|
|
507 ((eq teco-exp-op 'add)
|
|
|
508 (setq teco-exp-val1 (+ teco-exp-exp teco-exp-val1))
|
|
|
509 (setq teco-exp-op 'start))
|
|
|
510 ((eq teco-exp-op 'sub)
|
|
|
511 (setq teco-exp-val1 (- teco-exp-exp teco-exp-val1))
|
|
|
512 (setq teco-exp-op 'start))
|
|
|
513 ((eq teco-exp-op 'mult)
|
|
|
514 (setq teco-exp-val1 (* teco-exp-exp teco-exp-val1))
|
|
|
515 (setq teco-exp-op 'start))
|
|
|
516 ((eq teco-exp-op 'div)
|
|
|
517 (setq teco-exp-val1
|
|
|
518 (if (/= teco-exp-val1 0)
|
|
|
519 (/ teco-exp-exp teco-exp-val1)
|
|
|
520 0))
|
|
|
521 (setq teco-exp-op 'start))
|
|
|
522 ((eq teco-exp-op 'and)
|
|
|
523 (setq teco-exp-val1
|
|
|
524 (logand teco-exp-exp teco-exp-val1))
|
|
|
525 (setq teco-exp-op 'start))
|
|
|
526 ((eq teco-exp-op 'or)
|
|
|
527 (setq teco-exp-val1
|
|
|
528 (logior teco-exp-exp teco-exp-val1))
|
|
|
529 (setq teco-exp-op 'start))))
|
|
|
530 ;; dispatch on a type 2 character
|
|
|
531 (let ((r (aref teco-exec-2 cmdc)))
|
|
|
532 (if r
|
|
|
533 (funcall r)
|
|
|
534 (teco-error "ILL")))))))))))
|
|
|
535
|
|
|
536 ;; Type 1 commands
|
|
|
537
|
|
|
538 (teco-define-type-1
|
|
|
539 ?\m ; CR
|
|
|
540 nil)
|
|
|
541
|
|
|
542 (teco-define-type-1
|
|
|
543 ?\n ; LF
|
|
|
544 nil)
|
|
|
545
|
|
|
546 (teco-define-type-1
|
|
|
547 ?\^k ; VT
|
|
|
548 nil)
|
|
|
549
|
|
|
550 (teco-define-type-1
|
|
|
551 ?\^l ; FF
|
|
|
552 nil)
|
|
|
553
|
|
|
554 (teco-define-type-1
|
|
|
555 32 ; SPC
|
|
|
556 nil)
|
|
|
557
|
|
|
558 (teco-define-type-1
|
|
|
559 ?\e ; ESC
|
|
|
560 (if (teco-peek-command ?\e)
|
|
|
561 ;; ESC ESC terminates macro or command
|
|
|
562 (teco-pop-macro-stack)
|
|
|
563 ;; otherwise, consume argument
|
|
|
564 (setq teco-exp-flag1 nil)
|
|
|
565 (setq teco-exp-op 'start)))
|
|
|
566
|
|
|
567 (teco-define-type-1
|
|
|
568 ?! ; !
|
|
|
569 (while (/= (teco-get-command teco-trace) ?!)
|
|
|
570 nil))
|
|
|
571
|
|
|
572 (teco-define-type-1
|
|
|
573 ?@ ; @
|
|
|
574 ;; set at-flag
|
|
|
575 (setq teco-at-flag t))
|
|
|
576
|
|
|
577 (teco-define-type-1
|
|
|
578 ?: ; :
|
|
|
579 ;; is it '::'?
|
|
|
580 (if (teco-peek-command ?:)
|
|
|
581 (progn
|
|
|
582 ;; skip second colon
|
|
|
583 (teco-get-command teco-trace)
|
|
|
584 ;; set flag to show two colons
|
|
|
585 (setq teco-colon-flag 2))
|
|
|
586 ;; set flag to show one colon
|
|
|
587 (setq teco-colon-flag 1)))
|
|
|
588
|
|
|
589 (teco-define-type-1
|
|
|
590 ?? ; ?
|
|
|
591 ;; toggle trace
|
|
|
592 (setq teco-trace (not teco-trace)))
|
|
|
593
|
|
|
594 (teco-define-type-1
|
|
|
595 ?. ; .
|
|
|
596 ;; value is point
|
|
|
597 (setq teco-exp-val1 (point)
|
|
|
598 teco-exp-flag1 t))
|
|
|
599
|
|
|
600 (teco-define-type-1
|
|
|
601 ?z ; z
|
|
|
602 ;; value is point-max
|
|
|
603 (setq teco-exp-val1 (point-max)
|
|
|
604 teco-exp-flag1 t))
|
|
|
605
|
|
|
606 (teco-define-type-1
|
|
|
607 ?b ; b
|
|
|
608 ;; value is point-min
|
|
|
609 (setq teco-exp-val1 (point-min)
|
|
|
610 teco-exp-flag1 t))
|
|
|
611
|
|
|
612 (teco-define-type-1
|
|
|
613 ?h ; h
|
|
|
614 ;; value is b,z
|
|
|
615 (setq teco-exp-val1 (point-max)
|
|
|
616 teco-exp-val2 (point-min)
|
|
|
617 teco-exp-flag1 t
|
|
|
618 teco-exp-flag2 t
|
|
|
619 teco-exp-op 'start))
|
|
|
620
|
|
|
621 (teco-define-type-1
|
|
|
622 ?\^s ; ^s
|
|
|
623 ;; value is - length of last insert, etc.
|
|
|
624 (setq teco-exp-val1 teco-ctrl-s
|
|
|
625 teco-exp-flag1 t))
|
|
|
626
|
|
|
627 (teco-define-type-1
|
|
|
628 ?\^y ; ^y
|
|
|
629 ;; value is .+^S,.
|
|
|
630 (setq teco-exp-val1 (+ (point) teco-ctrl-s)
|
|
|
631 teco-exp-val2 (point)
|
|
|
632 teco-exp-flag1 t
|
|
|
633 teco-exp-flag2 t
|
|
|
634 teco-exp-op 'start))
|
|
|
635
|
|
|
636 (teco-define-type-1
|
|
|
637 ?\( ; \(
|
|
|
638 ;; push expression stack
|
|
|
639 (teco-push-exp-stack)
|
|
|
640 (setq teco-exp-flag1 nil
|
|
|
641 teco-exp-flag2 nil
|
|
|
642 teco-exp-op 'start))
|
|
|
643
|
|
|
644 (teco-define-type-1
|
|
|
645 ?\^p ; ^p
|
|
|
646 (teco-do-ctrl-p))
|
|
|
647
|
|
|
648 (teco-define-type-1
|
|
|
649 ?\C-^ ; ^^
|
|
|
650 ;; get next command character
|
|
|
651 (setq teco-exp-val1 (teco-get-command teco-trace)
|
|
|
652 teco-exp-flag1 t))
|
|
|
653
|
|
|
654
|
|
|
655 ;; Type 2 commands
|
|
|
656 (teco-define-type-2
|
|
|
657 ?+ ; +
|
|
|
658 (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
|
|
|
659 teco-exp-flag1 nil
|
|
|
660 teco-exp-op 'add))
|
|
|
661
|
|
|
662 (teco-define-type-2
|
|
|
663 ?- ; -
|
|
|
664 (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
|
|
|
665 teco-exp-flag1 nil
|
|
|
666 teco-exp-op 'sub))
|
|
|
667
|
|
|
668 (teco-define-type-2
|
|
|
669 ?* ; *
|
|
|
670 (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
|
|
|
671 teco-exp-flag1 nil
|
|
|
672 teco-exp-op 'mult))
|
|
|
673
|
|
|
674 (teco-define-type-2
|
|
|
675 ?/ ; /
|
|
|
676 (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
|
|
|
677 teco-exp-flag1 nil
|
|
|
678 teco-exp-op 'div))
|
|
|
679
|
|
|
680 (teco-define-type-2
|
|
|
681 ?& ; &
|
|
|
682 (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
|
|
|
683 teco-exp-flag1 nil
|
|
|
684 teco-exp-op 'and))
|
|
|
685
|
|
|
686 (teco-define-type-2
|
|
|
687 ?# ; #
|
|
|
688 (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
|
|
|
689 teco-exp-flag1 nil
|
|
|
690 teco-exp-op 'or))
|
|
|
691
|
|
|
692 (teco-define-type-2
|
|
|
693 ?\) ; \)
|
|
|
694 (if (or (not teco-exp-flag1) (not teco-exp-stack))
|
|
|
695 (teco-error "NAP"))
|
|
|
696 (let ((v teco-exp-val1))
|
|
|
697 (teco-pop-exp-stack)
|
|
|
698 (setq teco-exp-val1 v
|
|
|
699 teco-exp-flag1 t)))
|
|
|
700
|
|
|
701 (teco-define-type-2
|
|
|
702 ?, ; ,
|
|
|
703 (if (not teco-exp-flag1)
|
|
|
704 (teco-error "NAC"))
|
|
|
705 (setq teco-exp-val2 teco-exp-val1
|
|
|
706 teco-exp-flag2 t
|
|
|
707 teco-exp-flag1 nil))
|
|
|
708
|
|
|
709 (teco-define-type-2
|
|
|
710 ?\^_ ; ^_
|
|
|
711 (if (not teco-exp-flag1)
|
|
|
712 (teco-error "NAB")
|
|
|
713 (setq teco-exp-val1 (lognot teco-exp-val1))))
|
|
|
714
|
|
|
715 (teco-define-type-2
|
|
|
716 ?\^d ; ^d
|
|
|
717 (setq teco-ctrl-r 10
|
|
|
718 teco-exp-flag1 nil
|
|
|
719 teco-exp-op 'start))
|
|
|
720
|
|
|
721 (teco-define-type-2
|
|
|
722 ?\^o ; ^o
|
|
|
723 (setq teco-ctrl-r 8
|
|
|
724 teco-exp-flag1 nil
|
|
|
725 teco-exp-op 'start))
|
|
|
726
|
|
|
727 (teco-define-type-2
|
|
|
728 ?\^r ; ^r
|
|
|
729 (if teco-colon-flag
|
|
|
730 (progn
|
|
|
731 (recursive-edit)
|
|
|
732 (setq teco-colon-flag nil))
|
|
|
733 (if teco-exp-flag1
|
|
|
734 ;; set radix
|
|
|
735 (progn
|
|
|
736 (if (and (/= teco-exp-val1 8)
|
|
|
737 (/= teco-exp-val1 10)
|
|
|
738 (/= teco-exp-val1 16))
|
|
|
739 (teco-error "IRA"))
|
|
|
740 (setq teco-ctrl-r teco-exp-val1
|
|
|
741 teco-exp-flag1 nil
|
|
|
742 teco-exp-op 'start))
|
|
|
743 ;; get radix
|
|
|
744 (setq teco-exp-val1 teco-ctrl-r
|
|
|
745 teco-exp-flag1 t))))
|
|
|
746
|
|
|
747 (teco-define-type-2
|
|
|
748 ?\^c ; ^c
|
|
|
749 (if (teco-peek-command ?\^c)
|
|
|
750 ;; ^C^C stops execution
|
|
|
751 (throw 'teco-exit nil)
|
|
|
752 (if teco-macro-stack
|
|
|
753 ;; ^C inside macro exits macro
|
|
|
754 (teco-pop-macro-stack)
|
|
|
755 ;; ^C in command stops execution
|
|
|
756 (throw 'teco-exit nil))))
|
|
|
757
|
|
|
758 (teco-define-type-2
|
|
|
759 ?\^x ; ^x
|
|
|
760 ;; set/get search mode flag
|
|
|
761 (teco-set-var 'teco-ctrl-x))
|
|
|
762
|
|
|
763 (teco-define-type-2
|
|
|
764 ?m ; m
|
|
|
765 (let ((macro-name (teco-get-qspec nil
|
|
|
766 (teco-get-command teco-trace))))
|
|
|
767 (teco-push-macro-stack)
|
|
|
768 (setq teco-command-string (aref teco-qreg-text macro-name)
|
|
|
769 teco-command-pointer 0)))
|
|
|
770
|
|
|
771 (teco-define-type-2
|
|
|
772 ?< ; <
|
|
|
773 ;; begin iteration
|
|
|
774 (if (and teco-exp-flag1 (<= teco-exp-val1 0))
|
|
|
775 ;; if this is not to be executed, just skip the
|
|
|
776 ;; intervening stuff
|
|
|
777 (teco-find-enditer)
|
|
|
778 ;; push iteration stack
|
|
|
779 (teco-push-iter-stack teco-command-pointer
|
|
|
780 teco-exp-flag1 teco-exp-val1)
|
|
|
781 ;; consume the argument
|
|
|
782 (setq teco-exp-flag1 nil)))
|
|
|
783
|
|
|
784 (teco-define-type-2
|
|
|
785 ?> ; >
|
|
|
786 ;; end iteration
|
|
|
787 (if (not teco-iteration-stack)
|
|
|
788 (teco-error "BNI"))
|
|
|
789 ;; decrement count and pop conditionally
|
|
|
790 (teco-pop-iter-stack nil)
|
|
|
791 ;; consume arguments
|
|
|
792 (setq teco-exp-flag1 nil
|
|
|
793 teco-exp-flag2 nil
|
|
|
794 teco-exp-op 'start))
|
|
|
795
|
|
|
796 (teco-define-type-2
|
|
|
797 59 ; ;
|
|
|
798 ;; semicolon iteration exit
|
|
|
799 (if (not teco-iteration-stack)
|
|
|
800 (teco-error "SNI"))
|
|
|
801 ;; if exit
|
|
|
802 (if (if (>= (if teco-exp-flag1
|
|
|
803 teco-exp-val1
|
|
|
804 teco-search-result) 0)
|
|
|
805 (not teco-colon-flag)
|
|
|
806 teco-colon-flag)
|
|
|
807 (progn
|
|
|
808 (teco-find-enditer)
|
|
|
809 (teco-pop-iter-stack t)))
|
|
|
810 ;; consume argument and colon
|
|
|
811 (setq teco-exp-flag1 nil
|
|
|
812 teco-colon-flag nil
|
|
|
813 teco-exp-op 'start))
|
|
|
814
|
|
|
815 (teco-define-type-2
|
|
|
816 ?\" ; \"
|
|
|
817 ;; must be an argument
|
|
|
818 (if (not teco-exp-flag1)
|
|
|
819 (teco-error "NAQ"))
|
|
|
820 ;; consume argument
|
|
|
821 (setq teco-exp-flag1 nil
|
|
|
822 teco-exp-op 'start)
|
|
|
823 (let* (;; get the test specification
|
|
|
824 (c (aref teco-mapch-l (teco-get-command teco-trace)))
|
|
|
825 ;; determine whether the test is true
|
|
|
826 (test (cond ((eq c ?a)
|
|
|
827 (/= (logand (aref teco-char-types teco-exp-val1)
|
|
|
828 1) 0))
|
|
|
829 ((eq c ?c)
|
|
|
830 (/= (logand (aref teco-char-types teco-exp-val1)
|
|
|
831 2) 0))
|
|
|
832 ((eq c ?d)
|
|
|
833 (/= (logand (aref teco-char-types teco-exp-val1)
|
|
|
834 4) 0))
|
|
|
835 ((or (eq c ?e) (eq c ?f) (eq c ?u) (eq c ?=))
|
|
|
836 (= teco-exp-val1 0))
|
|
|
837 ((or (eq c ?g) (eq c ?>))
|
|
|
838 (> teco-exp-val1 0))
|
|
|
839 ((or (eq c ?l) (eq c ?s) (eq c ?t) (eq c ?<))
|
|
|
840 (< teco-exp-val1 0))
|
|
|
841 ((eq c ?n)
|
|
|
842 (/= teco-exp-val1 0))
|
|
|
843 ((eq c ?r)
|
|
|
844 (/= (logand (aref teco-char-types teco-exp-val1)
|
|
|
845 8) 0))
|
|
|
846 ((eq c ?v)
|
|
|
847 (/= (logand (aref teco-char-types teco-exp-val1)
|
|
|
848 16) 0))
|
|
|
849 ((eq c ?w)
|
|
|
850 (/= (logand (aref teco-char-types teco-exp-val1)
|
|
|
851 32) 0))
|
|
|
852 (t
|
|
|
853 (teco-error "IQC")))))
|
|
|
854 (if (not test)
|
|
|
855 ;; if the conditional isn't satisfied, read
|
|
|
856 ;; to matching | or '
|
|
|
857 (let ((ll 1)
|
|
|
858 c)
|
|
|
859 (while (> ll 0)
|
|
|
860 (while (progn (setq c (teco-skipto))
|
|
|
861 (and (/= c ?\")
|
|
|
862 (/= c ?|)
|
|
|
863 (/= c ?\')))
|
|
|
864 (if (= c ?\")
|
|
|
865 (setq ll (1+ ll))
|
|
|
866 (if (= c ?\')
|
|
|
867 (setq ll (1- ll))
|
|
|
868 (if (= ll 1)
|
|
|
869 (break))))))))))
|
|
|
870
|
|
|
871 (teco-define-type-2
|
|
|
872 ?' ; '
|
|
|
873 ;; ignore it if executing
|
|
|
874 t)
|
|
|
875
|
|
|
876 (teco-define-type-2
|
|
|
877 ?| ; |
|
|
|
878 (let ((ll 1)
|
|
|
879 c)
|
|
|
880 (while (> ll 0)
|
|
|
881 (while (progn (setq c (teco-skipto))
|
|
|
882 (and (/= c ?\")
|
|
|
883 (/= c ?\')))
|
|
|
884 nil)
|
|
|
885 (if (= c ?\")
|
|
|
886 (setq ll (1+ ll))
|
|
|
887 (setq ll (1- ll))))))
|
|
|
888
|
|
|
889 (teco-define-type-2
|
|
|
890 ?u ; u
|
|
|
891 (if (not teco-exp-flag1)
|
|
|
892 (teco-error "NAU"))
|
|
|
893 (aset teco-qreg-number
|
|
|
894 (teco-get-qspec 0 (teco-get-command teco-trace))
|
|
|
895 teco-exp-val1)
|
|
|
896 (setq teco-exp-flag1 teco-exp-flag2 ; command's value is second arg
|
|
|
897 teco-exp-val1 teco-exp-val2
|
|
|
898 teco-exp-flag2 nil
|
|
|
899 teco-exp-op 'start))
|
|
|
900
|
|
|
901 (teco-define-type-2
|
|
|
902 ?q ; q
|
|
|
903 ;; Qn is numeric val, :Qn is # of chars, mQn is mth char
|
|
|
904 (let ((mm (teco-get-qspec (or teco-colon-flag teco-exp-flag1)
|
|
|
905 (teco-get-command teco-trace))))
|
|
|
906 (if (not teco-exp-flag1)
|
|
|
907 (setq teco-exp-val1 (if teco-colon-flag
|
|
|
908 ;; :Qn
|
|
|
909 (length (aref teco-qreg-text mm))
|
|
|
910 ;; Qn
|
|
|
911 (aref teco-qreg-number mm))
|
|
|
912 teco-exp-flag1 t)
|
|
|
913 ;; mQn
|
|
|
914 (let ((v (aref teco-qreg-text mm)))
|
|
|
915 (setq teco-exp-val1 (condition-case nil
|
|
|
916 (aref v teco-exp-val1)
|
|
|
917 (error -1))
|
|
|
918 teco-exp-op 'start)))
|
|
|
919 (setq teco-colon-flag nil)))
|
|
|
920
|
|
|
921 (teco-define-type-2
|
|
|
922 ?% ; %
|
|
|
923 (let* ((mm (teco-get-qspec nil (teco-get-command teco-trace)))
|
|
|
924 (v (+ (aref teco-qreg-number mm) (teco-get-value 1))))
|
|
|
925 (aset teco-qreg-number mm v)
|
|
|
926 (setq teco-exp-val1 v
|
|
|
927 teco-exp-flag1 t)))
|
|
|
928
|
|
|
929 (teco-define-type-2
|
|
|
930 ?c ; c
|
|
|
931 (let ((p (+ (point) (teco-get-value 1))))
|
|
|
932 (if (or (< p (point-min)) (> p (point-max)))
|
|
|
933 (teco-error "POP")
|
|
|
934 (goto-char p)
|
|
|
935 (setq teco-exp-flag2 nil))))
|
|
|
936
|
|
|
937 (teco-define-type-2
|
|
|
938 ?r ; r
|
|
|
939 (let ((p (- (point) (teco-get-value 1))))
|
|
|
940 (if (or (< p (point-min)) (> p (point-max)))
|
|
|
941 (teco-error "POP")
|
|
|
942 (goto-char p)
|
|
|
943 (setq teco-exp-flag2 nil))))
|
|
|
944
|
|
|
945 (teco-define-type-2
|
|
|
946 ?j ; j
|
|
|
947 (let ((p (teco-get-value (point-min))))
|
|
|
948 (if (or (< p (point-min)) (> p (point-max)))
|
|
|
949 (teco-error "POP")
|
|
|
950 (goto-char p)
|
|
|
951 (setq teco-exp-flag2 nil))))
|
|
|
952
|
|
|
953 (teco-define-type-2
|
|
|
954 ?l ; l
|
|
|
955 ;; move forward by lines
|
|
|
956 (forward-char (teco-lines (teco-get-value 1))))
|
|
|
957
|
|
|
958 (teco-define-type-2
|
|
|
959 ?\C-q ; ^q
|
|
|
960 ;; number of characters until the nth line feed
|
|
|
961 (setq teco-exp-val1 (teco-lines (teco-get-value 1))
|
|
|
962 teco-exp-flag1 t))
|
|
|
963
|
|
|
964 (teco-define-type-2
|
|
|
965 ?= ; =
|
|
|
966 ;; print numeric value
|
|
|
967 (if (not teco-exp-flag1)
|
|
|
968 (teco-error "NAE"))
|
|
|
969 (teco-output (format
|
|
|
970 (if (teco-peek-command ?=)
|
|
|
971 ;; at least one more =
|
|
|
972 (progn
|
|
|
973 ;; read past it
|
|
|
974 (teco-get-command teco-trace)
|
|
|
975 (if (teco-peek-command ?=)
|
|
|
976 ;; another?
|
|
|
977 (progn
|
|
|
978 ;; read it too
|
|
|
979 (teco-get-command teco-trace)
|
|
|
980 ;; print in hex
|
|
|
981 "%x")
|
|
|
982 ;; print in octal
|
|
|
983 "%o"))
|
|
|
984 ;; print in decimal
|
|
|
985 "%d")
|
|
|
986 teco-exp-val1))
|
|
|
987 ;; add newline if no colon
|
|
|
988 (if (not teco-colon-flag)
|
|
|
989 (teco-output ?\n))
|
|
|
990 ;; absorb argument, etc.
|
|
|
991 (setq teco-exp-flag1 nil
|
|
|
992 teco-exp-flag2 nil
|
|
|
993 teco-colon-flag nil
|
|
|
994 teco-exp-op 'start))
|
|
|
995
|
|
|
996 (teco-define-type-2
|
|
|
997 ?\t ; TAB
|
|
|
998 (if exp-flag1
|
|
|
999 (teco-error "IIA"))
|
|
|
1000 (let ((text (teco-get-text-arg)))
|
|
|
1001 (insert ?\t text)
|
|
|
1002 (setq teco-ctrl-s (1+ (length text))))
|
|
|
1003 ;; clear arguments
|
|
|
1004 (setq teco-colon-flag nil
|
|
|
1005 teco-exp-flag1 nil
|
|
|
1006 teco-exp-flag2 nil))
|
|
|
1007
|
|
|
1008 (teco-define-type-2
|
|
|
1009 ?i ; i
|
|
|
1010 (let ((text (teco-get-text-arg)))
|
|
|
1011 (if teco-exp-flag1
|
|
|
1012 ;; if a nI$ command
|
|
|
1013 (progn
|
|
|
1014 ;; text argument must be null
|
|
|
1015 (or (string-equal text "") (teco-error "IIA"))
|
|
|
1016 ;; insert the character
|
|
|
1017 (insert teco-exp-val1)
|
|
|
1018 (setq teco-ctrl-s 1)
|
|
|
1019 ;; consume argument
|
|
|
1020 (setq teco-exp-op 'start))
|
|
|
1021 ;; otherwise, insert the text
|
|
|
1022 (insert text)
|
|
|
1023 (setq teco-ctrl-s (length text)))
|
|
|
1024 ;; clear arguments
|
|
|
1025 (setq teco-colon-flag nil
|
|
|
1026 teco-exp-flag1 nil
|
|
|
1027 teco-exp-flag2 nil)))
|
|
|
1028
|
|
|
1029 (teco-define-type-2
|
|
|
1030 ?t ; t
|
|
|
1031 (let ((args (teco-line-args nil)))
|
|
|
1032 (teco-output (buffer-substring (car args) (cdr args)))))
|
|
|
1033
|
|
|
1034 (teco-define-type-2
|
|
|
1035 ?v ; v
|
|
|
1036 (let ((ll (teco-get-value 1)))
|
|
|
1037 (teco-output (buffer-substring (+ (point) (teco-lines (- 1 ll)))
|
|
|
1038 (+ (point) (teco-lines ll))))))
|
|
|
1039
|
|
|
1040 (teco-define-type-2
|
|
|
1041 ?\C-a ; ^a
|
|
|
1042 (teco-output (teco-get-text-arg nil ?\C-a))
|
|
|
1043 (setq teco-at-flag nil
|
|
|
1044 teco-colon-flag nil
|
|
|
1045 teco-exp-flag1 nil
|
|
|
1046 teco-exp-flag2 nil
|
|
|
1047 teco-exp-op 'start))
|
|
|
1048
|
|
|
1049 (teco-define-type-2
|
|
|
1050 ?d ; d
|
|
|
1051 (if (not teco-exp-flag2)
|
|
|
1052 ;; if only one argument
|
|
|
1053 (delete-char (teco-get-value 1))
|
|
|
1054 ;; if two arguments, treat as n,mK
|
|
|
1055 (let ((ll (teco-line-args 1)))
|
|
|
1056 (delete-region (car ll) (cdr ll)))))
|
|
|
1057
|
|
|
1058 (teco-define-type-2
|
|
|
1059 ?k ; k
|
|
|
1060 (let ((ll (teco-line-args 1)))
|
|
|
1061 (delete-region (car ll) (cdr ll))))
|
|
|
1062
|
|
|
1063 (teco-define-type-2
|
|
|
1064 ?\C-u ; ^u
|
|
|
1065 (let* ((mm (teco-get-qspec nil (teco-get-command teco-trace)))
|
|
|
1066 (text-arg (teco-get-text-arg))
|
|
|
1067 (text (if (not teco-exp-flag1)
|
|
|
1068 text-arg
|
|
|
1069 (if (string-equal text-arg "")
|
|
|
1070 (char-to-string teco-exp-val1)
|
|
|
1071 (teco-error "IIA")))))
|
|
|
1072 ;; if :, append to the register
|
|
|
1073 (aset teco-qreg-text mm (if teco-colon-flag
|
|
|
1074 (concat (aref teco-qreg-text mm) text)
|
|
|
1075 text))
|
|
|
1076 ;; clear various flags
|
|
|
1077 (setq teco-exp-flag1 nil
|
|
|
1078 teco-at-flag nil
|
|
|
1079 teco-colon-flag nil
|
|
|
1080 teco-exp-flag1 nil)))
|
|
|
1081
|
|
|
1082 (teco-define-type-2
|
|
|
1083 ?x ; x
|
|
|
1084 (let* ((mm (teco-get-qspec nil (teco-get-command teco-trace)))
|
|
|
1085 (args (teco-line-args 0))
|
|
|
1086 (text (buffer-substring (car args) (cdr args))))
|
|
|
1087 ;; if :, append to the register
|
|
|
1088 (aset teco-qreg-text mm (if teco-colon-flag
|
|
|
1089 (concat (aref teco-qreg-text mm) text)
|
|
|
1090 text))
|
|
|
1091 ;; clear various flags
|
|
|
1092 (setq teco-exp-flag1 nil
|
|
|
1093 teco-at-flag nil
|
|
|
1094 teco-colon-flag nil
|
|
|
1095 teco-exp-flag1 nil)))
|
|
|
1096
|
|
|
1097 (teco-define-type-2
|
|
|
1098 ?g ; g
|
|
|
1099 (let ((mm (teco-get-qspec t (teco-get-command teco-trace))))
|
|
|
1100 (if teco-colon-flag
|
|
|
1101 (teco-output (aref teco-qreg-text mm))
|
|
|
1102 (insert (aref teco-qreg-text mm)))
|
|
|
1103 (setq teco-colon-flag nil)))
|
|
|
1104
|
|
|
1105 (teco-define-type-2
|
|
|
1106 ?\[ ; \[
|
|
|
1107 (let ((mm (teco-get-qspec t (teco-get-command teco-trace))))
|
|
|
1108 (setq teco-qreg-stack
|
|
|
1109 (cons (cons (aref teco-qreg-text mm)
|
|
|
1110 (aref teco-qreg-number mm))
|
|
|
1111 teco-qreg-stack))))
|
|
|
1112
|
|
|
1113 (teco-define-type-2
|
|
|
1114 ?\] ; \]
|
|
|
1115 (let ((mm (teco-get-qspec t (teco-get-command teco-trace))))
|
|
|
1116 (if teco-colon-flag
|
|
|
1117 (setq teco-exp-flag1 t
|
|
|
1118 teco-exp-val1 (if teco-qreg-stack -1 0))
|
|
|
1119 (if teco-qreg-stack
|
|
|
1120 (let ((pop (car teco-qreg-stack)))
|
|
|
1121 (aset teco-qreg-text mm (car pop))
|
|
|
1122 (aset teco-qreg-number mm (cdr pop))
|
|
|
1123 (setq teco-qreg-stack (cdr teco-qreg-stack)))
|
|
|
1124 (teco-error "CPQ")))
|
|
|
1125 (setq teco-colon-flag nil)))
|
|
|
1126
|
|
|
1127 (teco-define-type-2
|
|
|
1128 ?\\ ; \
|
|
|
1129 (if (not teco-exp-flag1)
|
|
|
1130 ;; no argument; read number
|
|
|
1131 (let ((p (point))
|
|
|
1132 (sign +1)
|
|
|
1133 (n 0)
|
|
|
1134 c)
|
|
|
1135 (setq c (char-after p))
|
|
|
1136 (if c
|
|
|
1137 (if (= c ?+)
|
|
|
1138 (setq p (1+ p))
|
|
|
1139 (if (= c ?-)
|
|
|
1140 (setq p (1+ p)
|
|
|
1141 sign -1))))
|
|
|
1142 (cond
|
|
|
1143 ((= teco-ctrl-r 8)
|
|
|
1144 (while (progn
|
|
|
1145 (setq c (char-after p))
|
|
|
1146 (and c (>= c ?0) (<= c ?7)))
|
|
|
1147 (setq p (1+ p)
|
|
|
1148 n (+ c -48 (* n 8)))))
|
|
|
1149 ((= teco-ctrl-r 10)
|
|
|
1150 (while (progn
|
|
|
1151 (setq c (char-after p))
|
|
|
1152 (and c (>= c ?0) (<= c ?9)))
|
|
|
1153 (setq p (1+ p)
|
|
|
1154 n (+ c -48 (* n 10)))))
|
|
|
1155 (t
|
|
|
1156 (while (progn
|
|
|
1157 (setq c (char-after p))
|
|
|
1158 (and c
|
|
|
1159 (or
|
|
|
1160 (and (>= c ?0) (<= c ?9))
|
|
|
1161 (and (>= c ?a) (<= c ?f))
|
|
|
1162 (and (>= c ?A) (<= c ?F)))))
|
|
|
1163 (setq p (1+ p)
|
|
|
1164 n (+ c (if (> c ?F)
|
|
|
1165 ;; convert 'a' to 10
|
|
|
1166 -87
|
|
|
1167 (if (> c ?9)
|
|
|
1168 ;; convert 'A' to 10
|
|
|
1169 -55
|
|
|
1170 ;; convert '0' to 0
|
|
|
1171 -48))
|
|
|
1172 (* n 16))))))
|
|
|
1173 (setq teco-exp-val1 (* n sign)
|
|
|
1174 teco-exp-flag1 t
|
|
|
1175 teco-ctrl-s (- (point) p)))
|
|
|
1176 ;; argument: insert it as a digit string
|
|
|
1177 (insert (format (cond
|
|
|
1178 ((= teco-ctrl-r 8) "%o")
|
|
|
1179 ((= teco-ctrl-r 10) "%d")
|
|
|
1180 (t "%x"))
|
|
|
1181 teco-exp-val1))
|
|
|
1182 (setq teco-exp-flag1 nil
|
|
|
1183 teco-exp-op 'start)))
|
|
|
1184
|
|
|
1185 (teco-define-type-2
|
|
|
1186 ?\C-t ; ^t
|
|
|
1187 (if teco-exp-flag1
|
|
|
1188 ;; type a character
|
|
|
1189 (progn
|
|
|
1190 (teco-output teco-exp-val1)
|
|
|
1191 (setq teco-exp-flag1 nil))
|
|
|
1192 ;; input a character
|
|
|
1193 (let* ((echo-keystrokes 0)
|
|
|
1194 (c (read-char)))
|
|
|
1195 (teco-output c)
|
|
|
1196 (setq teco-exp-val1 c
|
|
|
1197 teco-exp-flag1 t))))
|
|
|
1198
|
|
|
1199 (teco-define-type-2
|
|
|
1200 ?s ; s
|
|
|
1201 (let ((arg (teco-get-text-arg))
|
|
|
1202 (count (if teco-exp-flag1 teco-expr-val1 1))
|
|
|
1203 regexp)
|
|
|
1204 (if (not (string-equal arg ""))
|
|
|
1205 (setq regexp (teco-parse-search-string arg)
|
|
|
1206 teco-last-search-string arg
|
|
|
1207 teco-last-search-regexp regexp)
|
|
|
1208 (setq regexp (teco-last-search-regexp)
|
|
|
1209 arg teco-last-search-string))
|
|
|
1210 (let ((p (point))
|
|
|
1211 (result (cond
|
|
|
1212 ((> count 0)
|
|
|
1213 (re-search-forward regexp nil t count))
|
|
|
1214 ((< count 0)
|
|
|
1215 (re-search-backward regexp nil t count))
|
|
|
1216 (t
|
|
|
1217 ;; 0s always is successful
|
|
|
1218 t))))
|
|
|
1219 ;; if ::s, restore point
|
|
|
1220 (if (eq teco-colon-flag 2)
|
|
|
1221 (goto-char p))
|
|
|
1222 ;; if no real or implied colon, error if not found
|
|
|
1223 (if (and (not result)
|
|
|
1224 (not teco-colon-flag)
|
|
|
1225 (/= (teco-peekcmdc) 34))
|
|
|
1226 (teco-error "SRH"))
|
|
|
1227 ;; set return results
|
|
|
1228 (setq teco-exp-flag2 nil
|
|
|
1229 teco-colon-flag nil
|
|
|
1230 teco-at-flag nil
|
|
|
1231 teco-exp-op 'start)
|
|
|
1232 (if teco-colon-flag
|
|
|
1233 (setq teco-exp-flag1 t
|
|
|
1234 teco-exp-val1 (if result -1 0))
|
|
|
1235 (setq teco-exp-flag1 nil)))))
|
|
|
1236
|
|
|
1237 (defun teco-parse-search-string (s)
|
|
|
1238 (let ((i 0)
|
|
|
1239 (l (length s))
|
|
|
1240 (r "")
|
|
|
1241 c)
|
|
|
1242 (while (< i l)
|
|
|
1243 (setq r (concat r (teco-parse-search-string-1))))
|
|
|
1244 r))
|
|
|
1245
|
|
|
1246 (defun teco-parse-search-string-1 ()
|
|
|
1247 (if (>= i l)
|
|
|
1248 (teco-error "ISS"))
|
|
|
1249 (setq c (aref s i))
|
|
|
1250 (setq i (1+ i))
|
|
|
1251 (cond
|
|
|
1252 ((eq c ?\C-e) ; ^E - special match characters
|
|
|
1253 (teco-parse-search-string-e))
|
|
|
1254 ((eq c ?\C-n) ; ^Nx - match all but x
|
|
|
1255 (teco-parse-search-string-n))
|
|
|
1256 ((eq c ?\C-q) ; ^Qx - use x literally
|
|
|
1257 (teco-parse-search-string-q))
|
|
|
1258 ((eq c ?\C-s) ; ^S - match separator chars
|
|
|
1259 "[^A-Za-z0-9]")
|
|
|
1260 ((eq c ?\C-x) ; ^X - match any character
|
|
|
1261 "[\000-\377]")
|
|
|
1262 (t ; ordinary character
|
|
|
1263 (teco-parse-search-string-char c))))
|
|
|
1264
|
|
|
1265 (defun teco-parse-search-string-char (c)
|
|
|
1266 (regexp-quote (char-to-string c)))
|
|
|
1267
|
|
|
1268 (defun teco-parse-search-string-q ()
|
|
|
1269 (if (>= i l)
|
|
|
1270 (teco-error "ISS"))
|
|
|
1271 (setq c (aref s i))
|
|
|
1272 (setq i (1+ i))
|
|
|
1273 (teco-parse-search-string-char c))
|
|
|
1274
|
|
|
1275 (defun teco-parse-search-string-e ()
|
|
|
1276 (if (>= i l)
|
|
|
1277 (teco-error "ISS"))
|
|
|
1278 (setq c (aref s i))
|
|
|
1279 (setq i (1+ i))
|
|
|
1280 (cond
|
|
|
1281 ((or (eq c ?a) (eq c ?A)) ; ^EA - match alphabetics
|
|
|
1282 "[A-Za-z]")
|
|
|
1283 ((or (eq c ?c) (eq c ?C)) ; ^EC - match symbol constituents
|
|
|
1284 "[A-Za-z.$]")
|
|
|
1285 ((or (eq c ?d) (eq c ?D)) ; ^ED - match numerics
|
|
|
1286 "[0-9]")
|
|
|
1287 ((eq c ?g) ; ^EGq - match any char in q-reg
|
|
|
1288 (teco-parse-search-string-e-g))
|
|
|
1289 ((or (eq c ?l) (eq c ?L)) ; ^EL - match line terminators
|
|
|
1290 "[\012\013\014]")
|
|
|
1291 ((eq c ?q) ; ^EQq - use contents of q-reg
|
|
|
1292 (teco-parse-search-string-e-q))
|
|
|
1293 ((eq c ?r) ; ^ER - match alphanumerics
|
|
|
1294 "[A-Za-z0-9]")
|
|
|
1295 ((eq c ?s) ; ^ES - match non-null space/tab seq
|
|
|
1296 "[ \t]+")
|
|
|
1297 ((eq c ?v) ; ^EV - match lower case alphabetic
|
|
|
1298 "[a-z]")
|
|
|
1299 ((eq c ?w) ; ^EW - match upper case alphabetic
|
|
|
1300 "[A-Z]")
|
|
|
1301 ((eq c ?x) ; ^EX - match any character
|
|
|
1302 "[\000-\377]")
|
|
|
1303 (t
|
|
|
1304 (teco-error "ISS"))))
|
|
|
1305
|
|
|
1306 (defun teco-parse-search-string-e-q ()
|
|
|
1307 (if (>= i l)
|
|
|
1308 (teco-error "ISS"))
|
|
|
1309 (setq c (aref s i))
|
|
|
1310 (setq i (1+ i))
|
|
|
1311 (regexp-quote (aref reco:q-reg-text c)))
|
|
|
1312
|
|
|
1313 (defun teco-parse-search-string-e-g ()
|
|
|
1314 (if (>= i l)
|
|
|
1315 (teco-error "ISS"))
|
|
|
1316 (setq c (aref s i))
|
|
|
1317 (setq i (1+ i))
|
|
|
1318 (let* ((q (aref teco-qreg-text c))
|
|
|
1319 (len (length q))
|
|
|
1320 (null (= len 0))
|
|
|
1321 (one-char (= len 1))
|
|
|
1322 (dash-present (string-match "-" q))
|
|
|
1323 (caret-present (string-match "\\^" q))
|
|
|
1324 (outbracket-present (string-match "]" q))
|
|
|
1325 p)
|
|
|
1326 (cond
|
|
|
1327 (null
|
|
|
1328 "[^\000-\377]")
|
|
|
1329 (one-char
|
|
|
1330 (teco-parse-search-string-char c))
|
|
|
1331 (t
|
|
|
1332 (while (setq p (string-match "^]\\^"))
|
|
|
1333 (setq q (concat (substring q 1 p) (substring q (1+ p)))))
|
|
|
1334 (concat
|
|
|
1335 "["
|
|
|
1336 (if outbracket-present "]" "")
|
|
|
1337 (if dash-present "---" "")
|
|
|
1338 q
|
|
|
1339 (if caret-present "^" ""))))))
|
|
|
1340
|
|
|
1341 (defun teco-parse-search-string-n ()
|
|
|
1342 (let ((p (teco-parse-search-string-1)))
|
|
|
1343 (cond
|
|
|
1344 ((= (aref p 0) ?\[)
|
|
|
1345 (if (= (aref p 1) ?^)
|
|
|
1346 ;; complement character set
|
|
|
1347 (if (= (length p) 4)
|
|
|
1348 ;; complement of one character
|
|
|
1349 (teco-parse-search-string-char (aref p 2))
|
|
|
1350 ;; complement of more than one character
|
|
|
1351 (concat "[" (substring p 2)))
|
|
|
1352 ;; character set - invert it
|
|
|
1353 (concat "[^" (substring p 1))))
|
|
|
1354 ((= (aref p 0) ?\\)
|
|
|
1355 ;; single quoted character
|
|
|
1356 (concat "[^" (substring p 1) "]"))
|
|
|
1357 (t
|
|
|
1358 ;; single character
|
|
|
1359 (if (string-equal p "-")
|
|
|
1360 "[^---]"
|
|
|
1361 (concat "[^" p "]"))))))
|
|
|
1362
|
|
|
1363 (teco-define-type-2
|
|
|
1364 ?o ; o
|
|
|
1365 (let ((label (teco-get-text-arg))
|
|
|
1366 (index (and teco-exp-flag1 teco-exp-val1)))
|
|
|
1367 (setq teco-exp-flag1 nil)
|
|
|
1368 ;; handle computed goto by extracting the proper label
|
|
|
1369 (if index
|
|
|
1370 (if (< index 0)
|
|
|
1371 ;; argument < 0 is a noop
|
|
|
1372 (setq label "")
|
|
|
1373 ;; otherwise, find the n-th label (0-origin)
|
|
|
1374 (setq label (concat label ","))
|
|
|
1375 (let ((p 0))
|
|
|
1376 (while (and (> index 0)
|
|
|
1377 (setq p (string-match "," label p))
|
|
|
1378 (setq p (1+ p)))
|
|
|
1379 (setq index (1- index)))
|
|
|
1380 (setq q (string-match "," label p))
|
|
|
1381 (setq label (substring label p q)))))
|
|
|
1382 ;; if the label is non-null, find the correct label
|
|
|
1383 ;; start from beginning of iteration or macro, and look for tag
|
|
|
1384 (setq teco-command-pointer
|
|
|
1385 (if teco-iteration-stack
|
|
|
1386 ;; if in iteration, start at beginning of iteration
|
|
|
1387 (aref (car teco-iteration-stack) 0)
|
|
|
1388 ;; if not in iteration, start at beginning of command or macro
|
|
|
1389 0))
|
|
|
1390 ;; search for tag
|
|
|
1391 (catch 'label
|
|
|
1392 (let ((level 0)
|
|
|
1393 c p l)
|
|
|
1394 ;; look for interesting things, including !
|
|
|
1395 (while t
|
|
|
1396 (setq c (teco-skipto t))
|
|
|
1397 (cond
|
|
|
1398 ((= c ?<) ; start of iteration
|
|
|
1399 (setq level (1+ level)))
|
|
|
1400 ((= c ?>) ; end of iteration
|
|
|
1401 (if (= level 0)
|
|
|
1402 (teco-pop-iter-stack t)
|
|
|
1403 (setq level (1- level))))
|
|
|
1404 ((= c ?!) ; start of tag
|
|
|
1405 (setq p (string-match "!" teco-command-string teco-command-pointer))
|
|
|
1406 (if (and p
|
|
|
1407 (string-equal label (substring teco-command-string
|
|
|
1408 teco-command-pointer
|
|
|
1409 p)))
|
|
|
1410 (progn
|
|
|
1411 (setq teco-command-pointer (1+ p))
|
|
|
1412 (throw 'label nil))))))))))
|
|
|
1413
|
|
|
1414 (teco-define-type-2
|
|
|
1415 ?a ; :a
|
|
|
1416 ;; 'a' must be used as ':a'
|
|
|
1417 (if (and teco-exp-flag1 teco-colon-flag)
|
|
|
1418 (let ((char (+ (point) teco-exp-val1)))
|
|
|
1419 (setq teco-exp-val1
|
|
|
1420 (if (and (>= char (point-min))
|
|
|
1421 (< char (point-max)))
|
|
|
1422 (char-after char)
|
|
|
1423 -1)
|
|
|
1424 teco-colon-flag nil))
|
|
|
1425 (teco-error "ILL")))
|
|
|
1426
|
|
|
1427
|
|
|
1428 ;; Routines to get next character from command buffer
|
|
|
1429 ;; getcmdc0, when reading beyond command string, pops
|
|
|
1430 ;; macro stack and continues.
|
|
|
1431 ;; getcmdc, in similar circumstances, reports an error.
|
|
|
1432 ;; If pushcmdc() has returned any chars, read them first
|
|
|
1433 ;; routines type characters as read, if argument != 0.
|
|
|
1434
|
|
|
1435 (defun teco-get-command0 (trace)
|
|
|
1436 ;; get the next character
|
|
|
1437 (let (char)
|
|
|
1438 (while (not (condition-case nil
|
|
|
1439 (setq char (aref teco-command-string teco-command-pointer))
|
|
|
1440 ;; if we've exhausted the string, pop the macro stack
|
|
|
1441 ;; if we exhaust the macro stack, exit
|
|
|
1442 (error (teco-pop-macro-stack)
|
|
|
1443 nil))))
|
|
|
1444 ;; bump the command pointer
|
|
|
1445 (setq teco-command-pointer (1+ teco-command-pointer))
|
|
|
1446 ;; trace, if requested
|
|
|
1447 (and trace (teco-trace-type char))
|
|
|
1448 ;; return the character
|
|
|
1449 char))
|
|
|
1450
|
|
|
1451 ;; while (cptr.dot >= cptr.z) /* if at end of this level, pop macro stack
|
|
|
1452 ;; {
|
|
|
1453 ;; if (--msp < &mstack[0]) /* pop stack; if top level
|
|
|
1454 ;; {
|
|
|
1455 ;; msp = &mstack[0]; /* restore stack pointer
|
|
|
1456 ;; cmdc = ESC; /* return an ESC (ignored)
|
|
|
1457 ;; exitflag = 1; /* set to terminate execution
|
|
|
1458 ;; return(cmdc); /* exit "while" and return
|
|
|
1459 ;; }
|
|
|
1460 ;; }
|
|
|
1461 ;; cmdc = cptr.p->ch[cptr.c++]; /* get char
|
|
|
1462 ;; ++cptr.dot; /* increment character count
|
|
|
1463 ;; if (trace) type_char(cmdc); /* trace
|
|
|
1464 ;; if (cptr.c > CELLSIZE-1) /* and chain if need be
|
|
|
1465 ;; {
|
|
|
1466 ;; cptr.p = cptr.p->f;
|
|
|
1467 ;; cptr.c = 0;
|
|
|
1468 ;; }
|
|
|
1469 ;; return(cmdc);
|
|
|
1470 ;; }
|
|
|
1471
|
|
|
1472
|
|
|
1473 (defun teco-get-command (trace)
|
|
|
1474 ;; get the next character
|
|
|
1475 (let ((char (condition-case nil
|
|
|
1476 (aref teco-command-string teco-command-pointer)
|
|
|
1477 ;; if we've exhausted the string, give error
|
|
|
1478 (error
|
|
|
1479 (teco-error (if teco-macro-stack "UTM" "UTC"))))))
|
|
|
1480 ;; bump the command pointer
|
|
|
1481 (setq teco-command-pointer (1+ teco-command-pointer))
|
|
|
1482 ;; trace, if requested
|
|
|
1483 (and trace (teco-trace-type char))
|
|
|
1484 ;; return the character
|
|
|
1485 char))
|
|
|
1486
|
|
|
1487 ;; char getcmdc(trace)
|
|
|
1488 ;; {
|
|
|
1489 ;; if (cptr.dot++ >= cptr.z) ERROR((msp <= &mstack[0]) ? E_UTC : E_UTM);
|
|
|
1490 ;; else
|
|
|
1491 ;; {
|
|
|
1492 ;; cmdc = cptr.p->ch[cptr.c++]; /* get char
|
|
|
1493 ;; if (trace) type_char(cmdc); /* trace
|
|
|
1494 ;; if (cptr.c > CELLSIZE-1) /* and chain if need be
|
|
|
1495 ;; {
|
|
|
1496 ;; cptr.p = cptr.p->f;
|
|
|
1497 ;; cptr.c = 0;
|
|
|
1498 ;; }
|
|
|
1499 ;; }
|
|
|
1500 ;; return(cmdc);
|
|
|
1501 ;; }
|
|
|
1502
|
|
|
1503
|
|
|
1504 ;; peek at next char in command string, return 1 if it is equal
|
|
|
1505 ;; (case independent) to argument
|
|
|
1506
|
|
|
1507 (defun teco-peek-command (arg)
|
|
|
1508 (condition-case nil
|
|
|
1509 (eq (aref teco-mapch-l (aref teco-command-string teco-command-pointer))
|
|
|
1510 (aref teco-mapch-l arg))
|
|
|
1511 (error nil)))
|
|
|
1512
|
|
|
1513 ;; int peekcmdc(arg)
|
|
|
1514 ;; char arg;
|
|
|
1515 ;; {
|
|
|
1516 ;; return(((cptr.dot < cptr.z) && (mapch_l[cptr.p->ch[cptr.c]] == mapch_l[arg])) ? 1 : 0);
|
|
|
1517 ;; }
|
|
|
1518
|
|
|
1519 (defun teco-get-text-arg (&optional term-char default-term-char)
|
|
|
1520 ;; figure out what the terminating character is
|
|
|
1521 (setq teco-term-char (or term-char
|
|
|
1522 (if teco-at-flag
|
|
|
1523 (teco-get-command teco-trace)
|
|
|
1524 (or default-term-char
|
|
|
1525 ?\e)))
|
|
|
1526 teco-at_flag nil)
|
|
|
1527 (let ((s "")
|
|
|
1528 c)
|
|
|
1529 (while (progn
|
|
|
1530 (setq c (teco-get-command teco-trace))
|
|
|
1531 (/= c teco-term-char))
|
|
|
1532 (setq s (concat s (char-to-string c))))
|
|
|
1533 s))
|
|
|
1534
|
|
|
1535
|
|
|
1536 ;; Routines to manipulate the stacks
|
|
|
1537
|
|
|
1538 ;; Pop the macro stack. Throw to 'teco-exit' if the stack is empty.
|
|
|
1539 (defun teco-pop-macro-stack ()
|
|
|
1540 (if teco-macro-stack
|
|
|
1541 (let ((frame (car teco-macro-stack)))
|
|
|
1542 (setq teco-macro-stack (cdr teco-macro-stack)
|
|
|
1543 teco-command-string (aref frame 0)
|
|
|
1544 teco-command-pointer (aref frame 1)
|
|
|
1545 teco-exec-flags (aref frame 2)
|
|
|
1546 teco-iteration-stack (aref frame 3)
|
|
|
1547 teco-cond-stack (aref frame 4)))
|
|
|
1548 (throw 'teco-exit nil)))
|
|
|
1549
|
|
|
1550 ;; Push the macro stack.
|
|
|
1551 (defun teco-push-macro-stack ()
|
|
|
1552 (setq teco-macro-stack
|
|
|
1553 (cons (vector teco-command-string
|
|
|
1554 teco-command-pointer
|
|
|
1555 teco-exec-flags
|
|
|
1556 teco-iteration-stack
|
|
|
1557 teco-cond-stack)
|
|
|
1558 teco-macro-stack)))
|
|
|
1559
|
|
|
1560 ;; Pop the expression stack.
|
|
|
1561 (defun teco-pop-exp-stack ()
|
|
|
1562 (let ((frame (car teco-exp-stack)))
|
|
|
1563 (setq teco-exp-stack (cdr teco-exp-stack)
|
|
|
1564 teco-exp-val1 (aref frame 0)
|
|
|
1565 teco-exp-flag1 (aref frame 1)
|
|
|
1566 teco-exp-val2 (aref frame 2)
|
|
|
1567 teco-exp-flag2 (aref frame 3)
|
|
|
1568 teco-exp-exp (aref frame 4)
|
|
|
1569 teco-exp-op (aref frame 5))))
|
|
|
1570
|
|
|
1571 ;; Push the expression stack.
|
|
|
1572 (defun teco-push-exp-stack ()
|
|
|
1573 (setq teco-exp-stack
|
|
|
1574 (cons (vector teco-exp-val1
|
|
|
1575 teco-exp-flag1
|
|
|
1576 teco-exp-val2
|
|
|
1577 teco-exp-flag2
|
|
|
1578 teco-exp-exp
|
|
|
1579 teco-exp-op)
|
|
|
1580 teco-exp-stack)))
|
|
|
1581
|
|
|
1582 ;; Pop the iteration stack
|
|
|
1583 ;; if arg t, exit unconditionally
|
|
|
1584 ;; else check exit conditions and exit or reiterate
|
|
|
1585 (defun teco-pop-iter-stack (arg)
|
|
|
1586 (let ((frame (car teco-iteration-stack)))
|
|
|
1587 (if (or arg
|
|
|
1588 (not (aref frame 1))
|
|
|
1589 ;; test against 1, since one iteration has already been done
|
|
|
1590 (<= (aref frame 2) 1))
|
|
|
1591 ;; exit iteration
|
|
|
1592 (setq teco-iteration-stack (cdr teco-iteration-stack))
|
|
|
1593 ;; continue with iteration
|
|
|
1594 ;; decrement count
|
|
|
1595 (aset frame 2 (1- (aref frame 2)))
|
|
|
1596 ;; reset command pointer
|
|
|
1597 (setq teco-command-pointer (aref frame 0)))))
|
|
|
1598
|
|
|
1599 ;; Push the iteration stack
|
|
|
1600 (defun teco-push-iter-stack (pointer flag count)
|
|
|
1601 (setq teco-iteration-stack
|
|
|
1602 (cons (vector pointer
|
|
|
1603 flag
|
|
|
1604 count)
|
|
|
1605 teco-iteration-stack)))
|
|
|
1606
|
|
|
1607 (defun teco-find-enditer ()
|
|
|
1608 (let ((icnt 1)
|
|
|
1609 c)
|
|
|
1610 (while (> icnt 0)
|
|
|
1611 (while (progn (setq c (teco-skipto))
|
|
|
1612 (and (/= c ?<)
|
|
|
1613 (/= c ?>)))
|
|
|
1614 (if (= c ?<)
|
|
|
1615 (setq icnt (1+ icnt))
|
|
|
1616 (setq icnt (1- icnt)))))))
|
|
|
1617
|
|
|
1618
|
|
|
1619 ;; I/O routines
|
|
|
1620
|
|
|
1621 (defvar teco-output-buffer (get-buffer-create "*Teco Output*")
|
|
|
1622 "The buffer into which Teco output is written.")
|
|
|
1623
|
|
|
1624 (defun teco-out-init ()
|
|
|
1625 ;; Recreate the teco output buffer, if necessary
|
|
|
1626 (setq teco-output-buffer (get-buffer-create "*Teco Output*"))
|
|
|
1627 (save-excursion
|
|
|
1628 (set-buffer teco-output-buffer)
|
|
|
1629 ;; get a fresh line in output buffer
|
|
|
1630 (goto-char (point-max))
|
|
|
1631 (insert ?\n)
|
|
|
1632 ;; remember where to start displaying
|
|
|
1633 (setq teco-output-start (point))
|
|
|
1634 ;; clear minibuffer, in case we have to display in it
|
|
|
1635 (save-window-excursion
|
|
|
1636 (select-window (minibuffer-window))
|
|
|
1637 (erase-buffer))
|
|
|
1638 ;; if output is visible, position it correctly
|
|
|
1639 (let ((w (get-buffer-window teco-output-buffer)))
|
|
|
1640 (if w
|
|
|
1641 (progn
|
|
|
1642 (set-window-start w teco-output-start)
|
|
|
1643 (set-window-point w teco-output-start))))))
|
|
|
1644
|
|
|
1645 (defun teco-output (s)
|
|
|
1646 (let ((w (get-buffer-window teco-output-buffer))
|
|
|
1647 (b (current-buffer))
|
|
|
1648 (sw (selected-window)))
|
|
|
1649 ;; Put the text in the output buffer
|
|
|
1650 (set-buffer teco-output-buffer)
|
|
|
1651 (goto-char (point-max))
|
|
|
1652 (insert s)
|
|
|
1653 (let ((p (point)))
|
|
|
1654 (set-buffer b)
|
|
|
1655 (if w
|
|
|
1656 ;; if output is visible, move the window point to the end
|
|
|
1657 (set-window-point w p)
|
|
|
1658 ;; Otherwise, we have to figure out how to display the text
|
|
|
1659 ;; Has a newline followed by another character been added to the
|
|
|
1660 ;; output buffer? If so, we have to make the output buffer visible.
|
|
|
1661 (if (save-excursion
|
|
|
1662 (set-buffer teco-output-buffer)
|
|
|
1663 (backward-char 1)
|
|
|
1664 (search-backward "\n" teco-output-start t))
|
|
|
1665 ;; a newline has been seen, clear the minibuffer and make the
|
|
|
1666 ;; output buffer visible
|
|
|
1667 (progn
|
|
|
1668 (save-window-excursion
|
|
|
1669 (select-window (minibuffer-window))
|
|
|
1670 (erase-buffer))
|
|
|
1671 (let ((pop-up-windows t))
|
|
|
1672 (pop-to-buffer teco-output-buffer)
|
|
|
1673 (goto-char p)
|
|
|
1674 (set-window-start w teco-output-start)
|
|
|
1675 (set-window-point w p)
|
|
|
1676 (select-window sw)))
|
|
|
1677 ;; a newline has not been seen, add output to minibuffer
|
|
|
1678 (save-window-excursion
|
|
|
1679 (select-window (minibuffer-window))
|
|
|
1680 (goto-char (point-max))
|
|
|
1681 (insert s)))))))
|
|
|
1682
|
|
|
1683 ;; Output a character of tracing information
|
|
|
1684 (defun teco-trace-type (c)
|
|
|
1685 (teco-output (if (= c ?\e)
|
|
|
1686 ?$
|
|
|
1687 c)))
|
|
|
1688
|
|
|
1689 ;; Report an error
|
|
|
1690 (defun teco-error (code)
|
|
|
1691 (let ((text (cdr (assoc code teco-error-texts))))
|
|
|
1692 (teco-output (concat (if (save-excursion (set-buffer teco-output-buffer)
|
|
|
1693 (/= (point) teco-output-start))
|
|
|
1694 "\n"
|
|
|
1695 "")
|
|
|
1696 "? " code " " text))
|
|
|
1697 (beep)
|
|
|
1698 (if debug-on-error (debug nil code text))
|
|
|
1699 (throw 'teco-exit nil)))
|
|
|
1700
|
|
|
1701
|
|
|
1702 ;; Utility routines
|
|
|
1703
|
|
|
1704 ;; copy characters from command string to buffer
|
|
|
1705 (defun teco-moveuntil (string pointer terminate trace)
|
|
|
1706 (let ((count 0))
|
|
|
1707 (condition-case nil
|
|
|
1708 (while (/= (aref string pointer) terminate)
|
|
|
1709 (and teco-trace (teco-trace-type (aref string pointer)))
|
|
|
1710 (insert (aref string pointer))
|
|
|
1711 (setq pointer (1+ pointer))
|
|
|
1712 (setq count (1+ count)))
|
|
|
1713 (error (teco-error (if teco-macro-stack "UTM" "UTC"))))
|
|
|
1714 count))
|
|
|
1715
|
|
|
1716 ;; Convert character to q-register name
|
|
|
1717 ;; If file-or-search is t, allow _, *, %, #
|
|
|
1718 (defun teco-get-qspec (file-or-search char)
|
|
|
1719 ;; lower-case char
|
|
|
1720 (setq char (aref teco-mapch-l char))
|
|
|
1721 ;; test that it's valid
|
|
|
1722 (if (= (logand (aref teco-qspec-valid char) (if file-or-search 2 1)) 0)
|
|
|
1723 (teco-error "IQN"))
|
|
|
1724 char)
|
|
|
1725
|
|
|
1726 ;; Set or get value of a variable
|
|
|
1727 (defun teco-set-var (var)
|
|
|
1728 (if teco-exp-flag1
|
|
|
1729 (progn
|
|
|
1730 (if teco-exp-flag2
|
|
|
1731 ;; if two arguments, they they are <clear bits>, <set bits>
|
|
|
1732 (set var (logior (logand (symbol-value var) (lognot teco-exp-val2))
|
|
|
1733 teco-exp-val1))
|
|
|
1734 ;; if one argument, it is the new value
|
|
|
1735 (set var teco-exp-val1))
|
|
|
1736 ;; consume argument(s)
|
|
|
1737 (setq teco-exp-flag2 nil
|
|
|
1738 teco-exp-flag1 nil))
|
|
|
1739 ;; if no arguments, fetch the value
|
|
|
1740 (setq teco-exp-val1 (symbol-value var)
|
|
|
1741 teco-exp-flag1 t)))
|
|
|
1742
|
|
|
1743 ;; Get numeric argument
|
|
|
1744 (defun teco-get-value (default)
|
|
|
1745 (prog1
|
|
|
1746 (if teco-exp-flag1
|
|
|
1747 teco-exp-val1
|
|
|
1748 (if (eq teco-exp-op 'sub)
|
|
|
1749 (- default)
|
|
|
1750 default))
|
|
|
1751 ;; consume argument
|
|
|
1752 (setq teco-exp-flag1 nil
|
|
|
1753 teco-exp-op 'start)))
|
|
|
1754
|
|
|
1755 ;; Get argument measuring in lines
|
|
|
1756 (defun teco-lines (r)
|
|
|
1757 (- (save-excursion
|
|
|
1758 (if (> r 0)
|
|
|
1759 (if (search-forward "\n" nil t r)
|
|
|
1760 (point)
|
|
|
1761 (point-max))
|
|
|
1762 (if (search-backward "\n" nil t (- 1 r))
|
|
|
1763 (1+ (point))
|
|
|
1764 (point-min))))
|
|
|
1765 (point)))
|
|
|
1766
|
|
|
1767 ;; routine to handle args for K, T, X, etc.
|
|
|
1768 ;; if two args, 'char x' to 'char y'
|
|
|
1769 ;; if just one arg, then n lines (default 1)
|
|
|
1770 (defun teco-line-args (arg)
|
|
|
1771 (if teco-exp-flag2
|
|
|
1772 (cons teco-exp-val1 teco-exp-val2)
|
|
|
1773 (cons (point) (+ (point) (teco-lines (if teco-exp-flag1
|
|
|
1774 teco-exp-val1
|
|
|
1775 1))))))
|
|
|
1776
|
|
|
1777 ;; routine to skip to next ", ', |, <, or >
|
|
|
1778 ;; skips over these chars embedded in text strings
|
|
|
1779 ;; stops in ! if argument is t
|
|
|
1780 ;; returns character found
|
|
|
1781 (defun teco-skipto (&optional arg)
|
|
|
1782 (catch 'teco-skip
|
|
|
1783 (let (;; "at" prefix
|
|
|
1784 (atsw nil)
|
|
|
1785 ;; temp attributes
|
|
|
1786 ta
|
|
|
1787 ;; terminator
|
|
|
1788 term
|
|
|
1789 skipc)
|
|
|
1790 (while t ; forever
|
|
|
1791 (while (progn
|
|
|
1792 (setq skipc (teco-get-command nil)
|
|
|
1793 ta (aref teco-spec-chars skipc))
|
|
|
1794 ;; if char is ^, treat next char as control
|
|
|
1795 (if (eq skipc ?^)
|
|
|
1796 (setq skipc (logand 31 (teco-get-command nil))
|
|
|
1797 ta (aref teco-spec-chars skipc)))
|
|
|
1798 (= (logand ta 51) 0)) ; read until something interesting
|
|
|
1799 ; found
|
|
|
1800 nil)
|
|
|
1801 (if (/= (logand ta 32) 0)
|
|
|
1802 (teco-get-command nil)) ; if command takes a Q spec,
|
|
|
1803 ; skip the spec
|
|
|
1804 (if (/= (logand ta 16) 0) ; sought char found: quit
|
|
|
1805 (progn
|
|
|
1806 (if (= skipc ?\") ; quote must skip next char
|
|
|
1807 (teco-get-command nil))
|
|
|
1808 (throw 'teco-skip skipc)))
|
|
|
1809 (if (/= (logand ta 1) 0) ; other special char
|
|
|
1810 (cond
|
|
|
1811 ((eq skipc ?@) ; use alternative text terminator
|
|
|
1812 (setq atsw t))
|
|
|
1813 ((eq skipc ?\C-^) ; ^^ is value of next char
|
|
|
1814 ; skip that char
|
|
|
1815 (teco-get-command nil))
|
|
|
1816 ((eq skipc ?\C-a) ; type text
|
|
|
1817 (setq term (if atsw (teco-get-command nil) ?\C-a)
|
|
|
1818 atsw nil)
|
|
|
1819 (while (/= (teco-get-command nil) term)
|
|
|
1820 nil)) ; skip text
|
|
|
1821 ((eq skipc ?!) ; tag
|
|
|
1822 (if arg
|
|
|
1823 (throw 'teco-skip skipc))
|
|
|
1824 (while (/= (teco-get-command nil) ?!)
|
|
|
1825 nil)) ; skip until next !
|
|
|
1826 ((or (eq skipc ?e)
|
|
|
1827 (eq skipc ?f)) ; first char of two-letter E or F
|
|
|
1828 ; command
|
|
|
1829 nil))) ; not implemented
|
|
|
1830 (if (/= (logand ta 2) 0) ; command with a text
|
|
|
1831 ; argument
|
|
|
1832 (progn
|
|
|
1833 (setq term (if atsw (teco-get-command nil) ?\e)
|
|
|
1834 atsw nil)
|
|
|
1835 (while (/= (teco-get-command nil) term)
|
|
|
1836 nil) ; skip text
|
|
|
1837 ))))))
|
|
|
1838
|
|
|
1839
|
|
|
1840 (defvar teco-command-keymap
|
|
|
1841 ;; This is what used to be (make-vector 128 'teco-command-self-insert)
|
|
|
1842 ;; Oh well
|
|
|
1843 (let ((map (make-keymap)) (n 127))
|
|
|
1844 (while (>= n 0)
|
|
|
1845 (define-key map (if (< n 32) (list 'control (+ n 32)) n)
|
|
|
1846 'teco-command-self-insert)
|
|
|
1847 (setq n (1- n)))
|
|
|
1848 map)
|
|
|
1849 "Keymap used while reading teco commands.")
|
|
|
1850
|
|
|
1851 (define-key teco-command-keymap "\^g" 'teco-command-ctrl-g)
|
|
|
1852 (define-key teco-command-keymap "\^m" 'teco-command-return)
|
|
|
1853 (define-key teco-command-keymap "\^u" 'teco-command-ctrl-u)
|
|
|
1854 (define-key teco-command-keymap "\e" 'teco-command-escape)
|
|
|
1855 (define-key teco-command-keymap "\^?" 'teco-command-delete)
|
|
|
1856
|
|
|
1857 (defvar teco-command-escapes nil
|
|
|
1858 "Records where ESCs are, since they are represented in the command buffer
|
|
|
1859 by $.")
|
|
|
1860
|
|
|
1861 ;;;###autoload
|
|
|
1862 (defun teco-command ()
|
|
|
1863 "Read and execute a Teco command string."
|
|
|
1864 (interactive)
|
|
|
1865 (let* ((teco-command-escapes nil)
|
|
|
1866 (command (catch 'teco-command-quit
|
|
|
1867 (read-from-minibuffer teco-prompt nil
|
|
|
1868 teco-command-keymap))))
|
|
|
1869 (if command
|
|
|
1870 (progn
|
|
|
1871 (while teco-command-escapes
|
|
|
1872 (aset command (car teco-command-escapes) ?\e)
|
|
|
1873 (setq teco-command-escapes (cdr teco-command-escapes)))
|
|
|
1874 (setq teco-output-buffer (get-buffer-create "*Teco Output*"))
|
|
|
1875 (save-excursion
|
|
|
1876 (set-buffer teco-output-buffer)
|
|
|
1877 (goto-char (point-max))
|
|
|
1878 (insert teco-prompt command))
|
|
|
1879 (teco-execute-command command)))))
|
|
|
1880
|
|
|
1881 (defun teco-read-command ()
|
|
|
1882 "Read a teco command string from the user."
|
|
|
1883 (let ((command (catch 'teco-command-quit
|
|
|
1884 (read-from-minibuffer teco-prompt nil
|
|
|
1885 teco-command-keymap)))
|
|
|
1886 teco-command-escapes)
|
|
|
1887 (if command
|
|
|
1888 (while teco-command-escapes
|
|
|
1889 (aset command (car teco-command-escapes ?\e))
|
|
|
1890 (setq teco-command-escapes (cdr teco-command-escapes))))
|
|
|
1891 command))
|
|
|
1892
|
|
|
1893 (defun teco-command-self-insert ()
|
|
|
1894 (interactive)
|
|
|
1895 (insert last-command-char)
|
|
|
1896 (if (not (pos-visible-in-window-p))
|
|
|
1897 (enlarge-window 1)))
|
|
|
1898
|
|
|
1899 (defun teco-command-ctrl-g ()
|
|
|
1900 (interactive)
|
|
|
1901 (beep)
|
|
|
1902 (throw 'teco-command-quit nil))
|
|
|
1903
|
|
|
1904 (defun teco-command-return ()
|
|
|
1905 (interactive)
|
|
|
1906 (setq last-command-char ?\n)
|
|
|
1907 (teco-command-self-insert))
|
|
|
1908
|
|
|
1909 (defun teco-command-escape ()
|
|
|
1910 (interactive)
|
|
|
1911 ;; Two ESCs in a row terminate the command string
|
|
|
1912 (if (eq last-command 'teco-command-escape)
|
|
|
1913 (throw 'teco-command-quit (buffer-string)))
|
|
|
1914 (setq teco-command-escapes (cons (1- (point)) teco-command-escapes))
|
|
|
1915 (setq last-command-char ?$)
|
|
|
1916 (teco-command-self-insert))
|
|
|
1917
|
|
|
1918 (defun teco-command-ctrl-u ()
|
|
|
1919 (interactive)
|
|
|
1920 ;; delete the characters
|
|
|
1921 (kill-line 0)
|
|
|
1922 ;; forget that they were ESCs
|
|
|
1923 (while (and teco-command-escapes (<= (point) (car teco-command-escapes)))
|
|
|
1924 (setq teco-command-escapes (cdr teco-command-escapes)))
|
|
|
1925 ;; decide whether to shrink the window
|
|
|
1926 (while (let ((a (insert ?\n))
|
|
|
1927 (b (pos-visible-in-window-p))
|
|
|
1928 (c (backward-delete-char 1)))
|
|
|
1929 b)
|
|
|
1930 (shrink-window 1)))
|
|
|
1931
|
|
|
1932 (defun teco-command-delete ()
|
|
|
1933 (interactive)
|
|
|
1934 ;; delete the character
|
|
|
1935 (backward-delete-char 1)
|
|
|
1936 ;; forget that it was an ESC
|
|
|
1937 (if (and teco-command-escapes (= (point) (car teco-command-escapes)))
|
|
|
1938 (setq teco-command-escapes (cdr teco-command-escapes)))
|
|
|
1939 ;; decide whether to shrink the window
|
|
|
1940 (insert ?\n)
|
|
|
1941 (if (prog1 (pos-visible-in-window-p)
|
|
|
1942 (backward-delete-char 1))
|
|
|
1943 (shrink-window 1)))
|
|
|
1944
|
|
|
1945 (provide 'teco)
|
|
|
1946
|
|
|
1947 ;;; teco.el ends here
|
