aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-06-10 09:28:26 -0400
committerStefan Monnier2012-06-10 09:28:26 -0400
commitf80efb8695cd8b4480c5f041c484beb5486afb37 (patch)
tree11cdf753a8e8a270fa79eb1dc794aa8426d3893e
parent31ca4639ad1bfaa355a3f30ef92eb977bd2c6b78 (diff)
downloademacs-f80efb8695cd8b4480c5f041c484beb5486afb37.tar.gz
emacs-f80efb8695cd8b4480c5f041c484beb5486afb37.zip
Reduce use of cl in lisp/emacs-lisp/.
* lisp/emacs-lisp/timer.el, lisp/emacs-lisp/syntax.el, lisp/emacs-lisp/smie.el: * lisp/emacs-lisp/ewoc.el, lisp/emacs-lisp/cconv.el,lisp/emacs-lisp/derived.el: * lisp/emacs-lisp/byte-opt.el, lisp/emacs-lisp/autoload.el: Convert to cl-lib. * lisp/emacs-lisp/easymenu.el, lisp/emacs-lisp/easy-mmode.el: * lisp/emacs-lisp/bytecomp.el: Use pcase instead of `cl'. * lisp/emacs-lisp/cl-lib.el: Get rid of special cl-macs auto load.
-rw-r--r--lisp/ChangeLog17
-rw-r--r--lisp/emacs-lisp/autoload.el6
-rw-r--r--lisp/emacs-lisp/byte-opt.el10
-rw-r--r--lisp/emacs-lisp/bytecomp.el42
-rw-r--r--lisp/emacs-lisp/cconv.el56
-rw-r--r--lisp/emacs-lisp/cl-lib.el23
-rw-r--r--lisp/emacs-lisp/derived.el12
-rw-r--r--lisp/emacs-lisp/easy-mmode.el56
-rw-r--r--lisp/emacs-lisp/easymenu.el34
-rw-r--r--lisp/emacs-lisp/ewoc.el56
-rw-r--r--lisp/emacs-lisp/smie.el111
-rw-r--r--lisp/emacs-lisp/syntax.el36
-rw-r--r--lisp/emacs-lisp/timer.el48
13 files changed, 245 insertions, 262 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c159d04443a..f914fcf6f6c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
12012-06-10 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/timer.el, emacs-lisp/syntax.el, emacs-lisp/smie.el:
4 * emacs-lisp/ewoc.el, emacs-lisp/cconv.el, emacs-lisp/bytecomp.el:
5 * emacs-lisp/byte-opt.el, emacs-lisp/autoload.el: Convert to cl-lib.
6 * emacs-lisp/easymenu.el, emacs-lisp/easy-mmode.el:
7 * emacs-lisp/derived.el: Use pcase instead of `cl'.
8 * emacs-lisp/cl-lib.el: Get rid of special cl-macs auto load.
9
12012-06-10 Glenn Morris <rgm@gnu.org> 102012-06-10 Glenn Morris <rgm@gnu.org>
2 11
3 * mail/rmail.el (rmail-yank-current-message): Leave point at 12 * mail/rmail.el (rmail-yank-current-message): Leave point at
@@ -9,8 +18,8 @@
9 18
102012-06-10 Chong Yidong <cyd@gnu.org> 192012-06-10 Chong Yidong <cyd@gnu.org>
11 20
12 * cus-edit.el (customize-changed-options-previous-release): Bump 21 * cus-edit.el (customize-changed-options-previous-release):
13 to 24.1. 22 Bump to 24.1.
14 23
152012-06-09 Andreas Schwab <schwab@linux-m68k.org> 242012-06-09 Andreas Schwab <schwab@linux-m68k.org>
16 25
@@ -142,8 +151,8 @@
142 151
143 * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate): 152 * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate):
144 Likewise. 153 Likewise.
145 (flyspell-incorrect-face, flyspell-duplicate-face): Remove 154 (flyspell-incorrect-face, flyspell-duplicate-face):
146 obsolete aliases. 155 Remove obsolete aliases.
147 156
1482012-06-08 Michael Albinus <michael.albinus@gmx.de> 1572012-06-08 Michael Albinus <michael.albinus@gmx.de>
149 158
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index d9fc0fccf0e..9cd626c52f4 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -32,7 +32,7 @@
32 32
33(require 'lisp-mode) ;for `doc-string-elt' properties. 33(require 'lisp-mode) ;for `doc-string-elt' properties.
34(require 'help-fns) ;for help-add-fundoc-usage. 34(require 'help-fns) ;for help-add-fundoc-usage.
35(eval-when-compile (require 'cl)) 35(eval-when-compile (require 'cl-lib))
36 36
37(defvar generated-autoload-file nil 37(defvar generated-autoload-file nil
38 "File into which to write autoload definitions. 38 "File into which to write autoload definitions.
@@ -154,7 +154,7 @@ expression, in which case we want to handle forms differently."
154 defun* defmacro* define-overloadable-function)) 154 defun* defmacro* define-overloadable-function))
155 (let* ((macrop (memq car '(defmacro defmacro*))) 155 (let* ((macrop (memq car '(defmacro defmacro*)))
156 (name (nth 1 form)) 156 (name (nth 1 form))
157 (args (case car 157 (args (cl-case car
158 ((defun defmacro defun* defmacro* 158 ((defun defmacro defun* defmacro*
159 define-overloadable-function) (nth 2 form)) 159 define-overloadable-function) (nth 2 form))
160 ((define-skeleton) '(&optional str arg)) 160 ((define-skeleton) '(&optional str arg))
@@ -546,7 +546,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
546 (save-excursion 546 (save-excursion
547 ;; Insert the section-header line which lists the file name 547 ;; Insert the section-header line which lists the file name
548 ;; and which functions are in it, etc. 548 ;; and which functions are in it, etc.
549 (assert (= ostart output-start)) 549 (cl-assert (= ostart output-start))
550 (goto-char output-start) 550 (goto-char output-start)
551 (let ((relfile (file-relative-name absfile))) 551 (let ((relfile (file-relative-name absfile)))
552 (autoload-insert-section-header 552 (autoload-insert-section-header
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 25b4686f87d..ab0e22fb5ce 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -183,7 +183,7 @@
183;;; Code: 183;;; Code:
184 184
185(require 'bytecomp) 185(require 'bytecomp)
186(eval-when-compile (require 'cl)) 186(eval-when-compile (require 'cl-lib))
187(require 'macroexp) 187(require 'macroexp)
188 188
189(defun byte-compile-log-lap-1 (format &rest args) 189(defun byte-compile-log-lap-1 (format &rest args)
@@ -642,7 +642,7 @@
642 (while (eq (car-safe form) 'progn) 642 (while (eq (car-safe form) 'progn)
643 (setq form (car (last (cdr form))))) 643 (setq form (car (last (cdr form)))))
644 (cond ((consp form) 644 (cond ((consp form)
645 (case (car form) 645 (cl-case (car form)
646 (quote (cadr form)) 646 (quote (cadr form))
647 ;; Can't use recursion in a defsubst. 647 ;; Can't use recursion in a defsubst.
648 ;; (progn (byte-compile-trueconstp (car (last (cdr form))))) 648 ;; (progn (byte-compile-trueconstp (car (last (cdr form)))))
@@ -656,7 +656,7 @@
656 (while (eq (car-safe form) 'progn) 656 (while (eq (car-safe form) 'progn)
657 (setq form (car (last (cdr form))))) 657 (setq form (car (last (cdr form)))))
658 (cond ((consp form) 658 (cond ((consp form)
659 (case (car form) 659 (cl-case (car form)
660 (quote (null (cadr form))) 660 (quote (null (cadr form)))
661 ;; Can't use recursion in a defsubst. 661 ;; Can't use recursion in a defsubst.
662 ;; (progn (byte-compile-nilconstp (car (last (cdr form))))) 662 ;; (progn (byte-compile-nilconstp (car (last (cdr form)))))
@@ -1376,7 +1376,7 @@
1376 ;; This uses dynamic-scope magic. 1376 ;; This uses dynamic-scope magic.
1377 offset (disassemble-offset bytes)) 1377 offset (disassemble-offset bytes))
1378 (let ((opcode (aref byte-code-vector bytedecomp-op))) 1378 (let ((opcode (aref byte-code-vector bytedecomp-op)))
1379 (assert opcode) 1379 (cl-assert opcode)
1380 (setq bytedecomp-op opcode)) 1380 (setq bytedecomp-op opcode))
1381 (cond ((memq bytedecomp-op byte-goto-ops) 1381 (cond ((memq bytedecomp-op byte-goto-ops)
1382 ;; It's a pc. 1382 ;; It's a pc.
@@ -1619,7 +1619,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
1619 (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) 1619 (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1)
1620 (setq keep-going t 1620 (setq keep-going t
1621 rest (cdr rest)) 1621 rest (cdr rest))
1622 (if (eq 'byte-stack-set (car lap1)) (decf (cdr lap1))) 1622 (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
1623 (setq lap (delq lap0 (delq lap2 lap)))) 1623 (setq lap (delq lap0 (delq lap2 lap))))
1624 ;; 1624 ;;
1625 ;; not goto-X-if-nil --> goto-X-if-non-nil 1625 ;; not goto-X-if-nil --> goto-X-if-non-nil
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 25a901fd248..98bdcc69f95 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -120,7 +120,7 @@
120(require 'backquote) 120(require 'backquote)
121(require 'macroexp) 121(require 'macroexp)
122(require 'cconv) 122(require 'cconv)
123(eval-when-compile (require 'cl)) 123(eval-when-compile (require 'cl-lib))
124 124
125(or (fboundp 'defsubst) 125(or (fboundp 'defsubst)
126 ;; This really ought to be loaded already! 126 ;; This really ought to be loaded already!
@@ -738,7 +738,7 @@ BYTES and PC are updated after evaluating all the arguments."
738 (bytes-var (car (last args 2))) 738 (bytes-var (car (last args 2)))
739 (pc-var (car (last args)))) 739 (pc-var (car (last args))))
740 `(setq ,bytes-var ,(if (null (cdr byte-exprs)) 740 `(setq ,bytes-var ,(if (null (cdr byte-exprs))
741 `(progn (assert (<= 0 ,(car byte-exprs))) 741 `(progn (cl-assert (<= 0 ,(car byte-exprs)))
742 (cons ,@byte-exprs ,bytes-var)) 742 (cons ,@byte-exprs ,bytes-var))
743 `(nconc (list ,@(reverse byte-exprs)) ,bytes-var)) 743 `(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
744 ,pc-var (+ ,(length byte-exprs) ,pc-var)))) 744 ,pc-var (+ ,(length byte-exprs) ,pc-var))))
@@ -1591,7 +1591,7 @@ that already has a `.elc' file."
1591 (not (auto-save-file-name-p source)) 1591 (not (auto-save-file-name-p source))
1592 (not (string-equal dir-locals-file 1592 (not (string-equal dir-locals-file
1593 (file-name-nondirectory source)))) 1593 (file-name-nondirectory source))))
1594 (progn (case (byte-recompile-file source force arg) 1594 (progn (cl-case (byte-recompile-file source force arg)
1595 (no-byte-compile (setq skip-count (1+ skip-count))) 1595 (no-byte-compile (setq skip-count (1+ skip-count)))
1596 ((t) (setq file-count (1+ file-count))) 1596 ((t) (setq file-count (1+ file-count)))
1597 ((nil) (setq fail-count (1+ fail-count)))) 1597 ((nil) (setq fail-count (1+ fail-count))))
@@ -1725,12 +1725,12 @@ The value is non-nil if there were no errors, nil if errors."
1725 (set-buffer-multibyte nil)) 1725 (set-buffer-multibyte nil))
1726 ;; Run hooks including the uncompression hook. 1726 ;; Run hooks including the uncompression hook.
1727 ;; If they change the file name, then change it for the output also. 1727 ;; If they change the file name, then change it for the output also.
1728 (letf ((buffer-file-name filename) 1728 (cl-letf ((buffer-file-name filename)
1729 ((default-value 'major-mode) 'emacs-lisp-mode) 1729 ((default-value 'major-mode) 'emacs-lisp-mode)
1730 ;; Ignore unsafe local variables. 1730 ;; Ignore unsafe local variables.
1731 ;; We only care about a few of them for our purposes. 1731 ;; We only care about a few of them for our purposes.
1732 (enable-local-variables :safe) 1732 (enable-local-variables :safe)
1733 (enable-local-eval nil)) 1733 (enable-local-eval nil))
1734 ;; Arg of t means don't alter enable-local-variables. 1734 ;; Arg of t means don't alter enable-local-variables.
1735 (normal-mode t) 1735 (normal-mode t)
1736 ;; There may be a file local variable setting (bug#10419). 1736 ;; There may be a file local variable setting (bug#10419).
@@ -2611,7 +2611,7 @@ for symbols generated by the byte compiler itself."
2611 (byte-compile-make-lambda-lexenv fun)) 2611 (byte-compile-make-lambda-lexenv fun))
2612 reserved-csts))) 2612 reserved-csts)))
2613 ;; Build the actual byte-coded function. 2613 ;; Build the actual byte-coded function.
2614 (assert (eq 'byte-code (car-safe compiled))) 2614 (cl-assert (eq 'byte-code (car-safe compiled)))
2615 (apply #'make-byte-code 2615 (apply #'make-byte-code
2616 (if lexical-binding 2616 (if lexical-binding
2617 (byte-compile-make-args-desc arglist) 2617 (byte-compile-make-args-desc arglist)
@@ -2654,7 +2654,7 @@ for symbols generated by the byte compiler itself."
2654 (while (and rest (< i limit)) 2654 (while (and rest (< i limit))
2655 (cond 2655 (cond
2656 ((numberp (car rest)) 2656 ((numberp (car rest))
2657 (assert (< (car rest) byte-compile-reserved-constants))) 2657 (cl-assert (< (car rest) byte-compile-reserved-constants)))
2658 ((setq tmp (assq (car (car rest)) ret)) 2658 ((setq tmp (assq (car (car rest)) ret))
2659 (setcdr (car rest) (cdr tmp))) 2659 (setcdr (car rest) (cdr tmp)))
2660 (t 2660 (t
@@ -2933,9 +2933,9 @@ That command is designed for interactive use only" fn))
2933 (mapc 'byte-compile-form (cdr form)) 2933 (mapc 'byte-compile-form (cdr form))
2934 (unless fmax2 2934 (unless fmax2
2935 ;; Old-style byte-code. 2935 ;; Old-style byte-code.
2936 (assert (listp fargs)) 2936 (cl-assert (listp fargs))
2937 (while fargs 2937 (while fargs
2938 (case (car fargs) 2938 (cl-case (car fargs)
2939 (&optional (setq fargs (cdr fargs))) 2939 (&optional (setq fargs (cdr fargs)))
2940 (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) 2940 (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
2941 (push (cadr fargs) dynbinds) 2941 (push (cadr fargs) dynbinds)
@@ -2954,7 +2954,7 @@ That command is designed for interactive use only" fn))
2954 (t 2954 (t
2955 ;; Turn &rest args into a list. 2955 ;; Turn &rest args into a list.
2956 (let ((n (- alen (/ (1- fmax2) 2)))) 2956 (let ((n (- alen (/ (1- fmax2) 2))))
2957 (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) 2957 (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
2958 (if (< n 5) 2958 (if (< n 5)
2959 (byte-compile-out 2959 (byte-compile-out
2960 (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) 2960 (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n))
@@ -2967,7 +2967,7 @@ That command is designed for interactive use only" fn))
2967 ;; Unbind dynamic variables. 2967 ;; Unbind dynamic variables.
2968 (when dynbinds 2968 (when dynbinds
2969 (byte-compile-out 'byte-unbind (length dynbinds))) 2969 (byte-compile-out 'byte-unbind (length dynbinds)))
2970 (assert (eq byte-compile-depth (1+ start-depth)) 2970 (cl-assert (eq byte-compile-depth (1+ start-depth))
2971 nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth))) 2971 nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
2972 2972
2973(defun byte-compile-check-variable (var access-type) 2973(defun byte-compile-check-variable (var access-type)
@@ -2985,7 +2985,7 @@ That command is designed for interactive use only" fn))
2985 (and od 2985 (and od
2986 (not (memq var byte-compile-not-obsolete-vars)) 2986 (not (memq var byte-compile-not-obsolete-vars))
2987 (not (memq var byte-compile-global-not-obsolete-vars)) 2987 (not (memq var byte-compile-global-not-obsolete-vars))
2988 (or (case (nth 1 od) 2988 (or (cl-case (nth 1 od)
2989 (set (not (eq access-type 'reference))) 2989 (set (not (eq access-type 'reference)))
2990 (get (eq access-type 'reference)) 2990 (get (eq access-type 'reference))
2991 (t t))))) 2991 (t t)))))
@@ -3312,8 +3312,8 @@ discarding."
3312 (body (nthcdr 3 form)) 3312 (body (nthcdr 3 form))
3313 (fun 3313 (fun
3314 (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) 3314 (byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
3315 (assert (> (length env) 0)) ;Otherwise, we don't need a closure. 3315 (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure.
3316 (assert (byte-code-function-p fun)) 3316 (cl-assert (byte-code-function-p fun))
3317 (byte-compile-form `(make-byte-code 3317 (byte-compile-form `(make-byte-code
3318 ',(aref fun 0) ',(aref fun 1) 3318 ',(aref fun 0) ',(aref fun 1)
3319 (vconcat (vector . ,env) ',(aref fun 2)) 3319 (vconcat (vector . ,env) ',(aref fun 2))
@@ -3891,8 +3891,8 @@ binding slots have been popped."
3891 (if lexical-binding 3891 (if lexical-binding
3892 ;; Unbind both lexical and dynamic variables. 3892 ;; Unbind both lexical and dynamic variables.
3893 (progn 3893 (progn
3894 (assert (or (eq byte-compile-depth init-stack-depth) 3894 (cl-assert (or (eq byte-compile-depth init-stack-depth)
3895 (eq byte-compile-depth (1+ init-stack-depth)))) 3895 (eq byte-compile-depth (1+ init-stack-depth))))
3896 (byte-compile-unbind clauses init-lexenv (> byte-compile-depth 3896 (byte-compile-unbind clauses init-lexenv (> byte-compile-depth
3897 init-stack-depth))) 3897 init-stack-depth)))
3898 ;; Unbind dynamic variables. 3898 ;; Unbind dynamic variables.
@@ -4312,7 +4312,7 @@ invoked interactively."
4312 (if byte-compile-call-tree-sort 4312 (if byte-compile-call-tree-sort
4313 (setq byte-compile-call-tree 4313 (setq byte-compile-call-tree
4314 (sort byte-compile-call-tree 4314 (sort byte-compile-call-tree
4315 (case byte-compile-call-tree-sort 4315 (cl-case byte-compile-call-tree-sort
4316 (callers 4316 (callers
4317 (lambda (x y) (< (length (nth 1 x)) 4317 (lambda (x y) (< (length (nth 1 x))
4318 (length (nth 1 y))))) 4318 (length (nth 1 y)))))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index f43dd9e7ee4..6f411bdeb30 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -110,7 +110,7 @@
110;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder))) 110;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
111;; binders))) 111;; binders)))
112 112
113(eval-when-compile (require 'cl)) 113(eval-when-compile (require 'cl-lib))
114 114
115(defconst cconv-liftwhen 6 115(defconst cconv-liftwhen 6
116 "Try to do lambda lifting if the number of arguments + free variables 116 "Try to do lambda lifting if the number of arguments + free variables
@@ -173,7 +173,7 @@ Returns a form where all lambdas don't have any free variables."
173 ;; Here we assume that X appears at most once in M. 173 ;; Here we assume that X appears at most once in M.
174 (let* ((b (assq x m)) 174 (let* ((b (assq x m))
175 (res (if b (remq b m) m))) 175 (res (if b (remq b m) m)))
176 (assert (null (assq x res))) ;; Check the assumption was warranted. 176 (cl-assert (null (assq x res))) ;; Check the assumption was warranted.
177 res)) 177 res))
178 178
179(defun cconv--map-diff-set (m s) 179(defun cconv--map-diff-set (m s)
@@ -185,7 +185,7 @@ Returns a form where all lambdas don't have any free variables."
185 (nreverse res))) 185 (nreverse res)))
186 186
187(defun cconv--convert-function (args body env parentform) 187(defun cconv--convert-function (args body env parentform)
188 (assert (equal body (caar cconv-freevars-alist))) 188 (cl-assert (equal body (caar cconv-freevars-alist)))
189 (let* ((fvs (cdr (pop cconv-freevars-alist))) 189 (let* ((fvs (cdr (pop cconv-freevars-alist)))
190 (body-new '()) 190 (body-new '())
191 (letbind '()) 191 (letbind '())
@@ -251,11 +251,11 @@ ENV is a list where each entry takes the shape either:
251EXTEND is a list of variables which might need to be accessed even from places 251EXTEND is a list of variables which might need to be accessed even from places
252where they are shadowed, because some part of ENV causes them to be used at 252where they are shadowed, because some part of ENV causes them to be used at
253places where they originally did not directly appear." 253places where they originally did not directly appear."
254 (assert (not (delq nil (mapcar (lambda (mapping) 254 (cl-assert (not (delq nil (mapcar (lambda (mapping)
255 (if (eq (cadr mapping) 'apply-partially) 255 (if (eq (cadr mapping) 'apply-partially)
256 (cconv--set-diff (cdr (cddr mapping)) 256 (cconv--set-diff (cdr (cddr mapping))
257 extend))) 257 extend)))
258 env)))) 258 env))))
259 259
260 ;; What's the difference between fvrs and envs? 260 ;; What's the difference between fvrs and envs?
261 ;; Suppose that we have the code 261 ;; Suppose that we have the code
@@ -287,10 +287,10 @@ places where they originally did not directly appear."
287 ;; Check if var is a candidate for lambda lifting. 287 ;; Check if var is a candidate for lambda lifting.
288 ((and (member (cons binder form) cconv-lambda-candidates) 288 ((and (member (cons binder form) cconv-lambda-candidates)
289 (progn 289 (progn
290 (assert (and (eq (car value) 'function) 290 (cl-assert (and (eq (car value) 'function)
291 (eq (car (cadr value)) 'lambda))) 291 (eq (car (cadr value)) 'lambda)))
292 (assert (equal (cddr (cadr value)) 292 (cl-assert (equal (cddr (cadr value))
293 (caar cconv-freevars-alist))) 293 (caar cconv-freevars-alist)))
294 ;; Peek at the freevars to decide whether to λ-lift. 294 ;; Peek at the freevars to decide whether to λ-lift.
295 (let* ((fvs (cdr (car cconv-freevars-alist))) 295 (let* ((fvs (cdr (car cconv-freevars-alist)))
296 (fun (cadr value)) 296 (fun (cadr value))
@@ -307,7 +307,7 @@ places where they originally did not directly appear."
307 (funcbody-env ())) 307 (funcbody-env ()))
308 (push `(,var . (apply-partially ,var . ,fvs)) new-env) 308 (push `(,var . (apply-partially ,var . ,fvs)) new-env)
309 (dolist (fv fvs) 309 (dolist (fv fvs)
310 (pushnew fv new-extend) 310 (cl-pushnew fv new-extend)
311 (if (and (eq 'car (car-safe (cdr (assq fv env)))) 311 (if (and (eq 'car (car-safe (cdr (assq fv env))))
312 (not (memq fv funargs))) 312 (not (memq fv funargs)))
313 (push `(,fv . (car ,fv)) funcbody-env))) 313 (push `(,fv . (car ,fv)) funcbody-env)))
@@ -345,14 +345,14 @@ places where they originally did not directly appear."
345 (mapcar (lambda (mapping) 345 (mapcar (lambda (mapping)
346 (if (not (eq (cadr mapping) 'apply-partially)) 346 (if (not (eq (cadr mapping) 'apply-partially))
347 mapping 347 mapping
348 (assert (eq (car mapping) (nth 2 mapping))) 348 (cl-assert (eq (car mapping) (nth 2 mapping)))
349 (list* (car mapping) 349 (cl-list* (car mapping)
350 'apply-partially 350 'apply-partially
351 (car mapping) 351 (car mapping)
352 (mapcar (lambda (arg) 352 (mapcar (lambda (arg)
353 (if (eq var arg) 353 (if (eq var arg)
354 closedsym arg)) 354 closedsym arg))
355 (nthcdr 3 mapping))))) 355 (nthcdr 3 mapping)))))
356 new-env)) 356 new-env))
357 (setq new-extend (remq var new-extend)) 357 (setq new-extend (remq var new-extend))
358 (push closedsym new-extend) 358 (push closedsym new-extend)
@@ -455,7 +455,7 @@ places where they originally did not directly appear."
455 (let ((mapping (cdr (assq fun env)))) 455 (let ((mapping (cdr (assq fun env))))
456 (pcase mapping 456 (pcase mapping
457 (`(apply-partially ,_ . ,(and fvs `(,_ . ,_))) 457 (`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
458 (assert (eq (cadr mapping) fun)) 458 (cl-assert (eq (cadr mapping) fun))
459 `(,callsym ,fun 459 `(,callsym ,fun
460 ,@(mapcar (lambda (fv) 460 ,@(mapcar (lambda (fv)
461 (let ((exp (or (cdr (assq fv env)) fv))) 461 (let ((exp (or (cdr (assq fv env)) fv)))
@@ -551,7 +551,7 @@ FORM is the parent form that binds this var."
551 ;; Transfer uses collected in `envcopy' (via `newenv') back to `env'; 551 ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
552 ;; and compute free variables. 552 ;; and compute free variables.
553 (while env 553 (while env
554 (assert (and envcopy (eq (caar env) (caar envcopy)))) 554 (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
555 (let ((free nil) 555 (let ((free nil)
556 (x (cdr (car env))) 556 (x (cdr (car env)))
557 (y (cdr (car envcopy)))) 557 (y (cdr (car envcopy))))
@@ -559,8 +559,8 @@ FORM is the parent form that binds this var."
559 (when (car y) (setcar x t) (setq free t)) 559 (when (car y) (setcar x t) (setq free t))
560 (setq x (cdr x) y (cdr y))) 560 (setq x (cdr x) y (cdr y)))
561 (when free 561 (when free
562 (push (caar env) (cdr freevars)) 562 (cl-push (caar env) (cdr freevars))
563 (setf (nth 3 (car env)) t)) 563 (cl-setf (nth 3 (car env)) t))
564 (setq env (cdr env) envcopy (cdr envcopy)))))) 564 (setq env (cdr env) envcopy (cdr envcopy))))))
565 565
566(defun cconv-analyse-form (form env) 566(defun cconv-analyse-form (form env)
@@ -610,7 +610,7 @@ and updates the data stored in ENV."
610 ;; it is a mutated variable. 610 ;; it is a mutated variable.
611 (while forms 611 (while forms
612 (let ((v (assq (car forms) env))) ; v = non nil if visible 612 (let ((v (assq (car forms) env))) ; v = non nil if visible
613 (when v (setf (nth 2 v) t))) 613 (when v (cl-setf (nth 2 v) t)))
614 (cconv-analyse-form (cadr forms) env) 614 (cconv-analyse-form (cadr forms) env)
615 (setq forms (cddr forms)))) 615 (setq forms (cddr forms))))
616 616
@@ -656,7 +656,7 @@ and updates the data stored in ENV."
656 ;; lambda candidate list. 656 ;; lambda candidate list.
657 (let ((fdata (and (symbolp fun) (assq fun env)))) 657 (let ((fdata (and (symbolp fun) (assq fun env))))
658 (if fdata 658 (if fdata
659 (setf (nth 4 fdata) t) 659 (cl-setf (nth 4 fdata) t)
660 (cconv-analyse-form fun env))) 660 (cconv-analyse-form fun env)))
661 (dolist (form args) (cconv-analyse-form form env))) 661 (dolist (form args) (cconv-analyse-form form env)))
662 662
@@ -676,7 +676,7 @@ and updates the data stored in ENV."
676 ((pred symbolp) 676 ((pred symbolp)
677 (let ((dv (assq form env))) ; dv = declared and visible 677 (let ((dv (assq form env))) ; dv = declared and visible
678 (when dv 678 (when dv
679 (setf (nth 1 dv) t)))))) 679 (cl-setf (nth 1 dv) t))))))
680 680
681(provide 'cconv) 681(provide 'cconv)
682;;; cconv.el ends here 682;;; cconv.el ends here
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 6ec1060e39f..8c0743001f7 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -644,29 +644,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
644 644
645(load "cl-loaddefs" nil 'quiet) 645(load "cl-loaddefs" nil 'quiet)
646 646
647;; This goes here so that cl-macs can find it if it loads right now.
648(provide 'cl-lib)
649
650;; Things to do after byte-compiler is loaded.
651
652(defvar cl-hacked-flag nil)
653(defun cl-hack-byte-compiler ()
654 (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)
655 (progn
656 (setq cl-hacked-flag t) ; Do it first, to prevent recursion.
657 (load "cl-macs" nil t)
658 (run-hooks 'cl-hack-bytecomp-hook))))
659
660;; Try it now in case the compiler has already been loaded.
661(cl-hack-byte-compiler)
662
663;; Also make a hook in case compiler is loaded after this file.
664(add-hook 'bytecomp-load-hook 'cl-hack-byte-compiler)
665
666
667;; The following ensures that packages which expect the old-style cl.el
668;; will be happy with this one.
669
670(provide 'cl-lib) 647(provide 'cl-lib)
671 648
672(run-hooks 'cl-load-hook) 649(run-hooks 'cl-load-hook)
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 119479b2c0a..ea72e9492f0 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -90,8 +90,6 @@
90 90
91;;; Code: 91;;; Code:
92 92
93(eval-when-compile (require 'cl))
94
95;;; PRIVATE: defsubst must be defined before they are first used 93;;; PRIVATE: defsubst must be defined before they are first used
96 94
97(defsubst derived-mode-hook-name (mode) 95(defsubst derived-mode-hook-name (mode)
@@ -183,11 +181,11 @@ See Info node `(elisp)Derived Modes' for more details."
183 181
184 ;; Process the keyword args. 182 ;; Process the keyword args.
185 (while (keywordp (car body)) 183 (while (keywordp (car body))
186 (case (pop body) 184 (pcase (pop body)
187 (:group (setq group (pop body))) 185 (`:group (setq group (pop body)))
188 (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil)) 186 (`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
189 (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil)) 187 (`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
190 (t (pop body)))) 188 (_ (pop body))))
191 189
192 (setq docstring (derived-mode-make-docstring 190 (setq docstring (derived-mode-make-docstring
193 parent child docstring syntax abbrev)) 191 parent child docstring syntax abbrev))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index abb1edca4ee..4da48805278 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -51,8 +51,6 @@
51 51
52;;; Code: 52;;; Code:
53 53
54(eval-when-compile (require 'cl))
55
56(defun easy-mmode-pretty-mode-name (mode &optional lighter) 54(defun easy-mmode-pretty-mode-name (mode &optional lighter)
57 "Turn the symbol MODE into a string intended for the user. 55 "Turn the symbol MODE into a string intended for the user.
58If provided, LIGHTER will be used to help choose capitalization by, 56If provided, LIGHTER will be used to help choose capitalization by,
@@ -153,10 +151,10 @@ For example, you could write
153 ;; Allow skipping the first three args. 151 ;; Allow skipping the first three args.
154 (cond 152 (cond
155 ((keywordp init-value) 153 ((keywordp init-value)
156 (setq body (list* init-value lighter keymap body) 154 (setq body `(,init-value ,lighter ,keymap ,@body)
157 init-value nil lighter nil keymap nil)) 155 init-value nil lighter nil keymap nil))
158 ((keywordp lighter) 156 ((keywordp lighter)
159 (setq body (list* lighter keymap body) lighter nil keymap nil)) 157 (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
160 ((keywordp keymap) (push keymap body) (setq keymap nil))) 158 ((keywordp keymap) (push keymap body) (setq keymap nil)))
161 159
162 (let* ((last-message (make-symbol "last-message")) 160 (let* ((last-message (make-symbol "last-message"))
@@ -182,18 +180,18 @@ For example, you could write
182 ;; Check keys. 180 ;; Check keys.
183 (while (keywordp (setq keyw (car body))) 181 (while (keywordp (setq keyw (car body)))
184 (setq body (cdr body)) 182 (setq body (cdr body))
185 (case keyw 183 (pcase keyw
186 (:init-value (setq init-value (pop body))) 184 (`:init-value (setq init-value (pop body)))
187 (:lighter (setq lighter (purecopy (pop body)))) 185 (`:lighter (setq lighter (purecopy (pop body))))
188 (:global (setq globalp (pop body))) 186 (`:global (setq globalp (pop body)))
189 (:extra-args (setq extra-args (pop body))) 187 (`:extra-args (setq extra-args (pop body)))
190 (:set (setq set (list :set (pop body)))) 188 (`:set (setq set (list :set (pop body))))
191 (:initialize (setq initialize (list :initialize (pop body)))) 189 (`:initialize (setq initialize (list :initialize (pop body))))
192 (:group (setq group (nconc group (list :group (pop body))))) 190 (`:group (setq group (nconc group (list :group (pop body)))))
193 (:type (setq type (list :type (pop body)))) 191 (`:type (setq type (list :type (pop body))))
194 (:require (setq require (pop body))) 192 (`:require (setq require (pop body)))
195 (:keymap (setq keymap (pop body))) 193 (`:keymap (setq keymap (pop body)))
196 (:variable (setq variable (pop body)) 194 (`:variable (setq variable (pop body))
197 (if (not (and (setq tmp (cdr-safe variable)) 195 (if (not (and (setq tmp (cdr-safe variable))
198 (or (symbolp tmp) 196 (or (symbolp tmp)
199 (functionp tmp)))) 197 (functionp tmp))))
@@ -201,8 +199,8 @@ For example, you could write
201 (setq mode variable) 199 (setq mode variable)
202 (setq mode (car variable)) 200 (setq mode (car variable))
203 (setq setter (cdr variable)))) 201 (setq setter (cdr variable))))
204 (:after-hook (setq after-hook (pop body))) 202 (`:after-hook (setq after-hook (pop body)))
205 (t (push keyw extra-keywords) (push (pop body) extra-keywords)))) 203 (_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
206 204
207 (setq keymap-sym (if (and keymap (symbolp keymap)) keymap 205 (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
208 (intern (concat mode-name "-map")))) 206 (intern (concat mode-name "-map"))))
@@ -355,10 +353,10 @@ call another major mode in their body."
355 ;; Check keys. 353 ;; Check keys.
356 (while (keywordp (setq keyw (car keys))) 354 (while (keywordp (setq keyw (car keys)))
357 (setq keys (cdr keys)) 355 (setq keys (cdr keys))
358 (case keyw 356 (pcase keyw
359 (:group (setq group (nconc group (list :group (pop keys))))) 357 (`:group (setq group (nconc group (list :group (pop keys)))))
360 (:global (setq keys (cdr keys))) 358 (`:global (setq keys (cdr keys)))
361 (t (push keyw extra-keywords) (push (pop keys) extra-keywords)))) 359 (_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
362 360
363 (unless group 361 (unless group
364 ;; We might as well provide a best-guess default group. 362 ;; We might as well provide a best-guess default group.
@@ -479,13 +477,13 @@ Valid keywords and arguments are:
479 (while args 477 (while args
480 (let ((key (pop args)) 478 (let ((key (pop args))
481 (val (pop args))) 479 (val (pop args)))
482 (case key 480 (pcase key
483 (:name (setq name val)) 481 (`:name (setq name val))
484 (:dense (setq dense val)) 482 (`:dense (setq dense val))
485 (:inherit (setq inherit val)) 483 (`:inherit (setq inherit val))
486 (:suppress (setq suppress val)) 484 (`:suppress (setq suppress val))
487 (:group) 485 (`:group)
488 (t (message "Unknown argument %s in defmap" key))))) 486 (_ (message "Unknown argument %s in defmap" key)))))
489 (unless (keymapp m) 487 (unless (keymapp m)
490 (setq bs (append m bs)) 488 (setq bs (append m bs))
491 (setq m (if dense (make-keymap name) (make-sparse-keymap name)))) 489 (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index b3e54b415d8..7f9f8a33634 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -29,8 +29,6 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(eval-when-compile (require 'cl))
33
34(defvar easy-menu-precalculate-equivalent-keybindings nil 32(defvar easy-menu-precalculate-equivalent-keybindings nil
35 "Determine when equivalent key bindings are computed for easy-menu menus. 33 "Determine when equivalent key bindings are computed for easy-menu menus.
36It can take some time to calculate the equivalent key bindings that are shown 34It can take some time to calculate the equivalent key bindings that are shown
@@ -236,14 +234,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
236 (keywordp (setq keyword (car menu-items)))) 234 (keywordp (setq keyword (car menu-items))))
237 (setq arg (cadr menu-items)) 235 (setq arg (cadr menu-items))
238 (setq menu-items (cddr menu-items)) 236 (setq menu-items (cddr menu-items))
239 (case keyword 237 (pcase keyword
240 (:filter 238 (`:filter
241 (setq filter `(lambda (menu) 239 (setq filter `(lambda (menu)
242 (easy-menu-filter-return (,arg menu) ,menu-name)))) 240 (easy-menu-filter-return (,arg menu) ,menu-name))))
243 ((:enable :active) (setq enable (or arg ''nil))) 241 ((or `:enable `:active) (setq enable (or arg ''nil)))
244 (:label (setq label arg)) 242 (`:label (setq label arg))
245 (:help (setq help arg)) 243 (`:help (setq help arg))
246 ((:included :visible) (setq visible (or arg ''nil))))) 244 ((or `:included `:visible) (setq visible (or arg ''nil)))))
247 (if (equal visible ''nil) 245 (if (equal visible ''nil)
248 nil ; Invisible menu entry, return nil. 246 nil ; Invisible menu entry, return nil.
249 (if (and visible (not (easy-menu-always-true-p visible))) 247 (if (and visible (not (easy-menu-always-true-p visible)))
@@ -334,16 +332,16 @@ ITEM defines an item as in `easy-menu-define'."
334 (setq keyword (aref item count)) 332 (setq keyword (aref item count))
335 (setq arg (aref item (1+ count))) 333 (setq arg (aref item (1+ count)))
336 (setq count (+ 2 count)) 334 (setq count (+ 2 count))
337 (case keyword 335 (pcase keyword
338 ((:included :visible) (setq visible (or arg ''nil))) 336 ((or `:included `:visible) (setq visible (or arg ''nil)))
339 (:key-sequence (setq cache arg cache-specified t)) 337 (`:key-sequence (setq cache arg cache-specified t))
340 (:keys (setq keys arg no-name nil)) 338 (`:keys (setq keys arg no-name nil))
341 (:label (setq label arg)) 339 (`:label (setq label arg))
342 ((:active :enable) (setq active (or arg ''nil))) 340 ((or `:active `:enable) (setq active (or arg ''nil)))
343 (:help (setq prop (cons :help (cons arg prop)))) 341 (`:help (setq prop (cons :help (cons arg prop))))
344 (:suffix (setq suffix arg)) 342 (`:suffix (setq suffix arg))
345 (:style (setq style arg)) 343 (`:style (setq style arg))
346 (:selected (setq selected (or arg ''nil))))) 344 (`:selected (setq selected (or arg ''nil)))))
347 (if suffix 345 (if suffix
348 (setq label 346 (setq label
349 (if (stringp suffix) 347 (if (stringp suffix)
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index 9e214a9703c..02fdbc6e77f 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -96,11 +96,11 @@
96 96
97;;; Code: 97;;; Code:
98 98
99(eval-when-compile (require 'cl)) 99(eval-when-compile (require 'cl-lib))
100 100
101;; The doubly linked list is implemented as a circular list with a dummy 101;; The doubly linked list is implemented as a circular list with a dummy
102;; node first and last. The dummy node is used as "the dll". 102;; node first and last. The dummy node is used as "the dll".
103(defstruct (ewoc--node 103(cl-defstruct (ewoc--node
104 (:type vector) ;ewoc--node-nth needs this 104 (:type vector) ;ewoc--node-nth needs this
105 (:constructor nil) 105 (:constructor nil)
106 (:constructor ewoc--node-create (start-marker data))) 106 (:constructor ewoc--node-create (start-marker data)))
@@ -140,7 +140,7 @@ and (ewoc--node-nth dll -1) returns the last node."
140 140
141;;; The ewoc data type 141;;; The ewoc data type
142 142
143(defstruct (ewoc 143(cl-defstruct (ewoc
144 (:constructor nil) 144 (:constructor nil)
145 (:constructor ewoc--create (buffer pretty-printer dll)) 145 (:constructor ewoc--create (buffer pretty-printer dll))
146 (:conc-name ewoc--)) 146 (:conc-name ewoc--))
@@ -196,10 +196,10 @@ NODE and leaving the new node's start there. Return the new node."
196 (save-excursion 196 (save-excursion
197 (let ((elemnode (ewoc--node-create 197 (let ((elemnode (ewoc--node-create
198 (copy-marker (ewoc--node-start-marker node)) data))) 198 (copy-marker (ewoc--node-start-marker node)) data)))
199 (setf (ewoc--node-left elemnode) (ewoc--node-left node) 199 (cl-setf (ewoc--node-left elemnode) (ewoc--node-left node)
200 (ewoc--node-right elemnode) node 200 (ewoc--node-right elemnode) node
201 (ewoc--node-right (ewoc--node-left node)) elemnode 201 (ewoc--node-right (ewoc--node-left node)) elemnode
202 (ewoc--node-left node) elemnode) 202 (ewoc--node-left node) elemnode)
203 (ewoc--refresh-node pretty-printer elemnode dll) 203 (ewoc--refresh-node pretty-printer elemnode dll)
204 elemnode))) 204 elemnode)))
205 205
@@ -244,8 +244,8 @@ Normally, a newline is automatically inserted after the header,
244the footer and every node's printed representation. Optional 244the footer and every node's printed representation. Optional
245fourth arg NOSEP non-nil inhibits this." 245fourth arg NOSEP non-nil inhibits this."
246 (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)) 246 (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST))
247 (dll (progn (setf (ewoc--node-right dummy-node) dummy-node) 247 (dll (progn (cl-setf (ewoc--node-right dummy-node) dummy-node)
248 (setf (ewoc--node-left dummy-node) dummy-node) 248 (cl-setf (ewoc--node-left dummy-node) dummy-node)
249 dummy-node)) 249 dummy-node))
250 (wrap (if nosep 'identity 'ewoc--wrap)) 250 (wrap (if nosep 'identity 'ewoc--wrap))
251 (new-ewoc (ewoc--create (current-buffer) 251 (new-ewoc (ewoc--create (current-buffer)
@@ -258,12 +258,12 @@ fourth arg NOSEP non-nil inhibits this."
258 ;; Set default values 258 ;; Set default values
259 (unless header (setq header "")) 259 (unless header (setq header ""))
260 (unless footer (setq footer "")) 260 (unless footer (setq footer ""))
261 (setf (ewoc--node-start-marker dll) (copy-marker pos) 261 (cl-setf (ewoc--node-start-marker dll) (copy-marker pos)
262 foot (ewoc--insert-new-node dll footer hf-pp dll) 262 foot (ewoc--insert-new-node dll footer hf-pp dll)
263 head (ewoc--insert-new-node foot header hf-pp dll) 263 head (ewoc--insert-new-node foot header hf-pp dll)
264 (ewoc--hf-pp new-ewoc) hf-pp 264 (ewoc--hf-pp new-ewoc) hf-pp
265 (ewoc--footer new-ewoc) foot 265 (ewoc--footer new-ewoc) foot
266 (ewoc--header new-ewoc) head)) 266 (ewoc--header new-ewoc) head))
267 ;; Return the ewoc 267 ;; Return the ewoc
268 new-ewoc)) 268 new-ewoc))
269 269
@@ -274,7 +274,7 @@ fourth arg NOSEP non-nil inhibits this."
274 274
275(defun ewoc-set-data (node data) 275(defun ewoc-set-data (node data)
276 "Set NODE to encapsulate DATA." 276 "Set NODE to encapsulate DATA."
277 (setf (ewoc--node-data node) data)) 277 (cl-setf (ewoc--node-data node) data))
278 278
279(defun ewoc-enter-first (ewoc data) 279(defun ewoc-enter-first (ewoc data)
280 "Enter DATA first in EWOC. 280 "Enter DATA first in EWOC.
@@ -356,18 +356,18 @@ arguments will be passed to MAP-FUNCTION."
356 ;; If we are about to delete the node pointed at by last-node, 356 ;; If we are about to delete the node pointed at by last-node,
357 ;; set last-node to nil. 357 ;; set last-node to nil.
358 (when (eq last node) 358 (when (eq last node)
359 (setf last nil (ewoc--last-node ewoc) nil)) 359 (cl-setf last nil (ewoc--last-node ewoc) nil))
360 (delete-region (ewoc--node-start-marker node) 360 (delete-region (ewoc--node-start-marker node)
361 (ewoc--node-start-marker (ewoc--node-next dll node))) 361 (ewoc--node-start-marker (ewoc--node-next dll node)))
362 (set-marker (ewoc--node-start-marker node) nil) 362 (set-marker (ewoc--node-start-marker node) nil)
363 (setf L (ewoc--node-left node) 363 (cl-setf L (ewoc--node-left node)
364 R (ewoc--node-right node) 364 R (ewoc--node-right node)
365 ;; Link neighbors to each other. 365 ;; Link neighbors to each other.
366 (ewoc--node-right L) R 366 (ewoc--node-right L) R
367 (ewoc--node-left R) L 367 (ewoc--node-left R) L
368 ;; Forget neighbors. 368 ;; Forget neighbors.
369 (ewoc--node-left node) nil 369 (ewoc--node-left node) nil
370 (ewoc--node-right node) nil)))) 370 (ewoc--node-right node) nil))))
371 371
372(defun ewoc-filter (ewoc predicate &rest args) 372(defun ewoc-filter (ewoc predicate &rest args)
373 "Remove all elements in EWOC for which PREDICATE returns nil. 373 "Remove all elements in EWOC for which PREDICATE returns nil.
@@ -503,7 +503,7 @@ Return the node (or nil if we just passed the last node)."
503 (ewoc--set-buffer-bind-dll ewoc 503 (ewoc--set-buffer-bind-dll ewoc
504 (goto-char (ewoc--node-start-marker node)) 504 (goto-char (ewoc--node-start-marker node))
505 (if goal-column (move-to-column goal-column)) 505 (if goal-column (move-to-column goal-column))
506 (setf (ewoc--last-node ewoc) node))) 506 (cl-setf (ewoc--last-node ewoc) node)))
507 507
508(defun ewoc-refresh (ewoc) 508(defun ewoc-refresh (ewoc)
509 "Refresh all data in EWOC. 509 "Refresh all data in EWOC.
@@ -564,8 +564,8 @@ Return nil if the buffer has been deleted."
564 ((head (ewoc--header ewoc)) 564 ((head (ewoc--header ewoc))
565 (foot (ewoc--footer ewoc)) 565 (foot (ewoc--footer ewoc))
566 (hf-pp (ewoc--hf-pp ewoc))) 566 (hf-pp (ewoc--hf-pp ewoc)))
567 (setf (ewoc--node-data head) header 567 (cl-setf (ewoc--node-data head) header
568 (ewoc--node-data foot) footer) 568 (ewoc--node-data foot) footer)
569 (save-excursion 569 (save-excursion
570 (ewoc--refresh-node hf-pp head dll) 570 (ewoc--refresh-node hf-pp head dll)
571 (ewoc--refresh-node hf-pp foot dll)))) 571 (ewoc--refresh-node hf-pp foot dll))))
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 01274b7ba20..136dff6df68 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -121,7 +121,7 @@
121;; - smie-indent-comment doesn't interact well with mis-indented lines (where 121;; - smie-indent-comment doesn't interact well with mis-indented lines (where
122;; the indent rules don't do what the user wants). Not sure what to do. 122;; the indent rules don't do what the user wants). Not sure what to do.
123 123
124(eval-when-compile (require 'cl)) 124(eval-when-compile (require 'cl-lib))
125 125
126(defgroup smie nil 126(defgroup smie nil
127 "Simple Minded Indentation Engine." 127 "Simple Minded Indentation Engine."
@@ -155,7 +155,7 @@
155(defvar smie-warning-count 0) 155(defvar smie-warning-count 0)
156 156
157(defun smie-set-prec2tab (table x y val &optional override) 157(defun smie-set-prec2tab (table x y val &optional override)
158 (assert (and x y)) 158 (cl-assert (and x y))
159 (let* ((key (cons x y)) 159 (let* ((key (cons x y))
160 (old (gethash key table))) 160 (old (gethash key table)))
161 (if (and old (not (eq old val))) 161 (if (and old (not (eq old val)))
@@ -166,7 +166,7 @@
166 ;; don't hide real conflicts. 166 ;; don't hide real conflicts.
167 (puthash key (gethash key override) table) 167 (puthash key (gethash key override) table)
168 (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)) 168 (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))
169 (incf smie-warning-count)) 169 (cl-incf smie-warning-count))
170 (puthash key val table)))) 170 (puthash key val table))))
171 171
172(put 'smie-precs->prec2 'pure t) 172(put 'smie-precs->prec2 'pure t)
@@ -268,8 +268,8 @@ be either:
268 (unless (consp rhs) 268 (unless (consp rhs)
269 (signal 'wrong-type-argument `(consp ,rhs))) 269 (signal 'wrong-type-argument `(consp ,rhs)))
270 (if (not (member (car rhs) nts)) 270 (if (not (member (car rhs) nts))
271 (pushnew (car rhs) first-ops) 271 (cl-pushnew (car rhs) first-ops)
272 (pushnew (car rhs) first-nts) 272 (cl-pushnew (car rhs) first-nts)
273 (when (consp (cdr rhs)) 273 (when (consp (cdr rhs))
274 ;; If the first is not an OP we add the second (which 274 ;; If the first is not an OP we add the second (which
275 ;; should be an OP if BNF is an "operator grammar"). 275 ;; should be an OP if BNF is an "operator grammar").
@@ -282,16 +282,16 @@ be either:
282 (when (member (cadr rhs) nts) 282 (when (member (cadr rhs) nts)
283 (error "Adjacent non-terminals: %s %s" 283 (error "Adjacent non-terminals: %s %s"
284 (car rhs) (cadr rhs))) 284 (car rhs) (cadr rhs)))
285 (pushnew (cadr rhs) first-ops))) 285 (cl-pushnew (cadr rhs) first-ops)))
286 (let ((shr (reverse rhs))) 286 (let ((shr (reverse rhs)))
287 (if (not (member (car shr) nts)) 287 (if (not (member (car shr) nts))
288 (pushnew (car shr) last-ops) 288 (cl-pushnew (car shr) last-ops)
289 (pushnew (car shr) last-nts) 289 (cl-pushnew (car shr) last-nts)
290 (when (consp (cdr shr)) 290 (when (consp (cdr shr))
291 (when (member (cadr shr) nts) 291 (when (member (cadr shr) nts)
292 (error "Adjacent non-terminals: %s %s" 292 (error "Adjacent non-terminals: %s %s"
293 (cadr shr) (car shr))) 293 (cadr shr) (car shr)))
294 (pushnew (cadr shr) last-ops))))) 294 (cl-pushnew (cadr shr) last-ops)))))
295 (push (cons nt first-ops) first-ops-table) 295 (push (cons nt first-ops) first-ops-table)
296 (push (cons nt last-ops) last-ops-table) 296 (push (cons nt last-ops) last-ops-table)
297 (push (cons nt first-nts) first-nts-table) 297 (push (cons nt first-nts) first-nts-table)
@@ -307,7 +307,7 @@ be either:
307 (dolist (op (cdr (assoc first-nt first-ops-table))) 307 (dolist (op (cdr (assoc first-nt first-ops-table)))
308 (unless (member op first-ops) 308 (unless (member op first-ops)
309 (setq again t) 309 (setq again t)
310 (push op (cdr first-ops)))))))) 310 (cl-push op (cdr first-ops))))))))
311 ;; Same thing for last-ops. 311 ;; Same thing for last-ops.
312 (setq again t) 312 (setq again t)
313 (while (prog1 again (setq again nil)) 313 (while (prog1 again (setq again nil))
@@ -318,7 +318,7 @@ be either:
318 (dolist (op (cdr (assoc last-nt last-ops-table))) 318 (dolist (op (cdr (assoc last-nt last-ops-table)))
319 (unless (member op last-ops) 319 (unless (member op last-ops)
320 (setq again t) 320 (setq again t)
321 (push op (cdr last-ops)))))))) 321 (cl-push op (cdr last-ops))))))))
322 ;; Now generate the 2D precedence table. 322 ;; Now generate the 2D precedence table.
323 (dolist (rules bnf) 323 (dolist (rules bnf)
324 (dolist (rhs (cdr rules)) 324 (dolist (rhs (cdr rules))
@@ -416,12 +416,12 @@ from the table, e.g. the table will not include things like (\"if\" . \"else\").
416 (if no-inners 416 (if no-inners
417 (let ((last (car (last rhs)))) 417 (let ((last (car (last rhs))))
418 (unless (member last nts) 418 (unless (member last nts)
419 (pushnew (cons (car rhs) last) alist :test #'equal))) 419 (cl-pushnew (cons (car rhs) last) alist :test #'equal)))
420 ;; Reverse so that the "real" closer gets there first, 420 ;; Reverse so that the "real" closer gets there first,
421 ;; which is important for smie-close-block. 421 ;; which is important for smie-close-block.
422 (dolist (term (reverse (cdr rhs))) 422 (dolist (term (reverse (cdr rhs)))
423 (unless (member term nts) 423 (unless (member term nts)
424 (pushnew (cons (car rhs) term) alist :test #'equal))))))) 424 (cl-pushnew (cons (car rhs) term) alist :test #'equal)))))))
425 (nreverse alist))) 425 (nreverse alist)))
426 426
427(defun smie-bnf--set-class (table token class) 427(defun smie-bnf--set-class (table token class)
@@ -483,7 +483,7 @@ CSTS is a list of pairs representing arcs in a graph."
483 (push (concat "." (car elem)) res)) 483 (push (concat "." (car elem)) res))
484 (if (eq (cddr elem) val) 484 (if (eq (cddr elem) val)
485 (push (concat (car elem) ".") res))) 485 (push (concat (car elem) ".") res)))
486 (assert res) 486 (cl-assert res)
487 res)) 487 res))
488 cycle))) 488 cycle)))
489 (mapconcat 489 (mapconcat
@@ -498,9 +498,9 @@ CSTS is a list of pairs representing arcs in a graph."
498;; (right (nth 1 (assoc (cdr k) grammar)))) 498;; (right (nth 1 (assoc (cdr k) grammar))))
499;; (when (and left right) 499;; (when (and left right)
500;; (cond 500;; (cond
501;; ((< left right) (assert (eq v '<))) 501;; ((< left right) (cl-assert (eq v '<)))
502;; ((> left right) (assert (eq v '>))) 502;; ((> left right) (cl-assert (eq v '>)))
503;; (t (assert (eq v '=)))))))) 503;; (t (cl-assert (eq v '=))))))))
504;; prec2)) 504;; prec2))
505 505
506(put 'smie-prec2->grammar 'pure t) 506(put 'smie-prec2->grammar 'pure t)
@@ -514,25 +514,28 @@ PREC2 is a table as returned by `smie-precs->prec2' or
514 ;; final `table'. The value of each "variable" is kept in the `car'. 514 ;; final `table'. The value of each "variable" is kept in the `car'.
515 (let ((table ()) 515 (let ((table ())
516 (csts ()) 516 (csts ())
517 (eqs ()) 517 (eqs ()))
518 tmp x y)
519 ;; From `prec2' we construct a list of constraints between 518 ;; From `prec2' we construct a list of constraints between
520 ;; variables (aka "precedence levels"). These can be either 519 ;; variables (aka "precedence levels"). These can be either
521 ;; equality constraints (in `eqs') or `<' constraints (in `csts'). 520 ;; equality constraints (in `eqs') or `<' constraints (in `csts').
522 (maphash (lambda (k v) 521 (maphash (lambda (k v)
523 (when (consp k) 522 (when (consp k)
524 (if (setq tmp (assoc (car k) table)) 523 (let ((tmp (assoc (car k) table))
525 (setq x (cddr tmp)) 524 x y)
526 (setq x (cons nil nil)) 525 (if tmp
527 (push (cons (car k) (cons nil x)) table)) 526 (setq x (cddr tmp))
528 (if (setq tmp (assoc (cdr k) table)) 527 (setq x (cons nil nil))
529 (setq y (cdr tmp)) 528 (push (cons (car k) (cons nil x)) table))
530 (setq y (cons nil (cons nil nil))) 529 (if (setq tmp (assoc (cdr k) table))
531 (push (cons (cdr k) y) table)) 530 (setq y (cdr tmp))
532 (ecase v 531 (setq y (cons nil (cons nil nil)))
533 (= (push (cons x y) eqs)) 532 (push (cons (cdr k) y) table))
534 (< (push (cons x y) csts)) 533 (pcase v
535 (> (push (cons y x) csts))))) 534 (`= (push (cons x y) eqs))
535 (`< (push (cons x y) csts))
536 (`> (push (cons y x) csts))
537 (_ (error "SMIE error: prec2 has %S↦%S which ∉ {<,+,>}"
538 k v))))))
536 prec2) 539 prec2)
537 ;; First process the equality constraints. 540 ;; First process the equality constraints.
538 (let ((eqs eqs)) 541 (let ((eqs eqs))
@@ -572,13 +575,13 @@ PREC2 is a table as returned by `smie-precs->prec2' or
572 (unless (caar cst) 575 (unless (caar cst)
573 (setcar (car cst) i) 576 (setcar (car cst) i)
574 ;; (smie-check-grammar table prec2 'step1) 577 ;; (smie-check-grammar table prec2 'step1)
575 (incf i)) 578 (cl-incf i))
576 (setq csts (delq cst csts)))) 579 (setq csts (delq cst csts))))
577 (unless progress 580 (unless progress
578 (error "Can't resolve the precedence cycle: %s" 581 (error "Can't resolve the precedence cycle: %s"
579 (smie-debug--describe-cycle 582 (smie-debug--describe-cycle
580 table (smie-debug--prec2-cycle csts))))) 583 table (smie-debug--prec2-cycle csts)))))
581 (incf i 10)) 584 (cl-incf i 10))
582 ;; Propagate equality constraints back to their sources. 585 ;; Propagate equality constraints back to their sources.
583 (dolist (eq (nreverse eqs)) 586 (dolist (eq (nreverse eqs))
584 (when (null (cadr eq)) 587 (when (null (cadr eq))
@@ -589,8 +592,8 @@ PREC2 is a table as returned by `smie-precs->prec2' or
589 ;; So set it here rather than below since doing it below 592 ;; So set it here rather than below since doing it below
590 ;; makes it more difficult to obey the equality constraints. 593 ;; makes it more difficult to obey the equality constraints.
591 (setcar (cdr eq) i) 594 (setcar (cdr eq) i)
592 (incf i)) 595 (cl-incf i))
593 (assert (or (null (caar eq)) (eq (caar eq) (cadr eq)))) 596 (cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
594 (setcar (car eq) (cadr eq)) 597 (setcar (car eq) (cadr eq))
595 ;; (smie-check-grammar table prec2 'step2) 598 ;; (smie-check-grammar table prec2 'step2)
596 ) 599 )
@@ -598,19 +601,19 @@ PREC2 is a table as returned by `smie-precs->prec2' or
598 ;; left side of any < constraint). 601 ;; left side of any < constraint).
599 (dolist (x table) 602 (dolist (x table)
600 (unless (nth 1 x) 603 (unless (nth 1 x)
601 (setf (nth 1 x) i) 604 (cl-setf (nth 1 x) i)
602 (incf i)) ;See other (incf i) above. 605 (cl-incf i)) ;See other (cl-incf i) above.
603 (unless (nth 2 x) 606 (unless (nth 2 x)
604 (setf (nth 2 x) i) 607 (cl-setf (nth 2 x) i)
605 (incf i)))) ;See other (incf i) above. 608 (cl-incf i)))) ;See other (cl-incf i) above.
606 ;; Mark closers and openers. 609 ;; Mark closers and openers.
607 (dolist (x (gethash :smie-open/close-alist prec2)) 610 (dolist (x (gethash :smie-open/close-alist prec2))
608 (let* ((token (car x)) 611 (let* ((token (car x))
609 (cons (case (cdr x) 612 (cons (pcase (cdr x)
610 (closer (cddr (assoc token table))) 613 (`closer (cddr (assoc token table)))
611 (opener (cdr (assoc token table)))))) 614 (`opener (cdr (assoc token table))))))
612 (assert (numberp (car cons))) 615 (cl-assert (numberp (car cons)))
613 (setf (car cons) (list (car cons))))) 616 (cl-setf (car cons) (list (car cons)))))
614 (let ((ca (gethash :smie-closer-alist prec2))) 617 (let ((ca (gethash :smie-closer-alist prec2)))
615 (when ca (push (cons :smie-closer-alist ca) table))) 618 (when ca (push (cons :smie-closer-alist ca) table)))
616 ;; (smie-check-grammar table prec2 'step3) 619 ;; (smie-check-grammar table prec2 'step3)
@@ -706,19 +709,19 @@ Possible return values:
706 (condition-case err 709 (condition-case err
707 (progn (goto-char pos) (funcall next-sexp 1) nil) 710 (progn (goto-char pos) (funcall next-sexp 1) nil)
708 (scan-error (throw 'return 711 (scan-error (throw 'return
709 (list t (caddr err) 712 (list t (cl-caddr err)
710 (buffer-substring-no-properties 713 (buffer-substring-no-properties
711 (caddr err) 714 (cl-caddr err)
712 (+ (caddr err) 715 (+ (cl-caddr err)
713 (if (< (point) (caddr err)) 716 (if (< (point) (cl-caddr err))
714 -1 1))))))) 717 -1 1)))))))
715 (if (eq pos (point)) 718 (if (eq pos (point))
716 ;; We did not move, so let's abort the loop. 719 ;; We did not move, so let's abort the loop.
717 (throw 'return (list t (point)))))) 720 (throw 'return (list t (point))))))
718 ((not (numberp (funcall op-back toklevels))) 721 ((not (numberp (funcall op-back toklevels)))
719 ;; A token like a paren-close. 722 ;; A token like a paren-close.
720 (assert (numberp ; Otherwise, why mention it in smie-grammar. 723 (cl-assert (numberp ; Otherwise, why mention it in smie-grammar.
721 (funcall op-forw toklevels))) 724 (funcall op-forw toklevels)))
722 (push toklevels levels)) 725 (push toklevels levels))
723 (t 726 (t
724 (while (and levels (< (funcall op-back toklevels) 727 (while (and levels (< (funcall op-back toklevels)
@@ -1672,12 +1675,12 @@ KEYWORDS are additional arguments, which can use the following keywords:
1672 (while keywords 1675 (while keywords
1673 (let ((k (pop keywords)) 1676 (let ((k (pop keywords))
1674 (v (pop keywords))) 1677 (v (pop keywords)))
1675 (case k 1678 (pcase k
1676 (:forward-token 1679 (`:forward-token
1677 (set (make-local-variable 'smie-forward-token-function) v)) 1680 (set (make-local-variable 'smie-forward-token-function) v))
1678 (:backward-token 1681 (`:backward-token
1679 (set (make-local-variable 'smie-backward-token-function) v)) 1682 (set (make-local-variable 'smie-backward-token-function) v))
1680 (t (message "smie-setup: ignoring unknown keyword %s" k))))) 1683 (_ (message "smie-setup: ignoring unknown keyword %s" k)))))
1681 (let ((ca (cdr (assq :smie-closer-alist grammar)))) 1684 (let ((ca (cdr (assq :smie-closer-alist grammar))))
1682 (when ca 1685 (when ca
1683 (set (make-local-variable 'smie-closer-alist) ca) 1686 (set (make-local-variable 'smie-closer-alist) ca)
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 583d0b151c9..51bfc05ff5f 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -41,7 +41,7 @@
41 41
42;; Note: PPSS stands for `parse-partial-sexp state' 42;; Note: PPSS stands for `parse-partial-sexp state'
43 43
44(eval-when-compile (require 'cl)) 44(eval-when-compile (require 'cl-lib))
45 45
46(defvar font-lock-beginning-of-syntax-function) 46(defvar font-lock-beginning-of-syntax-function)
47 47
@@ -181,7 +181,7 @@ Note: back-references in REGEXPs do not work."
181 ;; If there's more than 1 rule, and the rule want to apply 181 ;; If there's more than 1 rule, and the rule want to apply
182 ;; highlight to match 0, create an extra group to be able to 182 ;; highlight to match 0, create an extra group to be able to
183 ;; tell when *this* match 0 has succeeded. 183 ;; tell when *this* match 0 has succeeded.
184 (incf offset) 184 (cl-incf offset)
185 (setq re (concat "\\(" re "\\)"))) 185 (setq re (concat "\\(" re "\\)")))
186 (setq re (syntax-propertize--shift-groups re offset)) 186 (setq re (syntax-propertize--shift-groups re offset))
187 (let ((code '()) 187 (let ((code '())
@@ -215,7 +215,7 @@ Note: back-references in REGEXPs do not work."
215 (setq offset 0))) 215 (setq offset 0)))
216 ;; Now construct the code for each subgroup rules. 216 ;; Now construct the code for each subgroup rules.
217 (dolist (case (cdr rule)) 217 (dolist (case (cdr rule))
218 (assert (null (cddr case))) 218 (cl-assert (null (cddr case)))
219 (let* ((gn (+ offset (car case))) 219 (let* ((gn (+ offset (car case)))
220 (action (nth 1 case)) 220 (action (nth 1 case))
221 (thiscode 221 (thiscode
@@ -260,7 +260,7 @@ Note: back-references in REGEXPs do not work."
260 code)))) 260 code))))
261 (push (cons condition (nreverse code)) 261 (push (cons condition (nreverse code))
262 branches)) 262 branches))
263 (incf offset (regexp-opt-depth orig-re)) 263 (cl-incf offset (regexp-opt-depth orig-re))
264 re)) 264 re))
265 rules 265 rules
266 "\\|"))) 266 "\\|")))
@@ -418,8 +418,8 @@ Point is at POS when this function returns."
418 (* 2 (/ (cdr (aref syntax-ppss-stats 5)) 418 (* 2 (/ (cdr (aref syntax-ppss-stats 5))
419 (1+ (car (aref syntax-ppss-stats 5))))))) 419 (1+ (car (aref syntax-ppss-stats 5)))))))
420 (progn 420 (progn
421 (incf (car (aref syntax-ppss-stats 0))) 421 (cl-incf (car (aref syntax-ppss-stats 0)))
422 (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos)) 422 (cl-incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
423 (parse-partial-sexp old-pos pos nil nil old-ppss)) 423 (parse-partial-sexp old-pos pos nil nil old-ppss))
424 424
425 (cond 425 (cond
@@ -435,8 +435,8 @@ Point is at POS when this function returns."
435 (setq pt-min (or (syntax-ppss-toplevel-pos old-ppss) 435 (setq pt-min (or (syntax-ppss-toplevel-pos old-ppss)
436 (nth 2 old-ppss))) 436 (nth 2 old-ppss)))
437 (<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span)) 437 (<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span))
438 (incf (car (aref syntax-ppss-stats 1))) 438 (cl-incf (car (aref syntax-ppss-stats 1)))
439 (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min)) 439 (cl-incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
440 (setq ppss (parse-partial-sexp pt-min pos))) 440 (setq ppss (parse-partial-sexp pt-min pos)))
441 ;; The OLD-* data can't be used. Consult the cache. 441 ;; The OLD-* data can't be used. Consult the cache.
442 (t 442 (t
@@ -464,8 +464,8 @@ Point is at POS when this function returns."
464 ;; Use the best of OLD-POS and CACHE. 464 ;; Use the best of OLD-POS and CACHE.
465 (if (or (not old-pos) (< old-pos pt-min)) 465 (if (or (not old-pos) (< old-pos pt-min))
466 (setq pt-best pt-min ppss-best ppss) 466 (setq pt-best pt-min ppss-best ppss)
467 (incf (car (aref syntax-ppss-stats 4))) 467 (cl-incf (car (aref syntax-ppss-stats 4)))
468 (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos)) 468 (cl-incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
469 (setq pt-best old-pos ppss-best old-ppss)) 469 (setq pt-best old-pos ppss-best old-ppss))
470 470
471 ;; Use the `syntax-begin-function' if available. 471 ;; Use the `syntax-begin-function' if available.
@@ -490,21 +490,21 @@ Point is at POS when this function returns."
490 (not (memq (get-text-property (point) 'face) 490 (not (memq (get-text-property (point) 'face)
491 '(font-lock-string-face font-lock-doc-face 491 '(font-lock-string-face font-lock-doc-face
492 font-lock-comment-face)))) 492 font-lock-comment-face))))
493 (incf (car (aref syntax-ppss-stats 5))) 493 (cl-incf (car (aref syntax-ppss-stats 5)))
494 (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point))) 494 (cl-incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
495 (setq pt-best (point) ppss-best nil)) 495 (setq pt-best (point) ppss-best nil))
496 496
497 (cond 497 (cond
498 ;; Quick case when we found a nearby pos. 498 ;; Quick case when we found a nearby pos.
499 ((< (- pos pt-best) syntax-ppss-max-span) 499 ((< (- pos pt-best) syntax-ppss-max-span)
500 (incf (car (aref syntax-ppss-stats 2))) 500 (cl-incf (car (aref syntax-ppss-stats 2)))
501 (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best)) 501 (cl-incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
502 (setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best))) 502 (setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))
503 ;; Slow case: compute the state from some known position and 503 ;; Slow case: compute the state from some known position and
504 ;; populate the cache so we won't need to do it again soon. 504 ;; populate the cache so we won't need to do it again soon.
505 (t 505 (t
506 (incf (car (aref syntax-ppss-stats 3))) 506 (cl-incf (car (aref syntax-ppss-stats 3)))
507 (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min)) 507 (cl-incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
508 508
509 ;; If `pt-min' is too far, add a few intermediate entries. 509 ;; If `pt-min' is too far, add a few intermediate entries.
510 (while (> (- pos pt-min) (* 2 syntax-ppss-max-span)) 510 (while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
@@ -513,7 +513,7 @@ Point is at POS when this function returns."
513 nil nil ppss)) 513 nil nil ppss))
514 (let ((pair (cons pt-min ppss))) 514 (let ((pair (cons pt-min ppss)))
515 (if cache-pred 515 (if cache-pred
516 (push pair (cdr cache-pred)) 516 (cl-push pair (cdr cache-pred))
517 (push pair syntax-ppss-cache)))) 517 (push pair syntax-ppss-cache))))
518 518
519 ;; Compute the actual return value. 519 ;; Compute the actual return value.
@@ -533,7 +533,7 @@ Point is at POS when this function returns."
533 (let ((pair (cons pos ppss))) 533 (let ((pair (cons pos ppss)))
534 (if cache-pred 534 (if cache-pred
535 (if (> (- (caar cache-pred) pos) syntax-ppss-max-span) 535 (if (> (- (caar cache-pred) pos) syntax-ppss-max-span)
536 (push pair (cdr cache-pred)) 536 (cl-push pair (cdr cache-pred))
537 (setcar cache-pred pair)) 537 (setcar cache-pred pair))
538 (if (or (null syntax-ppss-cache) 538 (if (or (null syntax-ppss-cache)
539 (> (- (caar syntax-ppss-cache) pos) 539 (> (- (caar syntax-ppss-cache) pos)
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 11ec0f0614c..1c30563c6a3 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -33,9 +33,9 @@
33;; triggered-p is nil if the timer is active (waiting to be triggered), 33;; triggered-p is nil if the timer is active (waiting to be triggered),
34;; t if it is inactive ("already triggered", in theory) 34;; t if it is inactive ("already triggered", in theory)
35 35
36(eval-when-compile (require 'cl)) 36(eval-when-compile (require 'cl-lib))
37 37
38(defstruct (timer 38(cl-defstruct (timer
39 (:constructor nil) 39 (:constructor nil)
40 (:copier nil) 40 (:copier nil)
41 (:constructor timer-create ()) 41 (:constructor timer-create ())
@@ -54,15 +54,15 @@
54 (timer--low-seconds timer) 54 (timer--low-seconds timer)
55 (timer--usecs timer))) 55 (timer--usecs timer)))
56 56
57(defsetf timer--time 57(cl-defsetf timer--time
58 (lambda (timer time) 58 (lambda (timer time)
59 (or (timerp timer) (error "Invalid timer")) 59 (or (timerp timer) (error "Invalid timer"))
60 (setf (timer--high-seconds timer) (pop time)) 60 (cl-setf (timer--high-seconds timer) (pop time))
61 (setf (timer--low-seconds timer) 61 (cl-setf (timer--low-seconds timer)
62 (if (consp time) (car time) time)) 62 (if (consp time) (car time) time))
63 (setf (timer--usecs timer) (or (and (consp time) (consp (cdr time)) 63 (cl-setf (timer--usecs timer) (or (and (consp time) (consp (cdr time))
64 (cadr time)) 64 (cadr time))
65 0)))) 65 0))))
66 66
67 67
68(defun timer-set-time (timer time &optional delta) 68(defun timer-set-time (timer time &optional delta)
@@ -70,8 +70,8 @@
70TIME must be in the internal format returned by, e.g., `current-time'. 70TIME must be in the internal format returned by, e.g., `current-time'.
71If optional third argument DELTA is a positive number, make the timer 71If optional third argument DELTA is a positive number, make the timer
72fire repeatedly that many seconds apart." 72fire repeatedly that many seconds apart."
73 (setf (timer--time timer) time) 73 (cl-setf (timer--time timer) time)
74 (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) 74 (cl-setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta))
75 timer) 75 timer)
76 76
77(defun timer-set-idle-time (timer secs &optional repeat) 77(defun timer-set-idle-time (timer secs &optional repeat)
@@ -81,10 +81,10 @@ time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
81If optional third argument REPEAT is non-nil, make the timer 81If optional third argument REPEAT is non-nil, make the timer
82fire each time Emacs is idle for that many seconds." 82fire each time Emacs is idle for that many seconds."
83 (if (consp secs) 83 (if (consp secs)
84 (setf (timer--time timer) secs) 84 (cl-setf (timer--time timer) secs)
85 (setf (timer--time timer) '(0 0 0)) 85 (cl-setf (timer--time timer) '(0 0 0))
86 (timer-inc-time timer secs)) 86 (timer-inc-time timer secs))
87 (setf (timer--repeat-delay timer) repeat) 87 (cl-setf (timer--repeat-delay timer) repeat)
88 timer) 88 timer)
89 89
90(defun timer-next-integral-multiple-of-time (time secs) 90(defun timer-next-integral-multiple-of-time (time secs)
@@ -124,8 +124,8 @@ SECS may be either an integer or a floating point number."
124(defun timer-inc-time (timer secs &optional usecs) 124(defun timer-inc-time (timer secs &optional usecs)
125 "Increment the time set in TIMER by SECS seconds and USECS microseconds. 125 "Increment the time set in TIMER by SECS seconds and USECS microseconds.
126SECS may be a fraction. If USECS is omitted, that means it is zero." 126SECS may be a fraction. If USECS is omitted, that means it is zero."
127 (setf (timer--time timer) 127 (cl-setf (timer--time timer)
128 (timer-relative-time (timer--time timer) secs usecs))) 128 (timer-relative-time (timer--time timer) secs usecs)))
129 129
130(defun timer-set-time-with-usecs (timer time usecs &optional delta) 130(defun timer-set-time-with-usecs (timer time usecs &optional delta)
131 "Set the trigger time of TIMER to TIME plus USECS. 131 "Set the trigger time of TIMER to TIME plus USECS.
@@ -133,9 +133,9 @@ TIME must be in the internal format returned by, e.g., `current-time'.
133The microsecond count from TIME is ignored, and USECS is used instead. 133The microsecond count from TIME is ignored, and USECS is used instead.
134If optional fourth argument DELTA is a positive number, make the timer 134If optional fourth argument DELTA is a positive number, make the timer
135fire repeatedly that many seconds apart." 135fire repeatedly that many seconds apart."
136 (setf (timer--time timer) time) 136 (cl-setf (timer--time timer) time)
137 (setf (timer--usecs timer) usecs) 137 (cl-setf (timer--usecs timer) usecs)
138 (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) 138 (cl-setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta))
139 timer) 139 timer)
140(make-obsolete 'timer-set-time-with-usecs 140(make-obsolete 'timer-set-time-with-usecs
141 "use `timer-set-time' and `timer-inc-time' instead." 141 "use `timer-set-time' and `timer-inc-time' instead."
@@ -145,8 +145,8 @@ fire repeatedly that many seconds apart."
145 "Make TIMER call FUNCTION with optional ARGS when triggering." 145 "Make TIMER call FUNCTION with optional ARGS when triggering."
146 (or (timerp timer) 146 (or (timerp timer)
147 (error "Invalid timer")) 147 (error "Invalid timer"))
148 (setf (timer--function timer) function) 148 (cl-setf (timer--function timer) function)
149 (setf (timer--args timer) args) 149 (cl-setf (timer--args timer) args)
150 timer) 150 timer)
151 151
152(defun timer--activate (timer &optional triggered-p reuse-cell idle) 152(defun timer--activate (timer &optional triggered-p reuse-cell idle)
@@ -170,8 +170,8 @@ fire repeatedly that many seconds apart."
170 (cond (last (setcdr last reuse-cell)) 170 (cond (last (setcdr last reuse-cell))
171 (idle (setq timer-idle-list reuse-cell)) 171 (idle (setq timer-idle-list reuse-cell))
172 (t (setq timer-list reuse-cell))) 172 (t (setq timer-list reuse-cell)))
173 (setf (timer--triggered timer) triggered-p) 173 (cl-setf (timer--triggered timer) triggered-p)
174 (setf (timer--idle-delay timer) idle) 174 (cl-setf (timer--idle-delay timer) idle)
175 nil) 175 nil)
176 (error "Invalid or uninitialized timer"))) 176 (error "Invalid or uninitialized timer")))
177 177
@@ -294,7 +294,7 @@ This function is called, by name, directly by the C code."
294 (apply (timer--function timer) (timer--args timer))) 294 (apply (timer--function timer) (timer--args timer)))
295 (error nil)) 295 (error nil))
296 (if retrigger 296 (if retrigger
297 (setf (timer--triggered timer) nil))) 297 (cl-setf (timer--triggered timer) nil)))
298 (error "Bogus timer event")))) 298 (error "Bogus timer event"))))
299 299
300;; This function is incompatible with the one in levents.el. 300;; This function is incompatible with the one in levents.el.