diff options
| author | Stefan Monnier | 2012-06-10 09:28:26 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-06-10 09:28:26 -0400 |
| commit | f80efb8695cd8b4480c5f041c484beb5486afb37 (patch) | |
| tree | 11cdf753a8e8a270fa79eb1dc794aa8426d3893e | |
| parent | 31ca4639ad1bfaa355a3f30ef92eb977bd2c6b78 (diff) | |
| download | emacs-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/ChangeLog | 17 | ||||
| -rw-r--r-- | lisp/emacs-lisp/autoload.el | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 42 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 56 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-lib.el | 23 | ||||
| -rw-r--r-- | lisp/emacs-lisp/derived.el | 12 | ||||
| -rw-r--r-- | lisp/emacs-lisp/easy-mmode.el | 56 | ||||
| -rw-r--r-- | lisp/emacs-lisp/easymenu.el | 34 | ||||
| -rw-r--r-- | lisp/emacs-lisp/ewoc.el | 56 | ||||
| -rw-r--r-- | lisp/emacs-lisp/smie.el | 111 | ||||
| -rw-r--r-- | lisp/emacs-lisp/syntax.el | 36 | ||||
| -rw-r--r-- | lisp/emacs-lisp/timer.el | 48 |
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 @@ | |||
| 1 | 2012-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 | |||
| 1 | 2012-06-10 Glenn Morris <rgm@gnu.org> | 10 | 2012-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 | ||
| 10 | 2012-06-10 Chong Yidong <cyd@gnu.org> | 19 | 2012-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 | ||
| 15 | 2012-06-09 Andreas Schwab <schwab@linux-m68k.org> | 24 | 2012-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 | ||
| 148 | 2012-06-08 Michael Albinus <michael.albinus@gmx.de> | 157 | 2012-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: | |||
| 251 | EXTEND is a list of variables which might need to be accessed even from places | 251 | EXTEND is a list of variables which might need to be accessed even from places |
| 252 | where they are shadowed, because some part of ENV causes them to be used at | 252 | where they are shadowed, because some part of ENV causes them to be used at |
| 253 | places where they originally did not directly appear." | 253 | places 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. |
| 58 | If provided, LIGHTER will be used to help choose capitalization by, | 56 | If 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. |
| 36 | It can take some time to calculate the equivalent key bindings that are shown | 34 | It 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, | |||
| 244 | the footer and every node's printed representation. Optional | 244 | the footer and every node's printed representation. Optional |
| 245 | fourth arg NOSEP non-nil inhibits this." | 245 | fourth 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 @@ | |||
| 70 | TIME must be in the internal format returned by, e.g., `current-time'. | 70 | TIME must be in the internal format returned by, e.g., `current-time'. |
| 71 | If optional third argument DELTA is a positive number, make the timer | 71 | If optional third argument DELTA is a positive number, make the timer |
| 72 | fire repeatedly that many seconds apart." | 72 | fire 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'. | |||
| 81 | If optional third argument REPEAT is non-nil, make the timer | 81 | If optional third argument REPEAT is non-nil, make the timer |
| 82 | fire each time Emacs is idle for that many seconds." | 82 | fire 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. |
| 126 | SECS may be a fraction. If USECS is omitted, that means it is zero." | 126 | SECS 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'. | |||
| 133 | The microsecond count from TIME is ignored, and USECS is used instead. | 133 | The microsecond count from TIME is ignored, and USECS is used instead. |
| 134 | If optional fourth argument DELTA is a positive number, make the timer | 134 | If optional fourth argument DELTA is a positive number, make the timer |
| 135 | fire repeatedly that many seconds apart." | 135 | fire 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. |