Commit c31afdbd authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

Load cl only during compilation.

(edmacro-mismatch, edmacro-subseq): New functions.
Use them instead of mismatch and subseq.
parent 539fbabb
......@@ -69,7 +69,8 @@
;;; Code:
(require 'cl)
(eval-when-compile
(require 'cl))
;;; The user-level commands for editing macros.
......@@ -221,7 +222,7 @@ or nil, use a compact 80-column format."
(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 @@ or nil, use a compact 80-column format."
(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 @@ doubt, use whitespace."
(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 @@ doubt, use whitespace."
(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 @@ doubt, use whitespace."
'(?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 @@ doubt, use whitespace."
(> 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 @@ doubt, use whitespace."
(> 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 @@ doubt, use whitespace."
(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 @@ doubt, use whitespace."
(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 @@ doubt, use whitespace."
(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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment