home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / sexp-history.el < prev    next >
Encoding:
Text File  |  1991-12-03  |  26.3 KB  |  742 lines
  1. ;; S-exp History Substitution in GNU Emacs Lisp-Interaction-Mode
  2. ;; Copyright (C) 1991 by Takeyuki Sakaguchi.
  3.  
  4. ;; LCD Archive Entry:
  5. ;; sexp-history|Takeyuki Sakaguchi|saka@train.ncl.omron.co.jp
  6. ;; |S-exp history substitution in GNU Emacs lisp-interaction-mode
  7. ;; |91-12-01|1.0|~/packages/sexp-history.tar.Z|
  8.  
  9. ;;   Author:            Takeyuki SAKAGUCHI
  10. ;;   Version:           1.0
  11. ;;   Last modification: Dec. 1, 1991
  12.  
  13. ;; This program is free software; you can redistribute it and/or
  14. ;; modify it under the terms of the GNU General Public License as
  15. ;; published by the Free Software Foundation; either version 1, or
  16. ;; (at your option) any later version.
  17.  
  18. ;; This program is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. ;; GNU General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU EMACS GENERAL PUBLIC
  24. ;; LICENSE along with GNU Emacs; see the file COPYING. If not,
  25. ;; write to the Free Software Foundation, 675 Mass Ave, Cambridge,
  26. ;; MA 02139, USA.
  27.  
  28.  
  29. (defvar sexp-history-event-max 20
  30.   "*Maximum number of events kept in the history buffer.")
  31.  
  32. (defvar sexp-history-histchars '(?! . ?^)
  33.   "*Pair of history substitution characters.")
  34.  
  35. (defvar sexp-history-list-order 'ascending
  36.   "*Listing order in sexp-history-list. Either 'descending or 'ascending.")
  37.  
  38. (defvar sexp-history-quoted-too nil
  39.   "*Whether substitute or not in quoted strings.
  40. If non-nil substitutes as well. Otherwise doesn't.")
  41.  
  42. (defvar sexp-history-echo-only nil
  43.   "*Whether evaluate or not after echoback in full.
  44. If non-nil echoes back but never evaluates. Otherwise does.")
  45.  
  46. (defvar sexp-history-map nil
  47.   "Keymap used while S-exp history substitution active.")
  48. (if sexp-history-map
  49.     nil
  50.   (setq sexp-history-map
  51.     (copy-keymap lisp-interaction-mode-map))
  52.   (substitute-key-definition 'eval-print-last-sexp
  53.                  'eval-print-last-sexp-with-history
  54.                  sexp-history-map))
  55.  
  56. (defvar sexp-history-syntax-table nil
  57.   "Syntax table used while parsing S-exp.
  58. \`equal\' to emacs-lisp-mode-syntax-table but not \`eq\'.")
  59. (if sexp-history-syntax-table
  60.     nil
  61.   (setq sexp-history-syntax-table
  62.     (copy-syntax-table emacs-lisp-mode-syntax-table)))
  63.  
  64. (defun sexp-history (reset-p)
  65.   "Lisp-Interaction-Mode with history substitution capability.
  66. With no arg, this command toggles on/off S-exp history substitution on
  67. current lisp-interaction-mode buffer. Otherwise turns on or resets.
  68.  
  69. Note: this command merely introduces several additional variables,
  70. functions and alternative key bindings to lisp-interaction-mode. It
  71. ever introduces NEITHER major NOR minor modes.
  72.  
  73. Additional variables:
  74.   sexp-history-event-max    maximum number of events kept in the
  75.                             history buffer. 20 by default.
  76.   sexp-history-histchars    pair of history substitution characters.
  77.                             (\`!\' . \`^\') by default.
  78.   sexp-history-list-order   listing order in sexp-history-list. Either
  79.                             'descending or 'ascending. 'ascending by
  80.                             default.
  81.   sexp-history-quoted-too   Whether substitute or not in quoted strings.
  82.                             If non-nil substitutes as well. Otherwise
  83.                             doesn't. nil by default.
  84.   sexp-history-echo-only    whether evaluate or not after echoback in
  85.                             full. If non-nil echoes back but never
  86.                             evaluates. Otherwise does. S-exp that in-
  87.                             vokes NO history substitution is evaluated
  88.                             regardless of this value. nil by default.
  89.   sexp-history-map          keymap used while S-exp history substitution
  90.                             active. This is the alternative map that
  91.                             invokes eval-print-last-sexp-with-history.
  92.   sexp-history-syntax-table syntax table used while parsing S-exp.
  93.                             \`equal\' to emacs-lisp-mode-syntax-table,
  94.                             but not \`eq\'.
  95.  
  96. Key binding alternation:
  97.   \\<sexp-history-map>\\[eval-print-last-sexp-with-history]    bound to command eval-print-last-sexp-with-history.
  98.  
  99. Type \\[describe-function] eval-print-last-sexp-with-history for the substitution
  100. notation in detail; \\[describe-function] lisp-interaction-mode for original features."
  101.   (interactive "P")
  102.   (if (not (eq major-mode 'lisp-interaction-mode))
  103.       (error "Not in lisp-interaction-mode.")
  104.     (cond ((eq (current-local-map) lisp-interaction-mode-map)
  105.        ;; make globals to buffer local.
  106.        (make-local-variable 'sexp-history-event-max)
  107.        (make-local-variable 'sexp-history-histchars)
  108.        (make-local-variable 'sexp-history-list-order)
  109.        (make-local-variable 'sexp-history-quoted-too)
  110.        (make-local-variable 'sexp-history-echo-only)
  111.        ;; sexp-history-event-buffer history buffer itself. Consists of alists
  112.        ;;                           of event number and S-exp string.
  113.        (make-local-variable 'sexp-history-event-buffer)
  114.        (setq sexp-history-event-buffer nil)
  115.        ;; sexp-history-current-event current event number.
  116.        (make-local-variable 'sexp-history-current-event)
  117.        (setq sexp-history-current-event 1)
  118.        ;; sexp-history-last-event the most recently referred event no.
  119.        (make-local-variable 'sexp-history-last-event)
  120.        (setq sexp-history-last-event nil)
  121.        ;; sexp-history-last-subst the most recent substitution.
  122.        (make-local-variable 'sexp-history-last-subst)
  123.        (setq sexp-history-last-subst nil)
  124.        ;; sexp-history-last-regexp the most recent regexp in modifier.
  125.        (make-local-variable 'sexp-history-last-regexp)
  126.        (setq sexp-history-last-regexp nil)
  127.        ;; sexp-history-termination termination point of the last S-exp.
  128.        (make-local-variable 'sexp-history-termination)
  129.        (setq sexp-history-termination 0)
  130.        (use-local-map sexp-history-map)
  131.        (message "S-exp history substitution active."))
  132.       (reset-p
  133.        (setq sexp-history-event-buffer nil
  134.          sexp-history-current-event 1
  135.          sexp-history-last-event nil
  136.          sexp-history-last-subst nil
  137.          sexp-history-last-regexp nil
  138.          sexp-history-termination 0)
  139.        (message "S-exp history substitution reset."))
  140.       (t
  141.        ;; restore locals to global.
  142.        (kill-local-variable 'sexp-history-event-max)
  143.        (kill-local-variable 'sexp-history-histchars)
  144.        (kill-local-variable 'sexp-history-list-order)
  145.        (kill-local-variable 'sexp-history-quoted-too)
  146.        (kill-local-variable 'sexp-history-echo-only)
  147.        ;; unbound locals.
  148.        (kill-local-variable 'sexp-history-event-buffer)
  149.        (makunbound 'sexp-history-event-buffer)
  150.        (kill-local-variable 'sexp-history-current-event)
  151.        (makunbound 'sexp-history-current-event)
  152.        (kill-local-variable 'sexp-history-last-event)
  153.        (makunbound 'sexp-history-last-event)
  154.        (kill-local-variable 'sexp-history-last-subst)
  155.        (makunbound 'sexp-history-last-subst)
  156.        (kill-local-variable 'sexp-history-last-regexp)
  157.        (makunbound 'sexp-history-last-regexp)
  158.        (kill-local-variable 'sexp-history-termination)
  159.        (makunbound 'sexp-history-termination)
  160.        (use-local-map lisp-interaction-mode-map)
  161.        (message "S-exp history substitution inactive.")))))
  162.  
  163. (defun eval-print-last-sexp-with-history ()
  164.   "Eval-Print-Last-Sexp with history substitution capability.
  165. Notation for substitution is similar to that of C shell:
  166.  
  167. Special forms:
  168.   !        stands for function call \`(sexp-history-list)\' that shows
  169.            current history listings.
  170.   ^RE^str^ abbreviates !!:s/RE/str/.
  171.  
  172. Primitive forms (event specifiers):
  173.   !!    stands for the most recently evaluated S-exp.
  174.   !^    stands for CAR of !! (equivalent to !!:^).
  175.   !*    stands for CDR of !! (equivalent to !!:*).
  176.   !$    stands for LAST of !! (equivalent to !!:$).
  177.   !n    stands for S-exp of absolute event number n.
  178.   !-n   stands for S-exp of relative event number n.
  179.   !RE   stands for the most recently evaluated S-exp that matches to RE
  180.         only at the beginning. Leading \`(\'s in S-exp are ignored. e.g.,
  181.         !foo matches to any of \`foo\', \`(foo\', \`((foo\', \`(((foo\', and
  182.         so on. This is equivalent to !?^\\(*foo?.
  183.   !{RE} is escaped form for !RE in case of misinterpretation. e.g.,
  184.         !{1} matches to S-exp beginning with \`1\' while !1 matches to
  185.         event number one.
  186.   !?RE? stands for the most recently evaluated S-exp that matches to RE
  187.         anywhere. Extracts only matching word(s) if followed by \`%\'.
  188.   !+    stands for the most recently referred event.
  189.   !++   stands for the next event to !+.
  190.   !&    stands for the most recent substitution.
  191.  
  192. Note: in RE, punctuation chars such as whitespace, single and double
  193. quotation marks, \`.\', \`(\', \`)\', \`[\' and \`]\' must be escaped by \`\\\' to
  194. mask their special meaning on emacs-lisp-mode-syntax-table. Moreover,
  195. notation closing chars such as \` \' in !RE, \`}\' in !{RE} and \`?\' in
  196. !?RE? also must be escaped. \`\\\' itself must be doubled like in a quoted
  197. string. For example:
  198.  
  199. !?foo\\.*bar\\[^\\\\\\\"\\]+$?  means match for \`foo.*bar[^\\\"]+$\'.
  200. !?\\(cons\\[\\\\\\ \\\\t\\]+foo? means match for \`(cons[\\ \\t]+foo\'.
  201. !?\\?=?                   means match for \`?=\'.
  202. !\\:=                     means match for \`^(*:=\'.
  203.  
  204. See The GNU Emacs Reference Manual for more details.
  205.  
  206. Additive forms (position designators/modifiers):
  207.   :^          stands for CAR of preceding notation.
  208.   :*          stands for CDR of preceding notation.
  209.   :$          stands for LAST of preceding notation.
  210.   :n          stands for NTH of preceding notation.
  211.   :n*         stands for NTHCDR of preceding notation.
  212.   :n-         is like n* but omitting the last.
  213.   :-m         abbreviates 0-m.
  214.   :n-m        stands for range in preceding notation.
  215.   :D          stands for deletion.
  216.   :i          stands for inside of parentheses.
  217.   :r          stands for REVERSE of preceding notation.
  218.   :s/RE/str/  stands for substitution of RE with str only once. If str
  219.               preceded by \`&\', appends it instead.
  220.   :gs/RE/str/ stands for substitution of RE with str globally. If str
  221.               preceded by \`&\', appends it instead.
  222.  
  223. Note: additive forms can be applied recursively. For example:
  224.   !*:*:5:$   means (LAST (nth 5 (cdr !*)))
  225.   !16:^:2    means (nth 2 (car !16))
  226.   !setq:$:^  means (car (LAST !setq)) 
  227.   !{1}:*:r   means (reverse (cdr !{1}))
  228.  
  229. Type \\[describe-function] eval-print-last-sexp for original features."
  230.   (interactive)
  231.   (skip-chars-backward "\ \t\n")
  232.   (setq sexp-history-termination (point))
  233.   (if (bobp)
  234.       nil
  235.     (let ((original-syntax-table (syntax-table))
  236.       (original-match-data (match-data)))
  237.       (set-syntax-table sexp-history-syntax-table)
  238.       (unwind-protect
  239.       (if (and (sexp-history-echoback)
  240.            sexp-history-echo-only)
  241.           nil
  242.         (let ((end (point)))
  243.           (backward-sexp 1)
  244.           (set-syntax-table original-syntax-table)
  245.           (store-match-data original-match-data)
  246.           (sexp-history-truncate (- sexp-history-current-event
  247.                     sexp-history-event-max))
  248.           (setq sexp-history-event-buffer
  249.             (cons (cons sexp-history-current-event
  250.                 (buffer-substring (point)
  251.                           end))
  252.               sexp-history-event-buffer))
  253.           (setq sexp-history-current-event
  254.             (1+ sexp-history-current-event))
  255.           (eval-region (point) end
  256.                (current-buffer))))
  257.     (save-excursion
  258.       (goto-char sexp-history-termination)
  259.       (or (eobp)
  260.           (/= (char-after (point)) 0)
  261.           (delete-char 1)))
  262.     (or (eq (syntax-table)
  263.         original-syntax-table)
  264.         (set-syntax-table original-syntax-table))
  265.     (store-match-data original-match-data)))))
  266.  
  267. (defun sexp-history-echoback ()
  268.   "Subordinate function for S-exp history."
  269.   ;; Echoes back S-exp in full after parsing the last S-exp.
  270.   ;; Returns t if any echoback done, nil otherwise.
  271.   (let ((replacement (sexp-history-parse-last-sexp)))
  272.     (if (null replacement)
  273.     nil
  274.       (let ((beginning))
  275.     (save-excursion
  276.       (backward-sexp 1)
  277.       (setq beginning (point)))
  278.     (insert "\n"
  279.         (buffer-substring beginning (point))))
  280.       (backward-sexp 1)
  281.       (while replacement
  282.     (forward-char (nth 0 (car replacement)))
  283.     (delete-char (nth 1 (car replacement)))
  284.     (insert (nth 2 (car replacement)))
  285.     (setq replacement (cdr replacement)))
  286.       t)))
  287.  
  288. (defun sexp-history-parse-last-sexp ()
  289.   "Subordinate function for S-exp history."
  290.   ;; Parses the last S-exp and returns replacement information for echo-
  291.   ;; back. It consists of lists of relative position, length and text
  292.   ;; to replace with.
  293.   (insert "\0")
  294.   (backward-char 1)
  295.   (backward-sexp 1)
  296.   (let ((replacement nil) (relp (point)) (char))
  297.     (while (/= (setq char (char-after (point))) 0)
  298.       (cond ((= char ?\\)
  299.          ;; `\' escape sequence.
  300.          (if (= (char-after (1+ (point))) 0)
  301.          (forward-char 1)
  302.            (forward-char 2)))
  303.         ((= char ??)
  304.          ;; `?' escape sequence.
  305.          (setq char (char-after (1+ (point))))
  306.          (cond ((= char 0)
  307.             (forward-char 1))
  308.            ((= char ?\\)
  309.             (forward-char 3))
  310.            (t
  311.             (forward-char 2))))
  312.         ((= char ?\")
  313.          ;; beginning of `"' quoted string.
  314.          (forward-char 1)
  315.          (or sexp-history-quoted-too
  316.          (while (/= (prog1
  317.                 (setq char (char-after (point)))
  318.                   (forward-char 1))
  319.                 ?\")
  320.            (if (= char ?\\)
  321.                (forward-char 1)))))
  322.         ((= char (car sexp-history-histchars))
  323.          ;; beginning of `!' notation.
  324.          (let ((bor) (lor) (repl nil))
  325.            (setq char (char-after (1+ (point))))
  326.            (cond ((= char 0)
  327.               ;; `!' special.
  328.               (setq lor 1
  329.                 repl "(sexp-history-list)"))
  330.              ((= char (car sexp-history-histchars))
  331.               ;; `!!' primitive.
  332.               (setq lor 2
  333.                 repl (sexp-history-match* -1)))
  334.              ((= char ?^)
  335.               ;; `!^' primitive.
  336.               (setq lor 2
  337.                 repl (sexp-history-apply
  338.                   'car (sexp-history-match* -1))))
  339.              ((= char ?*)
  340.               ;; `!*' primitive.
  341.               (setq lor 2
  342.                 repl (sexp-history-apply
  343.                   'cdr (sexp-history-match* -1))))
  344.              ((= char ?$)
  345.               ;; `!$' primitive.
  346.               (setq lor 2
  347.                 repl (sexp-history-apply
  348.                   'last (sexp-history-match* -1))))
  349.              ((= char ?+)
  350.               (cond ((= (char-after (+ (point) 2)) ?+)
  351.                  ;; `!++' primitive.
  352.                  (setq lor 3
  353.                    repl (sexp-history-match*
  354.                      (1+ sexp-history-last-event))))
  355.                 (t
  356.                  ;; `!+' primitive.
  357.                  (setq lor 2
  358.                    repl (sexp-history-match*
  359.                      sexp-history-last-event)))))
  360.              ((= char ?&)
  361.               ;; `!&' primitive.
  362.               (setq lor 2
  363.                 repl sexp-history-last-subst))
  364.               ((or (= char ?-)
  365.               (and (>= char ?0) (<= char ?9)))
  366.               (if (looking-at ".\\(\\-?[0-9]+\\)")
  367.               ;; `!n' primitive.
  368.               (let ((key (sexp-history-match-substring 1)))
  369.                 (setq lor (- (match-end 0) (point))
  370.                   repl (sexp-history-match*
  371.                     (string-to-int key))))
  372.             (error "Invalid notation: \`%c-\' -- missing \`n\'."
  373.                    (car sexp-history-histchars))))
  374.              ((= char ??)
  375.               (if (looking-at ".\\?\\(\\([^\0\\?]\\|\\(\\\\.\\)\\)+\\)\\?\\%?")
  376.               ;; `!?RE?' or `!?RE?%' primitive.
  377.               (let ((key (sexp-history-match-substring 1))
  378.                 (word-only-p (= (char-after
  379.                          (1- (match-end 0))) ?%)))
  380.                 (setq lor (- (match-end 0) (point))
  381.                   repl (sexp-history-match*
  382.                     (sexp-history-deesc-text key)
  383.                     nil word-only-p)))
  384.             (error "Invalid notation: \`%c?\' -- incomplete \`RE?\'."
  385.                    (car sexp-history-histchars))))
  386.              ((= char ?{)
  387.               (if (looking-at ".\\{\\(\\([^\0\\}]\\|\\(\\\\.\\)\\)+\\)\\}")
  388.               ;; `!{RE}' primitive.
  389.               (let ((key (sexp-history-match-substring 1)))
  390.                 (setq lor (- (match-end 0) (point))
  391.                   repl (sexp-history-match*
  392.                     (sexp-history-deesc-text key)
  393.                     t nil)))
  394.             (error "Invalid notation: \`%c{\' -- incomplete \`RE}\'."
  395.                    (car sexp-history-histchars))))
  396.              ((looking-at ".\\(\\([^\0\\ \\:]\\|\\(\\\\.\\)\\)+\\)")
  397.               ;; `!RE' primitive.
  398.               (let ((key (sexp-history-match-substring 1)))
  399.             (setq lor (- (match-end 0) (point))
  400.                   repl (sexp-history-match*
  401.                     (sexp-history-deesc-text key)
  402.                     t nil))))
  403.              (t
  404.               ;; otherwise: '! ' or '!:'.
  405.               (error "Invalid notation: \`%c%c\'."
  406.                  (car sexp-history-histchars) char)))
  407.            (setq bor (- (point) relp))
  408.            (or repl
  409.            (error "Event not found: \`%s\'."
  410.               (buffer-substring (point)
  411.                         (+ (point) lor))))
  412.            (forward-char lor)
  413.            (while (= (char-after (point)) ?:)
  414.          (let ((loa))
  415.            (setq char (char-after (1+ (point))))
  416.            (cond ((= char ?^)
  417.               ;; `:^' additive.
  418.               (setq loa 2
  419.                 repl (sexp-history-apply 'car repl)))
  420.              ((= char ?*)
  421.               ;; `:*' additive.
  422.               (setq loa 2
  423.                 repl (sexp-history-apply 'cdr repl)))
  424.              ((= char ?$)
  425.               ;; `:$' additive.
  426.               (setq loa 2
  427.                 repl (sexp-history-apply 'last repl)))
  428.              ((or (= char ?-)
  429.                   (and (>= char ?0) (<= char ?9)))
  430.               (if (looking-at ".\\(\\([0-9]+\\*?\\)\\)?\\(\\-\\)?\\(\\([0-9]+\\)\\)?")
  431.                   ;; `:n', `:n*', `:n-', `:-m' or `:n-m' additive.
  432.                   (let ((n (sexp-history-match-substring 1))
  433.                     (m (sexp-history-match-substring 4))
  434.                     (hyphen (sexp-history-match-substring 3)))
  435.                 (setq loa (- (match-end 0)
  436.                          (match-beginning 0)))
  437.                 (cond (hyphen
  438.                        ;; `:n-', `:-m' or `:n-m'.
  439.                        (and n
  440.                         (setq n (string-to-int n)))
  441.                        (and m
  442.                         (setq m (string-to-int m)))
  443.                        (if (or n m)
  444.                        (setq repl (sexp-history-range repl n m))
  445.                      (error "Invalid notation: \`%c-\' -- missing \`n\' or \`m\'."
  446.                         ?:)))
  447.                       (t
  448.                        ;; `:n' or `:n*'.
  449.                        (setq char (string-to-char (substring n -1))
  450.                          n (string-to-int n))
  451.                        (setq repl (sexp-history-apply
  452.                            (if (= char ?*)
  453.                                'nthcdr
  454.                              'nth) repl n)))))))
  455.              ((= char ?D)
  456.               ;; `:D' additive.
  457.               (setq loa 2
  458.                 repl (prin1-to-string
  459.                       (sexp-history-delete sexp-history-last-event))))
  460.              ((= char ?i)
  461.               ;; `:i' additive.
  462.               (setq loa 2
  463.                 repl (if (string-match "(\\(.*\\))" repl)
  464.                      (substring repl
  465.                             (match-beginning 1)
  466.                             (match-end 1))
  467.                        repl)))
  468.              ((= char ?r)
  469.               ;; `:r' additive.
  470.               (setq loa 2
  471.                 repl (sexp-history-apply
  472.                       'reverse repl)))
  473.              ((or (= (downcase char) ?g)
  474.                   (= (downcase char) ?s))
  475.               (if (looking-at ".[Gg]?[Ss]\\/\\(\\([^\0\\/]\\|\\(\\\\.\\)\\)+\\)?\\/\\&?\\(\\([^\0\\/]\\|\\(\\\\.\\)\\)*\\)\\/?")
  476.                   ;; `:s/RE/str/', `:gs/RE/str/', `:s/RE/&str/', `:gs/RE/&str/'
  477.                   ;; `:S/RE/str/', `:GS/RE/str/', `:S/RE/&str/' or `:GS/RE/&str/' additive.
  478.                   (let ((RE (sexp-history-deesc-text
  479.                      (sexp-history-match-substring 1)))
  480.                     (str (sexp-history-deesc-text
  481.                       (sexp-history-match-substring 4)))
  482.                     (count (if (= (char-after (1+ (match-beginning 0)))
  483.                           ?g)
  484.                            -1
  485.                          1))
  486.                     (append-p (= (char-after (1- (match-beginning 4)))
  487.                          ?&))
  488.                     (case-fold-search (if (or (= char ?G)
  489.                                   (= char ?S))
  490.                               (not case-fold-search)
  491.                             case-fold-search)))
  492.                 (setq loa (- (match-end 0)
  493.                          (match-beginning 0)))
  494.                 (or RE
  495.                     (setq RE sexp-history-last-regexp)
  496.                     (error "No previous lhs."))
  497.                 (or (setq repl
  498.                       (sexp-history-string-subst repl RE str count append-p))
  499.                     (error "Modifier failed: \`%s\' no match."
  500.                        RE))
  501.                 (setq sexp-history-last-regexp RE))
  502.                 (error "Invalid notation: \`%c(g)s\' -- incomplete \`RE/str/\'."
  503.                    ?:)))
  504.              (t
  505.               ;; otherwise.
  506.               (error "Invalid notation: \`%c%c\'."
  507.                  ?: char)))
  508.            (setq lor (+ lor loa))
  509.            (forward-char loa)))
  510.            (setq relp (point)
  511.              replacement (cons (list bor lor repl)
  512.                        replacement)
  513.              sexp-history-last-subst repl)))
  514.         ((= char (cdr sexp-history-histchars))
  515.          ;; beginning of `^' notation.
  516.          (let* ((histchar (regexp-quote (char-to-string char)))
  517.             (regexp (concat
  518.                  ".\\(\\([^\0" histchar
  519.                  "]\\|\\(\\\\.\\)\\)+\\)?" histchar
  520.                  "\\&?\\(\\([^\0" histchar
  521.                  "]\\|\\(\\\\.\\)\\)*\\)" histchar
  522.                  "?")))
  523.            (if (looking-at regexp)
  524.            (let ((bor (- (point) relp))
  525.              (lor (- (match-end 0) (match-beginning 0)))
  526.              (repl)
  527.              (RE (sexp-history-deesc-text
  528.                   (sexp-history-match-substring 1)))
  529.              (str (sexp-history-deesc-text
  530.                    (sexp-history-match-substring 4)))
  531.              (append-p (= (char-after (1- (match-beginning 4)))
  532.                       ?&)))
  533.              (or (setq repl
  534.                    (sexp-history-match* -1))
  535.              (error "Event not found: \`%s\'."
  536.                 (buffer-substring (point)
  537.                           (+ (point) lor))))
  538.              (or RE
  539.              (setq RE sexp-history-last-regexp)
  540.              (error "No previous lhs."))
  541.              (or (setq repl
  542.                    (sexp-history-string-subst repl RE str 1 append-p))
  543.              (error "Modifier failed: \`%s\' no match."
  544.                 RE))
  545.              (setq sexp-history-last-regexp RE)
  546.              (forward-char lor)
  547.              (setq relp (point)
  548.                replacement (cons (list bor lor repl)
  549.                          replacement)))
  550.          (error "Invalid notation: \`%c\' -- incomplete \`RE%cstr%c\'."
  551.             char char char))))
  552.         (t
  553.          (forward-char 1))))
  554.     (delete-char 1)
  555.     (and replacement
  556.      (setq replacement (cons (list (- (point) relp) 0 "")
  557.                  replacement))
  558.      (nreverse replacement))))
  559.  
  560. (defun sexp-history-match* (key &optional beginning-only-p word-only-p)
  561.   "Subordinate function for S-exp history."
  562.   ;; Extracts S-exp text of the newest event.
  563.   (let ((events (sexp-history-match key beginning-only-p word-only-p)))
  564.     (if (null events)
  565.     nil
  566.       (setq sexp-history-last-event (car (car events)))
  567.       (cdr (car events)))))
  568.  
  569. (defun sexp-history-match (key &optional beginning-only-p word-only-p)
  570.   "Subordinate function for S-exp history."
  571.   ;; Returns alists for events that match to given key.
  572.   ;; If no match returns nil. Matching policy is as follows:
  573.   ;;
  574.   ;; numeric key: > 0: match for absolute event number.
  575.   ;;              < 0: match for relative event number.
  576.   ;;
  577.   ;; string key:  match for regexp. If beginning-only-p is non-nil it
  578.   ;;              matches only at the beginning ignoring leading `('s.
  579.   ;;              Otherwise, matches anywhere. If word-only-p is non-nil
  580.   ;;              extracts only matching word(s).
  581.   (cond ((numberp key)
  582.      (if (>= key 0)
  583.          (list (assq key
  584.              sexp-history-event-buffer))
  585.        (list (assq (+ sexp-history-current-event key)
  586.                sexp-history-event-buffer))))
  587.     ((stringp key)
  588.      (if beginning-only-p
  589.          (setq key (concat "^(*" key))
  590.        (if word-only-p
  591.            (setq key (concat "\\(\\sw\\|\\s_\\)*"
  592.                  key
  593.                  "\\(\\sw\\|\\s_\\)*"))))
  594.      (delq nil
  595.            (mapcar (function
  596.             (lambda (event)
  597.               (and (string-match key (cdr event))
  598.                    (if word-only-p
  599.                    (cons (car event)
  600.                      (substring (cdr event)
  601.                             (match-beginning 0)
  602.                             (match-end 0)))
  603.                  event))))
  604.                sexp-history-event-buffer)))
  605.     (t
  606.      nil)))
  607.  
  608. (defun sexp-history-apply (func text &optional n)
  609.   "Subordinate function for S-exp history."
  610.   ;; Applies given function on given text that stands for S-exp.
  611.   (if (null text)
  612.       nil
  613.     (let ((sexp (car (read-from-string text)))
  614.       (print-escape-newlines t))
  615.       (if (listp sexp)
  616.       (cond ((eq func 'last)
  617.          (setq sexp (car (nreverse sexp))))
  618.         (n
  619.          (setq sexp (funcall func n sexp)))
  620.         (t
  621.          (setq sexp (funcall func sexp)))))
  622.       (prin1-to-string sexp))))
  623.  
  624. (defun sexp-history-range (text n m)
  625.   "Subordinate function for S-exp history."
  626.   ;; Extract from nth to mth of given text that stands for S-exp.
  627.   ;; If n is nil taken as the first. If m is nil taken as the second
  628.   ;; last.
  629.   (if (null text)
  630.       nil
  631.     (let ((sexp (car (read-from-string text)))
  632.       (print-escape-newlines t))
  633.       (if (listp sexp)
  634.       (let ((i 0))
  635.         (or n
  636.         (setq n 0))
  637.         (or m
  638.         (setq m (- (length sexp) 2)))
  639.         (setq sexp
  640.           (delq nil
  641.             (mapcar (function
  642.                  (lambda (element)
  643.                    (prog1
  644.                        (and (>= i n)
  645.                         (<= i m)
  646.                         element)
  647.                      (setq i (1+ i)))))
  648.                 sexp)))))
  649.       (prin1-to-string sexp))))
  650.  
  651. (defun sexp-history-deesc-text (text)
  652.   "Subordinate function for S-exp history."
  653.   ;; Eliminates '\' escape chars from given text.
  654.   (let ((new-text nil) (si 0) (char))
  655.     (while (< si (length text))
  656.       (setq char (aref text si))
  657.       (if (= char ?\\)
  658.       (setq si (1+ si)
  659.         char (aref text si)))
  660.       (setq new-text (concat
  661.               new-text
  662.               (char-to-string char)))
  663.       (setq si (1+ si)))
  664.     new-text))
  665.  
  666. (defun sexp-history-truncate (min)
  667.   "Subordinate function for S-exp history."
  668.   ;; Truncates the history buffer.
  669.   ;; Deletes all events whose number is equal or less than given
  670.   ;; mininum number except for the newest.
  671.   (let ((event-buffer sexp-history-event-buffer))
  672.     (while (cdr event-buffer)
  673.       (if (<= (car (car (cdr event-buffer))) min)
  674.       (setcdr event-buffer nil)
  675.     (setq event-buffer (cdr event-buffer))))))
  676.  
  677. (defun sexp-history-delete (event-no)
  678.   "Subordinate function for S-exp history."
  679.   ;; Deletes an event corresponding to given event-no.
  680.   ;; Returns t if deletion done, nil otherwise.
  681.   (let ((delete-event))
  682.     (if (null (setq delete-event (assq event-no
  683.                        sexp-history-event-buffer)))
  684.     nil
  685.       (setq sexp-history-event-buffer
  686.         (delq (assq event-no
  687.             sexp-history-event-buffer)
  688.           sexp-history-event-buffer))
  689.       t)))
  690.  
  691. (defun sexp-history-list ()
  692.   "Subordinate function for S-exp history."
  693.   ;; Prints S-exp history listings into current buffer.
  694.   ;; The order is as specified by sexp-history-list-order.
  695.   (if (not (eq major-mode 'lisp-interaction-mode))
  696.       (error "Not in lisp-interaction-mode")
  697.     (insert
  698.      (mapconcat (function
  699.          (lambda (event)
  700.            (format "\n%4d  %s"
  701.                (car event)
  702.                (cdr event))))
  703.         (if (eq sexp-history-list-order 'ascending)
  704.             (reverse sexp-history-event-buffer)
  705.           sexp-history-event-buffer)
  706.         nil))))
  707.  
  708. (defun sexp-history-string-subst (text regexp to-string &optional count append-p)
  709.   "Subordinate function for S-exp history."
  710.   ;; Substitutes matches to regexp with to-string.
  711.   ;; If count is non-nil taken as -1 that means `global' substitution.
  712.   ;; If append-p is non-nil inserts to-string immediately after the match
  713.   ;; instead of replacing with it. Returns nil if no match-and-replace done.
  714.   (if (null text)
  715.       nil
  716.     (or count
  717.     (setq count -1))
  718.     (let ((result nil) (beginning 0))
  719.       (while (and (/= count 0)
  720.           (string-match regexp text beginning))
  721.     (setq result (concat
  722.               result
  723.               (substring text
  724.                  beginning
  725.                  (if append-p
  726.                      (match-end 0)
  727.                    (match-beginning 0)))
  728.               to-string))
  729.     (setq count (1- count)
  730.           beginning (match-end 0)))
  731.       (if (> beginning 0)
  732.       (concat result (substring text beginning))
  733.     nil))))
  734.  
  735. (defun sexp-history-match-substring (level)
  736.   "Subordinate function for S-exp history."
  737.   ;; Returns matched buffer substring. nil if match empty.
  738.   (and (match-beginning level)
  739.        (buffer-substring
  740.     (match-beginning level)
  741.     (match-end level))))
  742.