Mercurial > emacs
changeset 12955:2e80892d4b39
Load cl only during compilation.
(edmacro-mismatch, edmacro-subseq): New functions.
Use them instead of mismatch and subseq.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Sun, 27 Aug 1995 17:50:39 +0000 |
| parents | c0ab245f1750 |
| children | 5d14ce2b3263 |
| files | lisp/edmacro.el |
| diffstat | 1 files changed, 72 insertions(+), 20 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/edmacro.el Sun Aug 27 17:18:05 1995 +0000 +++ b/lisp/edmacro.el Sun Aug 27 17:50:39 1995 +0000 @@ -69,7 +69,8 @@ ;;; Code: -(require 'cl) +(eval-when-compile + (require 'cl)) ;;; The user-level commands for editing macros. @@ -221,7 +222,7 @@ (let ((str (buffer-substring (match-beginning 1) (match-end 1)))) (unless (equal str "") - (setq cmd (and (not (equalp str "none")) + (setq cmd (and (not (equal str "none")) (intern str))) (and (fboundp cmd) (not (arrayp (symbol-function cmd))) (not (y-or-n-p @@ -236,7 +237,7 @@ (buffer-substring (match-beginning 1) (match-end 1))))) (unless (equal key "") - (if (equalp key "none") + (if (equal key "none") (setq no-keys t) (push key keys) (let ((b (key-binding key))) @@ -405,14 +406,14 @@ (let* ((prefix (or (and (integerp (aref rest-mac 0)) (memq (aref rest-mac 0) mdigs) - (memq (key-binding (subseq rest-mac 0 1)) + (memq (key-binding (edmacro-subseq rest-mac 0 1)) '(digit-argument negative-argument)) (let ((i 1)) (while (memq (aref rest-mac i) (cdr mdigs)) (incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (concat "M-" (subseq rest-mac 0 i) " ") - (callf subseq rest-mac i))))) + (prog1 (concat "M-" (edmacro-subseq rest-mac 0 i) " ") + (callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) @@ -420,7 +421,7 @@ (incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (loop repeat i concat "C-u ") - (callf subseq rest-mac i))))) + (callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) @@ -430,18 +431,18 @@ '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) (incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (concat "C-u " (subseq rest-mac 1 i) " ") - (callf subseq rest-mac i))))))) + (prog1 (concat "C-u " (edmacro-subseq rest-mac 1 i) " ") + (callf edmacro-subseq rest-mac i))))))) (bind-len (apply 'max 1 (loop for map in maps for b = (lookup-key map rest-mac) when b collect b))) - (key (subseq rest-mac 0 bind-len)) + (key (edmacro-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey (bind (or (loop for map in maps for b = (lookup-key map key) thereis (and (not (integerp b)) b)) (and (setq fkey (lookup-key function-key-map rest-mac)) - (setq tlen fkey tkey (subseq rest-mac 0 tlen) + (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) fkey (lookup-key function-key-map tkey)) (loop for map in maps for b = (lookup-key map fkey) @@ -467,7 +468,7 @@ (> first 32) (<= first maxkey) (/= first 92) (progn (if (> text 30) (setq text 30)) - (setq desc (concat (subseq rest-mac 0 text))) + (setq desc (concat (edmacro-subseq rest-mac 0 text))) (when (string-match "^[ACHMsS]-." desc) (setq text 2) (callf substring desc 0 2)) @@ -484,7 +485,7 @@ (> text bind-len) (memq (aref rest-mac text) '(return 13)) (progn - (setq desc (concat (subseq rest-mac bind-len text))) + (setq desc (concat (edmacro-subseq rest-mac bind-len text))) (commandp (intern-soft desc)))) (if (commandp (intern-soft desc)) (setq bind desc)) (setq desc (format "<<%s>>" desc)) @@ -521,15 +522,14 @@ (if prefix (setq desc (concat prefix desc))) (unless (string-match " " desc) (let ((times 1) (pos bind-len)) - (while (not (mismatch rest-mac rest-mac - :end1 bind-len :start2 pos - :end2 (+ bind-len pos))) + (while (not (edmacro-mismatch rest-mac rest-mac + 0 bind-len pos (+ bind-len pos))) (incf times) (incf pos bind-len)) (when (> times 1) (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times))))) - (setq rest-mac (subseq rest-mac bind-len)) + (setq rest-mac (edmacro-subseq rest-mac bind-len)) (if verbose (progn (unless (equal res "") (callf concat res "\n")) @@ -550,15 +550,67 @@ (incf len (length desc))))) res)) +(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) + "Compare SEQ1 with SEQ2, return index of first mismatching element. +Return nil if the sequences match. If one sequence is a prefix of the +other, the return value indicates the end of the shorted sequence." + (let (cl-test cl-test-not cl-key cl-from-end) + (or cl-end1 (setq cl-end1 (length cl-seq1))) + (or cl-end2 (setq cl-end2 (length cl-seq2))) + (if cl-from-end + (progn + (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) + (cl-check-match (elt cl-seq1 (1- cl-end1)) + (elt cl-seq2 (1- cl-end2)))) + (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2))) + (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) + (1- cl-end1))) + (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) + (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) + (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) + (cl-check-match (if cl-p1 (car cl-p1) + (aref cl-seq1 cl-start1)) + (if cl-p2 (car cl-p2) + (aref cl-seq2 cl-start2)))) + (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) + cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) + (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) + cl-start1))))) + +(defun edmacro-subseq (seq start &optional end) + "Return the subsequence of SEQ from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end." + (if (stringp seq) (substring seq start end) + (let (len) + (and end (< end 0) (setq end (+ end (setq len (length seq))))) + (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) + (cond ((listp seq) + (if (> start 0) (setq seq (nthcdr start seq))) + (if end + (let ((res nil)) + (while (>= (setq end (1- end)) start) + (cl-push (cl-pop seq) res)) + (nreverse res)) + (copy-sequence seq))) + (t + (or end (setq end (or len (length seq)))) + (let ((res (make-vector (max (- end start) 0) nil)) + (i 0)) + (while (< start end) + (aset res i (aref seq start)) + (setq i (1+ i) start (1+ start))) + res)))))) + (defun edmacro-fix-menu-commands (macro) (when (vectorp macro) (let ((i 0) ev) (while (< i (length macro)) (when (consp (setq ev (aref macro i))) (cond ((equal (cadadr ev) '(menu-bar)) - (setq macro (vconcat (subseq macro 0 i) + (setq macro (vconcat (edmacro-subseq macro 0 i) (vector 'menu-bar (car ev)) - (subseq macro (1+ i)))) + (edmacro-subseq macro (1+ i)))) (incf i)) ;; It would be nice to do pop-up menus, too, but not enough ;; info is recorded in macros to make this possible. @@ -647,7 +699,7 @@ (eq (aref res 1) ?\() (eq (aref res (- (length res) 2)) ?\C-x) (eq (aref res (- (length res) 1)) ?\))) - (setq res (subseq res 2 -2))) + (setq res (edmacro-subseq res 2 -2))) (if (and (not need-vector) (loop for ch across res always (and (integerp ch)