Load cl only during compilation.

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

diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 0255a675072f7394d28bd9c066ff19f3fc2eea4e..1cf9a104d9847769cdf8fd64ec13918664d08a4f 100644 (file)
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -69,7 +69,8 @@
 
 ;;; Code:
 \f
-(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)