home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mutt / builtin / basic.mut < prev    next >
Lisp/Scheme  |  1995-01-14  |  45KB  |  1,741 lines
  1. ;; Basic user interaction commands
  2. ;; C Durland    9/92 Public Domain
  3.  
  4. ;?*(yesno)
  5. ;?*pgm*(delete-char n) - delete n characters.  ?n < 0? do as pgm
  6.  
  7. ;/Changed (looking-at any ...) to
  8. ;/  (looking-at pattern move) [STRING [BOOL] : BOOL]
  9.  
  10. ;;;;;;;;;; keymaps
  11. ;; Keymaps have two parts:  prefix keys, the keymap
  12. ;; Ids:  0 is global map, 1 is buffer local map, manage like marks.
  13. ;; Always immortal, can't free
  14. ;; (prefix-key keymap-id ...)
  15. ;;/(create-keymap)
  16. ;;/(clear-keymap)    Yech - only for back compatibility
  17. ;;/(install-keymap id)
  18. ;;/(bind-key keymap-id pgm-name key-name ...)
  19.  
  20. ; ability to program the dialog buffer eg want to bind a key to insert the
  21. ;   current buffer (M-.).  Also want to unbind everything so you don't have
  22. ;   to use C-q in describe-key.
  23. ; bring out the undo numbers so they can be configured.  Also save undo stats.
  24.  
  25. ;; (window-length n x)
  26. ;;   x : shrink top window, shrink bottom window, you decide
  27. ;;   z : the window to shrink????
  28.  
  29. ;; Notes
  30. ;;   make arg-prefix int32
  31. ;;   replace or add twiddle.mut with transpose- stuff from simple.el
  32. ;;   add (do-self-insert) so can do a read-only mode or vi mode
  33. ;;   2 mods to (nth-buffer n) - negative n and skip flags.
  34. ;;   read-only
  35. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36.  
  37.  
  38. ;added:
  39. ; /(scroll-other-window)
  40. ;  Note big difference with GNU scroll-down/up = like my pager
  41.  
  42.  
  43. (include me.mh)
  44.  
  45. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48.  
  49. (small-int goal-column)
  50.  
  51. ;; Move forward by full lines.  If prefix < 0 move backwards.
  52. ;; The last command controls how the goal column is set.
  53. ;; Bound to "C-n"
  54.  
  55. (defun
  56.   next-line
  57.   {
  58.     (bool s)
  59.  
  60.       ;; Reset goal if last key not C-p or C-n
  61.     (if (command-flag CMDFLG-NTEST-AND-SET CF-LINE)
  62.     (goal-column (current-column)))
  63.  
  64.     (s (forward-line (arg-prefix)))
  65.     (current-column goal-column)
  66.  
  67.     (arg-flag FALSE 1)        ;; reset arg count
  68.  
  69.     s
  70.   }
  71.   previous-line { (arg-prefix (- 0 (arg-prefix))) (next-line) }
  72. )
  73.  
  74.  
  75. (defun
  76.   nextchar (int n) HIDDEN
  77.   {
  78.     (arg-flag FALSE 1)        ;; reset arg count
  79.     (forward-char n)
  80.   }
  81.   next-character     { (nextchar (arg-prefix)) }
  82.   previous-character { (nextchar (- 0 (arg-prefix))) }
  83. )
  84.  
  85. (defun
  86.   MAIN
  87.   {
  88.     (bind-key GLOBAL-KEYMAP
  89.     "next-line"            "C-n"
  90.     "previous-line"            "C-p"
  91.     "next-character"        "C-f"
  92.     "previous-character"        "C-b"
  93.     )
  94.   }
  95. )
  96.  
  97. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  98. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  99. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  100.  
  101.     ;; Notes:
  102.     ;;   For self-insert characters,
  103.     ;;     (arg-prefix n)(exe-key (convert-to CHARACTER char))) will put n
  104.     ;;     chars in to the current buffer.  But if char is bound to
  105.     ;;     anything (like tab is), you could get an infinite loop.
  106. (defun insert-n-chars (int n)(string chars) HIDDEN
  107. {
  108.   (int j)
  109.  
  110.   (j n)(while (< 0 j) { (insert-text chars)(-= j 1) })
  111. })
  112.  
  113. ;; Insert tab(s) into buffer.
  114. ;; If tabsize == 0, use true tabs.  Otherwise, simulate tab stops every
  115. ;;   tabsize characters using blanks.
  116. ;; Bound to "C-i"
  117. (defun tab
  118. {
  119.   (int n tab-size)
  120.  
  121.   (n (arg-prefix))
  122.  
  123.   (arg-flag FALSE 1)        ;; reset arg count
  124.  
  125.   (if (<= n 0) (done))        ;; I can insert 0 or more tabs but not less
  126.  
  127.   (if (== 0 (tab-size (tab-stops)))
  128.     (insert-n-chars n "^I")
  129.     {
  130.       (arg-prefix (- (* n tab-size) (mod (- (current-column) 1) tab-size)))
  131.       (exe-key 0x20)
  132.     })
  133. ;    (insert-n-chars
  134. ;    (- (* n tab-size) (mod (- (current-column) 1) tab-size)) " "))
  135.  
  136.   TRUE
  137. })
  138.  
  139.  
  140. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  141. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  142. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  143.  
  144.  
  145. ;; Insert a newline.
  146. ;; Bound to "C-m"
  147. ;; Returns:
  148. ;;   TRUE or aborts
  149. (defun newline
  150. {
  151.   (int n)
  152.  
  153.   (n (arg-prefix))
  154.  
  155.   (arg-flag FALSE 1)        ;; reset arg count
  156.  
  157.   (if (<= n 0)    ;; I can insert 0 or more newlines but not less
  158.     { TRUE (done) })
  159.  
  160.   (insert-n-chars n "^J")
  161.  
  162.   TRUE
  163. })
  164.  
  165. ;; Open up some blank space.  The basic plan is to insert a bunch of
  166. ;;   newlines, and then back up over them.
  167. ;; Bound to "C-o" (oh)
  168. (defun open-line
  169. {
  170.   (int n)
  171.  
  172.   (n (arg-prefix))
  173.  
  174.   (if (<= n 0)
  175.     {
  176.       (arg-flag FALSE 1)        ;; reset arg count
  177.       (done)                ;; nothing to do in this case
  178.     })
  179.  
  180.   (newline)
  181.   (forward-char (- 0 n))
  182. })
  183.  
  184.  
  185.  
  186. ;; Insert a newline, then enough tabs and spaces to duplicate the
  187. ;;   indentation of the previous line.  Assumes tabs are every eight
  188. ;;   characters.  Figure out the indentation of the current line.  Insert a
  189. ;;   newline by calling the standard routine.  Insert the indentation by
  190. ;;   inserting the right number of tabs and spaces.
  191. ;; Notes:
  192. ;;   If the cursor is in the middle of the leading whitespace, don't go
  193. ;;     past it when calculating the indent.  This makes newline-and-indent
  194. ;;     at the start of a line work "right".
  195. ;;   ??? If the current line is blank, should I get rid of the whitespace?
  196. ;;   ??? If doing more than one newline-and-indent, do I leave lines with
  197. ;;     just whitespace on them?
  198. ;;   !!!???(is-space) thinks C-l is white space so this will indent screwy
  199. ;;     under page breaks.  Is this a bug?  Maybe should use (looking-at '[
  200. ;;     ^I]') (like the C code did).  Could also break the line, use
  201. ;;     looking-at '\ +' to get the indent Drawback is may not be optimal
  202. ;;     tabbing vs spaces - BFD?
  203. ;; Bound to "C-j"
  204.  
  205. (defun newline-and-indent
  206. {
  207.   (int n col indent)
  208.  
  209.   (n (arg-prefix))
  210.  
  211.   (arg-flag FALSE 1)        ;; reset arg count
  212.  
  213.   (if (<= n 0) (done))
  214.  
  215.   (col (current-column))
  216.   (current-column 1)
  217.   (while (and (is-space) (!= col (current-column))) (forward-char 1))
  218.   (indent (current-column))
  219.  
  220. ;  (current-column col)
  221. ;
  222. ;  (while (!= 0 n)
  223. ;    {
  224. ;      (newline)(to-col indent)
  225. ;      (-= n 1)
  226. ;    })
  227.  
  228.   (current-column 1)
  229.   (if (looking-at '\ +$')    ;; doesn't work for <ws><dot>[<ws>]text
  230.     (delete-whitespace)
  231.     (current-column col))
  232.  
  233.   (insert-n-chars n "^J")
  234.   (to-col indent)
  235. })
  236.  
  237.  
  238. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  239. ;;;;;;;;;;;;;;;;;;;;;; Regions, Cuts and Yanks ;;;;;;;;;;;;;;;;;;;;;;;
  240. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  241.  
  242.     ;; Routine to add text to the cut buffer.
  243.     ;; This is a routine that everybody calls (instead of putting the code
  244.     ;;   in all the routines) because:
  245.     ;;   - Localizes cut buffer management.
  246.     ;;   - Allows other packages to overload this.  For example, the
  247.     ;;     kill-ring creates its own hook and the cut routines just work.
  248. (defun
  249.   cut-save-hook (int mark1 mark2) (bool prepend)
  250.   {
  251.     ;; Clear the cut buffer if last command wasn't also a cut
  252.     (if (command-flag CMDFLG-NTEST-AND-SET CF-CUT) (clear-bag CUT-BUFFER))
  253.     (if prepend
  254.       (prepend-to-bag CUT-BUFFER APPEND-REGION mark1 mark2)
  255.       (append-to-bag  CUT-BUFFER APPEND-REGION mark1 mark2))
  256.  
  257.     TRUE
  258.   }
  259. )
  260.  
  261. ;; Copy all of the characters in the region to the cut buffer.  Don't move
  262. ;;   dot at all.  This is a bit like a cut region followed by a yank.
  263. ;; Bound to "M-w"
  264.  
  265. (defun copy-region
  266. {
  267.   (if (not (mark-valid THE-MARK))
  268.     { (msg "Need to set the mark!") FALSE (done) })
  269.   (floc "cut-save-hook" THE-DOT THE-MARK FALSE)
  270.   TRUE
  271. })
  272.  
  273.  
  274. ;; Copy the region to the cut buffer and then delete it.
  275. ;; Bound to "C-w"
  276.  
  277. (defun cut-region { (if (copy-region) (delete-region)) })
  278.  
  279.  
  280.     ;; Yank text back from the cut buffer.
  281.     ;; Bound to "C-y"
  282.     ;; Notes:
  283.     ;;   This works or aborts - insert-bag bails if it runs out of memory.
  284.  
  285. (defun yank
  286. {
  287.   (int n)
  288.  
  289.   (n (arg-prefix))
  290.   (arg-flag FALSE 1)        ;; reset arg count
  291.  
  292.   (if (<= n 0) { TRUE (done) })        ;; nothing to do in this case
  293.  
  294.   (while (!= 0 n) { (insert-bag CUT-BUFFER)(-= n 1) })
  295.  
  296.   TRUE
  297. })
  298.  
  299.  
  300. ;; Cut line(s) of text.
  301. ;; If called without an argument, it cuts from dot to the end of the line,
  302. ;;   unless it is at the end of the line, where it cuts the newline.
  303. ;; If called with an argument:
  304. ;;   0:         Cut from the start of the line to dot.
  305. ;;   Positive:  Cut from dot forward over that number of newlines.
  306. ;;   Negative:  Cut backwards that number of newlines.
  307. ;; Bound to "C-k"
  308. ;; Notes:
  309. ;;   If n > number of lines left in the buffer, just cut those.  This means
  310. ;;     you can use a real big n to delete all text to the end of the buffer.
  311. ;;     This also fixes a problem for Mutt programs that got a region (that
  312. ;;     included the end-of-buffer) and tried to use cut-line to delete the
  313. ;;     region.
  314. ;;   The end of buffer checking is pretty sloppy.  I can get away with this
  315. ;;     because forward-line doesn't wrap around the ends of the buffer.
  316. ;;
  317. (defun cut-line
  318. {
  319.   (int n mark)
  320.  
  321.   (set-mark (mark (create-mark)))
  322.  
  323.   (if (not (arg-flag))
  324.     {
  325. ;      (n (current-column))(end-of-line)
  326. ;      (if (== 0 (- (current-column) n)) (forward-line 1))
  327.       (if (looking-at '\ *$')        ;; GNU behavior
  328.         (forward-line 1)
  329.     (end-of-line))
  330.     }
  331.     (forward-line (arg-prefix)))
  332.  
  333.   (floc "cut-save-hook" THE-DOT mark (< (arg-prefix) 0))
  334.   (delete-region THE-DOT mark)
  335.  
  336.   (free-mark mark)
  337.  
  338.   (arg-flag FALSE 1)        ;; reset arg count
  339.  
  340.   TRUE    ;;!!!???!!! can I check this? do I care?
  341. })
  342.  
  343.  
  344. ;; Delete n characters at the dot in the current buffer.  If n is
  345. ;;   negative, delete n characters before the dot.
  346. ;; Input:
  347. ;;   n : number of characters to delete.
  348. ;; Notes:
  349. ;;   If n is bigger than the number of characters to either end of the
  350. ;;     buffer (ie trying to delete more than there is), only delete what
  351. ;;     can.
  352. ;;   This is the same as delete-characters but is not meant to be called by
  353. ;;     a user key.
  354. (defun
  355.   delete-char (int n)
  356.   {
  357.     (int mark)
  358.  
  359.     (set-mark (mark (create-mark)))
  360.  
  361.     (forward-char n)
  362.  
  363.     (delete-region THE-DOT mark)
  364.  
  365.     (free-mark mark)
  366.  
  367.     TRUE    ;;!!!???? return value?
  368.   }
  369. )
  370.  
  371. ;; Delete n characters at the dot in the current buffer.  If n is
  372. ;;   negative, delete n characters before the dot.
  373. ;; Input:
  374. ;;   n : number of characters to delete.
  375. ;; Notes:
  376. ;;   If n is bigger than the number of characters to either end of the
  377. ;;     buffer (ie trying to delete more than there is), only delete what
  378. ;;     can.
  379. ;;   If 1 < (abs n), put the characters in the cut buffer.  This to make it
  380. ;;     easy to recover from accidently typing something like C-u 12345 C-h.
  381. ;;     Not sure how useful this is with undo.
  382. ;;   If deleting backwards, prepend cut text to the cut buffer so it will
  383. ;;     look correct when yanked.
  384. (defun
  385.   delete-characters (int n)    HIDDEN
  386.   {
  387.     (bool a-cut)
  388.     (int mark)
  389.  
  390.     (a-cut (arg-flag))
  391.  
  392.     (set-mark (mark (create-mark)))
  393.  
  394.     (forward-char n)
  395.  
  396.     (if a-cut (floc "cut-save-hook" THE-DOT mark (< n 0)))
  397.  
  398.     (delete-region THE-DOT mark)
  399.  
  400.     (free-mark mark)
  401.  
  402.     (arg-flag FALSE 1)        ;; reset arg count
  403.  
  404.     TRUE    ;;!!!??? can I check this?
  405.   }
  406. )
  407.  
  408. ;; Delete forward.
  409. ;; If any argument is present, it cuts rather than deletes, to prevent loss
  410. ;;   of text if typed with a big argument.
  411. ;; Normally bound to "C-d"
  412. (defun delete-character { (delete-characters (arg-prefix)) })
  413.  
  414. ;; Delete backwards.
  415. ;; Like delete forward, this actually does a cut if argument (^U) used.
  416. ;; Bound "C-h" (backspace).
  417. (defun delete-previous-character
  418.     { (delete-characters (- 0 (arg-prefix))) })
  419.  
  420. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  421. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  422. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  423.  
  424. (defun any-modified-buffers
  425. {
  426.   (int j bp)
  427.  
  428.   (for (j 0) (< j (buffers)) (+= j 1)
  429.     {
  430.       (bp (nth-buffer j))
  431.       (if (== BFModified    ;; Check to see if we care about this buffer
  432.           (bit-and (buffer-flags bp) (bit-or BFModified BFNoCare)))
  433.         { TRUE (done) })
  434.     })
  435.   FALSE
  436. })
  437.  
  438. ;; Quit command.  If an argument, always quit.  Otherwise confirm if a
  439. ;;   buffer has been changed and not written out.
  440. ;; Bound to "C-x C-c" and "C-c"
  441.  
  442. (defun exit
  443. {
  444.   (if (or (arg-flag)            ;; Argument forces it
  445.       (not (any-modified-buffers))    ;; All buffers clean
  446.       (yesno "Modified buffers!  Exit anyway"))    ;; User says it's OK
  447.     (stop-ME EXIT-ME))
  448. })
  449.  
  450.  
  451. ;; Abort.
  452. ;; Beep the beeper. Cut off any keyboard macro, etc., that are in progress.
  453. ;; Bound to "C-g"
  454.  
  455. (defun
  456.   abort
  457.   {
  458.     (stop-ME HALT-ALL-PROGRAMS)        ;; also stops this routine
  459.   }
  460.   MAIN { (register-hook STOP-ME-HOOK "terminated") }
  461.   terminated (int n)
  462.   {
  463.     (if (== n HALT-ALL-PROGRAMS)
  464.       {
  465.     (msg "[Terminated]")
  466.     (beep)
  467.       })
  468.   }
  469. )
  470.  
  471. (defun
  472.   buffer-read-only (bool read-only)
  473.   {
  474.     (if (== (nargs) 1)        ;; got read-only
  475.       (buffer-flags -1
  476.     (if read-only
  477.       (bit-or    (buffer-flags -1) BFRead_only)
  478.       (bit-clear (buffer-flags -1) BFRead_only))))
  479.     (!= 0 (bit-and (buffer-flags -1) BFRead_only))
  480.   }
  481.   toggle-read-only { (buffer-read-only (not (buffer-read-only))) }
  482. )
  483.  
  484. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  485. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  486. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  487.  
  488. (defun
  489.   cannonize-file-name (string fname)
  490.   {
  491.     (int bid)
  492.  
  493.     (bid (create-buffer ""))
  494.     (file-name bid fname)
  495.     (fname (file-name bid))
  496.     (free-buffer bid)
  497.  
  498.     (!= "" fname)
  499.   }
  500.   attached-file (string full-file-name)
  501.   {
  502.     (int j)
  503.  
  504.     (for (j 0) (< j (buffers)) (+= j 1)
  505.       (if (== full-file-name (file-name (nth-buffer j)))
  506.     { (nth-buffer j) (done) }))
  507.     -2
  508.   }
  509.   make-unique-buffer-name (string base-name)
  510.   {
  511.     (int n)
  512.     (string new-name)
  513.  
  514.     (if (== -2 (attached-buffer base-name)) { base-name (done) })
  515.  
  516.     (n 1)
  517.     (while
  518.       (!= -2 (attached-buffer (new-name (concat base-name "<" (+= n 1) ">"))))
  519.       ())
  520.     new-name
  521.   }
  522. )
  523.  
  524. (const
  525.   PF-VISIT    0
  526.   PF-READ    1
  527.   PF-INSERT    2
  528.   PF-WRITE    3
  529. )  
  530.  
  531.     ;; Prompt and ask for a file name for the file read/write/insert
  532.     ;;   routines.
  533.     ;; What it does:
  534.     ;;   - If the current buffer has a file name and that file name is a
  535.     ;;     path (ie has a "/" in it), prime ask with the path.  Otherwise,
  536.     ;;     prime ask with the current directory (being careful not to prime
  537.     ;;     with "//" in case cwd is "/".
  538.     ;;   - Ask the user for a file name.
  539.     ;;   - If they don't change the prime, return "" (since a path is not a
  540.     ;;       file name).
  541.     ;;     If they type "/foo", "~/foo" or "C:foo" (such that the input
  542.     ;;       looks like "/hoho//foo" because of the prime), return "/foo".
  543.     ;;       This makes it easy to override the prime.  This is what GNU
  544.     ;;       does.
  545.     ;;     Return the input.
  546.     ;; Notes:
  547.     ;;   The prime breaks file name completion if you have something like
  548.     ;;     "/hoho//foo".  Not sure how to fix this.  Don't like it in C
  549.     ;;     code, maybe with a programmable minibuffer could detect this
  550.     ;;     case before the completion occurs.
  551.     ;;   This is OS specific.  Ick.  But can be overridden.
  552. (defun
  553.   ask-for-file-name (int op)(string prompt)
  554.   {
  555.     (string fname b prime)
  556.  
  557.     (prime
  558.       (if (and (!= "" (file-name -1)) (re-string '\(.+/\)' (file-name -1)))
  559.     (sub~ (get-matched "&"))
  560.     (concat (sub~ (current-directory))
  561.       (if (== "/" (extract-elements (current-directory) -1 1)) "" "/"))))
  562.  
  563.     (prime-ask prime) (ask-user) (fname (complete CC_FNAME prompt))
  564.  
  565.     (cond
  566.       (== prime fname) (fname "")    ;; No response == ""
  567.       (== prime (extract-elements fname 0 (length-of prime)))
  568.         {
  569.       (b (extract-elements fname (length-of prime) 1000))
  570.       (if
  571.         (or
  572.           (re-string '\(/.+\)'  b)        ;; /foo//bar => /bar
  573.           (re-string '\(~.+\)'  b)        ;; /foo/~/bar => ~/bar
  574.           (re-string '\([a-zA-Z]:.+\)' b))    ;; /foo/C:/bar => C:/bar
  575.         (fname (get-matched '\1')))
  576.     })
  577.     fname
  578.   }
  579. )
  580.  
  581. (defun
  582.   read-it (string fname) HIDDEN
  583.   {
  584.     (bool save-undo s)
  585.     (int n error-code)
  586.  
  587.     (save-undo (undo-state))(turn-off-undo)
  588.     (clear-buffer)
  589.  
  590.     (msg "Reading file ...")    ;; this can take a long time
  591.     (s 
  592.       (if (file-to-buffer fname (loc n) (loc error-code))
  593.     {
  594.       (msg "[Read " n " line" (if (!= 1 n) "s]" "]"))
  595.       (beginning-of-buffer)
  596.       (read-file-hook)
  597.       TRUE
  598.     }
  599.     {
  600.       (if (== FIO_FNF error-code)
  601.         { (msg "[New file]") TRUE }
  602.         FALSE)
  603.     }))
  604.  
  605.     (buffer-modified -1 (not s))    ;; Not modified if no errors
  606.     (undo-state save-undo)
  607.     s
  608.   }
  609.   write-it (file-name) HIDDEN
  610.   {
  611.     (int n error-code)
  612.  
  613.     (msg "Writing file ...")    ;; this can take a long time
  614.     (if (buffer-to-file file-name (loc n) (loc error-code))
  615.       { (msg "[Wrote " n " line" (if (!= 1 n) "s]" "]")) TRUE }
  616.       {
  617.     (if (!= 0 (bit-and (buffer-flags -1) BFBad_read))
  618.       (msg "Buffer didn't read correctly, not written."))
  619.           FALSE
  620.       })
  621.   }
  622. )
  623.  
  624. ;; Select a file for editing.
  625. ;; Look around to see if you can find the file in another buffer; If you
  626. ;;   can find it just make it current.  If you cannot find the file, read
  627. ;;   it into a buffer and make current.
  628. ;; Input:
  629. ;;   f:  If no arg, use the current window to display the buffer.
  630. ;;       Otherwise, split the current window to create a new window for the
  631. ;;       buffer.
  632. ;; Bound to "C-xC-v" and "C-xC-f"
  633. (defun
  634.   visit-file
  635.   {
  636.     (bool popup)
  637.     (int bid)
  638.     (string fname bname)
  639.  
  640.     (popup (arg-flag))
  641.     (arg-flag FALSE 1)        ;; reset arg count
  642.  
  643.     (fname
  644.       (if (== 0 (nargs))
  645.         (floc "ask-for-file-name" PF-VISIT "Visit file: ")
  646.     (ask)))
  647.     (if (== "" fname) { FALSE (done) })    ;;!!!???
  648.     (if (not (cannonize-file-name fname))
  649.       {
  650. ;;!!!?? do I want complain?
  651.     (msg "Not a valid file name!")
  652.     FALSE
  653.     (done)
  654.       })
  655.     (if (!= -2 (bid (attached-file fname)))
  656.       {
  657.     (msg "[Old buffer]")
  658.     (if popup    ;; popup a window for the buffer
  659.       (current-window (popup-buffer bid 1 1))
  660.       {
  661.         (current-buffer bid TRUE)
  662.         (current-line 1)
  663.       })
  664.     TRUE
  665.     (done)
  666.       })
  667.  
  668.     (bname (make-unique-buffer-name (buffer-name fname)))
  669.  
  670.     (bid (create-buffer bname BFHuman))
  671.     (file-name bid fname)
  672.  
  673.     (if popup        ;; popup a window for the buffer
  674.       (current-window (popup-buffer bid 1 1))
  675.       (current-buffer bid TRUE))
  676.  
  677.     (read-it fname)
  678.   }
  679. )
  680.  
  681. ;; Read a file into the current buffer.  This is really easy; all you do
  682. ;;   is find the name of the file, and call the standard "read a file
  683. ;;   into the current buffer" code.
  684. ;; Bound to "C-x C-r"
  685. (defun read-file
  686. {
  687.   (string read-from)
  688.  
  689.   (arg-flag FALSE 1)        ;; reset arg count
  690.  
  691.   (read-from
  692.     (if (== 0 (nargs))
  693.       (floc "ask-for-file-name" PF-READ "Read file: ")
  694.       (ask)))
  695.   (if (and (== "" read-from) (== "" (read-from (file-name -1))))
  696.     {
  697.       (msg "Buffer \"" (buffer-name -1)
  698.        "\" is not attached to a file, can't read.")
  699.       FALSE
  700.       (done)
  701.     })
  702.  
  703.     ;;;!!! good enough test or restrict to MUNGED buffers?
  704.   (if (and (buffer-modified -1)
  705.        (not (yesno "Buffer has been modified, overwrite it anyway")))
  706.     { FALSE (done) })
  707.  
  708.   (file-name -1 read-from)
  709.  
  710.   (read-it read-from)
  711. })
  712.  
  713.     ;; Insert a file at the dot.
  714.     ;; Leave the dot at the start of the insert and put the mark after the
  715.     ;;   insert (ala GNU).
  716. (defun insert-file
  717. {
  718.   (int n error-code)
  719.   (string read-from)
  720.  
  721.   (read-from
  722.     (if (== 0 (nargs))
  723.       (floc "ask-for-file-name" PF-INSERT "Insert file: ")
  724.       (ask)))
  725.   (if (== "" read-from)
  726.     {
  727.       (msg "Not a valid file name!")
  728.       FALSE
  729.       (done)
  730.     })
  731.  
  732.   (set-mark THE-MARK)
  733.   (if (file-to-buffer read-from (loc n) (loc error-code))
  734.     {
  735.       (swap-marks)
  736.       (msg "[Inserted " n " line" (if (!= 1 n) "s]" "]"))
  737.       TRUE
  738.     }
  739.     {
  740.       (if (== FIO_FNF error-code) (msg "\"" read-from "\" not found!"))
  741.       FALSE
  742.     })
  743. })
  744.  
  745. ;; Ask for a file name and write the contents of the current buffer
  746. ;;   to that file. Clear the buffer changed flag.
  747. ;; Bound to "C-x C-w"
  748. (defun write-file
  749. {
  750.   (string write-to)
  751.  
  752.   (write-to
  753.     (if (== 0 (nargs))
  754.       (floc "ask-for-file-name" PF-WRITE "Write file: ")
  755.       (ask)))
  756.   (if (and (== "" write-to) (== "" (write-to (file-name -1))))
  757.     {
  758.       (msg "Buffer \"" (buffer-name -1)
  759.        "\" is not attached to a file, can't write.")
  760.       FALSE
  761.       (done)
  762.     })
  763.  
  764.   (write-it write-to)
  765. })
  766.  
  767. ;; Save the contents of the current buffer in its associatd file.  Do
  768. ;;   nothing if nothing has changed (this may be a bug, not a feature).
  769. ;;   Error if there is no remembered file name for the buffer.
  770. ;; Bound to "C-x C-s"
  771. (defun save-buffer
  772. {
  773.   (int n)
  774.  
  775.   (if (== "" (file-name -1))    ;; Must have a name
  776.     {
  777.       (msg "No file name for buffer \"" (buffer-name -1) "\".")
  778.       FALSE
  779.       (done)
  780.     })
  781.  
  782.   (if (== 0 (bit-and (buffer-flags -1) BFModified))
  783.     {
  784.       (msg "Buffer \"" (buffer-name -1) "\" not modified, not written.")
  785.       TRUE
  786.       (done)
  787.     })
  788.  
  789.   (write-it (file-name -1))
  790. })
  791.  
  792. (defun MAIN
  793. {
  794.   (bind-key GLOBAL-KEYMAP
  795.     "insert-file"            "C-xi"
  796.     "read-file"            "C-xC-r"
  797.     "visit-file"            "C-xC-f"
  798.     "visit-file"            "C-xC-v"
  799.     "save-buffer"            "C-xC-s"
  800.     "write-file"            "C-xC-w")
  801. })
  802.  
  803. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  804. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  805. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  806.  
  807. ;; Select a new current buffer and attach it to a current window.
  808. ;; If arg-flag, then the buffer must exist.
  809. ;; Changes the current buffer and current window.
  810. ;; Bound to "C-x b"
  811. ;; Notes
  812. ;;  Undo is turned on (via buffer-created-hook in undo.mut) for interactive
  813. ;;    buffers.
  814.  
  815. (int switch's-previous-buffer)
  816.  
  817. (defun
  818.   switch-to-buffer
  819.   {
  820.     (bool aflag)
  821.     (int bid previous-bid)
  822.     (string new-buffer-name)
  823.  
  824.     ;; if previous buffer doesn't exist, turn off prompt
  825.     (if (not (buffer-exists switch's-previous-buffer))
  826.       (switch's-previous-buffer -1))
  827.  
  828.     (new-buffer-name (complete CC_BUF
  829.       (concat
  830.         "Use buffer"
  831.     (if (== -1 switch's-previous-buffer)
  832.       ": "
  833.       (concat " [" (buffer-name switch's-previous-buffer) "]: ")))))
  834.  
  835.     (aflag (arg-flag))
  836.     (arg-flag FALSE 1)        ;; reset arg count
  837.  
  838.     (if (and
  839.       (== ""  new-buffer-name)
  840.       (== "" (new-buffer-name (buffer-name switch's-previous-buffer))))
  841.       { FALSE (done) })
  842.  
  843.     (previous-bid (current-buffer))
  844.  
  845.     (if (!= -2 (bid (attached-buffer new-buffer-name)))
  846.       (current-buffer bid TRUE)        ;; The buffer already exists
  847.       (if (aflag)            ;; It doesn't but should
  848.         {
  849.       (msg "Buffer \"" new-buffer-name "\" does not exist.")
  850.       FALSE
  851.       (done)
  852.     }
  853.     (current-buffer            ;; Create that sucker
  854.         (create-buffer new-buffer-name
  855.             (bit-or BFImmortal BFInteractive)) TRUE)))
  856.  
  857.     (switch's-previous-buffer previous-bid)
  858.  
  859.     TRUE
  860.   }
  861.   use-existing-buffer
  862.   {
  863.     (arg-prefix 1)
  864.     (switch-to-buffer (complete CC_BUF "Use existing buffer: "))
  865.   }
  866. )
  867.  
  868. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  869. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Marks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  870. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  871.  
  872. (defun
  873.   mark-valid (int mark-id)
  874.   {
  875.     (save-point {{ (goto-mark (arg 0)) }} mark-id)
  876.   }
  877. )
  878.  
  879. (defun
  880.   exchange-dot-and-mark
  881.   {
  882.     (if (not (mark-valid THE-MARK))
  883.     { (msg "Need to set the mark!") FALSE (done) })
  884.  
  885.     (swap-marks THE-DOT THE-MARK)
  886.   }
  887.   set-the-mark
  888.   {
  889.     (set-mark THE-MARK)
  890.     (msg "Mark set.")
  891.   }
  892. )
  893.  
  894.  
  895. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  896. ;;;;;;;;;;;;;;;;;;;;;;;;;; Cursor Movement ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  897. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  898.  
  899. (defun
  900.   beginning-of-buffer    { (current-line 1) }
  901.   end-of-buffer        { (current-line -1)(forward-line 1) }
  902.   beginning-of-line    { (current-column 1) }
  903.   end-of-line        { (if (forward-line 1) (forward-char -1)) }
  904. )
  905.  
  906. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  907. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  908. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  909.  
  910. (defun ME-command
  911. {
  912.   (string command)
  913.  
  914.   (command (complete (bit-or CC_PGM CC_SYSVAR) "Run command: "))
  915.   (if (== "" command) { FALSE (done) })        ;;!!!???
  916.   (if (not (pgm-exists command))
  917.     {
  918.       (if (check-name-of-sysvar command FALSE)
  919.     {
  920.       (set-sysvar command)
  921.       (done)
  922.     })
  923.       (msg "Command \"" command "\" does not exist.")
  924.       (need-help 0)
  925.       (done)
  926.     })
  927.  
  928.   (floc (command) ())
  929. })
  930.  
  931.  
  932. ;; Universal argument
  933. ;; Grap arg from keyboard, run the key.
  934. ;; Bound to "C-u"
  935. ;; Notes:
  936. ;;   The arg is maintained as a positive number because it makes the math
  937. ;;     easier.
  938. ;;   You can prime the arg.  For example, if you want M-5 to run
  939. ;;     universal-argument starting at 5, use:
  940. ;;     (defun Meta-5 { (arg-prefix 5)(universal-argument) }
  941. ;;     (bind-to-key "Meta-5" "M-5")
  942.  
  943. (int universal-argument-status)
  944. (defun
  945.   universal-argument-no-key
  946.   {
  947.     (== 0 universal-argument-status)
  948.   }
  949.   universal-argument
  950.   {
  951.     (int key n mflag)
  952.  
  953.     (mflag 0)        ;; -1 => minus, 0 => no key hit, 1 => key hit
  954.  
  955.     (n (if (arg-flag) (arg-prefix) 4))
  956.     (msg "Arg: " n)
  957.  
  958.     (while (or
  959.           (and (<= 0x30 (key (get-key))) (<= key 0x39)) ;; 0 <= key <= 9
  960.           (== key 0x155)                ;; C-u
  961.           (== key 0x2D))                ;; -
  962.  
  963.       {
  964.     (cond
  965.       (== key 0x155) (*= n 4)            ;; C-u
  966.       (== key 0x2D)                    ;; -
  967.         {
  968.           (if (!= 0 mflag) (break))
  969.           (n 0) (mflag -1)
  970.         }
  971.       TRUE
  972.         {
  973.           (if (== 0 mflag) { (if (not (arg-flag)) (n 0)) (mflag 1) })
  974.           (n (+ (* 10 n)(- key 0x30)))    ;; n = 10*n +(key - '0')
  975.         }
  976.     )
  977.     (msg "Arg: " (if (>= mflag 0) n (if (!= 0 n) (- 0 n) -1)))
  978.       })
  979.  
  980.     (if (== -1 mflag) { (if (== 0 n) (n 1) (*= n -1)) })
  981.  
  982.     (universal-argument-status mflag)
  983.  
  984.     (arg-prefix n)(exe-key key)
  985.  
  986.     ;; (exe-key) resets arg count
  987.   }
  988. )
  989.  
  990. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  991. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Words ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  992. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  993.  
  994. ;; Notes:
  995. ;;   Could merge delete-words with delete-characters easily.
  996. ;;   If deleting backwards, prepend cut text to the cut buffer so it will
  997. ;;     look correct when yanked.
  998. (defun
  999.   delete-words (int n)    HIDDEN
  1000.   {
  1001.     (int mark)
  1002.  
  1003.     (set-mark (mark (create-mark)))
  1004.  
  1005.     (forward-word n)
  1006.  
  1007.     (floc "cut-save-hook" THE-DOT mark (< n 0))
  1008.     (delete-region THE-DOT mark)
  1009.  
  1010.     (free-mark mark)
  1011.  
  1012.     (arg-flag FALSE 1)        ;; reset arg count
  1013.  
  1014.     TRUE        ;; !!!??? am I sure
  1015.   }
  1016.   cut-word        { (delete-words (arg-prefix)) }
  1017.   cut-previous-word { (delete-words (- 0 (arg-prefix))) }
  1018. )
  1019.  
  1020. (defun
  1021.   forward_word (int n) HIDDEN
  1022.   {
  1023.     (arg-flag FALSE 1)        ;; reset arg count
  1024.     (forward-word n)
  1025.   }
  1026.   next-word     { (forward_word (arg-prefix)) }
  1027.   previous-word { (forward_word (- 0 (arg-prefix))) }
  1028. )
  1029.  
  1030. (defun
  1031.   MAIN
  1032.   {
  1033.     (bind-key GLOBAL-KEYMAP
  1034.     "cut-previous-word"        "M-C-h"
  1035.     "cut-word"            "M-d"
  1036.     "cut-word"            "M-C-?"
  1037.     "next-word"            "M-f"
  1038.     "previous-word"            "M-b")
  1039.   }
  1040. )
  1041.  
  1042. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1043. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; OS Stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1044. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1045.  
  1046. ;; Fork a shell so the user can mess around outside of ME and return to
  1047. ;;   their edit session later.
  1048. ;; Bound to "C-z"
  1049. (defun spawn-shell
  1050. {
  1051.   (OS-shell (arg-prefix))
  1052.  
  1053.   (arg-flag FALSE 1)        ;; reset arg count
  1054.  
  1055.   TRUE
  1056. })
  1057.  
  1058.  
  1059. ;; Have the OS (usually though a shell) run a command (such as "ls").
  1060. ;; Bound to "C-x !"
  1061. (defun shell-command ; [(string the-command)]
  1062. {
  1063.   (string command)
  1064.  
  1065. ;;!!! actually, this should be if no args or ask-user
  1066.   (if (== 0 (nargs))    ;; (shell-command) most likely just bound to a key
  1067.     {
  1068.       (if (== "" (command (ask "Shell command: "))) { FALSE (done) })
  1069.       (ask-user)
  1070.       (OS-command command "[Return to resume editing]")
  1071.     }
  1072.     (OS-command (arg 0)))
  1073. })
  1074.  
  1075. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1076. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1077. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1078.  
  1079.  
  1080. ;; Quote the next character, and insert it into the buffer.  All the
  1081. ;;   characters are taken literally, with the exception of the newline,
  1082. ;;   which always has its line splitting meaning.  The character is
  1083. ;;   always read, even if it is inserted 0 times, for regularity.
  1084. ;; Bound to "C-q" and "C-^" (for terminals that need XON-XOFF).
  1085. ;; Notes:
  1086. ;;   Doesn't work so hot for multi character keys (like the function keys).
  1087. (defun quote
  1088. {
  1089.   (int n)
  1090.   (string key)
  1091.  
  1092.   (n (arg-prefix))
  1093.  
  1094.   (arg-flag FALSE 1)        ;; reset arg count
  1095.  
  1096.   (key (getchar))
  1097.  
  1098.   (if (== key "0")    ;;!!!??? ^Qx31 => "1"?
  1099.     (key (convert-to CHARACTER (convert-to NUMBER (ask "ASCII number: ")))))
  1100.  
  1101.   (if (<= n 0) (done))        ;; that was easy
  1102.  
  1103.   (insert-n-chars n key)
  1104. })
  1105.  
  1106. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1107. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1108. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1109.  
  1110. ;;!!! I really need to set parents ask frame here!
  1111. (defun
  1112.   bind-to-key
  1113.   {
  1114.     (string command key)
  1115.  
  1116.     (if (== "clear-keymap" (command (complete CC_PGM "Global bind command: ")))
  1117.       (clear-keymap GLOBAL-KEYMAP)
  1118.       (bind-key GLOBAL-KEYMAP command
  1119.             (if (== "" (key (ask "To key: "))) "C-m" key)))
  1120.   }
  1121.   bind-local-key
  1122.   {
  1123.     (string command key)
  1124.  
  1125.     (if (== "clear-keymap" (command (complete CC_PGM "Local bind command: ")))
  1126.       (clear-keymap LOCAL-KEYMAP)
  1127.       (bind-key LOCAL-KEYMAP command
  1128.             (if (== "" (key (ask "To key: "))) "C-m" key)))
  1129.   }
  1130. )
  1131.  
  1132. ;;!!! clone GNUs global-set-key and local-set-key
  1133.  
  1134. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1135. ;;;;;;;;;;;;;;;;;;;;;;;;;; Keyboard Macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1136. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1137.  
  1138. (defun
  1139.   MAIN { (register-hook STOP-ME-HOOK "End-macro") }
  1140.   End-macro
  1141.   {
  1142.      (if (== MACRO-RECORDING (keystroke-macro MACRO-STATE))
  1143.     (McModeline FALSE))
  1144.   }
  1145.   start-macro
  1146.   {
  1147.     (if (!= MACRO-OFF (keystroke-macro MACRO-STATE))
  1148.       { (msg "Can't start a macro now.")(done) })
  1149.  
  1150.     (keystroke-macro MACRO-START)
  1151.     (McModeline TRUE)
  1152.   }
  1153.   end-macro
  1154.   {
  1155.     (if (!= MACRO-RECORDING (keystroke-macro MACRO-STATE))
  1156.       { (msg "Not recording a macro!")(done) })
  1157.  
  1158.     (keystroke-macro MACRO-END)
  1159.     (McModeline FALSE)
  1160.   }
  1161.   execute-macro
  1162.   {
  1163.     (int n)
  1164.  
  1165.     (if (!= MACRO-OFF (keystroke-macro MACRO-STATE))
  1166.       { (msg "Stop recording before replaying.")(done) })
  1167.  
  1168.     (n (arg-prefix))
  1169.     (arg-flag FALSE 1)        ;; reset arg count
  1170.  
  1171.     (keystroke-macro MACRO-REPLAY n)
  1172.   }
  1173.   MAIN
  1174.   {
  1175.     (bind-key GLOBAL-KEYMAP
  1176.     "end-macro"            "C-x)"
  1177.     "execute-macro"            "C-xe"
  1178.     "start-macro"            "C-x(")
  1179.   }
  1180. )
  1181.  
  1182. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1183. ;;;;;;;;;;;;;;;;;;;;;;;;;; Library Routines ;;;;;;;;;;;;;;;;;;;;;;;;;;
  1184. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1185.  
  1186. ;;!!! I could pack bit-or, bit-and and bit-xor into (bit-op op x y z ...)
  1187. ;; and put the routines here.
  1188. (defun
  1189.   bit-not (int x) { (bit-xor x -1) }
  1190.   bit-clear (int x bit) { (bit-and x (bit-not bit)) }
  1191. )
  1192.  
  1193. (defun
  1194.   BoB        ;; return TRUE if at begining of buffer
  1195.   {
  1196.     (if (forward-char -1)
  1197.       { (forward-char 1) FALSE }
  1198.       TRUE)
  1199.   }
  1200.   ;; Notes
  1201.   ;;   EoB is just as easy (but would be slow in a while loop).
  1202. )
  1203.  
  1204. (defun
  1205.   save-point (pointer defun code) ;; [args]
  1206.   {
  1207.     (int point)
  1208.  
  1209.     (set-mark (point (create-mark)))
  1210.     (restore-point-and-return-value
  1211.       {{
  1212.     (goto-mark (arg 0))(free-mark (arg 0))
  1213.       }} (code (push-args 1)) point)
  1214.   }
  1215.   save-excursion (pointer defun code) ;; [args]
  1216.   {
  1217.     (bool displayed)
  1218.     (int buffer mark)
  1219.  
  1220.     (set-mark (mark (create-mark)))
  1221.     (buffer (current-buffer))
  1222.     (displayed (== buffer (attached-buffer (current-window))))
  1223.     (restore-point-and-return-value
  1224.       {{
  1225.     (current-buffer (arg 0) (arg 1))
  1226.     (goto-mark (arg 2))(free-mark (arg 2))
  1227.       }} (code (push-args 1)) buffer displayed mark)
  1228.   }
  1229.   restore-point-and-return-value
  1230.     (pointer defun restore-point) ; return-value args-for-code
  1231.     HIDDEN
  1232.   {
  1233.     (restore-point (push-args 2))
  1234.     (arg 1)            ;; Return value
  1235.   }
  1236. )
  1237.  
  1238.     ;; Returns:
  1239.     ;;   -2 : Buffer not displayed in a window
  1240.     ;;   id : Id of window showing buffer
  1241. (defun
  1242.   buffer-displayed (int buffer-id)
  1243.   {
  1244.     (int n)
  1245.  
  1246.     (for (n 0) (< n (windows)) (+= n 1)
  1247.     (if (== buffer-id (attached-buffer n)) { n (done) }))
  1248.     -2            ;; buffer not displayed
  1249.   }
  1250. )
  1251.  
  1252. (defun
  1253.   buffer-exists (int buffer-id)
  1254.   {
  1255.     (int j)
  1256.     (for (j 0) (< j (buffers)) (+= j 1)
  1257.       (if (== buffer-id (nth-buffer j)) { TRUE (done) }))
  1258.     FALSE
  1259.   }    
  1260. )
  1261.  
  1262. (defun
  1263.   prepend-to-bag (int the-bag op)
  1264.     ;; (string text) | (int mark1 mark2) | (int chars)
  1265.   {
  1266.     (int bag)
  1267.  
  1268.     (bag (create-bag))
  1269.     (append-to-bag bag (push-args 1))
  1270.     (append-to-bag bag APPEND-TEXT (bag-to-string the-bag))
  1271.     (clear-bag the-bag)
  1272.     (append-to-bag the-bag APPEND-TEXT (bag-to-string bag))
  1273.     (free-bag bag)
  1274.   }
  1275. )
  1276.  
  1277. (defun
  1278.   foreach (object)(pointer defun code)
  1279.   {
  1280.     (int n j)
  1281.  
  1282.     (n (length-of object))
  1283.     (for (j 0) (< j n) (+= j 1)
  1284.       (if (not (code (extract-element object j) (push-args 2))) (break)))
  1285.   }
  1286. )
  1287.  
  1288. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1289. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1290. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1291.  
  1292. ;; Load Mutt code from a file.
  1293. ;; Notes:
  1294. ;;   There is a bit of a sleeze here.  I want to (sometimes) load a file
  1295. ;;     only if it hasn't already been loaded so I (way) overload the
  1296. ;;     flags.  This is for back compatibility with ME2.
  1297. (defun
  1298.   load
  1299.   {
  1300.     (bool complain check-first)
  1301.  
  1302.     (complain (not (arg-flag)))
  1303.     (check-first (if (== 42 (arg-prefix)) TRUE FALSE))
  1304.  
  1305.     (arg-flag FALSE 1)        ;; reset arg count
  1306.  
  1307.     (load-code (complete CC_FNAME "Load file: ") complain check-first)
  1308.   }
  1309. )
  1310.  
  1311. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1312. ;;;;;;;;;;;;;;;;;;;;;;;; The ME Command Line ;;;;;;;;;;;;;;;;;;;;;;;;;
  1313. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1314.  
  1315. ;; file            eg me2 foo
  1316. ;; +linenum file    eg me2 +34 foo
  1317. ;; -i file        eg me2 -i foo, me2 +30 foo -i sam
  1318. ;; -insert file        same as -i
  1319.  
  1320. (bool read-em-all read-a-file)
  1321.  
  1322. (defun
  1323.   next-file
  1324.   {
  1325.     (int n)
  1326.  
  1327.     (n (arg-prefix))
  1328.     (arg-flag FALSE 1)        ;; reset arg count
  1329.     (while (>= (-= n 1) 0)
  1330.       {
  1331.     (read-a-file FALSE)
  1332.     (if (any-cmd-line-args-left)
  1333.       (process-command-line)
  1334.       { (msg "All files read in.")(done) })
  1335.       })
  1336.   }
  1337. )
  1338.  
  1339. (defun
  1340.   MAIN
  1341.   {
  1342.     (register-hook COMMAND-LINE-HOOK "ME-command-line")
  1343.   }
  1344.   ME-command-line (string cmd-arg)
  1345.   {
  1346.     (int n)
  1347.     (string the-arg)
  1348.  
  1349.     (cond
  1350.       (re-string '\+\(\d+\)$' cmd-arg)            ;; +linenum file
  1351.     {
  1352.       (n (convert-to NUMBER (get-matched '\1')))
  1353.       (next-cmd-line-arg the-arg)(visit-file the-arg)
  1354.       (current-line n)
  1355.     }
  1356.       (== "-all" cmd-arg) (read-em-all TRUE)        ;; -all
  1357.       (or (== "-i" cmd-arg)(== "-insert" cmd-arg))    ;; -i[nsert] file
  1358.         { (next-cmd-line-arg the-arg)(insert-file the-arg) }
  1359.       (or (== "-l" cmd-arg)(== "-load" cmd-arg))    ;; -l[oad] file
  1360.         { (next-cmd-line-arg the-arg)(load the-arg) }
  1361.       (or (== "-f" cmd-arg)(== "-funcall" cmd-arg))    ;; -f[uncall] pgm
  1362.         { (next-cmd-line-arg the-arg)(floc (the-arg)()) }
  1363.       (re-string '[^--].*' cmd-arg)        ;; no leading dash => file
  1364.     {
  1365.       (if (and (not (read-em-all)) (read-a-file))
  1366.         {
  1367.           (push-back-cmd-arg)
  1368.           (stop-processing-cmd-line)
  1369.         }
  1370.         {
  1371.           (read-a-file TRUE)
  1372.           (visit-file cmd-arg)
  1373.         })
  1374.     }
  1375.       TRUE { FALSE (done) }                ;; none of the above
  1376.     )
  1377.     TRUE                        ;; one of the above
  1378.   }
  1379. )
  1380.  
  1381. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1382. ;;;;;;;;;;;;;;;;;;;;;;;;;;; List Commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1383. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1384.  
  1385. (defun
  1386.   do-apropos (string word) HIDDEN
  1387.   {
  1388.     (int bid b2)
  1389.  
  1390.     (if (!= -2 (bid (attached-buffer HELP-BUFFER)))
  1391.       {
  1392.     (b2 (current-buffer))
  1393.     (current-buffer bid)(clear-buffer)
  1394.     (current-buffer b2)
  1395.       }
  1396.       (bid (create-buffer HELP-BUFFER
  1397.         (bit-or BFNoCare BFImmortal BFInteractive))))
  1398.  
  1399.     (list-keys bid word 7 GLOBAL-KEYMAP)
  1400.     (popup-buffer bid 1 1)
  1401.   }
  1402.   apropos
  1403.   {
  1404.     (do-apropos
  1405.       (complete (bit-or CC_MUTT CC_PGM CC_SYSVAR) "Apropos keyword: "))
  1406.   }
  1407.   describe-bindings { (do-apropos "") }
  1408.   describe-key    ;; what is a key bound to
  1409.   {
  1410.     (string key bind)
  1411.  
  1412.     (key (ask "Key: "))
  1413.     (if (== "" (bind (key-bound-to key)))(msg key " is not bound.")
  1414.     (msg key " is bound to " bind))
  1415.   }
  1416. )
  1417.  
  1418. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1419. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1420. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1421.  
  1422.  
  1423. ;; Ask a yes or no question in the message line.  Must be answered with
  1424. ;;   something starting with n, N, y or Y.  A CR ain't good enough!
  1425. ;; Input:
  1426. ;;   prompt:  What to ask the user.  " [y/n]? " is appended.
  1427. ;; Returns:  TRUE, FALSE, or aborts
  1428.  
  1429. ;;!!! this is REAL iffy
  1430. ;; Need to set parents ask frame, access to MMask_pgm()
  1431.  
  1432. ;(defun yesno ; (string prompt ...)
  1433. ;{
  1434. ;  (while TRUE
  1435. ;    {
  1436. ;      (ask-user)        ;;!!!???
  1437. ;      (switch (extract-elements (ask (push-args 0) " [y/n]? ") 0 1)
  1438. ;    "y" { TRUE  (done) }
  1439. ;    "Y" { TRUE  (done) }
  1440. ;    "n" { FALSE (done) }
  1441. ;    "N" { FALSE (done) }
  1442. ;      )
  1443. ;    })
  1444. ;;;!!!???if (MMask_pgm) return FALSE;    ;; I think I need this!
  1445. ;})
  1446.  
  1447. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1448. ;;;;;;;;;;;;;;;;;;;;;;;;;;;; Version Info ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1449. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1450.  
  1451. ;; Version and other general information about ME.  This is (typically)
  1452. ;;   stuff that ME internals send so that Mutt programs can do machine/OS
  1453. ;;   dependent things.
  1454. ;; Typical keys and list of data with that key:
  1455. ;;   OS: Major (such as Unix or MS-DOS), minor (such as HP-UX).
  1456. ;;   version: Program name (ME), major release, minor, patch level, date
  1457. ;;     of first release (of this version), date this version was released.
  1458. ;;   author: Name, email address, postal address.
  1459.  
  1460.  
  1461.     ;; Indexes into version info
  1462. (const
  1463.   VERSION-VERSION-KEY    "version"
  1464.   VERSION-NAME        0
  1465.   VERSION-MAJOR        1
  1466.   VERSION-MINOR        2
  1467.   VERSION-PATCH        3
  1468.   VERSION-FIRST-RELEASE    4
  1469.   VERSION-THIS-RELEASE    5
  1470.  
  1471.   VERSION-AUTHOR-KEY    "author"
  1472.   VERSION-AUTHOR    0
  1473.   VERSION-EMAIL        1
  1474.   VERSION-MAIL        2
  1475.  
  1476.   VERSION-OS-KEY    "OS"
  1477.   VERSION-OS-MAJOR    0
  1478.   VERSION-OS-MINOR    1
  1479. )
  1480.  
  1481. (list version-info)
  1482.  
  1483. (defun
  1484.   version-hook (string key info1 info2) ;; etc
  1485.   {
  1486.     (list info)
  1487.  
  1488.     (insert-object version-info 1000 key (insert-object info 0 (push-args 1)))
  1489.   }
  1490.   get-version-info (string key)        ;; Return list of infos
  1491.   {
  1492.     (int n j)
  1493.  
  1494.     (n (length-of (version-info)))
  1495.     (for (j 0) (< j n) (+= j 2)
  1496.     {
  1497.       (if (== key (extract-element version-info j))
  1498.         {
  1499.              (extract-element version-info (+ j 1))
  1500.       (done)
  1501.     })
  1502.     })
  1503.     (extract-elements version-info 0 0)        ;; empty list
  1504.   }
  1505.   version-query (string key subkey)
  1506.   {
  1507.     (int n j)
  1508.     (list info)
  1509.  
  1510.     (if (== 1 (nargs)) { (get-version-info key)(done) })
  1511.  
  1512.     (n (length-of (info (get-version-info key))))
  1513.     (for (j 0) (< j n) (+= j 1)
  1514.       (if (== subkey (extract-element info j)) { TRUE (done) }))
  1515.     FALSE
  1516.   }
  1517. )
  1518.  
  1519. (const
  1520.   VERSION-BUFFER    "*version-info*"
  1521. )
  1522.  
  1523. (defun
  1524.   vn (int n) HIDDEN { (extract-element (get-version-info "version") n) }
  1525.   vn1 (string key)(int n) HIDDEN
  1526.     { (extract-element (get-version-info key) n) }
  1527.   version
  1528.   {
  1529.     (msg (vn VERSION-NAME)(vn VERSION-MAJOR)
  1530.      " (Mutt Editor " (vn VERSION-MAJOR) ") "
  1531.      (vn VERSION-FIRST-RELEASE)
  1532.      " v" (vn VERSION-MAJOR) "." (vn VERSION-MINOR) " "
  1533.      (vn VERSION-THIS-RELEASE)
  1534.      " (c) " (vn1 "author" VERSION-AUTHOR)
  1535.     )
  1536.   }
  1537. ;  version-verbose
  1538. ;  {
  1539. ;    (int bid b2)
  1540. ;
  1541. ;    (b2 (current-buffer))
  1542. ;    (if (== -2 (bid (attached-buffer VERSION-BUFFER)))
  1543. ;      (bid (create-buffer VERSION-BUFFER
  1544. ;        (bit-or BFNoCare BFImmortal BFInteractive))))
  1545. ;
  1546. ;    (popup-buffer bid 1 1)
  1547. ;    (current-buffer bid)(clear-buffer)
  1548. ;    (insert-text
  1549. ;      "Name: " (vn VERSION-NAME)(vn VERSION-MAJOR) "^J"
  1550. ;      "Author: " (vn1 "author" VERSION-AUTHOR) "^J"
  1551. ;      "OS: " (vn1 "OS" VERSION-OS-MAJOR) "  " (vn1 "OS" VERSION-OS-MINOR)
  1552. ;    )
  1553. ;    (current-buffer b2)
  1554. ;  }
  1555.   bug-report
  1556.   {
  1557.     (small-int month day year weekday hh mm ss)    ;; TimeInfo
  1558.     (int bid)
  1559.     (list info)
  1560.  
  1561.     (read-clock (loc month))
  1562.  
  1563.     (visit-file "bugreport")
  1564.  
  1565.     (insert-text
  1566.       "To: " (vn1 "author" VERSION-EMAIL) "^J"
  1567.       "Subject: Bug Report for " (vn VERSION-NAME) " "
  1568.         (vn VERSION-MAJOR) "." (vn VERSION-MINOR) " "
  1569.         (vn VERSION-PATCH) " "  (vn VERSION-THIS-RELEASE) "^J"
  1570.       "Reply-To: <your email address>^J"
  1571.       "Date: " month "/" day "/" year "^J"
  1572.       "^J"
  1573.       "If you don't have Email, send to:^J" (vn1 "author" VERSION-AUTHOR) ", "
  1574.     (vn1 "author" VERSION-MAIL) "^J^J"
  1575.       "  OS: " (vn1 "OS" VERSION-OS-MAJOR) "  " 
  1576.                (vn1 "OS" VERSION-OS-MINOR) "^J"
  1577.       "^J"
  1578.       "Please enter bug report/gripe/comment:^J"
  1579.     )
  1580.     (end-of-buffer)
  1581.     (text-mode)
  1582.   }
  1583. )
  1584.  
  1585. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1586. ;;;;;;;;;;;;;;;;;;;;;;;;;;;; Bug Patches ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1587. ;;;;;;;;;;;;;;;;;;;; and Backwards Compatibility ;;;;;;;;;;;;;;;;;;;;;
  1588. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1589.  
  1590. (defun
  1591.   window-height { (window-length (push-args 0)) }
  1592.   goto-line (n) { (current-line n) }
  1593. )
  1594. (defun beeper
  1595. {
  1596.   (if (== 0 (nargs))
  1597.     (beep -1)
  1598.     (beep (push-args 0)))
  1599. })
  1600.  
  1601. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1602. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Keys ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1603. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1604.  
  1605. (defun
  1606.   !9 MAIN HIDDEN        ;; do this early!  Before any binds
  1607.   {
  1608.     (prefix-key 0 "C-[")    ;; escape is also Meta
  1609.     (prefix-key 1 "C-x")
  1610.   }
  1611. )
  1612.  
  1613. (defun MAIN        ;; bind keys
  1614. {
  1615. ;; hidebuf.mut isearch.mut markring.mut register.mut search.mut
  1616. ;; compile.mut findit.mut
  1617.  
  1618.     ;; ?GNU Emacs bindings
  1619.  
  1620.   (bind-key GLOBAL-KEYMAP
  1621.     "abort"                "C-g"
  1622.     "apropos"            "M-?"
  1623.  
  1624.     "dabbrev-expand"        "M-/"
  1625.  
  1626.     "exchange-dot-and-mark"        "C-xC-x"
  1627.     "set-the-mark"            "C-@"
  1628.     "set-the-mark"            "M- "
  1629.  
  1630.     "exit"                "C-xC-c"
  1631.     "exit"                "C-c"
  1632.  
  1633.     "ME-command"            "M-x"
  1634.     "next-file"            "C-xf"
  1635.  
  1636.     "open-line"            "C-o"
  1637.     "newline"            "C-m"
  1638.     "newline-and-indent"        "C-j"
  1639.     "newline-and-indent"        "M-C-o"
  1640.     "tab"                "C-i"
  1641.  
  1642.     "quote"                "C-q"
  1643.     "quote"                'C-^'  ;; In case XOFF takes over C-q
  1644.  
  1645.     "shell-command"            "C-x!"
  1646.     "spawn-shell"            "C-z"
  1647.  
  1648.     "switch-to-buffer"        "C-xb"
  1649.     "use-existing-buffer"        "C-xC-o"
  1650.  
  1651.     "transpose-chars"        "C-t"    ;; in twiddle.mut
  1652.     "universal-argument"        "C-u"
  1653.  
  1654.     "beginning-of-buffer"        "M-<"
  1655.     "end-of-buffer"            "M->"
  1656.  
  1657.     "beginning-of-line"        "C-a"
  1658.     "end-of-line"            "C-e"
  1659.  
  1660.     "copy-region"            "M-w"
  1661.     "cut-region"            "C-w"
  1662.     "yank"                "C-y"
  1663.     "cut-line"            "C-k"
  1664.  
  1665.     "delete-character"        "C-d"
  1666.     "delete-character"        "C-?"
  1667.     "delete-previous-character"    "C-h"
  1668.  
  1669.     "delete-buffer"            "C-xk"    ;; in delbuf.mut
  1670.  
  1671.     "query-replace"            "M-q"    ;; not GNU
  1672.     "query-replace"            "M-%"
  1673.     "re-query-replace"        "M-C-q"
  1674.  
  1675.     "Goto-line"            "M-g"
  1676.     "indent-rigidly"        "C-xC-i"  ;; in indent.mut
  1677.  
  1678.     "list-buffers"            "C-xC-b"    ;; in bstats.mut
  1679.     "show-buffer-stats"        "C-x="        ;; in bstats.mut
  1680.  
  1681.     "toggle-read-only"        "C-xC-q"
  1682.  
  1683.     "spell-word"            "M-$"        ;; in spell.mut
  1684.  
  1685.     "downcase-region"        "C-xC-l"    ;; in case.mut
  1686.     "upcase-region"            "C-xC-u"    ;; in case.mut
  1687.     "downcase-word"            "M-l"        ;; in case.mut
  1688.     "upcase-word"            "M-u"        ;; in case.mut
  1689.     "capitalize-word"        "M-c"        ;; in case.mut
  1690.  
  1691.     "copy-to-register"        "C-xx"        ;; in register.mut
  1692.     "copy-region-to-rectangle"    "C-xr"        ;; in register.mut
  1693.     "insert-register"        "C-xg"        ;; in register.mut
  1694.     "point-to-register"        "C-x/"        ;; in register.mut
  1695.     "register-to-point"        "C-xj"        ;; in register.mut
  1696.  
  1697.     "undo"                'C-_'    ;; undo.mut GNU binding
  1698.     "undo"                "C-xu"    ;; undo.mut GNU binding
  1699.  
  1700.         ;; Function keys
  1701.     "delete-whitespace"        "F-1"    ;; F1
  1702.     "next-buffer"            "F-2"    ;; F2
  1703.     "cut-the-line"            "F-5"    ;; F5
  1704.     "p-match"            "F-6"    ;; F6 in pmatch.mut
  1705.     "CR->CR&indent"            "F-7"    ;; F7
  1706.     "CR->CR"            "F-8"    ;; F8
  1707.     "set-the-mark"            "F-0"    ;; F10
  1708.  
  1709.     "mark-and-home"            "F-A"    ;; Home key
  1710.     "mark-and-end"            "F-B"    ;; End key
  1711.     "previous-line"            "F-C"    ;; Up Arrow
  1712.     "next-line"            "F-D"    ;; Down Arrow
  1713.     "next-character"        "F-E"    ;; Right Arrow
  1714.     "previous-character"        "F-F"    ;; Left Arrow
  1715.     "center-cursor"            "F-G"    ;; Insert key
  1716.     "delete-character"        "F-H"    ;; Delete key
  1717.     "previous-page"            "F-I"    ;; Page Down
  1718.     "next-page"            "F-J"    ;; Page Up
  1719.     "cut-line"            "F-K"    ;; Clear Line (HP terminals)
  1720.     "cut-the-line"            "F-L"    ;; Delete Line (HP terminals)
  1721.     "set-the-mark"            "F-N"    ;; Select (HP terminals)
  1722.     "scroll-down"            "F-O"    ;; Roll/Scroll Up
  1723.     "scroll-up"            "F-P"    ;; Roll/Scroll Down
  1724.  
  1725.         ;; Number pad
  1726.     "mark-and-home"            "F-{"    ;; Number pad Home key
  1727.     "mark-and-end"            "F-}"    ;; Number pad End key
  1728.     "previous-line"            'F-^'    ;; Number pad Up Arrow
  1729.     "next-line"            "F-."    ;; Number pad Down Arrow
  1730.     "next-character"        "F->"    ;; Number pad Right Arrow
  1731.     "previous-character"        "F-<"    ;; Number pad Left Arrow
  1732.     "toggle-overstrike"        "F-&"    ;; Number pad Insert
  1733.     "delete-character"        "F-#"    ;; Number pad Delete
  1734.     "next-page"            "F-["    ;; Number pad Page Up
  1735.     "previous-page"            "F-]"    ;; Number pad Page Down
  1736.  
  1737.         ;; Mouse
  1738.     "do-mouse"            MOUSE-KEY  ;; From the mouse driver
  1739.   )
  1740. })
  1741.