Load cl only during compilation.

(edmacro-mismatch, edmacro-subseq): New functions.
Use them instead of mismatch and subseq.

1 files changed, 72 insertions, 20 deletions

diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 0255a675072..1cf9a104d98 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -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)