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