From f687e62ac5dff18a81354e2a29f523c16e3446c3 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 19 Feb 2022 10:38:19 +0000 Subject: Fix symbols with position appearing in the output of `compile-defun' This happened with the tags of a condition-case. Also fix the detection of circular lists while stripping the positions from symbols with position. * lisp/emacs-lisp/byte-run.el (byte-run--circular-list-p): Remove. (byte-run--strip-s-p-1): Write a value of t into a hash table for each cons or vector/record encountered. (This is to prevent loops with circular structures.) This is now done for all arguments, not just those detected as circular lists. * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-defvar) (byte-compile-form, byte-compile-dynamic-variable-op) (byte-compile-constant, byte-compile-push-constant): Remove redundant calls to `bare-symbol'. (byte-compile-lambda): call `byte-run-strip-symbol-positions' on the arglist. (byte-compile-out): call `byte-run-strip-symbol-positions' on the operand. This is the main call to this function in bytecomp.el. * src/fns.c (hashfn_eq): Strip the position from an argument which is a symbol with position. (hash_lookup): No longer strip a position from a symbol with position. (sxhash_obj): Add handling for symbols with position, substituting their bare symbols when symbols with position are enabled. --- lisp/emacs-lisp/bytecomp.el | 28 +++++++++------------------- 1 file changed, 9 insertions(+), 19 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ff372151e1b..c59bb292f8f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2610,15 +2610,9 @@ list that represents a doc string reference. nil (byte-compile-docstring-length-warn form) (setq form (copy-sequence form)) - (cond ((consp (nth 2 form)) - (setcar (cdr (cdr form)) - (byte-compile-top-level (nth 2 form) nil 'file))) - ((symbolp (nth 2 form)) - (setcar (cddr form) (bare-symbol (nth 2 form)))) - (t (setcar (cddr form) (nth 2 form)))) - (setcar form (bare-symbol (car form))) - (if (symbolp (nth 1 form)) - (setcar (cdr form) (bare-symbol (nth 1 form)))) + (when (consp (nth 2 form)) + (setcar (cdr (cdr form)) + (byte-compile-top-level (nth 2 form) nil 'file))) form)) (put 'define-abbrev-table 'byte-hunk-handler @@ -3034,7 +3028,8 @@ lambda-expression." (byte-compile-docstring-length-warn fun) (byte-compile-check-lambda-list (nth 1 fun)) (let* ((arglist (nth 1 fun)) - (arglistvars (byte-compile-arglist-vars arglist)) + (arglistvars (byte-run-strip-symbol-positions + (byte-compile-arglist-vars arglist))) (byte-compile-bound-variables (append (if (not lexical-binding) arglistvars) byte-compile-bound-variables)) @@ -3337,12 +3332,10 @@ lambda-expression." (cond ((not (consp form)) (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form)) - (byte-compile-constant - (if (symbolp form) (bare-symbol form) form))) + (byte-compile-constant form)) ((and byte-compile--for-effect byte-compile-delete-errors) (setq byte-compile--for-effect nil)) - (t - (byte-compile-variable-ref (bare-symbol form))))) + (t (byte-compile-variable-ref form)))) ((symbolp (car form)) (let* ((fn (car form)) (handler (get fn 'byte-compile)) @@ -3572,7 +3565,6 @@ lambda-expression." (byte-compile-warn-obsolete var)))) (defsubst byte-compile-dynamic-variable-op (base-op var) - (if (symbolp var) (setq var (bare-symbol var))) (let ((tmp (assq var byte-compile-variables))) (unless tmp (setq tmp (list var)) @@ -3646,14 +3638,11 @@ assignment (i.e. `setq')." (defun byte-compile-constant (const) (if byte-compile--for-effect (setq byte-compile--for-effect nil) - (inline (byte-compile-push-constant - (if (symbolp const) (bare-symbol const) const))))) + (inline (byte-compile-push-constant const)))) ;; Use this for a constant that is not the value of its containing form. ;; This ignores byte-compile--for-effect. (defun byte-compile-push-constant (const) - (when (symbolp const) - (setq const (bare-symbol const))) (byte-compile-out 'byte-constant (byte-compile-get-constant const))) @@ -5120,6 +5109,7 @@ OP and OPERAND are as passed to `byte-compile-out'." (- 1 operand)))) (defun byte-compile-out (op &optional operand) + (setq operand (byte-run-strip-symbol-positions operand)) (push (cons op operand) byte-compile-output) (if (eq op 'byte-return) ;; This is actually an unnecessary case, because there should be no -- cgit v1.2.3 From 6092ee1c3ff503fbe8087e13b7eae2f904c4af3b Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 24 Feb 2022 17:30:39 +0000 Subject: Amend byte-run-strip-symbol-positions so that an unexec build builds This fixes bug #54098. * lisp/emacs-lisp/byte-run.el (byte-run--strip-list) (byte-run--strip-vector/record): New functions. These alter a list or vector/record structure only where a symbol with position gets replaced by a bare symbol. (byte-run-strip-symbol-positions): Reformulate to use the two new functions. (function-put): No longer strip positions from the second and third arguments. * lisp/emacs-lisp/bytecomp.el (byte-compile-out): Remove the senseless "stripping" of putative symbol positions from OPERAND, which is nil or a number. --- lisp/emacs-lisp/byte-run.el | 98 ++++++++++++++++++++++++++------------------- lisp/emacs-lisp/bytecomp.el | 3 +- 2 files changed, 57 insertions(+), 44 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index c542c550169..d7a2d8cecaf 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -37,53 +37,69 @@ the corresponding new element of the same type. The purpose of this is to detect circular structures.") -(defalias 'byte-run--strip-s-p-1 +(defalias 'byte-run--strip-list #'(lambda (arg) - "Strip all positions from symbols in ARG, modifying ARG. -Return the modified ARG." + "Strip the positions from symbols with position in the list ARG. +This is done by destructively modifying ARG. Return ARG." + (let ((a arg)) + (while + (and + (not (gethash a byte-run--ssp-seen)) + (progn + (puthash a t byte-run--ssp-seen) + (cond + ((symbol-with-pos-p (car a)) + (setcar a (bare-symbol (car a)))) + ((consp (car a)) + (byte-run--strip-list (car a))) + ((or (vectorp (car a)) (recordp (car a))) + (byte-run--strip-vector/record (car a)))) + (consp (cdr a)))) + (setq a (cdr a))) + (cond + ((symbol-with-pos-p (cdr a)) + (setcdr a (bare-symbol (cdr a)))) + ((or (vectorp (cdr a)) (recordp (cdr a))) + (byte-run--strip-vector/record (cdr a)))) + arg))) + +(defalias 'byte-run--strip-vector/record + #'(lambda (arg) + "Strip the positions from symbols with position in the vector/record ARG. +This is done by destructively modifying ARG. Return ARG." + (unless (gethash arg byte-run--ssp-seen) + (let ((len (length arg)) + (i 0) + elt) + (puthash arg t byte-run--ssp-seen) + (while (< i len) + (setq elt (aref arg i)) + (cond + ((symbol-with-pos-p elt) + (aset arg i elt)) + ((consp elt) + (byte-run--strip-list elt)) + ((or (vectorp elt) (recordp elt)) + (byte-run--strip-vector/record elt)))))) + arg)) + +(defalias 'byte-run-strip-symbol-positions + #'(lambda (arg) + "Strip all positions from symbols in ARG. +This modifies destructively then returns ARG. + +ARG is any Lisp object, but is usually a list or a vector or a +record, containing symbols with position." + (setq byte-run--ssp-seen (make-hash-table :test 'eq)) (cond ((symbol-with-pos-p arg) (bare-symbol arg)) - ((consp arg) - (let* ((hash (gethash arg byte-run--ssp-seen))) - (if hash ; Already processed this node. - arg - (let ((a arg) new) - (while - (progn - (puthash a t byte-run--ssp-seen) - (setq new (byte-run--strip-s-p-1 (car a))) - (setcar a new) - (and (consp (cdr a)) - (not - (setq hash (gethash (cdr a) byte-run--ssp-seen))))) - (setq a (cdr a))) - (setq new (byte-run--strip-s-p-1 (cdr a))) - (setcdr a new) - arg)))) - + (byte-run--strip-list arg)) ((or (vectorp arg) (recordp arg)) - (let ((hash (gethash arg byte-run--ssp-seen))) - (if hash - arg - (let* ((len (length arg)) - (i 0) - new) - (puthash arg t byte-run--ssp-seen) - (while (< i len) - (setq new (byte-run--strip-s-p-1 (aref arg i))) - (aset arg i new) - (setq i (1+ i))) - arg)))) - + (byte-run--strip-vector/record arg)) (t arg)))) -(defalias 'byte-run-strip-symbol-positions - #'(lambda (arg) - (setq byte-run--ssp-seen (make-hash-table :test 'eq)) - (byte-run--strip-s-p-1 arg))) - (defalias 'function-put ;; We don't want people to just use `put' because we can't conveniently ;; hook into `put' to remap old properties to new ones. But for now, there's @@ -92,9 +108,7 @@ Return the modified ARG." "Set FUNCTION's property PROP to VALUE. The namespace for PROP is shared with symbols. So far, FUNCTION can only be a symbol, not a lambda expression." - (put (bare-symbol function) - (byte-run-strip-symbol-positions prop) - (byte-run-strip-symbol-positions value)))) + (put (bare-symbol function) prop value))) (function-put 'defmacro 'doc-string-elt 3) (function-put 'defmacro 'lisp-indent-function 2) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c59bb292f8f..6f83429dd4b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5099,7 +5099,7 @@ binding slots have been popped." OP and OPERAND are as passed to `byte-compile-out'." (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos)) ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1 - ;; elements, and the push the result, for a total of -OPERAND. + ;; elements, and then push the result, for a total of -OPERAND. ;; For discardN*, of course, we just pop OPERAND elements. (- operand) (or (aref byte-stack+-info (symbol-value op)) @@ -5109,7 +5109,6 @@ OP and OPERAND are as passed to `byte-compile-out'." (- 1 operand)))) (defun byte-compile-out (op &optional operand) - (setq operand (byte-run-strip-symbol-positions operand)) (push (cons op operand) byte-compile-output) (if (eq op 'byte-return) ;; This is actually an unnecessary case, because there should be no -- cgit v1.2.3 From cb0aad2dbec3a26e49fd18c732dc943c4aec0ccb Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 28 Feb 2022 12:13:52 +0100 Subject: Clean up byte-compile-arglist-warn * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn): Remove unnecessary sort (only need min and max). Reduce mutation. --- lisp/emacs-lisp/bytecomp.el | 51 ++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 26 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6f83429dd4b..432fd2ad9c5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1583,32 +1583,31 @@ extra args." ;; number of arguments. (defun byte-compile-arglist-warn (name arglist macrop) ;; This is the first definition. See if previous calls are compatible. - (let ((calls (assq name byte-compile-unresolved-functions)) - nums sig min max) - (when (and calls macrop) - (byte-compile-warn-x name "macro `%s' defined too late" name)) - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions)) - (setq calls (delq t calls)) ;Ignore higher-order uses of the function. - (when (cddr calls) - (when (and (symbolp name) - (eq (function-get name 'byte-optimizer) - 'byte-compile-inline-expand)) - (byte-compile-warn-x name "defsubst `%s' was used before it was defined" - name)) - (setq sig (byte-compile-arglist-signature arglist) - nums (sort (copy-sequence (cddr calls)) (function <)) - min (car nums) - max (car (nreverse nums))) - (when (or (< min (car sig)) - (and (cdr sig) (> max (cdr sig)))) - (byte-compile-warn-x - name - "%s being defined to take %s%s, but was previously called with %s" - name - (byte-compile-arglist-signature-string sig) - (if (equal sig '(1 . 1)) " arg" " args") - (byte-compile-arglist-signature-string (cons min max)))))) + (let ((calls (assq name byte-compile-unresolved-functions))) + (when calls + (when macrop + (byte-compile-warn-x name "macro `%s' defined too late" name)) + (setq byte-compile-unresolved-functions + (delq calls byte-compile-unresolved-functions)) + (let ((nums (delq t (cddr calls)))) ; Ignore higher-order uses. + (when nums + (when (and (symbolp name) + (eq (function-get name 'byte-optimizer) + 'byte-compile-inline-expand)) + (byte-compile-warn-x + name "defsubst `%s' was used before it was defined" name)) + (let ((sig (byte-compile-arglist-signature arglist)) + (min (apply #'min nums)) + (max (apply #'max nums))) + (when (or (< min (car sig)) + (and (cdr sig) (> max (cdr sig)))) + (byte-compile-warn-x + name + "%s being defined to take %s%s, but was previously called with %s" + name + (byte-compile-arglist-signature-string sig) + (if (equal sig '(1 . 1)) " arg" " args") + (byte-compile-arglist-signature-string (cons min max))))))))) (let* ((old (byte-compile-fdefinition name macrop)) (initial (and macrop (cdr (assq name -- cgit v1.2.3 From 68cdb95019a24024e6000ae75de6aa974d9b4a23 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 6 Mar 2022 13:37:30 +0000 Subject: Restore call to byte-run-strip-symbol-positions in byte-compile-out Also increment a loop counter. This should fix bug #54248. * lisp/emacs-lisp/byte-run.el (byte-run--strip-vector/record): increment the loop counter 'i' in the main loop. * lisp/emacs-lisp/bytecomp.el (byte-compile-out): call byte-run-strip-symbol-positions on operands which are one-element lists. --- lisp/emacs-lisp/byte-run.el | 3 ++- lisp/emacs-lisp/bytecomp.el | 5 +++++ 2 files changed, 7 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index d7a2d8cecaf..384e8cba88f 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -80,7 +80,8 @@ This is done by destructively modifying ARG. Return ARG." ((consp elt) (byte-run--strip-list elt)) ((or (vectorp elt) (recordp elt)) - (byte-run--strip-vector/record elt)))))) + (byte-run--strip-vector/record elt))) + (setq i (1+ i))))) arg)) (defalias 'byte-run-strip-symbol-positions diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 432fd2ad9c5..9be44a8d5af 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5108,6 +5108,11 @@ OP and OPERAND are as passed to `byte-compile-out'." (- 1 operand)))) (defun byte-compile-out (op &optional operand) + "Push the operation onto `byte-compile-output'. +OP is an opcode, a symbol. OPERAND is either nil or a number or +a one-element list of a lisp form." + (when (and (consp operand) (null (cdr operand))) + (setq operand (byte-run-strip-symbol-positions operand))) (push (cons op operand) byte-compile-output) (if (eq op 'byte-return) ;; This is actually an unnecessary case, because there should be no -- cgit v1.2.3 From 31a2428d6f2ca792af18b43ceca5cec1ecce862f Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 16 Mar 2022 19:23:24 +0000 Subject: Strip positions from symbols before the eval in eval-{when,and}-compile. This fixes bug #54079. * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Change the position of 'byte-run-strip-symbol-positions' in the eval-when-compile entry. Add a call to `byte-run-strip-symbol-positions' in the eval-and-compile entry. --- lisp/emacs-lisp/bytecomp.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 9be44a8d5af..c680437f324 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -500,8 +500,9 @@ Return the compile-time value of FORM." byte-compile-new-defuns)) (setf result (byte-compile-eval + (byte-run-strip-symbol-positions (byte-compile-top-level - (byte-compile-preprocess form))))))) + (byte-compile-preprocess form)))))))) (list 'quote result)))) (eval-and-compile . ,(lambda (&rest body) (byte-compile-recurse-toplevel @@ -512,9 +513,10 @@ Return the compile-time value of FORM." ;; or byte-compile-file-form. (let* ((print-symbols-bare t) ; Possibly redundant binding. (expanded - (macroexpand--all-toplevel - form - macroexpand-all-environment))) + (byte-run-strip-symbol-positions + (macroexpand--all-toplevel + form + macroexpand-all-environment)))) (eval expanded lexical-binding) expanded))))) (with-suppressed-warnings -- cgit v1.2.3 From ab8a34ce8a54539cc9f66892145153312fa2a7fa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Mar 2022 16:07:42 -0400 Subject: * lisp/emacs-lisp/bytecomp.el (byte-compile-make-closure): Minor optimization --- lisp/emacs-lisp/bytecomp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c680437f324..c39d931517e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3924,7 +3924,7 @@ discarding." docstring-exp)) ;Otherwise, we don't need a closure. (cl-assert (byte-code-function-p fun)) (byte-compile-form - (if (or (not docstring-exp) (stringp docstring-exp)) + (if (macroexp-const-p docstring-exp) ;; Use symbols V0, V1 ... as placeholders for closure variables: ;; they should be short (to save space in the .elc file), yet ;; distinct when disassembled. @@ -3940,7 +3940,7 @@ discarding." (vconcat dummy-vars (aref fun 2)) (aref fun 3) (if docstring-exp - (cons docstring-exp (cdr opt-args)) + (cons (eval docstring-exp t) (cdr opt-args)) opt-args)))) `(make-closure ,proto-fun ,@env)) ;; Nontrivial doc string expression: create a bytecode object -- cgit v1.2.3 From 2b6a1c98dfba09d6922f1074047853366d26e31e Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 18 Apr 2022 10:19:54 +0000 Subject: Byte compiler: remove symbol positions from byte-switch tables This fixes bug #54990. * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Remove positions from symbols with positions in byte-switch tables, by temporarily removing the entries from the table, and reinserting them amended. --- lisp/emacs-lisp/bytecomp.el | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c39d931517e..43648fa657b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1009,13 +1009,22 @@ CONST2 may be evaluated multiple times." ;; Similarly, replace TAGs in all jump tables with the correct PC index. (dolist (hash-table byte-compile-jump-tables) - (maphash #'(lambda (value tag) - (setq pc (cadr tag)) - ;; We don't need to split PC here, as it is stored as a lisp - ;; object in the hash table (whereas other goto-* ops store - ;; it within 2 bytes in the byte string). - (puthash value pc hash-table)) - hash-table)) + (let (alist) + (maphash #'(lambda (value tag) + (setq pc (cadr tag)) + ;; We don't need to split PC here, as it is stored as a + ;; lisp object in the hash table (whereas other goto-* + ;; ops store it within 2 bytes in the byte string). + ;; De-position any symbols with position in `value'. + ;; Since this may change the hash table key, we remove + ;; the entry from the table and reinsert it outside the + ;; scope of the `maphash'. + (setq value (byte-run-strip-symbol-positions value)) + (push (cons value pc) alist) + (remhash value hash-table)) + hash-table) + (dolist (elt alist) + (puthash (car elt) (cdr elt) hash-table)))) (let ((bytecode (apply 'unibyte-string (nreverse bytes)))) (when byte-native-compiling ;; Spill LAP for the native compiler here. -- cgit v1.2.3 From 850074636e73509b09c28e965c1af054a84f4069 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 18 Apr 2022 15:16:54 +0000 Subject: Byte compiler: correct output warning message positions Correct the algorithm for determining the warning position to get the first symbol-with-position in byte-compile--form-stack. * lisp/emacs-lisp/bytecomp.el (byte-compile--first-symbol-with-pos): Function renamed and amended from byte-compile--first-symbol. (byte-compile--warning-source-offset): Call the new function above rather than the old one. --- lisp/emacs-lisp/bytecomp.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 43648fa657b..8128410916a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1173,16 +1173,16 @@ message buffer `default-directory'." (f2 (file-relative-name file dir))) (if (< (length f2) (length f1)) f2 f1))) -(defun byte-compile--first-symbol (form) - "Return the \"first\" symbol found in form, or 0 if there is none. +(defun byte-compile--first-symbol-with-pos (form) + "Return the \"first\" symbol with position found in form, or 0 if none. Here, \"first\" is by a depth first search." (let (sym) (cond - ((symbolp form) form) + ((symbol-with-pos-p form) form) ((consp form) - (or (and (symbolp (setq sym (byte-compile--first-symbol (car form)))) + (or (and (symbol-with-pos-p (setq sym (byte-compile--first-symbol-with-pos (car form)))) sym) - (and (symbolp (setq sym (byte-compile--first-symbol (cdr form)))) + (and (symbolp (setq sym (byte-compile--first-symbol-with-pos (cdr form)))) sym) 0)) ((and (vectorp form) @@ -1193,7 +1193,7 @@ Here, \"first\" is by a depth first search." (catch 'sym (while (< i len) (when (symbolp - (setq elt (byte-compile--first-symbol (aref form i)))) + (setq elt (byte-compile--first-symbol-with-pos (aref form i)))) (throw 'sym elt)) (setq i (1+ i))) 0))) @@ -1204,7 +1204,7 @@ Here, \"first\" is by a depth first search." Return nil if such is not found." (catch 'offset (dolist (form byte-compile-form-stack) - (let ((s (byte-compile--first-symbol form))) + (let ((s (byte-compile--first-symbol-with-pos form))) (if (symbol-with-pos-p s) (throw 'offset (symbol-with-pos-pos s))))))) -- cgit v1.2.3 From 5b23c9942ae057c886e68edb8c4bf09bf7e8eda9 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Fri, 22 Apr 2022 17:16:21 +0000 Subject: Byte compiler: correct output warning message positions (part 2) A supplementary commit to that on 2022-04-18: * lisp/emacs-lisp/bytecomp.el (byte-compile--first-symbol-with-pos): Handle vectors and records correctly. * lisp/emacs-lisp/byte-run.el (byte-run--ssp-seen): Correct the doc string. --- lisp/emacs-lisp/byte-run.el | 3 +-- lisp/emacs-lisp/bytecomp.el | 4 ++-- 2 files changed, 3 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 384e8cba88f..0113051c8eb 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -32,8 +32,7 @@ (defvar byte-run--ssp-seen nil "Which conses/vectors/records have been processed in strip-symbol-positions? -The value is a hash table, the key being the old element and the value being -the corresponding new element of the same type. +The value is a hash table, the keys being the elements and the values being t. The purpose of this is to detect circular structures.") diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 8128410916a..f97324f3a8f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1185,14 +1185,14 @@ Here, \"first\" is by a depth first search." (and (symbolp (setq sym (byte-compile--first-symbol-with-pos (cdr form)))) sym) 0)) - ((and (vectorp form) + ((and (or (vectorp form) (recordp form)) (> (length form) 0)) (let ((i 0) (len (length form)) elt) (catch 'sym (while (< i len) - (when (symbolp + (when (symbol-with-pos-p (setq elt (byte-compile--first-symbol-with-pos (aref form i)))) (throw 'sym elt)) (setq i (1+ i))) -- cgit v1.2.3 From 0b9b363dabd70032a288e14333896022caa2d252 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Fri, 22 Apr 2022 19:11:31 +0000 Subject: Byte compiler: Prevent special forms' symbols being replaced by bare symbols These are symbols with position from source code, which should not be replaced by bare symbols in, e.g., optimization functions. * lisp/Makefile.in: (BYTE_COMPILE_FLAGS, compile-first case): Set max-specpdl-size to 5000 for the benefit of lisp/emacs-lisp/comp.el. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker) (byte-optimize--rename-var, byte-optimize-if, byte-optimize-letX) * lisp/emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel) (byte-compile-lambda) * lisp/emacs-lisp/cconv.el (cconv-convert) * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Preserve, e.g., (car form) in the byte compiler, when this form's car is a symbol with position of a special form, rather than replacing the symbol with a bare symbol, e.g. 'cond. --- lisp/Makefile.in | 4 +- lisp/emacs-lisp/byte-opt.el | 115 ++++++++++++------------- lisp/emacs-lisp/bytecomp.el | 4 +- lisp/emacs-lisp/cconv.el | 22 ++--- lisp/emacs-lisp/macroexp.el | 203 ++++++++++++++++++++++---------------------- 5 files changed, 176 insertions(+), 172 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 308407a8bf1..fabf6ed55e1 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -78,7 +78,9 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \ BYTE_COMPILE_FLAGS = \ --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS) # ... but we must prefer .elc files for those in the early bootstrap. -compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS) +# A larger `max-specpdl-size' is needed for emacs-lisp/comp.el. +compile-first: BYTE_COMPILE_FLAGS = \ + --eval '(setq max-specpdl-size 5000)' $(BYTE_COMPILE_EXTRA_FLAGS) # Files to compile before others during a bootstrap. This is done to # speed up the bootstrap process. They're ordered by size, so we use diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 39bb6224595..d3d8405d068 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -338,7 +338,7 @@ for speeding up processing.") (let ((exps-opt (byte-optimize-body exps t))) (if (macroexp-const-p exp-opt) `(progn ,@exps-opt ,exp-opt) - `(prog1 ,exp-opt ,@exps-opt))) + `(,fn ,exp-opt ,@exps-opt))) exp-opt))) (`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps) @@ -358,7 +358,7 @@ for speeding up processing.") (then-opt (and test-opt (byte-optimize-form then for-effect))) (else-opt (and (not (and test-opt const)) (byte-optimize-body else for-effect)))) - `(if ,test-opt ,then-opt . ,else-opt))) + `(,fn ,test-opt ,then-opt . ,else-opt))) (`(,(or 'and 'or) . ,exps) ;; FIXME: We have to traverse the expressions in left-to-right @@ -397,7 +397,7 @@ for speeding up processing.") ;; as mutated variables have been marked as non-substitutable. (condition (byte-optimize-form (car condition-body) nil)) (body (byte-optimize-body (cdr condition-body) t))) - `(while ,condition . ,body))) + `(,fn ,condition . ,body))) (`(interactive . ,_) (byte-compile-warn-x form "misplaced interactive spec: `%s'" form) @@ -409,7 +409,7 @@ for speeding up processing.") form) (`(condition-case ,var ,exp . ,clauses) - `(condition-case ,var ;Not evaluated. + `(,fn ,var ;Not evaluated. ,(byte-optimize-form exp for-effect) ,@(mapcar (lambda (clause) (let ((byte-optimize--lexvars @@ -432,14 +432,14 @@ for speeding up processing.") (let ((bodyform (byte-optimize-form exp for-effect))) (pcase exps (`(:fun-body ,f) - `(unwind-protect ,bodyform + `(,fn ,bodyform :fun-body ,(byte-optimize-form f nil))) (_ - `(unwind-protect ,bodyform + `(,fn ,bodyform . ,(byte-optimize-body exps t)))))) (`(catch ,tag . ,exps) - `(catch ,(byte-optimize-form tag nil) + `(,fn ,(byte-optimize-form tag nil) . ,(byte-optimize-body exps for-effect))) ;; Needed as long as we run byte-optimize-form after cconv. @@ -495,7 +495,7 @@ for speeding up processing.") (cons (byte-optimize-form (car rest) nil) (cdr rest))))) (push name byte-optimize--dynamic-vars) - `(defvar ,name . ,optimized-rest))) + `(,fn ,name . ,optimized-rest))) (`(,(pred byte-code-function-p) . ,exps) (cons fn (mapcar #'byte-optimize-form exps))) @@ -561,49 +561,50 @@ for speeding up processing.") (defun byte-optimize--rename-var (var new-var form) "Replace VAR with NEW-VAR in FORM." - (pcase form - ((pred symbolp) (if (eq form var) new-var form)) - (`(setq . ,args) - (let ((new-args nil)) - (while args - (push (byte-optimize--rename-var var new-var (car args)) new-args) - (push (byte-optimize--rename-var var new-var (cadr args)) new-args) - (setq args (cddr args))) - `(setq . ,(nreverse new-args)))) - ;; In binding constructs like `let', `let*' and `condition-case' we - ;; rename everything for simplicity, even new bindings named VAR. - (`(,(and head (or 'let 'let*)) ,bindings . ,body) - `(,head - ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b)) - bindings) - ,@(byte-optimize--rename-var-body var new-var body))) - (`(condition-case ,res-var ,protected-form . ,handlers) - `(condition-case ,(byte-optimize--rename-var var new-var res-var) - ,(byte-optimize--rename-var var new-var protected-form) - ,@(mapcar (lambda (h) - (cons (car h) - (byte-optimize--rename-var-body var new-var (cdr h)))) - handlers))) - (`(internal-make-closure ,vars ,env . ,rest) - `(internal-make-closure - ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest)) - (`(defvar ,name . ,rest) - ;; NAME is not renamed here; we only care about lexical variables. - `(defvar ,name . ,(byte-optimize--rename-var-body var new-var rest))) - - (`(cond . ,clauses) - `(cond ,@(mapcar (lambda (c) - (byte-optimize--rename-var-body var new-var c)) - clauses))) - - (`(function . ,_) form) - (`(quote . ,_) form) - (`(lambda . ,_) form) - - ;; Function calls and special forms not handled above. - (`(,head . ,args) - `(,head . ,(byte-optimize--rename-var-body var new-var args))) - (_ form))) + (let ((fn (car-safe form))) + (pcase form + ((pred symbolp) (if (eq form var) new-var form)) + (`(setq . ,args) + (let ((new-args nil)) + (while args + (push (byte-optimize--rename-var var new-var (car args)) new-args) + (push (byte-optimize--rename-var var new-var (cadr args)) new-args) + (setq args (cddr args))) + `(,fn . ,(nreverse new-args)))) + ;; In binding constructs like `let', `let*' and `condition-case' we + ;; rename everything for simplicity, even new bindings named VAR. + (`(,(and head (or 'let 'let*)) ,bindings . ,body) + `(,head + ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b)) + bindings) + ,@(byte-optimize--rename-var-body var new-var body))) + (`(condition-case ,res-var ,protected-form . ,handlers) + `(,fn ,(byte-optimize--rename-var var new-var res-var) + ,(byte-optimize--rename-var var new-var protected-form) + ,@(mapcar (lambda (h) + (cons (car h) + (byte-optimize--rename-var-body var new-var (cdr h)))) + handlers))) + (`(internal-make-closure ,vars ,env . ,rest) + `(,fn + ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest)) + (`(defvar ,name . ,rest) + ;; NAME is not renamed here; we only care about lexical variables. + `(,fn ,name . ,(byte-optimize--rename-var-body var new-var rest))) + + (`(cond . ,clauses) + `(,fn ,@(mapcar (lambda (c) + (byte-optimize--rename-var-body var new-var c)) + clauses))) + + (`(function . ,_) form) + (`(quote . ,_) form) + (`(lambda . ,_) form) + + ;; Function calls and special forms not handled above. + (`(,head . ,args) + `(,head . ,(byte-optimize--rename-var-body var new-var args))) + (_ form)))) (defun byte-optimize-let-form (head form for-effect) ;; Recursively enter the optimizer for the bindings and body @@ -1174,21 +1175,21 @@ See Info node `(elisp) Integer Basics'." (proper-list-p clause)) (if (null (cddr clause)) ;; A trivial `progn'. - (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form))) + (byte-optimize-if `(,(car form) ,(cadr clause) ,@(nthcdr 2 form))) (nconc (butlast clause) (list (byte-optimize-if - `(if ,(car (last clause)) ,@(nthcdr 2 form))))))) + `(,(car form) ,(car (last clause)) ,@(nthcdr 2 form))))))) ((byte-compile-trueconstp clause) `(progn ,clause ,(nth 2 form))) ((byte-compile-nilconstp clause) `(progn ,clause ,@(nthcdr 3 form))) ((nth 2 form) (if (equal '(nil) (nthcdr 3 form)) - (list 'if clause (nth 2 form)) + (list (car form) clause (nth 2 form)) form)) ((or (nth 3 form) (nthcdr 4 form)) - (list 'if + (list (car form) ;; Don't make a double negative; ;; instead, take away the one that is there. (if (and (consp clause) (memq (car clause) '(not null)) @@ -1267,7 +1268,7 @@ See Info node `(elisp) Integer Basics'." (and (consp binding) (cadr binding))) bindings) ,const) - `(let* ,(butlast bindings) + `(,head ,(butlast bindings) ,@(and (consp (car (last bindings))) (cdar (last bindings))) ,const))) @@ -1282,7 +1283,7 @@ See Info node `(elisp) Integer Basics'." `(progn ,@(mapcar (lambda (binding) (and (consp binding) (cadr binding))) bindings)) - `(let* ,(butlast bindings) + `(,head ,(butlast bindings) ,@(and (consp (car (last bindings))) (cdar (last bindings)))))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f97324f3a8f..28237d67d29 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -471,7 +471,7 @@ Return the compile-time value of FORM." (let ((print-symbols-bare t)) ; Possibly redundant binding. (setf form (macroexp-macroexpand form byte-compile-macro-environment))) (if (eq (car-safe form) 'progn) - (cons 'progn + (cons (car form) (mapcar (lambda (subform) (byte-compile-recurse-toplevel subform non-toplevel-case)) @@ -3084,7 +3084,7 @@ lambda-expression." ;; which may include "calls" to ;; internal-make-closure (Bug#29988). lexical-binding) - (setq int `(interactive ,newform))))) + (setq int `(,(car int) ,newform))))) ((cdr int) ; Invalid (interactive . something). (byte-compile-warn-x int "malformed interactive spec: %s" int)))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index be4fea7be14..4535f1aa6eb 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -500,11 +500,11 @@ places where they originally did not directly appear." args))) (`(cond . ,cond-forms) ; cond special form - `(cond . ,(mapcar (lambda (branch) - (mapcar (lambda (form) - (cconv-convert form env extend)) - branch)) - cond-forms))) + `(,(car form) . ,(mapcar (lambda (branch) + (mapcar (lambda (form) + (cconv-convert form env extend)) + branch)) + cond-forms))) (`(function (lambda ,args . ,body) . ,_) (let ((docstring (if (eq :documentation (car-safe (car body))) @@ -538,7 +538,7 @@ places where they originally did not directly appear." (msg (when (eq class :unused) (cconv--warn-unused-msg var "variable"))) (newprotform (cconv-convert protected-form env extend))) - `(condition-case ,var + `(,(car form) ,var ,(if msg (macroexp--warn-wrap var msg newprotform 'lexical) newprotform) @@ -554,9 +554,9 @@ places where they originally did not directly appear." `((let ((,var (list ,var))) ,@body)))))) handlers)))) - (`(unwind-protect ,form . ,body) - `(unwind-protect ,(cconv-convert form env extend) - :fun-body ,(cconv--convert-function () body env form))) + (`(unwind-protect ,form1 . ,body) + `(,(car form) ,(cconv-convert form1 env extend) + :fun-body ,(cconv--convert-function () body env form1))) (`(setq . ,forms) ; setq special form (if (= (logand (length forms) 1) 1) @@ -568,7 +568,7 @@ places where they originally did not directly appear." (sym-new (or (cdr (assq sym env)) sym)) (value (cconv-convert (pop forms) env extend))) (push (pcase sym-new - ((pred symbolp) `(setq ,sym-new ,value)) + ((pred symbolp) `(,(car form) ,sym-new ,value)) (`(car-safe ,iexp) `(setcar ,iexp ,value)) ;; This "should never happen", but for variables which are ;; mutated+captured+unused, we may end up trying to `setq' @@ -604,7 +604,7 @@ places where they originally did not directly appear." (cons fun args))))))) (`(interactive . ,forms) - `(interactive . ,(mapcar (lambda (form) + `(,(car form) . ,(mapcar (lambda (form) (cconv-convert form nil nil)) forms))) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e4bc2df2803..51c6e8e0ca2 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -330,108 +330,109 @@ Assumes the caller has bound `macroexpand-all-environment'." (setq form (macroexp-macroexpand form macroexpand-all-environment)) ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when ;; I tried it, it broke the bootstrap :-( - (pcase form - (`(cond . ,clauses) - (macroexp--cons 'cond (macroexp--all-clauses clauses) form)) - (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare)) - (macroexp--cons - 'condition-case - (macroexp--cons err - (macroexp--cons (macroexp--expand-all body) - (macroexp--all-clauses handlers 1) - (cddr form)) - (cdr form)) - form)) - (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_) - (push name macroexp--dynvars) - (macroexp--all-forms form 2)) - (`(function ,(and f `(lambda . ,_))) - (let ((macroexp--dynvars macroexp--dynvars)) - (macroexp--cons 'function - (macroexp--cons (macroexp--all-forms f 2) - nil - (cdr form)) - form))) - (`(,(or 'function 'quote) . ,_) form) - (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) - pcase--dontcare)) - (let ((macroexp--dynvars macroexp--dynvars)) + (let ((fn (car-safe form))) + (pcase form + (`(cond . ,clauses) + (macroexp--cons fn (macroexp--all-clauses clauses) form)) + (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare)) (macroexp--cons - fun - (macroexp--cons - (macroexp--all-clauses bindings 1) - (if (null body) - (macroexp-unprogn - (macroexp-warn-and-return - (format "Empty %s body" fun) - nil nil 'compile-only fun)) - (macroexp--all-forms body)) - (cdr form)) - form))) - (`(,(and fun `(lambda . ,_)) . ,args) - ;; Embedded lambda in function position. - ;; If the byte-optimizer is loaded, try to unfold this, - ;; i.e. rewrite it to (let () ). We'd do it in the optimizer - ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the - ;; creation of a closure, thus resulting in much better code. - (let ((newform (macroexp--unfold-lambda form))) - (if (eq newform form) - ;; Unfolding failed for some reason, avoid infinite recursion. - (macroexp--cons (macroexp--all-forms fun 2) - (macroexp--all-forms args) - form) - (macroexp--expand-all newform)))) - (`(funcall ,exp . ,args) - (let ((eexp (macroexp--expand-all exp)) - (eargs (macroexp--all-forms args))) - ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' - ;; has a compiler-macro, or to unfold it. - (pcase eexp - ((and `#',f - (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636 - (macroexp--expand-all `(,f . ,eargs))) - (_ `(funcall ,eexp . ,eargs))))) - (`(funcall . ,_) form) ;bug#53227 - (`(,func . ,_) - (let ((handler (function-get func 'compiler-macro)) - (funargs (function-get func 'funarg-positions))) - ;; Check functions quoted with ' rather than with #' - (dolist (funarg funargs) - (let ((arg (nth funarg form))) - (when (and (eq 'quote (car-safe arg)) - (eq 'lambda (car-safe (cadr arg)))) - (setcar (nthcdr funarg form) - (macroexp-warn-and-return - (format "%S quoted with ' rather than with #'" - (let ((f (cadr arg))) - (if (symbolp f) f `(lambda ,(nth 1 f) ...)))) - arg nil nil (cadr arg)))))) - ;; Macro expand compiler macros. This cannot be delayed to - ;; byte-optimize-form because the output of the compiler-macro can - ;; use macros. - (if (null handler) - ;; No compiler macro. We just expand each argument (for - ;; setq/setq-default this works alright because the variable names - ;; are symbols). - (macroexp--all-forms form 1) - ;; If the handler is not loaded yet, try (auto)loading the - ;; function itself, which may in turn load the handler. - (unless (functionp handler) - (with-demoted-errors "macroexp--expand-all: %S" - (autoload-do-load (indirect-function func) func))) - (let ((newform (macroexp--compiler-macro handler form))) - (if (eq form newform) - ;; The compiler macro did not find anything to do. - (if (equal form (setq newform (macroexp--all-forms form 1))) - form - ;; Maybe after processing the args, some new opportunities - ;; appeared, so let's try the compiler macro again. - (setq form (macroexp--compiler-macro handler newform)) - (if (eq newform form) - newform - (macroexp--expand-all newform))) - (macroexp--expand-all newform)))))) - (_ form))) + fn + (macroexp--cons err + (macroexp--cons (macroexp--expand-all body) + (macroexp--all-clauses handlers 1) + (cddr form)) + (cdr form)) + form)) + (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_) + (push name macroexp--dynvars) + (macroexp--all-forms form 2)) + (`(function ,(and f `(lambda . ,_))) + (let ((macroexp--dynvars macroexp--dynvars)) + (macroexp--cons fn + (macroexp--cons (macroexp--all-forms f 2) + nil + (cdr form)) + form))) + (`(,(or 'function 'quote) . ,_) form) + (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) + pcase--dontcare)) + (let ((macroexp--dynvars macroexp--dynvars)) + (macroexp--cons + fun + (macroexp--cons + (macroexp--all-clauses bindings 1) + (if (null body) + (macroexp-unprogn + (macroexp-warn-and-return + (format "Empty %s body" fun) + nil nil 'compile-only fun)) + (macroexp--all-forms body)) + (cdr form)) + form))) + (`(,(and fun `(lambda . ,_)) . ,args) + ;; Embedded lambda in function position. + ;; If the byte-optimizer is loaded, try to unfold this, + ;; i.e. rewrite it to (let () ). We'd do it in the optimizer + ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the + ;; creation of a closure, thus resulting in much better code. + (let ((newform (macroexp--unfold-lambda form))) + (if (eq newform form) + ;; Unfolding failed for some reason, avoid infinite recursion. + (macroexp--cons (macroexp--all-forms fun 2) + (macroexp--all-forms args) + form) + (macroexp--expand-all newform)))) + (`(funcall ,exp . ,args) + (let ((eexp (macroexp--expand-all exp)) + (eargs (macroexp--all-forms args))) + ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' + ;; has a compiler-macro, or to unfold it. + (pcase eexp + ((and `#',f + (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636 + (macroexp--expand-all `(,f . ,eargs))) + (_ `(funcall ,eexp . ,eargs))))) + (`(funcall . ,_) form) ;bug#53227 + (`(,func . ,_) + (let ((handler (function-get func 'compiler-macro)) + (funargs (function-get func 'funarg-positions))) + ;; Check functions quoted with ' rather than with #' + (dolist (funarg funargs) + (let ((arg (nth funarg form))) + (when (and (eq 'quote (car-safe arg)) + (eq 'lambda (car-safe (cadr arg)))) + (setcar (nthcdr funarg form) + (macroexp-warn-and-return + (format "%S quoted with ' rather than with #'" + (let ((f (cadr arg))) + (if (symbolp f) f `(lambda ,(nth 1 f) ...)))) + arg nil nil (cadr arg)))))) + ;; Macro expand compiler macros. This cannot be delayed to + ;; byte-optimize-form because the output of the compiler-macro can + ;; use macros. + (if (null handler) + ;; No compiler macro. We just expand each argument (for + ;; setq/setq-default this works alright because the variable names + ;; are symbols). + (macroexp--all-forms form 1) + ;; If the handler is not loaded yet, try (auto)loading the + ;; function itself, which may in turn load the handler. + (unless (functionp handler) + (with-demoted-errors "macroexp--expand-all: %S" + (autoload-do-load (indirect-function func) func))) + (let ((newform (macroexp--compiler-macro handler form))) + (if (eq form newform) + ;; The compiler macro did not find anything to do. + (if (equal form (setq newform (macroexp--all-forms form 1))) + form + ;; Maybe after processing the args, some new opportunities + ;; appeared, so let's try the compiler macro again. + (setq form (macroexp--compiler-macro handler newform)) + (if (eq newform form) + newform + (macroexp--expand-all newform))) + (macroexp--expand-all newform)))))) + (_ form)))) (pop byte-compile-form-stack))) ;; Record which arguments expect functions, so we can warn when those -- cgit v1.2.3 From 4dba7c31a225950198482fe1eb558aac7a36d964 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Apr 2022 17:31:13 -0400 Subject: Use `advice--cd*r` where applicable * lisp/emacs-lisp/bytecomp.el (byte-compile--function-signature): * lisp/emacs-lisp/advice.el (ad-get-orig-definition): * lisp/help.el (help-function-arglist): Use `advice--cd*r`. --- lisp/emacs-lisp/advice.el | 3 +-- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/help.el | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 8e43ae68072..86a42b208e7 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1814,8 +1814,7 @@ Redefining advices affect the construction of an advised definition." (if (symbolp function) (setq function (if (fboundp function) (advice--strip-macro (symbol-function function))))) - (while (advice--p function) (setq function (advice--cdr function))) - function) + (advice--cd*r function)) (defun ad-clear-advicefunname-definition (function) (let ((advicefunname (ad-get-advice-info-field function 'advicefunname))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 28237d67d29..c0dffe544cf 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1439,7 +1439,7 @@ when printing the error message." (and (eq 'macro (car-safe f)) (setq f (cdr f))) ;; Advice wrappers have "catch all" args, so fetch the actual underlying ;; function to find the real arguments. - (while (advice--p f) (setq f (advice--cdr f))) + (setq f (advice--cd*r f)) (if (eq (car-safe f) 'declared) (byte-compile-arglist-signature (nth 1 f)) (condition-case nil diff --git a/lisp/help.el b/lisp/help.el index c5de59d6bc7..2d08ceb86c7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2039,7 +2039,7 @@ the same names as used in the original source code, when possible." (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) ;; Advice wrappers have "catch all" args, so fetch the actual underlying ;; function to find the real arguments. - (while (advice--p def) (setq def (advice--cdr def))) + (setq def (advice--cd*r def)) ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) (cond -- cgit v1.2.3 From 231cf5ee2bed8a2b574ad424b624b36c0ee0733f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 11 May 2022 12:51:11 +0200 Subject: Warn about quoted symbols in defcustom choice/other forms * lisp/emacs-lisp/bytecomp.el (byte-compile--suspicious-defcustom-choice): New function (bug#16271). (byte-compile-nogroup-warn): Use it to warn about forms like (choice (const :tag "foo" 'bar)). --- etc/NEWS | 13 +++++++++++++ lisp/emacs-lisp/bytecomp.el | 32 ++++++++++++++++++++++++++++---- test/lisp/emacs-lisp/bytecomp-tests.el | 6 ++++++ 3 files changed, 47 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/etc/NEWS b/etc/NEWS index a0164bbf3f0..595e477e2f3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1767,6 +1767,19 @@ functions. * Lisp Changes in Emacs 29.1 +** Byte compilation + +--- +*** Byte compilation will now warn about some malformed 'defcustom' types. +It's very common to write 'defcustom' types on the form: + + :type '(choice (const :tag "foo" 'bar)) + +I.e., double-quoting the 'bar', which is almost never the correct +value. The byte compiler will now issue a warning if it encounters +these forms. + + +++ *** 'restore-buffer-modified-p' can now alter buffer auto-save state. With a FLAG value of 'autosaved', it will mark the buffer as having diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c0dffe544cf..cbf2659109a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1562,15 +1562,39 @@ extra args." (dolist (elt '(format message error)) (put elt 'byte-compile-format-like t)) +(defun byte-compile--suspicious-defcustom-choice (type) + "Say whether defcustom TYPE looks odd." + ;; Check whether there's anything like (choice (const :tag "foo" ;; 'bar)). + ;; We don't actually follow the syntax for defcustom types, but this + ;; should be good enough. + (catch 'found + (if (and (consp type) + (proper-list-p type)) + (if (memq (car type) '(const other)) + (when (assq 'quote type) + (throw 'found t)) + (when (memq t (mapcar #'byte-compile--suspicious-defcustom-choice + type)) + (throw 'found t))) + nil))) + ;; Warn if a custom definition fails to specify :group, or :type. (defun byte-compile-nogroup-warn (form) (let ((keyword-args (cdr (cdr (cdr (cdr form))))) (name (cadr form))) (when (eq (car-safe name) 'quote) - (or (not (eq (car form) 'custom-declare-variable)) - (plist-get keyword-args :type) - (byte-compile-warn-x (cadr name) - "defcustom for `%s' fails to specify type" (cadr name))) + (when (eq (car form) 'custom-declare-variable) + (let ((type (plist-get keyword-args :type))) + (cond + ((not type) + (byte-compile-warn-x (cadr name) + "defcustom for `%s' fails to specify type" + (cadr name))) + ((byte-compile--suspicious-defcustom-choice type) + (byte-compile-warn-x + (cadr name) + "defcustom for `%s' has syntactically odd type `%s'" + (cadr name) type))))) (if (and (memq (car form) '(custom-declare-face custom-declare-variable)) byte-compile-current-group) ;; The group will be provided implicitly. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index abd33ab8e5a..051e8b9e5c9 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1538,6 +1538,12 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (TEST-IN-COMMENTS t) (TEST-IN-STRINGS t) (TEST-IN-CODE t) \ (FIXTURE-FN \\='#\\='electric-pair-mode))" fill-column))) +(defun test-bytecomp-defgroup-choice () + (should-not (byte-compile--suspicious-defcustom-choice 'integer)) + (should-not (byte-compile--suspicious-defcustom-choice + '(choice (const :tag "foo" bar)))) + (should (byte-compile--suspicious-defcustom-choice + '(choice (const :tag "foo" 'bar))))) ;; Local Variables: ;; no-byte-compile: t -- cgit v1.2.3 From ed0b589480a1e0a20364e1349fa8fa957ecb1efc Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 11 May 2022 17:17:10 -0400 Subject: (byte-compile-eval): Avoid some false positive "noruntime" warnings * lisp/emacs-lisp/bytecomp.el (byte-compile-eval): Loosen the check before refraining from adding a function to noruntime. --- lisp/emacs-lisp/bytecomp.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cbf2659109a..1fef9b00d85 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1056,8 +1056,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (dolist (s xs) (pcase s (`(defun . ,f) - (unless (seq-some #'autoloadp - (get (cdr s) 'function-history)) + ;; If `f' has a history, it's presumably because + ;; it was already defined beforehand (typically + ;; as an autoload). It could also be because it + ;; was defined twice during `form', in which case + ;; we arguably should add it to b-c-noruntime-functions, + ;; but it's not clear it's worth the trouble + ;; trying to recognize that case. + (unless (get f 'function-history) (push f byte-compile-noruntime-functions))))))))))))) (defun byte-compile-eval-before-compile (form) -- cgit v1.2.3 From 7969e41654b2b5c628c290deb938699a95e85fec Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 18 May 2022 09:18:15 +0000 Subject: Fix M-x compile-defun when an interactive form is (list ...) This is for when lexical-binding is nil. The problem fixed was M-x compile-defun leaving symbols with position in the compiled function's arglist and interactive form. This fixes bug #55323. Also ensure the doc string is correctly stripped when lexical-binding is t. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): For a (list ...) interactive form when lexical-binding is nil, strip the positions from the symbols in the form. Also strip the position from the symbols in the arglist. (byte-compile-make-closure): (Twice) strip symbols from positions in the doc string expression. Add comments. --- lisp/emacs-lisp/bytecomp.el | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1fef9b00d85..e72b96af4a9 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3114,7 +3114,8 @@ lambda-expression." ;; which may include "calls" to ;; internal-make-closure (Bug#29988). lexical-binding) - (setq int `(,(car int) ,newform))))) + (setq int `(,(car int) ,newform)) + (setq int (byte-run-strip-symbol-positions int))))) ; for compile-defun. ((cdr int) ; Invalid (interactive . something). (byte-compile-warn-x int "malformed interactive spec: %s" int)))) @@ -3129,7 +3130,7 @@ lambda-expression." (byte-compile-make-lambda-lexenv arglistvars)) reserved-csts)) - (bare-arglist arglist)) + (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun. ;; Build the actual byte-coded function. (cl-assert (eq 'byte-code (car-safe compiled))) (let ((out @@ -3951,7 +3952,9 @@ discarding." (byte-defop-compiler-1 internal-get-closed-var byte-compile-get-closed-var) (defun byte-compile-make-closure (form) - "Byte-compile the special `internal-make-closure' form." + "Byte-compile the special `internal-make-closure' form. + +This function is never called when `lexical-binding' is nil." (if byte-compile--for-effect (setq byte-compile--for-effect nil) (let* ((vars (nth 1 form)) (env (nth 2 form)) @@ -3973,24 +3976,33 @@ discarding." (number-sequence 4 (1- (length fun))))) (proto-fun (apply #'make-byte-code - (aref fun 0) (aref fun 1) + (aref fun 0) ; The arglist is always the 15-bit + ; form, never the list of symbols. + (aref fun 1) ; The byte-code. ;; Prepend dummy cells to the constant vector, ;; to get the indices right when disassembling. (vconcat dummy-vars (aref fun 2)) - (aref fun 3) + (aref fun 3) ; Stack depth of function (if docstring-exp - (cons (eval docstring-exp t) (cdr opt-args)) + (cons + (eval (byte-run-strip-symbol-positions + docstring-exp) + t) + (cdr opt-args)) ; The interactive spec will + ; have been stripped in + ; `byte-compile-lambda'. opt-args)))) `(make-closure ,proto-fun ,@env)) ;; Nontrivial doc string expression: create a bytecode object ;; from small pieces at run time. `(make-byte-code - ',(aref fun 0) ',(aref fun 1) - (vconcat (vector . ,env) ',(aref fun 2)) + ',(aref fun 0) ; 15-bit form of arglist descriptor. + ',(aref fun 1) ; The byte-code. + (vconcat (vector . ,env) ',(aref fun 2)) ; constant vector. ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) (if docstring-exp `(,(car rest) - ,docstring-exp + ,(byte-run-strip-symbol-positions docstring-exp) ,@(cddr rest)) rest)))) )))) -- cgit v1.2.3 From a0524584e93a66278dcf7bb998398f7484f9e8b5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 22 May 2022 20:06:24 +0200 Subject: Allow suppressing messages about the wrong number of arguments * lisp/emacs-lisp/byte-run.el (with-suppressed-warnings): Add `wrong-args'. * lisp/emacs-lisp/bytecomp.el (byte-compile-emit-callargs-warn) (byte-compile-subr-wrong-args): Allow suppressing wrong number of arguments. --- lisp/emacs-lisp/byte-run.el | 2 +- lisp/emacs-lisp/bytecomp.el | 32 +++++++++++++++++--------------- 2 files changed, 18 insertions(+), 16 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 0113051c8eb..2d11f350f0b 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -637,7 +637,7 @@ The warnings that can be suppressed are a subset of the warnings in `byte-compile-warning-types'; see the variable `byte-compile-warnings' for a fuller explanation of the warning types. The types that can be suppressed with this macro are -`free-vars', `callargs', `redefine', `obsolete', +`free-vars', `callargs', `redefine', `obsolete', `wrong-args', `interactive-only', `lexical', `mapcar', `constants' and `suspicious'. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e72b96af4a9..920cdbe5a6f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1494,15 +1494,16 @@ when printing the error message." byte-compile-unresolved-functions))))) (defun byte-compile-emit-callargs-warn (name actual-args min-args max-args) - (byte-compile-warn-x - name - "%s called with %d argument%s, but %s %s" - name actual-args - (if (= 1 actual-args) "" "s") - (if (< actual-args min-args) - "requires" - "accepts only") - (byte-compile-arglist-signature-string (cons min-args max-args)))) + (when (byte-compile-warning-enabled-p 'wrong-args name) + (byte-compile-warn-x + name + "`%s' called with %d argument%s, but %s %s" + name actual-args + (if (= 1 actual-args) "" "s") + (if (< actual-args min-args) + "requires" + "accepts only") + (byte-compile-arglist-signature-string (cons min-args max-args))))) (defun byte-compile--check-arity-bytecode (form bytecode) "Check that the call in FORM matches that allowed by BYTECODE." @@ -3838,12 +3839,13 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (defun byte-compile-subr-wrong-args (form n) - (byte-compile-warn-x (car form) - "`%s' called with %d arg%s, but requires %s" - (car form) (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s") n) - ;; Get run-time wrong-number-of-args error. - (byte-compile-normal-call form)) + (when (byte-compile-warning-enabled-p 'wrong-args (car form)) + (byte-compile-warn-x (car form) + "`%s' called with %d arg%s, but requires %s" + (car form) (length (cdr form)) + (if (= 1 (length (cdr form))) "" "s") n) + ;; Get run-time wrong-number-of-args error. + (byte-compile-normal-call form))) (defun byte-compile-no-args (form) (if (not (= (length form) 1)) -- cgit v1.2.3 From f14f6180b78656eec2f4dad5b79eb5da20bd0b70 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 22 May 2022 20:14:03 +0200 Subject: Fix previous warning suppression change * lisp/emacs-lisp/bytecomp.el (byte-compile-emit-callargs-warn) (byte-compile-subr-wrong-args): * lisp/emacs-lisp/byte-run.el (with-suppressed-warnings): * lisp/cedet/semantic/fw.el (semantic-install-function-overrides): The `wrong-args' warning is really called `callargs'. --- lisp/cedet/semantic/fw.el | 2 +- lisp/emacs-lisp/byte-run.el | 2 +- lisp/emacs-lisp/bytecomp.el | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index c60778a34da..d07d8d42a8c 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -278,7 +278,7 @@ OVERRIDES will be installed globally for this major mode. If MODE is nil, OVERRIDES will be installed locally in the current buffer. This later installation should be done in MODE hook." (declare (obsolete define-mode-local-override "29.1")) - (with-suppressed-warnings ((wrong-args mode-local-bind)) + (with-suppressed-warnings ((callargs mode-local-bind)) (mode-local-bind ;; Add the semantic- prefix to OVERLOAD short names. (mapcar diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 2d11f350f0b..0113051c8eb 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -637,7 +637,7 @@ The warnings that can be suppressed are a subset of the warnings in `byte-compile-warning-types'; see the variable `byte-compile-warnings' for a fuller explanation of the warning types. The types that can be suppressed with this macro are -`free-vars', `callargs', `redefine', `obsolete', `wrong-args', +`free-vars', `callargs', `redefine', `obsolete', `interactive-only', `lexical', `mapcar', `constants' and `suspicious'. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 920cdbe5a6f..61382d6989f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1494,7 +1494,7 @@ when printing the error message." byte-compile-unresolved-functions))))) (defun byte-compile-emit-callargs-warn (name actual-args min-args max-args) - (when (byte-compile-warning-enabled-p 'wrong-args name) + (when (byte-compile-warning-enabled-p 'callargs name) (byte-compile-warn-x name "`%s' called with %d argument%s, but %s %s" @@ -3839,7 +3839,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (defun byte-compile-subr-wrong-args (form n) - (when (byte-compile-warning-enabled-p 'wrong-args (car form)) + (when (byte-compile-warning-enabled-p 'callargs (car form)) (byte-compile-warn-x (car form) "`%s' called with %d arg%s, but requires %s" (car form) (length (cdr form)) -- cgit v1.2.3 From 2701cd59b521989530a7eb7489540c64177e0f69 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 24 May 2022 18:48:39 +0200 Subject: Make byte compilation warn about wrong quoting in doc strings * lisp/emacs-lisp/bytecomp.el (byte-compile-docstring-length-warn): Made into obsolete alias. (byte-compile-docstring-style-warn): Also warn about other stylistic issues. (byte-compile-file-form-autoload, byte-compile-file-form-defvar) (byte-compile-file-form-defvar-function, byte-compile-lambda) (byte-compile-defvar, byte-compile-file-form-defalias): Adjust callers. --- etc/NEWS | 14 ++++++++++++++ lisp/emacs-lisp/bytecomp.el | 47 ++++++++++++++++++++++++++++++--------------- 2 files changed, 46 insertions(+), 15 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/etc/NEWS b/etc/NEWS index 0adb4e289a5..857f300384d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1911,6 +1911,20 @@ This returns non-nil if its argument its an uppercase character. ** Byte compilation +--- +*** Byte compilation will now warn about some quoting mistakes in doc strings. +When writing code snippets that contains the ' character (APOSTROPHE), +that quote character has to be escaped to avoid Emacs displaying it as +’ (LEFT SINGLE QUOTATION MARK), which would make code examples like + + (setq foo '(1 2 3)) + +invalid. Emacs will now warn during byte compilation if it seems +something like that, and also warn about when using RIGHT/LEFT SINGLE +QUOTATION MARK directly. In both these cases, if these characters +should really be present in the doc string, they should be quoted with +\=. + --- *** Byte compilation will now warn about some malformed 'defcustom' types. It's very common to write 'defcustom' types on the form: diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 61382d6989f..87798288fb5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -325,7 +325,8 @@ Elements of the list may be: constants let-binding of, or assignment to, constants/nonvariables. docstrings docstrings that are too wide (longer than `byte-compile-docstring-max-column' or - `fill-column' characters, whichever is bigger). + `fill-column' characters, whichever is bigger) or + have other stylistic issues. suspicious constructs that usually don't do what the coder wanted. If the list begins with `not', then the remaining elements specify warnings to @@ -1729,8 +1730,12 @@ value, it will override this variable." :safe #'integerp :version "28.1") -(defun byte-compile-docstring-length-warn (form) - "Warn if documentation string of FORM is too wide. +(define-obsolete-function-alias 'byte-compile-docstring-length-warn + 'byte-compile-docstring-style-warn "29.1") + +(defun byte-compile-docstring-style-warn (form) + "Warn if there are stylistic problems with the docstring in FORM. +Warn if documentation string of FORM is too wide. It is too wide if it has any lines longer than the largest of `fill-column' and `byte-compile-docstring-max-column'." (when (byte-compile-warning-enabled-p 'docstrings) @@ -1750,12 +1755,24 @@ It is too wide if it has any lines longer than the largest of (when (and (consp name) (eq (car name) 'quote)) (setq name (cadr name))) (setq name (if name (format " `%s' " name) "")) - (when (and kind docs (stringp docs) - (byte-compile--wide-docstring-p docs col)) - (byte-compile-warn-x - name - "%s%sdocstring wider than %s characters" - kind name col)))) + (when (and kind docs (stringp docs)) + (when (byte-compile--wide-docstring-p docs col) + (byte-compile-warn-x + name + "%s%sdocstring wider than %s characters" + kind name col)) + ;; There's a "naked" ' character before a symbol/list, so it + ;; should probably be quoted with \=. + (when (string-match-p "\\( \"\\|[ \t]\\|^\\)'[a-z(]" docs) + (byte-compile-warn-x + name "%s%sdocstring has wrong usage of unescaped single quotes (use \\= or different quoting)" + kind name)) + ;; There's a "Unicode quote" in the string -- it should probably + ;; be an ASCII one instead. + (when (string-match-p "\\( \"\\|[ \t]\\|^\\)[‘’]" docs) + (byte-compile-warn-x + name "%s%sdocstring has wrong usage of \"fancy\" single quotation marks" + kind name))))) form) ;; If we have compiled any calls to functions which are not known to be @@ -2617,7 +2634,7 @@ list that represents a doc string reference. (if (stringp (nth 3 form)) (prog1 form - (byte-compile-docstring-length-warn form)) + (byte-compile-docstring-style-warn form)) ;; No doc string, so we can compile this as a normal form. (byte-compile-keep-pending form 'byte-compile-normal-call))) @@ -2649,7 +2666,7 @@ list that represents a doc string reference. (if (and (null (cddr form)) ;No `value' provided. (eq (car form) 'defvar)) ;Just a declaration. nil - (byte-compile-docstring-length-warn form) + (byte-compile-docstring-style-warn form) (setq form (copy-sequence form)) (when (consp (nth 2 form)) (setcar (cdr (cdr form)) @@ -2674,7 +2691,7 @@ list that represents a doc string reference. (byte-compile-warn-x newname "Alias for `%S' should be declared before its referent" newname))))) - (byte-compile-docstring-length-warn form) + (byte-compile-docstring-style-warn form) (byte-compile-keep-pending form)) (put 'custom-declare-variable 'byte-hunk-handler @@ -3066,7 +3083,7 @@ lambda-expression." (setq fun (cons 'lambda fun)) (unless (eq 'lambda (car-safe fun)) (error "Not a lambda list: %S" fun))) - (byte-compile-docstring-length-warn fun) + (byte-compile-docstring-style-warn fun) (byte-compile-check-lambda-list (nth 1 fun)) (let* ((arglist (nth 1 fun)) (arglistvars (byte-run-strip-symbol-positions @@ -4942,7 +4959,7 @@ binding slots have been popped." (nth 1 form) "global/dynamic var `%s' lacks a prefix" (nth 1 form))) - (byte-compile-docstring-length-warn form) + (byte-compile-docstring-style-warn form) (let ((fun (nth 0 form)) (var (nth 1 form)) (value (nth 2 form)) @@ -5018,7 +5035,7 @@ binding slots have been popped." ;; - `arg' is the expression to which it is defined. ;; - `rest' is the rest of the arguments. (`(,_ ',name ,arg . ,rest) - (byte-compile-docstring-length-warn form) + (byte-compile-docstring-style-warn form) (pcase-let* ;; `macro' is non-nil if it defines a macro. ;; `fun' is the function part of `arg' (defaults to `arg'). -- cgit v1.2.3 From e05acb07d337dc35ad6b0c6cffe8e391db447a0c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 26 May 2022 17:19:45 +0200 Subject: Faster and less recursive byte-compile--first-symbol-with-pos * lisp/emacs-lisp/bytecomp.el (byte-compile--first-symbol-with-pos) (byte-compile--warning-source-offset): Remove recursion for cdr-traversal of lists, and optimise (bug#55414). --- lisp/emacs-lisp/bytecomp.el | 57 +++++++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 31 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 87798288fb5..d7140ad9e63 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1181,39 +1181,34 @@ message buffer `default-directory'." (if (< (length f2) (length f1)) f2 f1))) (defun byte-compile--first-symbol-with-pos (form) - "Return the \"first\" symbol with position found in form, or 0 if none. -Here, \"first\" is by a depth first search." - (let (sym) - (cond - ((symbol-with-pos-p form) form) - ((consp form) - (or (and (symbol-with-pos-p (setq sym (byte-compile--first-symbol-with-pos (car form)))) - sym) - (and (symbolp (setq sym (byte-compile--first-symbol-with-pos (cdr form)))) - sym) - 0)) - ((and (or (vectorp form) (recordp form)) - (> (length form) 0)) - (let ((i 0) - (len (length form)) - elt) - (catch 'sym - (while (< i len) - (when (symbol-with-pos-p - (setq elt (byte-compile--first-symbol-with-pos (aref form i)))) - (throw 'sym elt)) - (setq i (1+ i))) - 0))) - (t 0)))) + "Return the first symbol with position in form, or nil if none. +Order is by depth-first search." + (cond + ((symbol-with-pos-p form) form) + ((consp form) + (or (byte-compile--first-symbol-with-pos (car form)) + (let ((sym nil)) + (setq form (cdr form)) + (while (and (consp form) + (not (setq sym (byte-compile--first-symbol-with-pos + (car form))))) + (setq form (cdr form))) + (or sym + (and form (byte-compile--first-symbol-with-pos form)))))) + ((vectorp form) + (let ((len (length form)) + (i 0) + (sym nil)) + (while (and (< i len) + (not (setq sym (byte-compile--first-symbol-with-pos + (aref form i))))) + (setq i (1+ i))) + sym)))) (defun byte-compile--warning-source-offset () - "Return a source offset from `byte-compile-form-stack'. -Return nil if such is not found." - (catch 'offset - (dolist (form byte-compile-form-stack) - (let ((s (byte-compile--first-symbol-with-pos form))) - (if (symbol-with-pos-p s) - (throw 'offset (symbol-with-pos-pos s))))))) + "Return a source offset from `byte-compile-form-stack' or nil if none." + (let ((sym (byte-compile--first-symbol-with-pos byte-compile-form-stack))) + (and sym (symbol-with-pos-pos sym)))) ;; This is used as warning-prefix for the compiler. ;; It is always called with the warnings buffer current. -- cgit v1.2.3 From 80ba4c170756049a101b4e6692882ac30ba5e1a5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 25 May 2022 17:53:39 -0400 Subject: eval.c: New functions `defvar-1` and `defconst-1` (bug#55156) The bytecode interpreter can't directly call special forms, so the byte-compiler usually converts special forms into some sequence of byte codes (basically, providing a duplicate definition of the special form). There are still two exceptions to this: `defconst` and `defvar`, where the compiler instead generates a convoluted chunk of code like: (funcall '(lambda (x) (defvar x )) ) where the quote makes sure we keep the function non-compiled, so as to end up running the special form at run time. Get rid of this workaround by introducing `defvar-1` and `defconst-1` which provide a *functional* interface to the functionality of the corresponding special form. * src/eval.c (defvar, Fdefvar_1, Fdefconst_1): New functions, extracted from `Fdefvar` and `Fdefconst`. (Fdefvar, Fdefconst): Use them. (syms_of_eval): `defsubr` the new functions. * lisp/emacs-lisp/bytecomp.el (byte-compile-tmp-var): Delete const. (byte-compile-defvar): Simplify using the new functions. * doc/lispref/variables.texi (Defining Variables): Adjust the doc of `defvar` to reflect the actual semantics implemented. --- doc/lispref/variables.texi | 9 +++--- lisp/emacs-lisp/bytecomp.el | 23 ++++++------- src/eval.c | 78 ++++++++++++++++++++++++++++++--------------- 3 files changed, 68 insertions(+), 42 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index f0e3f337a69..c29547d00db 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -527,10 +527,11 @@ If @var{symbol} has a buffer-local binding in the current buffer, rather than the buffer-local binding. It sets the default value if the default value is void. @xref{Buffer-Local Variables}. -If @var{symbol} is already lexically bound (e.g., if the @code{defvar} -form occurs in a @code{let} form with lexical binding enabled), then -@code{defvar} sets the dynamic value. The lexical binding remains in -effect until its binding construct exits. @xref{Variable Scoping}. +If @var{symbol} is already let bound (e.g., if the @code{defvar} +form occurs in a @code{let} form), then @code{defvar} sets the toplevel +default value, like @code{set-default-toplevel-value}. +The let binding remains in effect until its binding construct exits. +@xref{Variable Scoping}. @cindex @code{eval-defun}, and @code{defvar} forms @cindex @code{eval-last-sexp}, and @code{defvar} forms diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d7140ad9e63..ee530f95d09 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4943,8 +4943,6 @@ binding slots have been popped." (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars)) (byte-compile-normal-call form)) -(defconst byte-compile-tmp-var (make-symbol "def-tmp-var")) - (defun byte-compile-defvar (form) ;; This is not used for file-level defvar/consts. (when (and (symbolp (nth 1 form)) @@ -4977,18 +4975,17 @@ binding slots have been popped." string "third arg to `%s %s' is not a string: %s" fun var string)) + ;; Delegate the actual work to the function version of the + ;; special form, named with a "-1" suffix. (byte-compile-form-do-effect - (if (cddr form) ; `value' provided - ;; Quote with `quote' to prevent byte-compiling the body, - ;; which would lead to an inf-loop. - `(funcall '(lambda (,byte-compile-tmp-var) - (,fun ,var ,byte-compile-tmp-var ,@(nthcdr 3 form))) - ,value) - (if (eq fun 'defconst) - ;; This will signal an appropriate error at runtime. - `(eval ',form) - ;; A simple (defvar foo) just returns foo. - `',var))))) + (cond + ((eq fun 'defconst) `(defconst-1 ',var ,@(nthcdr 2 form))) + ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. + (t `(defvar-1 ',var + ;; Don't eval `value' if `defvar' wouldn't eval it either. + ,(if (macroexp-const-p value) value + `(if (boundp ',var) nil ,value)) + ,@(nthcdr 3 form))))))) (defun byte-compile-autoload (form) (and (macroexp-const-p (nth 1 form)) diff --git a/src/eval.c b/src/eval.c index 08e2dce61e4..c3be1dc12c8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -756,6 +756,33 @@ value. */) return Qnil; } +static Lisp_Object +defvar (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring, bool eval) +{ + Lisp_Object tem; + + CHECK_SYMBOL (sym); + + tem = Fdefault_boundp (sym); + + /* Do it before evaluating the initial value, for self-references. */ + Finternal__define_uninitialized_variable (sym, docstring); + + if (NILP (tem)) + Fset_default (sym, eval ? eval_sub (initvalue) : initvalue); + else + { /* Check if there is really a global binding rather than just a let + binding that shadows the global unboundness of the var. */ + union specbinding *binding = default_toplevel_binding (sym); + if (binding && EQ (specpdl_old_value (binding), Qunbound)) + { + set_specpdl_old_value (binding, + eval ? eval_sub (initvalue) : initvalue); + } + } + return sym; +} + DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0, doc: /* Define SYMBOL as a variable, and return SYMBOL. You are not required to define a variable in order to use it, but @@ -770,12 +797,10 @@ value. If SYMBOL is buffer-local, its default value is what is set; buffer-local values are not affected. If INITVALUE is missing, SYMBOL's value is not set. -If SYMBOL has a local binding, then this form affects the local -binding. This is usually not what you want. Thus, if you need to -load a file defining variables, with this form or with `defconst' or -`defcustom', you should always load that file _outside_ any bindings -for these variables. (`defconst' and `defcustom' behave similarly in -this respect.) +If SYMBOL is let-bound, then this form does not affect the local let +binding but the toplevel default binding instead, like +`set-toplevel-default-binding`. +(`defcustom' behaves similarly in this respect.) The optional argument DOCSTRING is a documentation string for the variable. @@ -786,7 +811,7 @@ To define a buffer-local variable, use `defvar-local'. usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) (Lisp_Object args) { - Lisp_Object sym, tem, tail; + Lisp_Object sym, tail; sym = XCAR (args); tail = XCDR (args); @@ -798,24 +823,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail)))) error ("Too many arguments"); Lisp_Object exp = XCAR (tail); - - tem = Fdefault_boundp (sym); tail = XCDR (tail); - - /* Do it before evaluating the initial value, for self-references. */ - Finternal__define_uninitialized_variable (sym, CAR (tail)); - - if (NILP (tem)) - Fset_default (sym, eval_sub (exp)); - else - { /* Check if there is really a global binding rather than just a let - binding that shadows the global unboundness of the var. */ - union specbinding *binding = default_toplevel_binding (sym); - if (binding && EQ (specpdl_old_value (binding), Qunbound)) - { - set_specpdl_old_value (binding, eval_sub (exp)); - } - } + return defvar (sym, exp, CAR (tail), true); } else if (!NILP (Vinternal_interpreter_environment) && (SYMBOLP (sym) && !XSYMBOL (sym)->u.s.declared_special)) @@ -834,6 +843,14 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) return sym; } +DEFUN ("defvar-1", Fdefvar_1, Sdefvar_1, 2, 3, 0, + doc: /* Like `defvar' but as a function. +More specifically behaves like (defvar SYM 'INITVALUE DOCSTRING). */) + (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring) +{ + return defvar (sym, initvalue, docstring, false); +} + DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0, doc: /* Define SYMBOL as a constant variable. This declares that neither programs nor users should ever change the @@ -863,9 +880,18 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) error ("Too many arguments"); docstring = XCAR (XCDR (XCDR (args))); } + tem = eval_sub (XCAR (XCDR (args))); + return Fdefconst_1 (sym, tem, docstring); +} +DEFUN ("defconst-1", Fdefconst_1, Sdefconst_1, 2, 3, 0, + doc: /* Like `defconst' but as a function. +More specifically, behaves like (defconst SYM 'INITVALUE DOCSTRING). */) + (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring) +{ + CHECK_SYMBOL (sym); + Lisp_Object tem = initvalue; Finternal__define_uninitialized_variable (sym, docstring); - tem = eval_sub (XCAR (XCDR (args))); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); /* FIXME: set-default-toplevel-value? */ @@ -4333,9 +4359,11 @@ alist of active lexical bindings. */); defsubr (&Sdefault_toplevel_value); defsubr (&Sset_default_toplevel_value); defsubr (&Sdefvar); + defsubr (&Sdefvar_1); defsubr (&Sdefvaralias); DEFSYM (Qdefvaralias, "defvaralias"); defsubr (&Sdefconst); + defsubr (&Sdefconst_1); defsubr (&Sinternal__define_uninitialized_variable); defsubr (&Smake_var_non_special); defsubr (&Slet); -- cgit v1.2.3 From c9aff6fe5a26ca402b0f0bc89f71a2cc46671882 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 29 May 2022 10:49:13 +0200 Subject: Traverse record literals in byte-compile--first-symbol-with-pos * lisp/emacs-lisp/bytecomp.el (byte-compile--first-symbol-with-pos): Traverse record literals as well as vectors. Either is rather pointless but there were some strong feelings about it. --- lisp/emacs-lisp/bytecomp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ee530f95d09..5d16d55089e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1195,7 +1195,7 @@ Order is by depth-first search." (setq form (cdr form))) (or sym (and form (byte-compile--first-symbol-with-pos form)))))) - ((vectorp form) + ((or (vectorp form) (recordp form)) (let ((len (length form)) (i 0) (sym nil)) -- cgit v1.2.3 From 977f3f27c549db27a2d6fb33e0112b03f9b57371 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 3 Jun 2022 13:09:25 +0200 Subject: Don't issue warnings for Unicode quotes for now * lisp/emacs-lisp/bytecomp.el (byte-compile-docstring-style-warn): Remove warning for "Unicode quotes" for now (bug#55780). --- lisp/emacs-lisp/bytecomp.el | 6 ------ 1 file changed, 6 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5d16d55089e..2e89504e8ff 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1761,12 +1761,6 @@ It is too wide if it has any lines longer than the largest of (when (string-match-p "\\( \"\\|[ \t]\\|^\\)'[a-z(]" docs) (byte-compile-warn-x name "%s%sdocstring has wrong usage of unescaped single quotes (use \\= or different quoting)" - kind name)) - ;; There's a "Unicode quote" in the string -- it should probably - ;; be an ASCII one instead. - (when (string-match-p "\\( \"\\|[ \t]\\|^\\)[‘’]" docs) - (byte-compile-warn-x - name "%s%sdocstring has wrong usage of \"fancy\" single quotation marks" kind name))))) form) -- cgit v1.2.3 From 493ae66be08a99ea7918ee8210aec3eb925c8fad Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 8 Jun 2022 10:03:55 +0200 Subject: Preserve doc string in `byte-compile` (bug#55830) * lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Don't transpose doc string and interactive spec, which must come in this order. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-function-attributes): New test. --- lisp/emacs-lisp/bytecomp.el | 1 + test/lisp/emacs-lisp/bytecomp-tests.el | 21 +++++++++++++++++++++ 2 files changed, 22 insertions(+) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2e89504e8ff..ab21fba8a27 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2926,6 +2926,7 @@ FUN should be either a `lambda' value or a `closure' value." (push (pop body) preamble)) (when (eq (car-safe (car body)) 'interactive) (push (pop body) preamble)) + (setq preamble (nreverse preamble)) ;; Turn the function's closed vars (if any) into local let bindings. (dolist (binding env) (cond diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 39f053136ae..27098d0bb1c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1553,6 +1553,27 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (should (byte-compile--suspicious-defcustom-choice '(choice (const :tag "foo" 'bar))))) +(ert-deftest bytecomp-function-attributes () + ;; Check that `byte-compile' keeps the declarations, interactive spec and + ;; doc string of the function (bug#55830). + (let ((fname 'bytecomp-test-fun)) + (fset fname nil) + (put fname 'pure nil) + (put fname 'lisp-indent-function nil) + (eval `(defun ,fname (x) + "tata" + (declare (pure t) (indent 1)) + (interactive "P") + (list 'toto x)) + t) + (let ((bc (byte-compile fname))) + (should (byte-code-function-p bc)) + (should (equal (funcall bc 'titi) '(toto titi))) + (should (equal (aref bc 5) "P")) + (should (equal (get fname 'pure) t)) + (should (equal (get fname 'lisp-indent-function) 1)) + (should (equal (aref bc 4) "tata\n\n(fn X)"))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: -- cgit v1.2.3 From 6825e5686a4bf21f5d5a0ae1af889097cfa2f597 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 3 Jun 2022 20:31:10 +0200 Subject: Normalise setq during macro-expansion Early normalisation of setq during macroexpand-all allows later stages, cconv, byte-opt and codegen, to be simplified and duplicated checks to be eliminated. * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Normalise all setq forms to a sequence of (setq VAR EXPR). Emit warnings if necessary. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyze-form): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): * lisp/emacs-lisp/bytecomp.el (byte-compile-setq): Simplify. * test/lisp/emacs-lisp/bytecomp-tests.el: Adapt and add tests. * test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el; * test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el: New files. --- lisp/emacs-lisp/byte-opt.el | 41 +++++++----------- lisp/emacs-lisp/bytecomp.el | 26 ++++-------- lisp/emacs-lisp/cconv.el | 47 ++++++++------------- lisp/emacs-lisp/macroexp.el | 48 ++++++++++++++++++++++ .../warn-variable-setq-nonvariable.el | 3 ++ .../bytecomp-resources/warn-variable-setq-odd.el | 3 ++ test/lisp/emacs-lisp/bytecomp-tests.el | 8 +++- 7 files changed, 101 insertions(+), 75 deletions(-) create mode 100644 test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el create mode 100644 test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 69795f9c112..0e10e332b29 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -463,32 +463,21 @@ for speeding up processing.") ;; is a *value* and shouldn't appear in the car. (`((closure . ,_) . ,_) form) - (`(setq . ,args) - (let ((var-expr-list nil)) - (while args - (unless (and (consp args) - (symbolp (car args)) (consp (cdr args))) - (byte-compile-warn-x form "malformed setq form: %S" form)) - (let* ((var (car args)) - (expr (cadr args)) - (lexvar (assq var byte-optimize--lexvars)) - (value (byte-optimize-form expr nil))) - (when lexvar - (setcar (cdr lexvar) t) ; Mark variable to be kept. - (setcdr (cdr lexvar) nil) ; Inhibit further substitution. - - (when (memq var byte-optimize--aliased-vars) - ;; Cancel aliasing of variables aliased to this one. - (dolist (v byte-optimize--lexvars) - (when (eq (nth 2 v) var) - ;; V is bound to VAR but VAR is now mutated: - ;; cancel aliasing. - (setcdr (cdr v) nil))))) - - (push var var-expr-list) - (push value var-expr-list)) - (setq args (cddr args))) - (cons fn (nreverse var-expr-list)))) + (`(setq ,var ,expr) + (let ((lexvar (assq var byte-optimize--lexvars)) + (value (byte-optimize-form expr nil))) + (when lexvar + (setcar (cdr lexvar) t) ; Mark variable to be kept. + (setcdr (cdr lexvar) nil) ; Inhibit further substitution. + + (when (memq var byte-optimize--aliased-vars) + ;; Cancel aliasing of variables aliased to this one. + (dolist (v byte-optimize--lexvars) + (when (eq (nth 2 v) var) + ;; V is bound to VAR but VAR is now mutated: + ;; cancel aliasing. + (setcdr (cdr v) nil))))) + `(,fn ,var ,value))) (`(defvar ,(and (pred symbolp) name) . ,rest) (let ((optimized-rest (and rest diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ab21fba8a27..1f868d2217c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4225,25 +4225,13 @@ This function is never called when `lexical-binding' is nil." (byte-defop-compiler-1 quote) (defun byte-compile-setq (form) - (let* ((args (cdr form)) - (len (length args))) - (if (= (logand len 1) 1) - (progn - (byte-compile-report-error - (format-message - "missing value for `%S' at end of setq" (car (last args)))) - (byte-compile-form - `(signal 'wrong-number-of-arguments '(setq ,len)) - byte-compile--for-effect)) - (if args - (while args - (byte-compile-form (car (cdr args))) - (or byte-compile--for-effect (cdr (cdr args)) - (byte-compile-out 'byte-dup 0)) - (byte-compile-variable-set (car args)) - (setq args (cdr (cdr args)))) - ;; (setq), with no arguments. - (byte-compile-form nil byte-compile--for-effect))) + (cl-assert (= (length form) 3)) ; normalised in macroexp + (let ((var (nth 1 form)) + (expr (nth 2 form))) + (byte-compile-form expr) + (unless byte-compile--for-effect + (byte-compile-out 'byte-dup 0)) + (byte-compile-variable-set var) (setq byte-compile--for-effect nil))) (byte-defop-compiler-1 set-default) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 1a501f50bfc..b12f1db677e 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -555,29 +555,19 @@ places where they originally did not directly appear." `(,(car form) ,(cconv-convert form1 env extend) :fun-body ,(cconv--convert-function () body env form1))) - (`(setq . ,forms) ; setq special form - (if (= (logand (length forms) 1) 1) - ;; With an odd number of args, let bytecomp.el handle the error. - form - (let ((prognlist ())) - (while forms - (let* ((sym (pop forms)) - (sym-new (or (cdr (assq sym env)) sym)) - (value (cconv-convert (pop forms) env extend))) - (push (pcase sym-new - ((pred symbolp) `(,(car form) ,sym-new ,value)) - (`(car-safe ,iexp) `(setcar ,iexp ,value)) - ;; This "should never happen", but for variables which are - ;; mutated+captured+unused, we may end up trying to `setq' - ;; on a closed-over variable, so just drop the setq. - (_ ;; (byte-compile-report-error - ;; (format "Internal error in cconv of (setq %s ..)" - ;; sym-new)) - value)) - prognlist))) - (if (cdr prognlist) - `(progn . ,(nreverse prognlist)) - (car prognlist))))) + (`(setq ,var ,expr) + (let ((var-new (or (cdr (assq var env)) var)) + (value (cconv-convert expr env extend))) + (pcase var-new + ((pred symbolp) `(,(car form) ,var-new ,value)) + (`(car-safe ,iexp) `(setcar ,iexp ,value)) + ;; This "should never happen", but for variables which are + ;; mutated+captured+unused, we may end up trying to `setq' + ;; on a closed-over variable, so just drop the setq. + (_ ;; (byte-compile-report-error + ;; (format "Internal error in cconv of (setq %s ..)" + ;; sym-new)) + value)))) (`(,(and (or 'funcall 'apply) callsym) ,fun . ,args) ;; These are not special forms but we treat them separately for the needs @@ -751,14 +741,13 @@ This function does not return anything but instead fills the (cconv-analyze-form (cadr (pop body-forms)) env)) (cconv--analyze-function vrs body-forms env form)) - (`(setq . ,forms) + (`(setq ,var ,expr) ;; If a local variable (member of env) is modified by setq then ;; it is a mutated variable. - (while forms - (let ((v (assq (car forms) env))) ; v = non nil if visible - (when v (setf (nth 2 v) t))) - (cconv-analyze-form (cadr forms) env) - (setq forms (cddr forms)))) + (let ((v (assq var env))) ; v = non nil if visible + (when v + (setf (nth 2 v) t))) + (cconv-analyze-form expr env)) (`((lambda . ,_) . ,_) ; First element is lambda expression. (byte-compile-warn-x diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 51c6e8e0ca2..bae303c213c 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -369,6 +369,54 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp--all-forms body)) (cdr form)) form))) + (`(setq ,(and var (pred symbolp) + (pred (not booleanp)) (pred (not keywordp))) + ,expr) + ;; Fast path for the setq common case. + (let ((new-expr (macroexp--expand-all expr))) + (if (eq new-expr expr) + form + `(,fn ,var ,new-expr)))) + (`(setq . ,args) + ;; Normalise to a sequence of (setq SYM EXPR). + ;; Malformed code is translated to code that signals an error + ;; at run time. + (let ((nargs (length args))) + (if (/= (logand nargs 1) 0) + (macroexp-warn-and-return + "odd number of arguments in `setq' form" + `(signal 'wrong-number-of-arguments '(setq ,nargs)) + nil 'compile-only fn) + (let ((assignments nil)) + (while (consp (cdr-safe args)) + (let* ((var (car args)) + (expr (cadr args)) + (new-expr (macroexp--expand-all expr)) + (assignment + (if (and (symbolp var) + (not (booleanp var)) (not (keywordp var))) + `(,fn ,var ,new-expr) + (macroexp-warn-and-return + (format-message "attempt to set %s `%s'" + (if (symbolp var) + "constant" + "non-variable") + var) + (cond + ((keywordp var) + ;; Accept `(setq :a :a)' for compatibility. + `(if (eq ,var ,new-expr) + ,var + (signal 'setting-constant (list ',var)))) + ((symbolp var) + `(signal 'setting-constant (list ',var))) + (t + `(signal 'wrong-type-argument + (list 'symbolp ',var)))) + nil 'compile-only var)))) + (push assignment assignments)) + (setq args (cddr args))) + (cons 'progn (nreverse assignments)))))) (`(,(and fun `(lambda . ,_)) . ,args) ;; Embedded lambda in function position. ;; If the byte-optimizer is loaded, try to unfold this, diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el new file mode 100644 index 00000000000..5a56913cd9b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (setq (a) nil)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el new file mode 100644 index 00000000000..9ce80de08cd --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo (a b) + (setq a 1 b)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 27098d0bb1c..9abc17a1c41 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -951,11 +951,17 @@ byte-compiled. Run with dynamic binding." "let-bind nonvariable") (bytecomp--define-warning-file-test "warn-variable-set-constant.el" - "variable reference to constant") + "attempt to set constant") (bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el" "variable reference to nonvariable") +(bytecomp--define-warning-file-test "warn-variable-setq-nonvariable.el" + "attempt to set non-variable") + +(bytecomp--define-warning-file-test "warn-variable-setq-odd.el" + "odd number of arguments") + (bytecomp--define-warning-file-test "warn-wide-docstring-autoload.el" "autoload .foox. docstring wider than .* characters") -- cgit v1.2.3 From d6600481ae9423eb2c51150967050afb05c301b8 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 14 Jun 2022 19:09:20 +0200 Subject: Run cconv for dynbound code as well Make cconv work for dynamically bound code and always run it. This allows later stages to benefit from transformations and normalisations in cconv. * lisp/emacs-lisp/bytecomp.el (byte-compile-preprocess): Always run cconv. * lisp/emacs-lisp/cconv.el (cconv--analyze-function) (cconv-analyze-form): In dynbound code, treat all variable bindings as dynamic (lambda, let, let* and condition-case). --- lisp/emacs-lisp/bytecomp.el | 4 +--- lisp/emacs-lisp/cconv.el | 29 ++++++++++++++++------------- 2 files changed, 17 insertions(+), 16 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1f868d2217c..af74c0699b9 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2557,9 +2557,7 @@ list that represents a doc string reference. ;; macroexpand-all. ;; (if (memq byte-optimize '(t source)) ;; (setq form (byte-optimize-form form for-effect))) - (cond - (lexical-binding (cconv-closure-convert form)) - (t form))) + (cconv-closure-convert form)) ;; byte-hunk-handlers cannot call this! (defun byte-compile-toplevel-file-form (top-level-form) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index b12f1db677e..eca1123899c 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -664,18 +664,19 @@ FORM is the parent form that binds this var." ;; Push it before recursing, so cconv-freevars-alist contains entries in ;; the order they'll be used by closure-convert-rec. (push freevars cconv-freevars-alist) - (dolist (arg args) - (cond - ((byte-compile-not-lexical-var-p arg) - (byte-compile-warn-x - arg - "Lexical argument shadows the dynamic variable %S" - arg)) - ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... - (t (let ((varstruct (list arg nil nil nil nil))) - (cl-pushnew arg byte-compile-lexical-variables) - (push (cons (list arg) (cdr varstruct)) newvars) - (push varstruct newenv))))) + (when lexical-binding + (dolist (arg args) + (cond + ((byte-compile-not-lexical-var-p arg) + (byte-compile-warn-x + arg + "Lexical argument shadows the dynamic variable %S" + arg)) + ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... + (t (let ((varstruct (list arg nil nil nil nil))) + (cl-pushnew arg byte-compile-lexical-variables) + (push (cons (list arg) (cdr varstruct)) newvars) + (push varstruct newenv)))))) (dolist (form body) ;Analyze body forms. (cconv-analyze-form form newenv)) ;; Summarize resulting data about arguments. @@ -724,7 +725,7 @@ This function does not return anything but instead fills the (cconv-analyze-form value (if (eq letsym 'let*) env orig-env))) - (unless (byte-compile-not-lexical-var-p var) + (unless (or (byte-compile-not-lexical-var-p var) (not lexical-binding)) (cl-pushnew var byte-compile-lexical-variables) (let ((varstruct (list var nil nil nil nil))) (push (cons binder (cdr varstruct)) newvars) @@ -769,6 +770,8 @@ This function does not return anything but instead fills the (`(condition-case ,var ,protected-form . ,handlers) (cconv-analyze-form protected-form env) + (unless lexical-binding + (setq var nil)) (when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) (byte-compile-warn-x var "Lexical variable shadows the dynamic variable %S" var)) -- cgit v1.2.3 From 1ac74e28622e3ebbe76daf84f0a6f310a8ea3c45 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 6 Jun 2022 11:10:05 +0200 Subject: Simplify byte-compiler assuming cconv normalisations * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker) (byte-optimize-let-form, byte-optimize-letX): * lisp/emacs-lisp/bytecomp.el (byte-compile-unwind-protect): Simplify source optimisation and codegen code that can now rely on normalised let/let* and unwind-protect forms. --- lisp/emacs-lisp/byte-opt.el | 40 +++++++++------------------------------- lisp/emacs-lisp/bytecomp.el | 7 ++----- 2 files changed, 11 insertions(+), 36 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0e10e332b29..fc49e88f8ee 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -422,7 +422,7 @@ for speeding up processing.") (byte-optimize-body (cdr clause) for-effect)))) clauses))) - (`(unwind-protect ,exp . ,exps) + (`(unwind-protect ,exp :fun-body ,f) ;; The unwinding part of an unwind-protect is compiled (and thus ;; optimized) as a top-level form, but run the optimizer for it here ;; anyway for lexical variable usage and substitution. But the @@ -430,13 +430,7 @@ for speeding up processing.") ;; unwind-protect itself. (The unwinding part is always for effect, ;; but that isn't handled properly yet.) (let ((bodyform (byte-optimize-form exp for-effect))) - (pcase exps - (`(:fun-body ,f) - `(,fn ,bodyform - :fun-body ,(byte-optimize-form f nil))) - (_ - `(,fn ,bodyform - . ,(byte-optimize-body exps t)))))) + `(,fn ,bodyform :fun-body ,(byte-optimize-form f nil)))) (`(catch ,tag . ,exps) `(,fn ,(byte-optimize-form tag nil) @@ -695,13 +689,8 @@ for speeding up processing.") (let ((byte-optimize--lexvars nil)) (cons (mapcar (lambda (binding) - (if (symbolp binding) - binding - (when (or (atom binding) (cddr binding)) - (byte-compile-warn-x - binding "malformed let binding: `%S'" binding)) - (list (car binding) - (byte-optimize-form (nth 1 binding) nil)))) + (list (car binding) + (byte-optimize-form (nth 1 binding) nil))) (car form)) (byte-optimize-body (cdr form) for-effect))))) @@ -1253,28 +1242,17 @@ See Info node `(elisp) Integer Basics'." ;; Body is empty or just contains a constant. (`(,head ,bindings . ,(or '() `(,(and const (pred macroexp-const-p))))) (if (eq head 'let) - `(progn ,@(mapcar (lambda (binding) - (and (consp binding) (cadr binding))) - bindings) - ,const) - `(,head ,(butlast bindings) - ,@(and (consp (car (last bindings))) - (cdar (last bindings))) - ,const))) + `(progn ,@(mapcar #'cadr bindings) ,const) + `(,head ,(butlast bindings) ,(cadar (last bindings)) ,const))) ;; Body is last variable. (`(,head ,(and bindings - (let last-var (let ((last (car (last bindings)))) - (if (consp last) (car last) last)))) + (let last-var (caar (last bindings)))) ,(and last-var ; non-linear pattern (pred symbolp) (pred (not keywordp)) (pred (not booleanp)))) (if (eq head 'let) - `(progn ,@(mapcar (lambda (binding) - (and (consp binding) (cadr binding))) - bindings)) - `(,head ,(butlast bindings) - ,@(and (consp (car (last bindings))) - (cdar (last bindings)))))) + `(progn ,@(mapcar #'cadr bindings)) + `(,head ,(butlast bindings) ,(cadar (last bindings))))) (_ form))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index af74c0699b9..d28ec0be16d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4806,11 +4806,8 @@ binding slots have been popped." (byte-compile-out-tag endtag))) (defun byte-compile-unwind-protect (form) - (pcase (cddr form) - (`(:fun-body ,f) - (byte-compile-form f)) - (handlers - (byte-compile-form `#'(lambda () ,@handlers)))) + (cl-assert (eq (caddr form) :fun-body)) + (byte-compile-form (nth 3 form)) (byte-compile-out 'byte-unwind-protect 0) (byte-compile-form-do-effect (car (cdr form))) (byte-compile-out 'byte-unbind 1)) -- cgit v1.2.3 From 2ebe0524e823c2b811f484bd4df977df5fa49203 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 18 Jun 2022 15:15:57 +0200 Subject: More aggressive bytecode split between top-level forms (bug#55972) * lisp/emacs-lisp/bytecomp.el (byte-compile-keep-pending): Allow bytecode split between all kinds of top-level forms, not just those with chunk handlers, to prevent individual chunks from growing too large. In particular this helps compilation of package-quickstart.el. --- lisp/emacs-lisp/bytecomp.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d28ec0be16d..7f408472da1 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2521,13 +2521,12 @@ list that represents a doc string reference. (defun byte-compile-keep-pending (form &optional handler) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-one-form form t))) + ;; To avoid consing up monstrously large forms at load time, we split + ;; the output regularly. + (when (nthcdr 300 byte-compile-output) + (byte-compile-flush-pending)) (if handler (let ((byte-compile--for-effect t)) - ;; To avoid consing up monstrously large forms at load time, we split - ;; the output regularly. - (and (memq (car-safe form) '(fset defalias)) - (nthcdr 300 byte-compile-output) - (byte-compile-flush-pending)) (funcall handler form) (if byte-compile--for-effect (byte-compile-discard))) -- cgit v1.2.3 From 93b018c664e1f95b41d0239c651a79a237edfc38 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 19 Jun 2022 13:37:10 +0200 Subject: Add mechanism for gradually phasing in new byte compilation warnings * lisp/Makefile.in (BYTE_COMPILE_FLAGS): Enable all byte compilation warnings. * lisp/emacs-lisp/bytecomp.el (byte-compile-warning-types): Add docstrings-non-ascii-quotes and document new semantics for `all' and t. (byte-compile--emacs-build-warning-types): New constant. (byte-compile-warning-enabled-p): Implement the new semantics. (byte-compile-docstring-style-warn): Reinstate the Unicode quote warning. --- lisp/Makefile.in | 3 ++- lisp/emacs-lisp/bytecomp.el | 41 +++++++++++++++++++++++++++++++++-------- 2 files changed, 35 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 8728467977a..9516f2fc364 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -67,7 +67,8 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \ # Set load-prefer-newer for the benefit of the non-bootstrappers. BYTE_COMPILE_FLAGS = \ - --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS) + --eval "(setq load-prefer-newer t byte-compile-warnings 'all)" \ + $(BYTE_COMPILE_EXTRA_FLAGS) # ... but we must prefer .elc files for those in the early bootstrap. # A larger `max-specpdl-size' is needed for emacs-lisp/comp.el. compile-first: BYTE_COMPILE_FLAGS = \ diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7f408472da1..2ae9aa13bb6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -299,10 +299,10 @@ The information is logged to `byte-compile-log-buffer'." '(redefine callargs free-vars unresolved obsolete noruntime interactive-only make-local mapcar constants suspicious lexical lexical-dynamic - docstrings not-unused) + docstrings docstrings-non-ascii-quotes not-unused) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t - "List of warnings that the byte-compiler should issue (t for all). + "List of warnings that the byte-compiler should issue (t for almost all). Elements of the list may be: @@ -327,15 +327,28 @@ Elements of the list may be: `byte-compile-docstring-max-column' or `fill-column' characters, whichever is bigger) or have other stylistic issues. + docstrings-non-ascii-quotes docstrings that have non-ASCII quotes. + This depends on the `docstrings' warning type. suspicious constructs that usually don't do what the coder wanted. If the list begins with `not', then the remaining elements specify warnings to -suppress. For example, (not mapcar) will suppress warnings about mapcar." +suppress. For example, (not mapcar) will suppress warnings about mapcar. + +The t value means \"all non experimental warning types\", and +excludes the types in `byte-compile--emacs-build-warning-types'. +A value of `all' really means all." :type `(choice (const :tag "All" t) (set :menu-tag "Some" ,@(mapcar (lambda (x) `(const ,x)) byte-compile-warning-types)))) +(defconst byte-compile--emacs-build-warning-types + '(docstrings-non-ascii-quotes) + "List of warning types that are only enabled during Emacs builds. +This is typically either warning types that are being phased in +(but shouldn't be enabled for packages yet), or that are only relevant +for the Emacs build itself.") + (defvar byte-compile--suppressed-warnings nil "Dynamically bound by `with-suppressed-warnings' to suppress warnings.") @@ -354,10 +367,15 @@ suppress. For example, (not mapcar) will suppress warnings about mapcar." (memq symbol (cdr elem))) (setq suppress t))) (and (not suppress) - (or (eq byte-compile-warnings t) - (if (eq (car byte-compile-warnings) 'not) - (not (memq warning byte-compile-warnings)) - (memq warning byte-compile-warnings)))))) + ;; During an Emacs build, we want all warnings. + (or (eq byte-compile-warnings 'all) + ;; If t, we want almost all the warnings, but not the + ;; ones that are Emacs build specific. + (and (not (memq warning byte-compile--emacs-build-warning-types)) + (or (eq byte-compile-warnings t) + (if (eq (car byte-compile-warnings) 'not) + (not (memq warning byte-compile-warnings)) + (memq warning byte-compile-warnings)))))))) ;;;###autoload (defun byte-compile-disable-warning (warning) @@ -1761,7 +1779,14 @@ It is too wide if it has any lines longer than the largest of (when (string-match-p "\\( \"\\|[ \t]\\|^\\)'[a-z(]" docs) (byte-compile-warn-x name "%s%sdocstring has wrong usage of unescaped single quotes (use \\= or different quoting)" - kind name))))) + kind name)) + ;; There's a "Unicode quote" in the string -- it should probably + ;; be an ASCII one instead. + (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) + (when (string-match-p "\\( \"\\|[ \t]\\|^\\)[‘’]" docs) + (byte-compile-warn-x + name "%s%sdocstring has wrong usage of \"fancy\" single quotation marks" + kind name)))))) form) ;; If we have compiled any calls to functions which are not known to be -- cgit v1.2.3 From 4ae315f7c3b5bc370d9d66eab5428685a6097606 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 20 Jun 2022 18:31:05 +0000 Subject: Fix potential (goto-char nil) in byte-compile-warning-prefix * lisp/emacs-lisp/bytecomp.el (byte-compile-warning-prefix): Replace a wrong 'or' form involving OFFSET with simply OFFSET. This prevents OFFSET from possibly being nil in the first branch of the containing `if' form. --- lisp/emacs-lisp/bytecomp.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2ae9aa13bb6..198eb4df5c8 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1246,8 +1246,7 @@ Order is by depth-first search." load-file-name dir))) (t ""))) (offset (byte-compile--warning-source-offset)) - (pos (if (and byte-compile-current-file - (or offset (not symbols-with-pos-enabled))) + (pos (if (and byte-compile-current-file offset) (with-current-buffer byte-compile-current-buffer (let (new-l new-c) (save-excursion -- cgit v1.2.3 From acf9dcdc51280933eba9f249e41ab41d2896aa93 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 21 Jun 2022 19:07:46 +0200 Subject: Check defface doc strings * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-custom-declare-variable): We already warn about missing groups from byte-compile-normal-call, so this would be a double warning. (custom-declare-face) (byte-compile-file-form-custom-declare-face): Add doc string checking for defface. --- lisp/emacs-lisp/bytecomp.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 198eb4df5c8..04c107a7cfa 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1756,7 +1756,8 @@ It is too wide if it has any lines longer than the largest of (pcase (car form) ((or 'autoload 'custom-declare-variable 'defalias 'defconst 'define-abbrev-table - 'defvar 'defvaralias) + 'defvar 'defvaralias + 'custom-declare-face) (setq kind (nth 0 form)) (setq name (nth 1 form)) (setq docs (nth 3 form))) @@ -2705,11 +2706,10 @@ list that represents a doc string reference. (byte-compile-keep-pending form)) (put 'custom-declare-variable 'byte-hunk-handler - 'byte-compile-file-form-custom-declare-variable) -(defun byte-compile-file-form-custom-declare-variable (form) - (when (byte-compile-warning-enabled-p 'callargs) - (byte-compile-nogroup-warn form)) - (byte-compile-file-form-defvar-function form)) + 'byte-compile-file-form-defvar-function) + +(put 'custom-declare-face 'byte-hunk-handler + 'byte-compile-docstring-style-warn) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) -- cgit v1.2.3 From dbbf38d43f1f49a38efd260bda655e0b3cd2b6d5 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 21 Jun 2022 19:10:14 +0200 Subject: Document and test 'no-byte-compile' behavior. * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Document behavior if 'no-byte-compile' is set. * test/lisp/emacs-lisp/bytecomp-tests.el (byte-compile-file/no-byte-compile): New unit test. * test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el: New test file. --- lisp/emacs-lisp/bytecomp.el | 3 +++ test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el | 1 + test/lisp/emacs-lisp/bytecomp-tests.el | 7 +++++++ 3 files changed, 11 insertions(+) create mode 100644 test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 04c107a7cfa..4fd65bb5d53 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2089,6 +2089,9 @@ If compilation is needed, this functions returns the result of The output file's name is generated by passing FILENAME to the function `byte-compile-dest-file' (which see). The value is non-nil if there were no errors, nil if errors. +If the file sets the file variable `no-byte-compile', it is not +compiled, any existing output file is removed, and the return +value is `no-byte-compile'. See also `emacs-lisp-byte-compile-and-load'." (declare (advertised-calling-convention (filename) "28.1")) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el b/test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el new file mode 100644 index 00000000000..00ad1947507 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el @@ -0,0 +1 @@ +;; -*- no-byte-compile: t; -*- diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index fbc00b30c54..9c5bef09a34 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1642,6 +1642,13 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (setq actual (nreverse actual)) (should (equal actual expected))))))) +(ert-deftest byte-compile-file/no-byte-compile () + (let* ((src-file (ert-resource-file "no-byte-compile.el")) + (dest-file (make-temp-file "bytecomp-tests-" nil ".elc")) + (byte-compile-dest-file-function (lambda (_) dest-file))) + (should (eq (byte-compile-file src-file) 'no-byte-compile)) + (should-not (file-exists-p dest-file)))) + ;; Local Variables: ;; no-byte-compile: t -- cgit v1.2.3 From 48248c901d0884c042345c3ae1ba8fdfeb195c74 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 23 Jun 2022 14:33:46 +0200 Subject: Remove unused function in bytecomp.el * lisp/emacs-lisp/bytecomp.el (byte-compile-delete-first): Remove. --- lisp/emacs-lisp/bytecomp.el | 12 ------------ 1 file changed, 12 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4fd65bb5d53..a8c68f81531 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1174,18 +1174,6 @@ message buffer `default-directory'." (t (insert (format "%s\n" string))))))) -;; copied from gnus-util.el -(defsubst byte-compile-delete-first (elt list) - (if (eq (car list) elt) - (cdr list) - (let ((total list)) - (while (and (cdr list) - (not (eq (cadr list) elt))) - (setq list (cdr list))) - (when (cdr list) - (setcdr list (cddr list))) - total))) - (defvar byte-compile-last-warned-form nil) (defvar byte-compile-last-logged-file nil) (defvar byte-compile-root-dir nil -- cgit v1.2.3 From 253a4a2c689d757cb798cfb9f51b2110283d7146 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 24 Jun 2022 11:48:42 +0200 Subject: Bytecode opcode comments update This is a cosmetic change only; there is no change in behaviour. * lisp/emacs-lisp/bytecomp.el: * src/bytecode.c (BYTE_CODES, exec_byte_code): Update and/or remove incorrect, outdated or useless comments. Clarify. Reorder where appropriate. Rename Bsave_current_buffer to Bsave_current_buffer_OBSOLETE and Bsave_current_buffer_1 to Bsave_current_buffer, reflecting the state since 1996. --- lisp/emacs-lisp/bytecomp.el | 27 ++++++++++++++------------- src/bytecode.c | 16 +++++++++++----- 2 files changed, 25 insertions(+), 18 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a8c68f81531..bd3db85c148 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -681,10 +681,13 @@ Each element is (INDEX . VALUE)") (put 'byte-stack+-info 'tmp-compile-time-value nil))) -;; These opcodes are special in that they pack their argument into the -;; opcode word. -;; +;; The following opcodes (1-47) use the 3 lowest bits for an immediate +;; argument. + (byte-defop 0 1 byte-stack-ref "for stack reference") +;; Code 0 is actually unused but reserved as invalid code for detecting +;; corrupted bytecode. Codes 1-7 are stack-ref. + (byte-defop 8 1 byte-varref "for variable reference") (byte-defop 16 -1 byte-varset "for setting a variable") (byte-defop 24 -1 byte-varbind "for binding a variable") @@ -692,11 +695,9 @@ Each element is (INDEX . VALUE)") (byte-defop 40 0 byte-unbind "for unbinding special bindings") ;; codes 8-47 are consumed by the preceding opcodes -;; New (in Emacs-24.4) bytecodes for more efficient handling of non-local exits -;; (especially useful in lexical-binding code). (byte-defop 48 0 byte-pophandler) -(byte-defop 50 -1 byte-pushcatch) (byte-defop 49 -1 byte-pushconditioncase) +(byte-defop 50 -1 byte-pushcatch) ;; unused: 51-55 @@ -719,9 +720,9 @@ Each element is (INDEX . VALUE)") (byte-defop 72 -1 byte-aref) (byte-defop 73 -2 byte-aset) (byte-defop 74 0 byte-symbol-value) -(byte-defop 75 0 byte-symbol-function) ; this was commented out +(byte-defop 75 0 byte-symbol-function) (byte-defop 76 -1 byte-set) -(byte-defop 77 -1 byte-fset) ; this was commented out +(byte-defop 77 -1 byte-fset) (byte-defop 78 -1 byte-get) (byte-defop 79 -2 byte-substring) (byte-defop 80 -1 byte-concat2) @@ -739,8 +740,9 @@ Each element is (INDEX . VALUE)") (byte-defop 92 -1 byte-plus) (byte-defop 93 -1 byte-max) (byte-defop 94 -1 byte-min) -(byte-defop 95 -1 byte-mult) ; v19 only +(byte-defop 95 -1 byte-mult) (byte-defop 96 1 byte-point) +(byte-defop 97 0 byte-save-current-buffer-OBSOLETE) ; unused since v20 (byte-defop 98 0 byte-goto-char) (byte-defop 99 0 byte-insert) (byte-defop 100 1 byte-point-max) @@ -762,7 +764,6 @@ Each element is (INDEX . VALUE)") (byte-defop 115 0 byte-set-mark-OBSOLETE) (byte-defop 116 1 byte-interactive-p-OBSOLETE) -;; These ops are new to v19 (byte-defop 117 0 byte-forward-char) (byte-defop 118 0 byte-forward-word) (byte-defop 119 -1 byte-skip-chars-forward) @@ -819,7 +820,6 @@ the unwind-action") ;; unused: 146 -;; these ops are new to v19 (byte-defop 147 -2 byte-set-marker) (byte-defop 148 0 byte-match-beginning) (byte-defop 149 0 byte-match-end) @@ -866,10 +866,11 @@ the unwind-action") "to take a hash table and a value from the stack, and jump to the address the value maps to, if any.") -;; unused: 182-191 +;; unused: 184-191 (byte-defop 192 1 byte-constant "for reference to a constant") -;; codes 193-255 are consumed by byte-constant. +;; Codes 193-255 are consumed by `byte-constant', which uses the 6 +;; lowest bits for an immediate argument. (defconst byte-constant-limit 64 "Exclusive maximum index usable in the `byte-constant' opcode.") diff --git a/src/bytecode.c b/src/bytecode.c index fa068e1ec6b..d75767bb0c5 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -176,8 +176,8 @@ DEFINE (Bmin, 0136) \ DEFINE (Bmult, 0137) \ \ DEFINE (Bpoint, 0140) \ -/* Was Bmark in v17. */ \ -DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \ +/* 0141 was Bmark in v17, Bsave_current_buffer in 18-19. */ \ +DEFINE (Bsave_current_buffer_OBSOLETE, 0141) /* Obsolete since 20. */ \ DEFINE (Bgoto_char, 0142) \ DEFINE (Binsert, 0143) \ DEFINE (Bpoint_max, 0144) \ @@ -194,7 +194,7 @@ DEFINE (Bbolp, 0156) \ DEFINE (Bbobp, 0157) \ DEFINE (Bcurrent_buffer, 0160) \ DEFINE (Bset_buffer, 0161) \ -DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \ +DEFINE (Bsave_current_buffer, 0162) \ /* 0163 was Bset_mark in v17. */ \ DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \ \ @@ -924,8 +924,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, record_unwind_protect_excursion (); NEXT; - CASE (Bsave_current_buffer): /* Obsolete since ??. */ - CASE (Bsave_current_buffer_1): + CASE (Bsave_current_buffer_OBSOLETE): /* Obsolete since 20. */ + CASE (Bsave_current_buffer): record_unwind_current_buffer (); NEXT; @@ -1678,6 +1678,12 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, /* TODO: Perhaps introduce another byte-code for switch when the number of cases is less, which uses a simple vector for linear search as the jump table. */ + + /* TODO: Instead of pushing the table in a separate + Bconstant op, use an immediate argument (maybe separate + switch opcodes for 1-byte and 2-byte constant indices). + This would also get rid of some hacks that assume each + Bswitch to be preceded by a Bconstant. */ Lisp_Object jmp_table = POP; if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) emacs_abort (); -- cgit v1.2.3 From 162c6c12f97db9b4b3042dc8d122027e9fb01e71 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 4 Jul 2022 18:42:26 +0200 Subject: Prefer defvar-keymap in emacs-lisp/*.el * lisp/emacs-lisp/backtrace.el (backtrace-mode-map): * lisp/emacs-lisp/bytecomp.el (emacs-lisp-compilation-mode-map): * lisp/emacs-lisp/checkdoc.el (checkdoc-minor-mode-map): * lisp/emacs-lisp/crm.el (crm-local-completion-map) (crm-local-must-match-map): * lisp/emacs-lisp/debug.el (debugger-mode-map): * lisp/emacs-lisp/edebug.el (edebug-mode-map, edebug-global-map) (edebug-eval-mode-map): * lisp/emacs-lisp/eieio-custom.el (eieio-custom-mode-map): * lisp/emacs-lisp/elp.el (elp-results-symname-map): * lisp/emacs-lisp/lisp-mode.el (lisp-mode-shared-map): * lisp/emacs-lisp/re-builder.el (reb-mode-map) (reb-lisp-mode-map, reb-subexp-mode-map): * lisp/emacs-lisp/tabulated-list.el (tabulated-list-mode-map) (tabulated-list-sort-button-map): * lisp/emacs-lisp/timer-list.el (timer-list-mode-map): --- lisp/emacs-lisp/backtrace.el | 114 ++++++++++---------- lisp/emacs-lisp/bytecomp.el | 6 +- lisp/emacs-lisp/checkdoc.el | 56 +++++----- lisp/emacs-lisp/crm.el | 39 +++---- lisp/emacs-lisp/debug.el | 93 +++++++++-------- lisp/emacs-lisp/edebug.el | 213 ++++++++++++++++++-------------------- lisp/emacs-lisp/eieio-custom.el | 8 +- lisp/emacs-lisp/elp.el | 12 +-- lisp/emacs-lisp/lisp-mode.el | 35 +++---- lisp/emacs-lisp/re-builder.el | 60 +++++------ lisp/emacs-lisp/tabulated-list.el | 49 ++++----- lisp/emacs-lisp/timer-list.el | 12 +-- 12 files changed, 332 insertions(+), 365 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 3231877a30c..e305822af1f 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -199,63 +199,63 @@ functions returns non-nil. When adding a function to this hook, you should also set the :source-available flag for the backtrace frames where the source code location is known.") -(defvar backtrace-mode-map - (let ((map (copy-keymap special-mode-map))) - (set-keymap-parent map button-buffer-map) - (define-key map "n" 'backtrace-forward-frame) - (define-key map "p" 'backtrace-backward-frame) - (define-key map "v" 'backtrace-toggle-locals) - (define-key map "#" 'backtrace-toggle-print-circle) - (define-key map ":" 'backtrace-toggle-print-gensym) - (define-key map "s" 'backtrace-goto-source) - (define-key map "\C-m" 'backtrace-help-follow-symbol) - (define-key map "+" 'backtrace-multi-line) - (define-key map "-" 'backtrace-single-line) - (define-key map "." 'backtrace-expand-ellipses) - (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] 'mouse-select-window) - (easy-menu-define nil map "" - '("Backtrace" - ["Next Frame" backtrace-forward-frame - :help "Move cursor forwards to the start of a backtrace frame"] - ["Previous Frame" backtrace-backward-frame - :help "Move cursor backwards to the start of a backtrace frame"] - "--" - ["Show Variables" backtrace-toggle-locals - :style toggle - :active (backtrace-get-index) - :selected (plist-get (backtrace-get-view) :show-locals) - :help "Show or hide the local variables for the frame at point"] - ["Show Circular Structures" backtrace-toggle-print-circle - :style toggle - :active (backtrace-get-index) - :selected (plist-get (backtrace-get-view) :print-circle) - :help - "Condense or expand shared or circular structures in the frame at point"] - ["Show Uninterned Symbols" backtrace-toggle-print-gensym - :style toggle - :active (backtrace-get-index) - :selected (plist-get (backtrace-get-view) :print-gensym) - :help - "Toggle unique printing of uninterned symbols in the frame at point"] - ["Expand \"...\"s" backtrace-expand-ellipses - :help "Expand all the abbreviated forms in the current frame"] - ["Show on Multiple Lines" backtrace-multi-line - :help "Use line breaks and indentation to make a form more readable"] - ["Show on Single Line" backtrace-single-line] - "--" - ["Go to Source" backtrace-goto-source - :active (and (backtrace-get-index) - (plist-get (backtrace-frame-flags - (nth (backtrace-get-index) backtrace-frames)) - :source-available)) - :help "Show the source code for the current frame"] - ["Help for Symbol" backtrace-help-follow-symbol - :help "Show help for symbol at point"] - ["Describe Backtrace Mode" describe-mode - :help "Display documentation for backtrace-mode"])) - map) - "Local keymap for `backtrace-mode' buffers.") +(defvar-keymap backtrace-mode-map + :doc "Local keymap for `backtrace-mode' buffers." + :parent (make-composed-keymap special-mode-map + button-buffer-map) + "n" #'backtrace-forward-frame + "p" #'backtrace-backward-frame + "v" #'backtrace-toggle-locals + "#" #'backtrace-toggle-print-circle + ":" #'backtrace-toggle-print-gensym + "s" #'backtrace-goto-source + "RET" #'backtrace-help-follow-symbol + "+" #'backtrace-multi-line + "-" #'backtrace-single-line + "." #'backtrace-expand-ellipses + "" 'mouse-face + "" #'mouse-select-window + + :menu + '("Backtrace" + ["Next Frame" backtrace-forward-frame + :help "Move cursor forwards to the start of a backtrace frame"] + ["Previous Frame" backtrace-backward-frame + :help "Move cursor backwards to the start of a backtrace frame"] + "--" + ["Show Variables" backtrace-toggle-locals + :style toggle + :active (backtrace-get-index) + :selected (plist-get (backtrace-get-view) :show-locals) + :help "Show or hide the local variables for the frame at point"] + ["Show Circular Structures" backtrace-toggle-print-circle + :style toggle + :active (backtrace-get-index) + :selected (plist-get (backtrace-get-view) :print-circle) + :help + "Condense or expand shared or circular structures in the frame at point"] + ["Show Uninterned Symbols" backtrace-toggle-print-gensym + :style toggle + :active (backtrace-get-index) + :selected (plist-get (backtrace-get-view) :print-gensym) + :help + "Toggle unique printing of uninterned symbols in the frame at point"] + ["Expand \"...\"s" backtrace-expand-ellipses + :help "Expand all the abbreviated forms in the current frame"] + ["Show on Multiple Lines" backtrace-multi-line + :help "Use line breaks and indentation to make a form more readable"] + ["Show on Single Line" backtrace-single-line] + "--" + ["Go to Source" backtrace-goto-source + :active (and (backtrace-get-index) + (plist-get (backtrace-frame-flags + (nth (backtrace-get-index) backtrace-frames)) + :source-available)) + :help "Show the source code for the current frame"] + ["Help for Symbol" backtrace-help-follow-symbol + :help "Show help for symbol at point"] + ["Describe Backtrace Mode" describe-mode + :help "Display documentation for backtrace-mode"])) (defconst backtrace--flags-width 2 "Width in characters of the flags for a backtrace frame.") diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index bd3db85c148..6545c8d961d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1123,10 +1123,8 @@ message buffer `default-directory'." :type '(repeat (choice (const :tag "Default" nil) (string :tag "Directory")))) -(defvar emacs-lisp-compilation-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "g" 'emacs-lisp-compilation-recompile) - map)) +(defvar-keymap emacs-lisp-compilation-mode-map + "g" #'emacs-lisp-compilation-recompile) (defvar emacs-lisp-compilation--current-file nil) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 2c9adfe2d27..611f32e23c6 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1279,38 +1279,30 @@ TEXT, START, END and UNFIXABLE conform to ;;; Minor Mode specification ;; -(defvar checkdoc-minor-mode-map - (let ((map (make-sparse-keymap)) - (pmap (make-sparse-keymap))) - ;; Override some bindings - (define-key map "\C-\M-x" #'checkdoc-eval-defun) - (define-key map "\C-x`" #'checkdoc-continue) - (define-key map [menu-bar emacs-lisp eval-buffer] - #'checkdoc-eval-current-buffer) - ;; Add some new bindings under C-c ? - (define-key pmap "x" #'checkdoc-defun) - (define-key pmap "X" #'checkdoc-ispell-defun) - (define-key pmap "`" #'checkdoc-continue) - (define-key pmap "~" #'checkdoc-ispell-continue) - (define-key pmap "s" #'checkdoc-start) - (define-key pmap "S" #'checkdoc-ispell-start) - (define-key pmap "d" #'checkdoc) - (define-key pmap "D" #'checkdoc-ispell) - (define-key pmap "b" #'checkdoc-current-buffer) - (define-key pmap "B" #'checkdoc-ispell-current-buffer) - (define-key pmap "e" #'checkdoc-eval-current-buffer) - (define-key pmap "m" #'checkdoc-message-text) - (define-key pmap "M" #'checkdoc-ispell-message-text) - (define-key pmap "c" #'checkdoc-comments) - (define-key pmap "C" #'checkdoc-ispell-comments) - (define-key pmap " " #'checkdoc-rogue-spaces) - - ;; bind our submap into map - (define-key map "\C-c?" pmap) - map) - "Keymap used to override evaluation key-bindings for documentation checking.") - -;; Add in a menubar with easy-menu +(defvar-keymap checkdoc-minor-mode-map + :doc "Keymap used to override evaluation key-bindings for documentation checking." + ;; Override some bindings + "C-M-x" #'checkdoc-eval-defun + "C-x `" #'checkdoc-continue + " " #'checkdoc-eval-current-buffer + + ;; Add some new bindings under C-c ? + "C-c ? x" #'checkdoc-defun + "C-c ? X" #'checkdoc-ispell-defun + "C-c ? `" #'checkdoc-continue + "C-c ? ~" #'checkdoc-ispell-continue + "C-c ? s" #'checkdoc-start + "C-c ? S" #'checkdoc-ispell-start + "C-c ? d" #'checkdoc + "C-c ? D" #'checkdoc-ispell + "C-c ? b" #'checkdoc-current-buffer + "C-c ? B" #'checkdoc-ispell-current-buffer + "C-c ? e" #'checkdoc-eval-current-buffer + "C-c ? m" #'checkdoc-message-text + "C-c ? M" #'checkdoc-ispell-message-text + "C-c ? c" #'checkdoc-comments + "C-c ? C" #'checkdoc-ispell-comments + "C-c ? SPC" #'checkdoc-rogue-spaces) (easy-menu-define nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu." diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 8a5c3d3730c..9d9c91e510e 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -87,28 +87,23 @@ It should be a regexp that does not match the list of completion candidates. The default value is `crm-default-separator'.") -(defvar crm-local-completion-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-completion-map) - (define-key map [remap minibuffer-complete] #'crm-complete) - (define-key map [remap minibuffer-complete-word] #'crm-complete-word) - (define-key map [remap minibuffer-completion-help] #'crm-completion-help) - map) - "Local keymap for minibuffer multiple input with completion. -Analog of `minibuffer-local-completion-map'.") - -(defvar crm-local-must-match-map - (let ((map (make-sparse-keymap))) - ;; We'd want to have multiple inheritance here. - (set-keymap-parent map minibuffer-local-must-match-map) - (define-key map [remap minibuffer-complete] #'crm-complete) - (define-key map [remap minibuffer-complete-word] #'crm-complete-word) - (define-key map [remap minibuffer-completion-help] #'crm-completion-help) - (define-key map [remap minibuffer-complete-and-exit] - #'crm-complete-and-exit) - map) - "Local keymap for minibuffer multiple input with exact match completion. -Analog of `minibuffer-local-must-match-map' for crm.") +(defvar-keymap crm-local-completion-map + :doc "Local keymap for minibuffer multiple input with completion. +Analog of `minibuffer-local-completion-map'." + :parent minibuffer-local-completion-map + " " #'crm-complete + " " #'crm-complete-word + " " #'crm-completion-help) + +(defvar-keymap crm-local-must-match-map + :doc "Local keymap for minibuffer multiple input with exact match completion. +Analog of `minibuffer-local-must-match-map' for crm." + ;; We'd want to have multiple inheritance here. + :parent minibuffer-local-must-match-map + " " #'crm-complete + " " #'crm-complete-word + " " #'crm-completion-help + " " #'crm-complete-and-exit) (defvar crm-completion-table nil "An alist whose elements' cars are strings, or an obarray. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index c4929eb2b01..460057b3afd 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -560,52 +560,53 @@ The environment used is the one when entering the activation frame at point." 'backtrace-toggle-locals "28.1") -(defvar debugger-mode-map - (let ((map (make-keymap))) - (set-keymap-parent map backtrace-mode-map) - (define-key map "b" 'debugger-frame) - (define-key map "c" 'debugger-continue) - (define-key map "j" 'debugger-jump) - (define-key map "r" 'debugger-return-value) - (define-key map "u" 'debugger-frame-clear) - (define-key map "d" 'debugger-step-through) - (define-key map "l" 'debugger-list-functions) - (define-key map "q" 'debugger-quit) - (define-key map "e" 'debugger-eval-expression) - (define-key map "R" 'debugger-record-expression) - (define-key map [mouse-2] 'push-button) - (easy-menu-define nil map "" - '("Debugger" - ["Step through" debugger-step-through - :help "Proceed, stepping through subexpressions of this expression"] - ["Continue" debugger-continue - :help "Continue, evaluating this expression without stopping"] - ["Jump" debugger-jump - :help "Continue to exit from this frame, with all debug-on-entry suspended"] - ["Eval Expression..." debugger-eval-expression - :help "Eval an expression, in an environment like that outside the debugger"] - ["Display and Record Expression" debugger-record-expression - :help "Display a variable's value and record it in `*Backtrace-record*' buffer"] - ["Return value..." debugger-return-value - :help "Continue, specifying value to return."] - "--" - ["Debug frame" debugger-frame - :help "Request entry to debugger when this frame exits"] - ["Cancel debug frame" debugger-frame-clear - :help "Do not enter debugger when this frame exits"] - ["List debug on entry functions" debugger-list-functions - :help "Display a list of all the functions now set to debug on entry"] - "--" - ["Next Line" next-line - :help "Move cursor down"] - ["Help for Symbol" backtrace-help-follow-symbol - :help "Show help for symbol at point"] - ["Describe Debugger Mode" describe-mode - :help "Display documentation for debugger-mode"] - "--" - ["Quit" debugger-quit - :help "Quit debugging and return to top level"])) - map)) +(defvar-keymap debugger-mode-map + :full t + :parent backtrace-mode-map + "b" #'debugger-frame + "c" #'debugger-continue + "j" #'debugger-jump + "r" #'debugger-return-value + "u" #'debugger-frame-clear + "d" #'debugger-step-through + "l" #'debugger-list-functions + "q" #'debugger-quit + "e" #'debugger-eval-expression + "R" #'debugger-record-expression + + "" #'push-button + + :menu + '("Debugger" + ["Step through" debugger-step-through + :help "Proceed, stepping through subexpressions of this expression"] + ["Continue" debugger-continue + :help "Continue, evaluating this expression without stopping"] + ["Jump" debugger-jump + :help "Continue to exit from this frame, with all debug-on-entry suspended"] + ["Eval Expression..." debugger-eval-expression + :help "Eval an expression, in an environment like that outside the debugger"] + ["Display and Record Expression" debugger-record-expression + :help "Display a variable's value and record it in `*Backtrace-record*' buffer"] + ["Return value..." debugger-return-value + :help "Continue, specifying value to return."] + "--" + ["Debug frame" debugger-frame + :help "Request entry to debugger when this frame exits"] + ["Cancel debug frame" debugger-frame-clear + :help "Do not enter debugger when this frame exits"] + ["List debug on entry functions" debugger-list-functions + :help "Display a list of all the functions now set to debug on entry"] + "--" + ["Next Line" next-line + :help "Move cursor down"] + ["Help for Symbol" backtrace-help-follow-symbol + :help "Show help for symbol at point"] + ["Describe Debugger Mode" describe-mode + :help "Display documentation for debugger-mode"] + "--" + ["Quit" debugger-quit + :help "Quit debugging and return to top level"])) (put 'debugger-mode 'mode-class 'special) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index b05ec3a7683..1a1d58d6e36 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3809,74 +3809,72 @@ be installed in `emacs-lisp-mode-map'.") ;; The following isn't a GUD binding. (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode)) -(defvar edebug-mode-map - (let ((map (copy-keymap emacs-lisp-mode-map))) - ;; control - (define-key map " " 'edebug-step-mode) - (define-key map "n" 'edebug-next-mode) - (define-key map "g" 'edebug-go-mode) - (define-key map "G" 'edebug-Go-nonstop-mode) - (define-key map "t" 'edebug-trace-mode) - (define-key map "T" 'edebug-Trace-fast-mode) - (define-key map "c" 'edebug-continue-mode) - (define-key map "C" 'edebug-Continue-fast-mode) - - ;;(define-key map "f" 'edebug-forward) not implemented - (define-key map "f" 'edebug-forward-sexp) - (define-key map "h" 'edebug-goto-here) - - (define-key map "I" 'edebug-instrument-callee) - (define-key map "i" 'edebug-step-in) - (define-key map "o" 'edebug-step-out) - - ;; quitting and stopping - (define-key map "q" 'top-level) - (define-key map "Q" 'edebug-top-level-nonstop) - (define-key map "a" 'abort-recursive-edit) - (define-key map "S" 'edebug-stop) - - ;; breakpoints - (define-key map "b" 'edebug-set-breakpoint) - (define-key map "u" 'edebug-unset-breakpoint) - (define-key map "U" 'edebug-unset-breakpoints) - (define-key map "B" 'edebug-next-breakpoint) - (define-key map "x" 'edebug-set-conditional-breakpoint) - (define-key map "X" 'edebug-set-global-break-condition) - (define-key map "D" 'edebug-toggle-disable-breakpoint) - - ;; evaluation - (define-key map "r" 'edebug-previous-result) - (define-key map "e" 'edebug-eval-expression) - (define-key map "\C-x\C-e" 'edebug-eval-last-sexp) - (define-key map "E" 'edebug-visit-eval-list) - - ;; views - (define-key map "w" 'edebug-where) - (define-key map "v" 'edebug-view-outside) ;; maybe obsolete?? - (define-key map "p" 'edebug-bounce-point) - (define-key map "P" 'edebug-view-outside) ;; same as v - (define-key map "W" 'edebug-toggle-save-windows) - - ;; misc - (define-key map "?" 'edebug-help) - (define-key map "d" 'edebug-pop-to-backtrace) - - (define-key map "-" 'negative-argument) - - ;; statistics - (define-key map "=" 'edebug-temp-display-freq-count) - - ;; GUD bindings - (define-key map "\C-c\C-s" 'edebug-step-mode) - (define-key map "\C-c\C-n" 'edebug-next-mode) - (define-key map "\C-c\C-c" 'edebug-go-mode) - - (define-key map "\C-x " 'edebug-set-breakpoint) - (define-key map "\C-c\C-d" 'edebug-unset-breakpoint) - (define-key map "\C-c\C-t" - (lambda () (interactive) (edebug-set-breakpoint t))) - (define-key map "\C-c\C-l" 'edebug-where) - map)) +(defvar-keymap edebug-mode-map + :parent emacs-lisp-mode-map + ;; control + "SPC" #'edebug-step-mode + "n" #'edebug-next-mode + "g" #'edebug-go-mode + "G" #'edebug-Go-nonstop-mode + "t" #'edebug-trace-mode + "T" #'edebug-Trace-fast-mode + "c" #'edebug-continue-mode + "C" #'edebug-Continue-fast-mode + + ;;"f" #'edebug-forward ; not implemented + "f" #'edebug-forward-sexp + "h" #'edebug-goto-here + + "I" #'edebug-instrument-callee + "i" #'edebug-step-in + "o" #'edebug-step-out + + ;; quitting and stopping + "q" #'top-level + "Q" #'edebug-top-level-nonstop + "a" #'abort-recursive-edit + "S" #'edebug-stop + + ;; breakpoints + "b" #'edebug-set-breakpoint + "u" #'edebug-unset-breakpoint + "U" #'edebug-unset-breakpoints + "B" #'edebug-next-breakpoint + "x" #'edebug-set-conditional-breakpoint + "X" #'edebug-set-global-break-condition + "D" #'edebug-toggle-disable-breakpoint + + ;; evaluation + "r" #'edebug-previous-result + "e" #'edebug-eval-expression + "C-x C-e" #'edebug-eval-last-sexp + "E" #'edebug-visit-eval-list + + ;; views + "w" #'edebug-where + "v" #'edebug-view-outside ; maybe obsolete?? + "p" #'edebug-bounce-point + "P" #'edebug-view-outside ; same as v + "W" #'edebug-toggle-save-windows + + ;; misc + "?" #'edebug-help + "d" #'edebug-pop-to-backtrace + + "-" #'negative-argument + + ;; statistics + "=" #'edebug-temp-display-freq-count + + ;; GUD bindings + "C-c C-s" #'edebug-step-mode + "C-c C-n" #'edebug-next-mode + "C-c C-c" #'edebug-go-mode + + "C-x SPC" #'edebug-set-breakpoint + "C-c C-d" #'edebug-unset-breakpoint + "C-c C-t" (lambda () (interactive) (edebug-set-breakpoint t)) + "C-c C-l" #'edebug-where) ;; Autoloading these global bindings doesn't make sense because ;; they cannot be used anyway unless Edebug is already loaded and active. @@ -3891,38 +3889,35 @@ be installed in `emacs-lisp-mode-map'.") (define-obsolete-variable-alias 'global-edebug-map 'edebug-global-map "28.1") -(defvar edebug-global-map - (let ((map (make-sparse-keymap))) - - (define-key map " " 'edebug-step-mode) - (define-key map "g" 'edebug-go-mode) - (define-key map "G" 'edebug-Go-nonstop-mode) - (define-key map "t" 'edebug-trace-mode) - (define-key map "T" 'edebug-Trace-fast-mode) - (define-key map "c" 'edebug-continue-mode) - (define-key map "C" 'edebug-Continue-fast-mode) - - ;; breakpoints - (define-key map "b" 'edebug-set-breakpoint) - (define-key map "u" 'edebug-unset-breakpoint) - (define-key map "U" 'edebug-unset-breakpoints) - (define-key map "x" 'edebug-set-conditional-breakpoint) - (define-key map "X" 'edebug-set-global-break-condition) - (define-key map "D" 'edebug-toggle-disable-breakpoint) - - ;; views - (define-key map "w" 'edebug-where) - (define-key map "W" 'edebug-toggle-save-windows) - - ;; quitting - (define-key map "q" 'top-level) - (define-key map "Q" 'edebug-top-level-nonstop) - (define-key map "a" 'abort-recursive-edit) - - ;; statistics - (define-key map "=" 'edebug-display-freq-count) - map) - "Global map of edebug commands, available from any buffer.") +(defvar-keymap edebug-global-map + :doc "Global map of edebug commands, available from any buffer." + "SPC" #'edebug-step-mode + "g" #'edebug-go-mode + "G" #'edebug-Go-nonstop-mode + "t" #'edebug-trace-mode + "T" #'edebug-Trace-fast-mode + "c" #'edebug-continue-mode + "C" #'edebug-Continue-fast-mode + + ;; breakpoints + "b" #'edebug-set-breakpoint + "u" #'edebug-unset-breakpoint + "U" #'edebug-unset-breakpoints + "x" #'edebug-set-conditional-breakpoint + "X" #'edebug-set-global-break-condition + "D" #'edebug-toggle-disable-breakpoint + + ;; views + "w" #'edebug-where + "W" #'edebug-toggle-save-windows + + ;; quitting + "q" #'top-level + "Q" #'edebug-top-level-nonstop + "a" #'abort-recursive-edit + + ;; statistics + "=" #'edebug-display-freq-count) (when edebug-global-prefix (global-unset-key edebug-global-prefix) @@ -4093,16 +4088,14 @@ May only be called from within `edebug--recursive-edit'." -(defvar edebug-eval-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map lisp-interaction-mode-map) - (define-key map "\C-c\C-w" 'edebug-where) - (define-key map "\C-c\C-d" 'edebug-delete-eval-item) - (define-key map "\C-c\C-u" 'edebug-update-eval-list) - (define-key map "\C-x\C-e" 'edebug-eval-last-sexp) - (define-key map "\C-j" 'edebug-eval-print-last-sexp) - map) - "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.") +(defvar-keymap edebug-eval-mode-map + :doc "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode." + :parent lisp-interaction-mode-map + "C-c C-w" #'edebug-where + "C-c C-d" #'edebug-delete-eval-item + "C-c C-u" #'edebug-update-eval-list + "C-x C-e" #'edebug-eval-last-sexp + "C-j" #'edebug-eval-print-last-sexp) (put 'edebug-eval-mode 'mode-class 'special) diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index ebb6f2cd8c8..4b8b4275f1a 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -329,11 +329,9 @@ Argument OBJ is the object that has been customized." Optional argument GROUP is the sub-group of slots to display." (eieio-customize-object obj group)) -(defvar eieio-custom-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map widget-keymap) - map) - "Keymap for EIEIO Custom mode.") +(defvar-keymap eieio-custom-mode-map + :doc "Keymap for EIEIO Custom mode." + :parent widget-keymap) (define-derived-mode eieio-custom-mode fundamental-mode "EIEIO Custom" "Major mode for customizing EIEIO objects. diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 385ddb3f414..03c5b94e3b4 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -472,13 +472,11 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." (insert atstr)) (insert "\n")))) -(defvar elp-results-symname-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'elp-results-jump-to-definition) - (define-key map [follow-link] 'mouse-face) - (define-key map "\C-m" 'elp-results-jump-to-definition) - map) - "Keymap used on the function name column." ) +(defvar-keymap elp-results-symname-map + :doc "Keymap used on the function name column." + "" #'elp-results-jump-to-definition + "" 'mouse-face + "RET" #'elp-results-jump-to-definition) (defun elp-results-jump-to-definition (&optional event) "Jump to the definition of the function at point." diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 65f76a4fa35..c559dd427cb 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -753,17 +753,16 @@ font-lock keywords will not be case sensitive." (progn (forward-sexp 1) (point))))))) -(defvar lisp-mode-shared-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map prog-mode-map) - (define-key map "\e\C-q" 'indent-sexp) - (define-key map "\177" 'backward-delete-char-untabify) - ;; This gets in the way when viewing a Lisp file in view-mode. As - ;; long as [backspace] is mapped into DEL via the - ;; function-key-map, this should remain disabled!! - ;;;(define-key map [backspace] 'backward-delete-char-untabify) - map) - "Keymap for commands shared by all sorts of Lisp modes.") +(defvar-keymap lisp-mode-shared-map + :doc "Keymap for commands shared by all sorts of Lisp modes." + :parent prog-mode-map + "C-M-q" #'indent-sexp + "DEL" #'backward-delete-char-untabify + ;; This gets in the way when viewing a Lisp file in view-mode. As + ;; long as [backspace] is mapped into DEL via the + ;; function-key-map, this should remain disabled!! + ;;;"" #'backward-delete-char-untabify + ) (defcustom lisp-mode-hook nil "Hook run when entering Lisp mode." @@ -779,14 +778,12 @@ font-lock keywords will not be case sensitive." ;;; Generic Lisp mode. -(defvar lisp-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map lisp-mode-shared-map) - (define-key map "\e\C-x" 'lisp-eval-defun) - (define-key map "\C-c\C-z" 'run-lisp) - map) - "Keymap for ordinary Lisp mode. -All commands in `lisp-mode-shared-map' are inherited by this map.") +(defvar-keymap lisp-mode-map + :doc "Keymap for ordinary Lisp mode. +All commands in `lisp-mode-shared-map' are inherited by this map." + :parent lisp-mode-shared-map + "C-M-x" #'lisp-eval-defun + "C-c C-z" #'run-lisp) (easy-menu-define lisp-mode-menu lisp-mode-map "Menu for ordinary Lisp mode." diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 24770fac67f..46b429ce6fe 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -216,19 +216,17 @@ Except for Lisp syntax this is the same as `reb-regexp'.") "Buffer to use for the RE Builder.") ;; Define the local "\C-c" keymap -(defvar reb-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'reb-toggle-case) - (define-key map "\C-c\C-q" 'reb-quit) - (define-key map "\C-c\C-w" 'reb-copy) - (define-key map "\C-c\C-s" 'reb-next-match) - (define-key map "\C-c\C-r" 'reb-prev-match) - (define-key map "\C-c\C-i" 'reb-change-syntax) - (define-key map "\C-c\C-e" 'reb-enter-subexp-mode) - (define-key map "\C-c\C-b" 'reb-change-target-buffer) - (define-key map "\C-c\C-u" 'reb-force-update) - map) - "Keymap used by the RE Builder.") +(defvar-keymap reb-mode-map + :doc "Keymap used by the RE Builder." + "C-c C-c" #'reb-toggle-case + "C-c C-q" #'reb-quit + "C-c C-w" #'reb-copy + "C-c C-s" #'reb-next-match + "C-c C-r" #'reb-prev-match + "C-c C-i" #'reb-change-syntax + "C-c C-e" #'reb-enter-subexp-mode + "C-c C-b" #'reb-change-target-buffer + "C-c C-u" #'reb-force-update) (easy-menu-define reb-mode-menu reb-mode-map "Menu for the RE Builder." @@ -263,12 +261,10 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (setq-local blink-matching-paren nil) (reb-mode-common)) -(defvar reb-lisp-mode-map - (let ((map (make-sparse-keymap))) - ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from - ;; `emacs-lisp-mode' - (define-key map "\C-c" (lookup-key reb-mode-map "\C-c")) - map)) +(defvar-keymap reb-lisp-mode-map + ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from + ;; `emacs-lisp-mode' + "C-c" (keymap-lookup reb-mode-map "C-c")) (define-derived-mode reb-lisp-mode emacs-lisp-mode "RE Builder Lisp" @@ -278,16 +274,22 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (require 'rx)) ; require rx anyway (reb-mode-common)) -(defvar reb-subexp-mode-map - (let ((m (make-keymap))) - (suppress-keymap m) - ;; Again share the "\C-c" keymap for the commands - (define-key m "\C-c" (lookup-key reb-mode-map "\C-c")) - (define-key m "q" 'reb-quit-subexp-mode) - (dotimes (digit 10) - (define-key m (int-to-string digit) 'reb-display-subexp)) - m) - "Keymap used by the RE Builder for the subexpression mode.") +(defvar-keymap reb-subexp-mode-map + :doc "Keymap used by the RE Builder for the subexpression mode." + :full t :suppress t + ;; Again share the "\C-c" keymap for the commands + "C-c" (keymap-lookup reb-mode-map "C-c") + "q" #'reb-quit-subexp-mode + "0" #'reb-display-subexp + "1" #'reb-display-subexp + "2" #'reb-display-subexp + "3" #'reb-display-subexp + "4" #'reb-display-subexp + "5" #'reb-display-subexp + "6" #'reb-display-subexp + "7" #'reb-display-subexp + "8" #'reb-display-subexp + "9" #'reb-display-subexp) (defun reb-mode-common () "Setup functions common to functions `reb-mode' and `reb-lisp-mode'." diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 7d815a3cedc..9868d8c4ec0 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -216,33 +216,28 @@ If ADVANCE is non-nil, move forward by one line afterwards." (while (re-search-forward re nil 'noerror) (tabulated-list-put-tag empty))))) -(defvar tabulated-list-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (make-composed-keymap - button-buffer-map - special-mode-map)) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) - (define-key map (kbd "M-") 'tabulated-list-previous-column) - (define-key map (kbd "M-") 'tabulated-list-next-column) - (define-key map "S" 'tabulated-list-sort) - (define-key map "}" 'tabulated-list-widen-current-column) - (define-key map "{" 'tabulated-list-narrow-current-column) - (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] 'mouse-select-window) - map) - "Local keymap for `tabulated-list-mode' buffers.") - -(defvar tabulated-list-sort-button-map - (let ((map (make-sparse-keymap))) - (define-key map [header-line mouse-1] 'tabulated-list-col-sort) - (define-key map [header-line mouse-2] 'tabulated-list-col-sort) - (define-key map [mouse-1] 'tabulated-list-col-sort) - (define-key map [mouse-2] 'tabulated-list-col-sort) - (define-key map "\C-m" 'tabulated-list-sort) - (define-key map [follow-link] 'mouse-face) - map) - "Local keymap for `tabulated-list-mode' sort buttons.") +(defvar-keymap tabulated-list-mode-map + :doc "Local keymap for `tabulated-list-mode' buffers." + :parent (make-composed-keymap button-buffer-map + special-mode-map) + "n" #'next-line + "p" #'previous-line + "M-" #'tabulated-list-previous-column + "M-" #'tabulated-list-next-column + "S" #'tabulated-list-sort + "}" #'tabulated-list-widen-current-column + "{" #'tabulated-list-narrow-current-column + "" 'mouse-face + "" #'mouse-select-window) + +(defvar-keymap tabulated-list-sort-button-map + :doc "Local keymap for `tabulated-list-mode' sort buttons." + " " #'tabulated-list-col-sort + " " #'tabulated-list-col-sort + "" #'tabulated-list-col-sort + "" #'tabulated-list-col-sort + "RET" #'tabulated-list-sort + "" 'mouse-face) (defun tabulated-list-make-glyphless-char-display-table () "Make the `glyphless-char-display' table used for text-mode frames. diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index aef18d0ba27..8c56108dcbc 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -81,13 +81,11 @@ ;; doing. Kids, don't try this at home! ;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.") -(defvar timer-list-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "c" 'timer-list-cancel) - (easy-menu-define nil map "" - '("Timers" - ["Cancel" timer-list-cancel t])) - map)) +(defvar-keymap timer-list-mode-map + "c" #'timer-list-cancel + :menu + '("Timers" + ["Cancel" timer-list-cancel t])) (define-derived-mode timer-list-mode tabulated-list-mode "Timer-List" "Mode for listing and controlling timers." -- cgit v1.2.3 From 9d866a1f8da870dcf82f87d5ed9d5ca932d5477b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 5 Jul 2022 16:26:45 +0200 Subject: Make some defcustom types more restrictive * lisp/abbrev.el (abbrev-suggest-hint-threshold): * lisp/bookmark.el (bookmark-bmenu-file-column) (bookmark-menu-length): * lisp/buff-menu.el (Buffer-menu-size-width) (Buffer-menu-mode-width): * lisp/calendar/calendar.el (calendar-week-start-day) (calendar-intermonth-spacing, calendar-column-width) (calendar-day-digit-width): * lisp/calc/calc.el (calc-undo-length): * lisp/calendar/timeclock.el (timeclock-workday): * lisp/comint.el (comint-buffer-maximum-size) (comint-input-ring-size): * lisp/doc-view.el (doc-view-resolution, doc-view-image-width): * lisp/emacs-lisp/bytecomp.el (byte-compile-docstring-max-column): * lisp/emacs-lisp/comp.el (native-comp-debug) (native-comp-verbose, native-comp-async-jobs-number): * lisp/emacs-lisp/package.el (package-name-column-width) (package-version-column-width, package-status-column-width) (package-archive-column-width): * lisp/eshell/esh-mode.el (eshell-buffer-maximum-lines): * lisp/frame.el (blink-cursor-blinks): * lisp/info.el (Info-breadcrumbs-depth): * lisp/jit-lock.el (jit-lock-chunk-size): * lisp/kmacro.el (kmacro-ring-max): * lisp/menu-bar.el (yank-menu-length, yank-menu-max-items): * lisp/midnight.el (clean-buffer-list-delay-general) (clean-buffer-list-delay-special): * lisp/net/dictionary.el (dictionary-port) (dictionary-proxy-port): * lisp/net/ldap.el (ldap-default-port): * lisp/net/pop3.el (pop3-port, pop3-stream-length): * lisp/net/rcirc.el (rcirc-default-port): * lisp/net/sieve-manage.el (sieve-manage-default-port): * lisp/play/spook.el (spook-phrase-default-count): * lisp/play/tetris.el (tetris-buffer-width) (tetris-buffer-height, tetris-width, tetris-height) (tetris-top-left-x, tetris-top-left-y): * lisp/profiler.el (profiler-sampling-interval): * lisp/progmodes/sql.el (sql-port): * lisp/recentf.el (recentf-max-menu-items): * lisp/strokes.el (strokes-grid-resolution): * lisp/tab-bar.el (tab-bar-tab-name-truncated-max): * lisp/term/xterm.el (xterm-max-cut-length): * lisp/time.el (display-time-interval, world-clock-timer-second): * lisp/url/url-cache.el (url-cache-expire-time): * lisp/url/url-cookie.el (url-cookie-save-interval): * lisp/url/url-history.el (url-history-save-interval): * lisp/url/url-queue.el (url-queue-parallel-processes) (url-queue-timeout): * lisp/url/url-vars.el (url-max-password-attempts) (url-max-redirections): * lisp/vc/emerge.el (emerge-min-visible-lines): * lisp/vc/vc.el (vc-log-show-limit): * lisp/window.el (window-min-height, window-min-width): * lisp/winner.el (winner-ring-size): Use :type natnum. * lisp/savehist.el (savehist-file-modes): Fix setting to nil value and use :type natnum. --- lisp/abbrev.el | 4 ++-- lisp/bookmark.el | 4 ++-- lisp/buff-menu.el | 4 ++-- lisp/calc/calc.el | 2 +- lisp/calendar/calendar.el | 8 ++++---- lisp/calendar/timeclock.el | 2 +- lisp/comint.el | 4 ++-- lisp/doc-view.el | 4 ++-- lisp/emacs-lisp/bytecomp.el | 4 ++-- lisp/emacs-lisp/comp.el | 6 +++--- lisp/emacs-lisp/package.el | 8 ++++---- lisp/eshell/esh-mode.el | 2 +- lisp/frame.el | 2 +- lisp/info.el | 2 +- lisp/jit-lock.el | 2 +- lisp/kmacro.el | 2 +- lisp/menu-bar.el | 4 ++-- lisp/midnight.el | 4 ++-- lisp/net/dictionary.el | 4 ++-- lisp/net/ldap.el | 2 +- lisp/net/pop3.el | 4 ++-- lisp/net/rcirc.el | 2 +- lisp/net/sieve-manage.el | 2 +- lisp/play/spook.el | 2 +- lisp/play/tetris.el | 12 ++++++------ lisp/profiler.el | 2 +- lisp/progmodes/sql.el | 4 ++-- lisp/recentf.el | 2 +- lisp/savehist.el | 3 ++- lisp/strokes.el | 2 +- lisp/tab-bar.el | 2 +- lisp/term/xterm.el | 2 +- lisp/time.el | 4 ++-- lisp/url/url-cache.el | 2 +- lisp/url/url-cookie.el | 2 +- lisp/url/url-history.el | 2 +- lisp/url/url-queue.el | 4 ++-- lisp/url/url-vars.el | 4 ++-- lisp/vc/emerge.el | 2 +- lisp/vc/vc.el | 2 +- lisp/window.el | 4 ++-- lisp/winner.el | 2 +- 42 files changed, 71 insertions(+), 70 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/abbrev.el b/lisp/abbrev.el index e875d77faae..21aa3311d6f 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -885,8 +885,8 @@ longer than the abbrev, the benefit of informing the user is not significant. If you always want to be informed about existing abbrevs for the text you type, set this value to zero or less. This setting only applies if `abbrev-suggest' is non-nil." - :type 'number - :version "28.1") + :type 'natnum + :version "28.1") (defun abbrev--suggest-get-active-tables-including-parents () "Return a list of all active abbrev tables, including parent tables." diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 7138822447c..b2130557dcc 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -160,7 +160,7 @@ This includes the annotations column.") (defcustom bookmark-bmenu-file-column 30 "Column at which to display filenames in a buffer listing bookmarks. You can toggle whether files are shown with \\\\[bookmark-bmenu-toggle-filenames]." - :type 'integer) + :type 'natnum) (defcustom bookmark-bmenu-toggle-filenames t @@ -174,7 +174,7 @@ A non-nil value may result in truncated bookmark names." (defcustom bookmark-menu-length 70 "Maximum length of a bookmark name displayed on a popup menu." - :type 'integer) + :type 'natnum) ;; FIXME: Is it really worth a customization option? (defcustom bookmark-search-delay 0.2 diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 179cc5484cd..539ef673f0b 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -92,13 +92,13 @@ number." (defcustom Buffer-menu-size-width 7 "Width of buffer size column in the Buffer Menu." - :type 'number + :type 'natnum :group 'Buffer-menu :version "24.3") (defcustom Buffer-menu-mode-width 16 "Width of mode name column in the Buffer Menu." - :type 'number + :type 'natnum :group 'Buffer-menu) (defcustom Buffer-menu-use-frame-buffer-list t diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index b03dcfeb5b7..254c703ee22 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -412,7 +412,7 @@ and deleted by `calc-pop'." (defcustom calc-undo-length 100 "The number of undo steps that will be preserved when Calc is quit." - :type 'integer) + :type 'natnum) (defcustom calc-highlight-selections-with-faces nil "If non-nil, use a separate face to indicate selected sub-formulas. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 9a77ae72d02..0d9e6976443 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -211,7 +211,7 @@ If you change this variable directly (without using customize) after starting `calendar', you should call `calendar-redraw' to update the calendar display to reflect the change, otherwise movement commands will not work correctly." - :type 'integer + :type 'natnum ;; Change the initialize so that if you reload calendar.el, it will not ;; cause a redraw. :initialize 'custom-initialize-default @@ -511,7 +511,7 @@ Then redraw the calendar, if necessary." :initialize #'custom-initialize-default :set (lambda (sym val) (calendar-set-layout-variable sym val 1)) - :type 'integer + :type 'natnum :version "23.1") ;; FIXME calendar-month-column-width? @@ -520,7 +520,7 @@ Then redraw the calendar, if necessary." :initialize #'custom-initialize-default :set (lambda (sym val) (calendar-set-layout-variable sym val 3)) - :type 'integer + :type 'natnum :version "23.1") (defun calendar-day-header-construct (&optional width) @@ -553,7 +553,7 @@ Must be at least one less than `calendar-column-width'." :initialize #'custom-initialize-default :set (lambda (sym val) (calendar-set-layout-variable sym val 2)) - :type 'integer + :type 'natnum :version "23.1") (defcustom calendar-intermonth-header nil diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 1c6a557a0d3..7bdaf7ceff6 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -86,7 +86,7 @@ (defcustom timeclock-workday (* 8 60 60) "The length of a work period in seconds." - :type 'integer) + :type 'natnum) (defvar timeclock--previous-workday nil) diff --git a/lisp/comint.el b/lisp/comint.el index 4fc1ffcf0cd..7e22aa78fce 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -330,12 +330,12 @@ This variable is buffer-local in all Comint buffers." "The maximum size in lines for Comint buffers. Comint buffers are truncated from the top to be no greater than this number, if the function `comint-truncate-buffer' is on `comint-output-filter-functions'." - :type 'integer + :type 'natnum :group 'comint) (defcustom comint-input-ring-size 500 "Size of the input history ring in `comint-mode'." - :type 'integer + :type 'natnum :group 'comint :version "23.2") diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 63be1b16f3d..25c476b99ba 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -225,7 +225,7 @@ are available (see Info node `(emacs)Document View')" (defcustom doc-view-resolution 100 "Dots per inch resolution used to render the documents. Higher values result in larger images." - :type 'number) + :type 'natnum) (defvar doc-view-doc-type nil "The type of document in the current buffer. @@ -301,7 +301,7 @@ scaling." Has only an effect if `doc-view-scale-internally' is non-nil and support for scaling is compiled into Emacs." :version "24.1" - :type 'number) + :type 'natnum) (defcustom doc-view-dvipdfm-program "dvipdfm" "Program to convert DVI files to PDF. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6545c8d961d..5ef517d7e32 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1725,8 +1725,8 @@ The byte-compiler will emit a warning for documentation strings containing lines wider than this. If `fill-column' has a larger value, it will override this variable." :group 'bytecomp - :type 'integer - :safe #'integerp + :type 'natnum + :safe #'natnump :version "28.1") (define-obsolete-function-alias 'byte-compile-docstring-length-warn diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2109aa9923a..73285e0f24d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -63,7 +63,7 @@ This is intended for debugging the compiler itself. 2 emit debug symbols and dump pseudo C code. 3 emit debug symbols and dump: pseudo C code, GCC intermediate passes and libgccjit log file." - :type 'integer + :type 'natnum :safe #'natnump :version "28.1") @@ -74,7 +74,7 @@ This is intended for debugging the compiler itself. 1 final LIMPLE is logged. 2 LAP, final LIMPLE, and some pass info are logged. 3 max verbosity." - :type 'integer + :type 'natnum :risky t :version "28.1") @@ -111,7 +111,7 @@ during bootstrap." "Default number of subprocesses used for async native compilation. Value of zero means to use half the number of the CPU's execution units, or one if there's just one execution unit." - :type 'integer + :type 'natnum :risky t :version "28.1") diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2c43db98993..85a154a8e07 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -418,22 +418,22 @@ synchronously." (defcustom package-name-column-width 30 "Column width for the Package name in the package menu." - :type 'number + :type 'natnum :version "28.1") (defcustom package-version-column-width 14 "Column width for the Package version in the package menu." - :type 'number + :type 'natnum :version "28.1") (defcustom package-status-column-width 12 "Column width for the Package status in the package menu." - :type 'number + :type 'natnum :version "28.1") (defcustom package-archive-column-width 8 "Column width for the Package archive in the package menu." - :type 'number + :type 'natnum :version "28.1") diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index db36909fb86..972d4f9df00 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -146,7 +146,7 @@ See variable `eshell-scroll-to-bottom-on-output' and function Eshell buffers are truncated from the top to be no greater than this number, if the function `eshell-truncate-buffer' is on `eshell-output-filter-functions'." - :type 'integer) + :type 'natnum) (defcustom eshell-output-filter-functions '(eshell-postoutput-scroll-to-bottom diff --git a/lisp/frame.el b/lisp/frame.el index 6996bb2e9c6..9476cb0ec46 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2841,7 +2841,7 @@ Values smaller than 0.2 sec are treated as 0.2 sec." "How many times to blink before using a solid cursor on NS, X, and MS-Windows. Use 0 or negative value to blink forever." :version "24.4" - :type 'integer + :type 'natnum :group 'cursor) (defvar blink-cursor-blinks-done 1 diff --git a/lisp/info.el b/lisp/info.el index f9d63b0f32d..906385fdc71 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -260,7 +260,7 @@ This only has an effect if `Info-hide-note-references' is non-nil." "Depth of breadcrumbs to display. 0 means do not display breadcrumbs." :version "23.1" - :type 'integer) + :type 'natnum) (defcustom Info-search-whitespace-regexp "\\s-+" "If non-nil, regular expression to match a sequence of whitespace chars. diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index a3ada443702..be26ca55f0d 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -51,7 +51,7 @@ This variable controls both `display-time' and stealth fontification. The optimum value is a little over the typical number of buffer characters which fit in a typical window." - :type 'integer) + :type 'natnum) (defcustom jit-lock-stealth-time nil diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 14be909722b..92118ad1433 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -129,7 +129,7 @@ Set to nil if no mouse binding is desired." (defcustom kmacro-ring-max 8 "Maximum number of keyboard macros to save in macro ring." - :type 'integer) + :type 'natnum) (defcustom kmacro-execute-before-append t diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 92989fcfb2e..a134654a020 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2194,12 +2194,12 @@ otherwise it could decide to silently do nothing." (defcustom yank-menu-length 20 "Text of items in `yank-menu' longer than this will be truncated." - :type 'integer + :type 'natnum :group 'menu) (defcustom yank-menu-max-items 60 "Maximum number of entries to display in the `yank-menu'." - :type 'integer + :type 'natnum :group 'menu :version "29.1") diff --git a/lisp/midnight.el b/lisp/midnight.el index 3e309a5c881..60d9b565ef0 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -67,14 +67,14 @@ The autokilling is done by `clean-buffer-list' when it is in `midnight-hook'. Currently displayed and/or modified (unsaved) buffers, as well as buffers matching `clean-buffer-list-kill-never-buffer-names' and `clean-buffer-list-kill-never-regexps' are excluded." - :type 'integer) + :type 'natnum) (defcustom clean-buffer-list-delay-special 3600 "The number of seconds before some buffers become eligible for autokilling. Buffers matched by `clean-buffer-list-kill-regexps' and `clean-buffer-list-kill-buffer-names' are killed if they were last displayed more than this many seconds ago." - :type 'integer) + :type 'natnum) (defcustom clean-buffer-list-kill-regexps '("\\`\\*Man ") "List of regexps saying which buffers will be killed at midnight. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index e0824f39716..eec405373db 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -89,7 +89,7 @@ You can specify here: This port is probably always 2628 so there should be no need to modify it." :group 'dictionary :set #'dictionary-set-server-var - :type 'number + :type 'natnum :version "28.1") (defcustom dictionary-identification @@ -206,7 +206,7 @@ where the current word was found." "The port of the proxy server, used only when `dictionary-use-http-proxy' is set." :group 'dictionary-proxy :set #'dictionary-set-server-var - :type 'number + :type 'natnum :version "28.1") (defcustom dictionary-use-single-buffer diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index da45457891b..0f2943cbb03 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -54,7 +54,7 @@ a separator." Initialized from the LDAP library at build time. Default value is 389." :type '(choice (const :tag "Use library default" nil) - (integer :tag "Port number"))) + (natnum :tag "Port number"))) (defcustom ldap-default-base nil "Default base for LDAP searches. diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index 0f6dfb6ad46..de225d76dcc 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el @@ -59,7 +59,7 @@ (defcustom pop3-port 110 "POP3 port." :version "22.1" ;; Oort Gnus - :type 'number + :type 'natnum :group 'pop3) (defcustom pop3-password-required t @@ -88,7 +88,7 @@ valid value is `apop'." The lower the number, the more latency-sensitive the fetching will be. If your pop3 server doesn't support streaming at all, set this to 1." - :type 'number + :type 'natnum :version "24.1" :group 'pop3) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 36352a46734..dc0946fb09a 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -130,7 +130,7 @@ be displayed instead." (defcustom rcirc-default-port 6667 "The default port to connect to." - :type 'integer) + :type 'natnum) (defcustom rcirc-default-nick (user-login-name) "Your nick." diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index 50342b9105a..a39e35a53a1 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -131,7 +131,7 @@ for doing the actual authentication." (defcustom sieve-manage-default-port "sieve" "Default port number or service name for managesieve protocol." - :type '(choice integer string) + :type '(choice natnum string) :version "24.4") (defcustom sieve-manage-default-stream 'network diff --git a/lisp/play/spook.el b/lisp/play/spook.el index f2bdba1c2aa..ccff2e75b0a 100644 --- a/lisp/play/spook.el +++ b/lisp/play/spook.el @@ -49,7 +49,7 @@ (defcustom spook-phrase-default-count 15 "Default number of phrases to insert." - :type 'integer) + :type 'natnum) ;;;###autoload (defun spook () diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index d9bc0dd020c..a6bfea81ee1 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -95,27 +95,27 @@ If the return value is a number, it is used as the timer period." (defcustom tetris-buffer-width 30 "Width of used portion of buffer." - :type 'number) + :type 'natnum) (defcustom tetris-buffer-height 22 "Height of used portion of buffer." - :type 'number) + :type 'natnum) (defcustom tetris-width 10 "Width of playing area." - :type 'number) + :type 'natnum) (defcustom tetris-height 20 "Height of playing area." - :type 'number) + :type 'natnum) (defcustom tetris-top-left-x 3 "X position of top left of playing area." - :type 'number) + :type 'natnum) (defcustom tetris-top-left-y 1 "Y position of top left of playing area." - :type 'number) + :type 'natnum) (defcustom tetris-allow-repetitions t "If non-nil, use a random selection for each shape. diff --git a/lisp/profiler.el b/lisp/profiler.el index 94c24c62aa6..8670e5786a4 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -38,7 +38,7 @@ (defcustom profiler-sampling-interval 1000000 "Default sampling interval in nanoseconds." - :type 'integer + :type 'natnum :group 'profiler) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index ef8375e859c..b950f93f2a0 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -274,8 +274,8 @@ file. Since that is a plaintext file, this could be dangerous." (defcustom sql-port 0 "Default port for connecting to a MySQL or Postgres server." :version "24.1" - :type 'number - :safe 'numberp) + :type 'natnum + :safe 'natnump) (defcustom sql-default-directory nil "Default directory for SQL processes." diff --git a/lisp/recentf.el b/lisp/recentf.el index 601b2642f76..4bc1ab5c219 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -178,7 +178,7 @@ The default is to call `find-file' to edit the selected file." (defcustom recentf-max-menu-items 10 "Maximum number of items in the recentf menu." :group 'recentf - :type 'integer) + :type 'natnum) (defcustom recentf-menu-filter nil "Function used to filter files displayed in the recentf menu. diff --git a/lisp/savehist.el b/lisp/savehist.el index 172acaa4e87..8924c8dde23 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -97,7 +97,8 @@ This is decimal, not octal. The default is 384 (0600 in octal). Set to nil to use the default permissions that Emacs uses, typically mandated by umask. The default is a bit more restrictive to protect the user's privacy." - :type 'integer) + :type '(choice (natnum :tag "Specify") + (const :tag "Use default" :value nil))) (defcustom savehist-autosave-interval (* 5 60) "The interval between autosaves of minibuffer history. diff --git a/lisp/strokes.el b/lisp/strokes.el index 5402ebf1e1c..376cbc0cfee 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -252,7 +252,7 @@ WARNING: Changing the value of this variable will gravely affect the figure out what it should be based on your needs and on how quick the particular platform(s) you're operating on, and only then start programming in your custom strokes." - :type 'integer) + :type 'natnum) (defcustom strokes-file (locate-user-emacs-file "strokes" ".strokes") "File containing saved strokes for Strokes mode." diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 4ca177f73b7..fdfbe207b5f 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -618,7 +618,7 @@ Also add the number of windows in the window configuration." "Maximum length of the tab name from the current buffer. Effective when `tab-bar-tab-name-function' is customized to `tab-bar-tab-name-truncated'." - :type 'integer + :type 'natnum :group 'tab-bar :version "27.1") diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index a7e257f41c5..08e38c9a050 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -66,7 +66,7 @@ If you select a region larger than this size, it won't be copied to your system clipboard. Since clipboard data is base 64 encoded, the actual number of string bytes that can be copied is 3/4 of this value." :version "25.1" - :type 'integer) + :type 'natnum) (defcustom xterm-set-window-title nil "Whether Emacs should set window titles to an Emacs frame in an XTerm." diff --git a/lisp/time.el b/lisp/time.el index cd985bfb288..e7066cae7a5 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -93,7 +93,7 @@ Non-nil means \\[display-time] should display day and date as well as time." (defcustom display-time-interval 60 "Seconds between updates of time in the mode line." - :type 'integer) + :type 'natnum) (defcustom display-time-24hr-format nil "Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23. @@ -519,7 +519,7 @@ If the value is t instead of an alist, use the value of (defcustom world-clock-timer-second 60 "Interval in seconds for updating the `world-clock' buffer." - :type 'integer + :type 'natnum :version "28.1") (defface world-clock-label diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 3e69227124f..db8c121cf00 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -37,7 +37,7 @@ "Default maximum time in seconds before cache files expire. Used by the function `url-cache-expired'." :version "24.1" - :type 'integer + :type 'natnum :group 'url-cache) ;; Cache manager diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 15c78512c64..0709cdd3fa1 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -360,7 +360,7 @@ to run the `url-cookie-setup-save-timer' function manually." (set-default var val) (if (bound-and-true-p url-setup-done) (url-cookie-setup-save-timer))) - :type 'integer + :type 'natnum :group 'url-cookie) (defun url-cookie-setup-save-timer () diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el index cb4814afcad..058e601301b 100644 --- a/lisp/url/url-history.el +++ b/lisp/url/url-history.el @@ -63,7 +63,7 @@ to run the `url-history-setup-save-timer' function manually." (set-default var val) (if (bound-and-true-p url-setup-done) (url-history-setup-save-timer))) - :type 'integer + :type 'natnum :group 'url-history) (defvar url-history-timer nil) diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index b2e24607e11..cf45a7f681a 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -36,13 +36,13 @@ (defcustom url-queue-parallel-processes 6 "The number of concurrent processes." :version "24.1" - :type 'integer + :type 'natnum :group 'url) (defcustom url-queue-timeout 5 "How long to let a job live once it's started (in seconds)." :version "24.1" - :type 'integer + :type 'natnum :group 'url) ;;; Internal variables. diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 1012525568b..de42599e0d4 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -297,7 +297,7 @@ get the first available language (as opposed to the default)." (defcustom url-max-password-attempts 5 "Maximum number of times a password will be prompted for. Applies when a protected document is denied by the server." - :type 'integer + :type 'natnum :group 'url) (defcustom url-show-status t @@ -330,7 +330,7 @@ undefined." (defcustom url-max-redirections 30 "The maximum number of redirection requests to honor in a HTTP connection. A negative number means to honor an unlimited number of redirection requests." - :type 'integer + :type 'natnum :group 'url) (defcustom url-confirmation-func 'y-or-n-p diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index 6e94ea07157..422ed5c0a4d 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -221,7 +221,7 @@ depend on the flags." (defcustom emerge-min-visible-lines 3 "Number of lines to show above and below the flags when displaying a difference." - :type 'integer) + :type 'natnum) (defcustom emerge-temp-file-prefix (expand-file-name "emerge" temporary-file-directory) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index d6f0f4a4977..d3e53858c16 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -824,7 +824,7 @@ for the backend you use." "Limit the number of items shown by the VC log commands. Zero means unlimited. Not all VC backends are able to support this feature." - :type 'integer) + :type 'natnum) (defcustom vc-allow-async-revert nil "Specifies whether the diff during \\[vc-revert] may be asynchronous. diff --git a/lisp/window.el b/lisp/window.el index eba888a89dd..a3ef2521bb7 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -451,7 +451,7 @@ window to a height less than the one specified here, an application should instead call `window-resize' with a non-nil IGNORE argument. In order to have `split-window' make a window shorter, explicitly specify the SIZE argument of that function." - :type 'integer + :type 'natnum :version "24.1" :group 'windows) @@ -483,7 +483,7 @@ window to a width less than the one specified here, an application should instead call `window-resize' with a non-nil IGNORE argument. In order to have `split-window' make a window narrower, explicitly specify the SIZE argument of that function." - :type 'integer + :type 'natnum :version "24.1" :group 'windows) diff --git a/lisp/winner.el b/lisp/winner.el index 9b2433b4929..38ab5f51016 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -50,7 +50,7 @@ (defcustom winner-ring-size 200 "Maximum number of stored window configurations per frame." - :type 'integer) + :type 'natnum) (defcustom winner-boring-buffers '("*Completions*") "List of buffer names whose windows `winner-undo' will not restore. -- cgit v1.2.3 From 739e3dbe050468e1d9aa0a48bfc656ae20fd8f9d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 3 Dec 2021 23:17:04 +0100 Subject: Remove many items obsolete since 24.1 * lisp/allout.el (allout-abbreviate-flattened-numbering) (allout-mode-deactivate-hook): * lisp/ansi-color.el (ansi-color-unfontify-region): * lisp/auth-source.el (auth-source-hide-passwords) (auth-source-user-or-password) (auth-source-forget-user-or-password): * lisp/cedet/data-debug.el (data-debug-map): * lisp/cedet/semantic/grammar.el (semantic-grammar-syntax-table) (semantic-grammar-map): * lisp/chistory.el (command-history-map): * lisp/comint.el (comint-dynamic-complete) (comint-dynamic-complete-as-filename) (comint-dynamic-simple-complete): * lisp/dired-x.el (read-filename-at-point) (dired-x-submit-report): * lisp/dos-fns.el (register-name-alist, make-register) (register-value, set-register-value, intdos, mode25, mode4350): * lisp/emacs-lisp/bytecomp.el (byte-compile-disable-print-circle): * lisp/emacs-lisp/chart.el (chart-map): * lisp/emacs-lisp/package.el (package-menu-view-commentary): * lisp/emacs-lock.el (toggle-emacs-lock, emacs-lock-from-exiting): * lisp/erc/erc.el (erc-complete-word): * lisp/eshell/em-cmpl.el (eshell-cmpl-suffix-list): * lisp/eshell/esh-util.el (eshell-for): * lisp/files.el (inhibit-first-line-modes-regexps) (inhibit-first-line-modes-suffixes): * lisp/gnus/gnus-msg.el (gnus-outgoing-message-group) (gnus-debug-files, gnus-debug-exclude-variables): * lisp/gnus/gnus-registry.el (gnus-registry-user-format-function-M): * lisp/gnus/gnus.el (gnus-local-domain, gnus-carpal): * lisp/gnus/nnimap.el (nnimap-split-rule): * lisp/iimage.el (turn-on-iimage-mode): * lisp/image.el (image-extension-data, image-library-alist): * lisp/mail/emacsbug.el (report-emacs-bug-pretest-address): * lisp/mail/mail-utils.el (rmail-dont-reply-to): * lisp/mail/mailalias.el (mail-complete-function) (mail-completion-at-point-function): * lisp/mail/rmail.el (rmail-dont-reply-to-names) (rmail-default-dont-reply-to-names): * lisp/mail/sendmail.el (mail-mailer-swallows-blank-line) (mail-sent-via): * lisp/menu-bar.el (menu-bar-kill-ring-save): * lisp/minibuffer.el (completion-annotate-function) (minibuffer-local-filename-must-match-map): * lisp/msb.el (msb-after-load-hooks): * lisp/obsolete/eieio-compat.el (eieio-defmethod) (eieio-defgeneric): * lisp/obsolete/info-edit.el (Info-edit-map): * lisp/obsolete/starttls.el (starttls-any-program-available): * lisp/progmodes/cfengine.el (cfengine-mode-abbrevs): * lisp/progmodes/cwarn.el (turn-on-cwarn-mode): * lisp/progmodes/make-mode.el (makefile-complete): * lisp/progmodes/meta-mode.el (meta-complete-symbol) (meta-mode-map): * lisp/progmodes/pascal.el (pascal-toggle-completions) (pascal-last-completions, pascal-show-completions): * lisp/progmodes/prolog.el (prolog-char-quote-workaround): * lisp/progmodes/which-func.el (which-func-mode): [FUNCTION] * lisp/simple.el (count-lines-region, minibuffer-completing-symbol): * lisp/speedbar.el (speedbar-syntax-table, speedbar-key-map): * lisp/strokes.el (strokes-report-bug): * lisp/subr.el (condition-case-no-debug): * lisp/term/ns-win.el (ns-alternatives-map) (ns-store-cut-buffer-internal): * lisp/term/w32-win.el (w32-default-color-map): * lisp/term/x-win.el (x-cut-buffer-or-selection-value): * lisp/textmodes/bibtex.el (bibtex-complete) (bibtex-entry-field-alist): * lisp/textmodes/reftex-index.el (reftex-index-map) (reftex-index-phrases-map): * lisp/textmodes/reftex-sel.el (reftex-select-label-map) (reftex-select-bib-map): * lisp/textmodes/reftex-toc.el (reftex-toc-map): * lisp/textmodes/rst.el (rst-block-face, rst-external-face) (rst-definition-face, rst-directive-face, rst-comment-face) (rst-emphasis1-face, rst-emphasis2-face, rst-literal-face) (rst-reference-face): * lisp/vc/vc-hooks.el (vc-toggle-read-only): * lisp/view.el (view-return-to-alist) (view-return-to-alist-update): Remove many functions and variables obsolete since 24.1. * lisp/textmodes/bibtex.el (bibtex-entry-alist): Don't use above removed variable 'bibtex-entry-field-alist'. * lisp/cedet/data-debug.el (data-debug-edebug-expr) (data-debug-eval-expression): * lisp/emacs-lisp/trace.el (trace--read-args): * lisp/files-x.el (read-file-local-variable-value): * lisp/simple.el (read--expression): Don't use above removed variable 'minibuffer-completing-symbol'. * lisp/textmodes/rst.el (rst-font-lock-keywords): Don't use above removed variables. * src/w32fns.c (Fw32_default_color_map): Delete obsolete function. (syms_of_w32fns): Delete defsubr for above defun. * src/keyboard.c (syms_of_keyboard) : Delete DEFVARs. : Delete DEFSYM. (syms_of_keyboard_for_pdumper): Adjust for above change. (command_loop_1): Don't run deferred-action-function hook. * lisp/subr.el (deferred-action-list, deferred-action-function): Delete obsoletion statements. * lisp/emacs-lisp/ert-x.el (ert-simulate-command): Don't run 'deferred-action-list' hook. * doc/lispref/hooks.texi (Standard Hooks): Delete 'deferred-action-function'. * lisp/emacs-lisp/lisp.el (field-complete): * lisp/eshell/em-cmpl.el (eshell-cmpl-initialize): * lisp/gnus/gnus-msg.el (gnus-inews-insert-gcc): * lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): * lisp/mail/mail-utils.el (mail-dont-reply-to): * lisp/mail/sendmail.el (sendmail-send-it): * lisp/mail/smtpmail.el (smtpmail-send-it): * lisp/minibuffer.el (minibuffer-completion-help): * lisp/progmodes/python.el: Don't use above removed items. * lisp/emacs-lisp/eieio-core.el: * lisp/mail/mailalias.el (mail-complete-alist): Doc fixes; don't refer to above removed items. ; * etc/NEWS: List removed items. --- doc/lispref/hooks.texi | 1 - etc/NEWS | 47 +++++++++++++ lisp/allout.el | 8 --- lisp/ansi-color.el | 3 - lisp/auth-source.el | 85 ------------------------ lisp/cedet/data-debug.el | 16 ++--- lisp/cedet/semantic/grammar.el | 4 -- lisp/chistory.el | 2 - lisp/comint.el | 70 -------------------- lisp/dired-x.el | 7 -- lisp/dos-fns.el | 16 ----- lisp/emacs-lisp/bytecomp.el | 11 +--- lisp/emacs-lisp/chart.el | 1 - lisp/emacs-lisp/eieio-core.el | 4 +- lisp/emacs-lisp/ert-x.el | 3 - lisp/emacs-lisp/lisp.el | 9 +-- lisp/emacs-lisp/package.el | 3 - lisp/emacs-lisp/trace.el | 7 +- lisp/emacs-lock.el | 11 ---- lisp/erc/erc.el | 2 - lisp/eshell/em-cmpl.el | 11 ---- lisp/eshell/esh-util.el | 9 --- lisp/files-x.el | 3 +- lisp/files.el | 6 -- lisp/gnus/gnus-msg.el | 44 +------------ lisp/gnus/gnus-registry.el | 3 - lisp/gnus/gnus.el | 15 ----- lisp/gnus/nnimap.el | 3 - lisp/iimage.el | 3 - lisp/image.el | 9 --- lisp/mail/emacsbug.el | 3 - lisp/mail/mail-utils.el | 11 +--- lisp/mail/mailalias.el | 29 +-------- lisp/mail/rmail.el | 14 ---- lisp/mail/sendmail.el | 40 ------------ lisp/mail/smtpmail.el | 2 - lisp/menu-bar.el | 3 - lisp/minibuffer.el | 25 +------ lisp/msb.el | 3 - lisp/obsolete/eieio-compat.el | 15 ----- lisp/obsolete/info-edit.el | 1 - lisp/obsolete/starttls.el | 3 - lisp/progmodes/cfengine.el | 9 --- lisp/progmodes/cwarn.el | 3 - lisp/progmodes/make-mode.el | 1 - lisp/progmodes/meta-mode.el | 3 - lisp/progmodes/pascal.el | 15 ----- lisp/progmodes/prolog.el | 10 +-- lisp/progmodes/python.el | 1 - lisp/progmodes/which-func.el | 3 - lisp/simple.el | 33 ++++------ lisp/speedbar.el | 4 -- lisp/strokes.el | 2 - lisp/subr.el | 5 -- lisp/term/ns-win.el | 6 -- lisp/term/w32-win.el | 1 - lisp/term/x-win.el | 3 - lisp/textmodes/bibtex.el | 11 ---- lisp/textmodes/reftex-index.el | 4 -- lisp/textmodes/reftex-sel.el | 4 -- lisp/textmodes/reftex-toc.el | 1 - lisp/textmodes/rst.el | 145 ++++++++++------------------------------- lisp/vc/vc-hooks.el | 9 --- lisp/view.el | 46 ------------- src/keyboard.c | 18 ----- src/w32fns.c | 8 --- 66 files changed, 114 insertions(+), 796 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi index 107d036202e..59b7930732f 100644 --- a/doc/lispref/hooks.texi +++ b/doc/lispref/hooks.texi @@ -290,7 +290,6 @@ auto-fill-function command-error-function compose-chars-after-function composition-function-table -deferred-action-function input-method-function load-read-function load-source-file-function diff --git a/etc/NEWS b/etc/NEWS index 226af8d7d6a..1e6fb06bdcc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2247,6 +2247,53 @@ Use 'exif-parse-file' and 'exif-field' instead. ** 'insert-directory' alternatives should not change the free disk space line. This change is now applied in 'dired-insert-directory'. +--- +** Some functions and variables obsolete since Emacs 24 have been removed: +'Info-edit-map', 'allout-abbreviate-flattened-numbering', +'allout-mode-deactivate-hook', 'ansi-color-unfontify-region', +'auth-source-forget-user-or-password', 'auth-source-hide-passwords', +'auth-source-user-or-password', 'bibtex-complete', +'bibtex-entry-field-alist', 'byte-compile-disable-print-circle', +'cfengine-mode-abbrevs', 'chart-map', 'comint-dynamic-complete', +'comint-dynamic-complete-as-filename', +'comint-dynamic-simple-complete', 'command-history-map', +'completion-annotate-function', 'condition-case-no-debug', +'count-lines-region', 'data-debug-map', 'deferred-action-list', +'deferred-action-function', 'dired-x-submit-report', +'eieio-defgeneric', 'eieio-defmethod', 'emacs-lock-from-exiting', +'erc-complete-word', 'eshell-cmpl-suffix-list', 'eshell-for', +'gnus-carpal', 'gnus-debug-exclude-variables', 'gnus-debug-files', +'gnus-local-domain', 'gnus-outgoing-message-group', +'gnus-registry-user-format-function-M', 'image-extension-data', +'image-library-alist', 'inhibit-first-line-modes-regexps', +'inhibit-first-line-modes-suffixes', 'intdos', +'mail-complete-function', 'mail-completion-at-point-function', +'mail-mailer-swallows-blank-line', 'mail-sent-via', 'make-register', +'makefile-complete', 'menu-bar-kill-ring-save', +'meta-complete-symbol', 'meta-mode-map', +'minibuffer-completing-symbol', +'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350', +'msb-after-load-hooks', 'nnimap-split-rule', 'ns-alternatives-map', +'ns-store-cut-buffer-internal', 'package-menu-view-commentary', +'pascal-last-completions', 'pascal-show-completions', +'pascal-toggle-completions', 'prolog-char-quote-workaround', +'read-filename-at-point', 'reftex-index-map', +'reftex-index-phrases-map', 'reftex-select-bib-map', +'reftex-select-label-map', 'reftex-toc-map', 'register-name-alist', +'register-value', 'report-emacs-bug-pretest-address', +'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to', +'rmail-dont-reply-to-names', 'rst-block-face', 'rst-comment-face', +'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face', +'rst-emphasis2-face', 'rst-external-face', 'rst-literal-face', +'rst-reference-face', 'semantic-grammar-map', +'semantic-grammar-syntax-table', 'set-register-value', +'speedbar-key-map', 'speedbar-syntax-table', +'starttls-any-program-available', 'strokes-report-bug', +'toggle-emacs-lock', 'turn-on-cwarn-mode', 'turn-on-iimage-mode', +'vc-toggle-read-only', 'view-return-to-alist', +'view-return-to-alist-update', 'w32-default-color-map' (function), +'which-func-mode' (function), 'x-cut-buffer-or-selection-value'. + --- ** Some functions and variables obsolete since Emacs 23 have been removed: 'find-emacs-lisp-shadows', 'newsticker-cache-filename', diff --git a/lisp/allout.el b/lisp/allout.el index de8ee85b391..e07bac4ef99 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -733,8 +733,6 @@ Set this var to the bullet you want to use for file cross-references." (put 'allout-presentation-padding 'safe-local-variable #'integerp) ;;;_ = allout-flattened-numbering-abbreviation -(define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering - 'allout-flattened-numbering-abbreviation "24.1") (defcustom allout-flattened-numbering-abbreviation nil "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic numbers to minimal amount with some context. Otherwise, entire @@ -1350,11 +1348,6 @@ their settings before `allout-mode' was started." ;;;_ = allout-mode-hook (defvar allout-mode-hook nil "Hook run when allout mode starts.") -;;;_ = allout-mode-deactivate-hook -(define-obsolete-variable-alias 'allout-mode-deactivate-hook - 'allout-mode-off-hook "24.1") -(defvar allout-mode-deactivate-hook nil - "Hook run when allout mode ends.") ;;;_ = allout-exposure-category (defvar allout-exposure-category nil "Symbol for use as allout invisible-text overlay category.") @@ -1779,7 +1772,6 @@ hooks, by which independent code can cooperate with allout without changes to the allout core. Here are key ones: `allout-mode-hook' -`allout-mode-deactivate-hook' (deprecated) `allout-mode-off-hook' `allout-exposure-change-functions' `allout-structure-added-functions' diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index d5db9ecfed0..6f1c270c239 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -456,9 +456,6 @@ variable, and is meant to be used in `compilation-filter-hook'." (_ (ansi-color-apply-on-region compilation-filter-start (point)))))) -(define-obsolete-function-alias 'ansi-color-unfontify-region - 'font-lock-default-unfontify-region "24.1") - ;; Working with strings (defvar-local ansi-color-context nil "Context saved between two calls to `ansi-color-apply'. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index fc62e36dfc2..12da2c3d73d 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -164,8 +164,6 @@ Overrides `password-cache-expiry' through a let-binding." (defvar auth-source-creation-prompts nil "Default prompts for token values. Usually let-bound.") -(make-obsolete 'auth-source-hide-passwords nil "24.1") - (defcustom auth-source-save-behavior 'ask "If set, auth-source will respect it for save behavior." :version "23.2" ;; No Gnus @@ -2325,89 +2323,6 @@ See `auth-source-search' for details on SPEC." (push item all))) (nreverse all))) -;;; older API - -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz") - -;; deprecate the old interface -(make-obsolete 'auth-source-user-or-password - 'auth-source-search "24.1") -(make-obsolete 'auth-source-forget-user-or-password - 'auth-source-forget "24.1") - -(defun auth-source-user-or-password - (mode host port &optional username create-missing delete-existing) - "Find MODE (string or list of strings) matching HOST and PORT. - -DEPRECATED in favor of `auth-source-search'! - -USERNAME is optional and will be used as \"login\" in a search -across the Secret Service API (see secrets.el) if the resulting -items don't have a username. This means that if you search for -username \"joe\" and it matches an item but the item doesn't have -a :user attribute, the username \"joe\" will be returned. - -A non-nil DELETE-EXISTING means deleting any matching password -entry in the respective sources. This is useful only when -CREATE-MISSING is non-nil as well; the intended use case is to -remove wrong password entries. - -If no matching entry is found, and CREATE-MISSING is non-nil, -the password will be retrieved interactively, and it will be -stored in the password database which matches best (see -`auth-sources'). - -MODE can be \"login\" or \"password\"." - (auth-source-do-debug - "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s" - mode host port username) - - (let* ((listy (listp mode)) - (mode (if listy mode (list mode))) - ;; (cname (if username - ;; (format "%s %s:%s %s" mode host port username) - ;; (format "%s %s:%s" mode host port))) - (search (list :host host :port port)) - (search (if username (append search (list :user username)) search)) - (search (if create-missing - (append search (list :create t)) - search)) - (search (if delete-existing - (append search (list :delete t)) - search)) - ;; (found (if (not delete-existing) - ;; (gethash cname auth-source-cache) - ;; (remhash cname auth-source-cache) - ;; nil))) - (found nil)) - (if found - (progn - (auth-source-do-debug - "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s" - mode - ;; don't show the password - (if (and (member "password" mode) t) - "SECRET" - found) - host port username) - found) ; return the found data - ;; else, if not found, search with a max of 1 - (let ((choice (nth 0 (apply #'auth-source-search - (append '(:max 1) search))))) - (when choice - (dolist (m mode) - (cond - ((equal "password" m) - (push (if (plist-get choice :secret) - (funcall (plist-get choice :secret)) - nil) found)) - ((equal "login" m) - (push (plist-get choice :user) found))))) - (setq found (nreverse found)) - (setq found (if listy found (car-safe found))))) - - found)) - (defun auth-source-user-and-password (host &optional user) (let* ((auth-info (car (if user diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index 0edc853edda..e7635c0aec5 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -854,7 +854,6 @@ If PARENT is non-nil, it is somehow related as a parent to thing." table) "Syntax table used in data-debug macro buffers.") -(define-obsolete-variable-alias 'data-debug-map 'data-debug-mode-map "24.1") (defvar data-debug-mode-map (let ((km (make-sparse-keymap))) (suppress-keymap km) @@ -1028,11 +1027,9 @@ Do nothing if already contracted." (defun data-debug-edebug-expr (expr) "Dump out the contents of some expression EXPR in edebug with ddebug." (interactive - (list (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history)) - )) + (list (read-from-minibuffer "Eval: " + nil read-expression-map t + 'read-expression-history))) (let ((v (eval expr t))) (if (not v) (message "Expression %s is nil." expr) @@ -1043,10 +1040,9 @@ Do nothing if already contracted." If the result is something simple, show it in the echo area. If the result is a list or vector, then use the data debugger to display it." (interactive - (list (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history)))) + (list (read-from-minibuffer "Eval: " + nil read-expression-map t + 'read-expression-history))) (let (result) (if (null eval-expression-debug-on-error) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 74d4a229fac..97456265ead 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1123,8 +1123,6 @@ END is the limit of the search." ;;;; Define major mode ;;;; -(define-obsolete-variable-alias 'semantic-grammar-syntax-table - 'semantic-grammar-mode-syntax-table "24.1") (defvar semantic-grammar-mode-syntax-table (let ((table (make-syntax-table (standard-syntax-table)))) (modify-syntax-entry ?\: "." table) ;; COLON @@ -1197,8 +1195,6 @@ END is the limit of the search." semantic-grammar-mode-keywords-1 "Font Lock keywords used to highlight Semantic grammar buffers.") -(define-obsolete-variable-alias 'semantic-grammar-map - 'semantic-grammar-mode-map "24.1") (defvar semantic-grammar-mode-map (let ((km (make-sparse-keymap))) diff --git a/lisp/chistory.el b/lisp/chistory.el index 33b21422114..9dce60a19fe 100644 --- a/lisp/chistory.el +++ b/lisp/chistory.el @@ -119,8 +119,6 @@ The buffer is left in Command History mode." (error "No command history") (command-history-mode))))) -(define-obsolete-variable-alias 'command-history-map - 'command-history-mode-map "24.1") (defvar command-history-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map (make-composed-keymap lisp-mode-shared-map diff --git a/lisp/comint.el b/lisp/comint.el index 7e22aa78fce..d52623c00ae 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3299,10 +3299,6 @@ Magic characters are those in `comint-file-name-quote-list'." (defun comint-completion-at-point () (run-hook-with-args-until-success 'comint-dynamic-complete-functions)) -(define-obsolete-function-alias - 'comint-dynamic-complete - 'completion-at-point "24.1") - (defun comint-dynamic-complete-filename () "Dynamically complete the filename at point. Completes if after a filename. @@ -3383,13 +3379,6 @@ See `completion-table-with-quoting' and `comint-unquote-function'.") (goto-char (match-end 0)) (insert filesuffix))))))))) -(defun comint-dynamic-complete-as-filename () - "Dynamically complete at point as a filename. -See `comint-dynamic-complete-filename'. Returns t if successful." - (declare (obsolete comint-filename-completion "24.1")) - (let ((data (comint--complete-file-name-data))) - (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))) - (defun comint-replace-by-expanded-filename () "Dynamically expand and complete the filename at point. Replace the filename with an expanded, canonicalized and @@ -3404,65 +3393,6 @@ filename absolute. For expansion see `expand-file-name' and (replace-match (expand-file-name filename) t t) (comint-dynamic-complete-filename)))) - -(defun comint-dynamic-simple-complete (stub candidates) - "Dynamically complete STUB from CANDIDATES list. -This function inserts completion characters at point by -completing STUB from the strings in CANDIDATES. If completion is -ambiguous, possibly show a completions listing in a separate -buffer. - -Return nil if no completion was inserted. -Return `sole' if completed with the only completion match. -Return `shortest' if completed with the shortest match. -Return `partial' if completed as far as possible. -Return `listed' if a completion listing was shown. - -See also `comint-dynamic-complete-filename'." - (declare (obsolete completion-in-region "24.1")) - (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin))) - (minibuffer-p (window-minibuffer-p)) - (suffix (cond ((not comint-completion-addsuffix) "") - ((not (consp comint-completion-addsuffix)) " ") - (t (cdr comint-completion-addsuffix)))) - (completions (all-completions stub candidates))) - (cond ((null completions) - (if minibuffer-p - (minibuffer-message "No completions of %s" stub) - (message "No completions of %s" stub)) - nil) - ((= 1 (length completions)) ; Gotcha! - (let ((completion (car completions))) - (if (string-equal completion stub) - (unless minibuffer-p - (message "Sole completion")) - (insert (substring completion (length stub))) - (unless minibuffer-p - (message "Completed"))) - (insert suffix) - 'sole)) - (t ; There's no unique completion. - (let ((completion (try-completion stub candidates))) - ;; Insert the longest substring. - (insert (substring completion (length stub))) - (cond ((and comint-completion-recexact comint-completion-addsuffix - (string-equal stub completion) - (member completion completions)) - ;; It's not unique, but user wants shortest match. - (insert suffix) - (unless minibuffer-p - (message "Completed shortest")) - 'shortest) - ((or comint-completion-autolist - (string-equal stub completion)) - ;; It's not unique, list possible completions. - (comint-dynamic-list-completions completions stub) - 'listed) - (t - (unless minibuffer-p - (message "Partially completed")) - 'partial))))))) - (defun comint-dynamic-list-filename-completions () "Display a list of possible completions for the filename at point." (interactive) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index db5a93b60c3..1e1bf9efd68 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1531,13 +1531,6 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." nil (file-name-nondirectory guess))) (read-file-name prompt default-directory))) -(define-obsolete-function-alias 'read-filename-at-point - 'dired-x-read-filename-at-point "24.1") ; is this even needed? - - -;;; Epilog - -(define-obsolete-function-alias 'dired-x-submit-report 'report-emacs-bug "24.1") (define-obsolete-function-alias 'dired-man #'dired-do-man "29.1") (define-obsolete-function-alias 'dired-info #'dired-do-info "29.1") diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index ea54eea6036..edbe9e494f1 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el @@ -231,9 +231,6 @@ returned unaltered." (add-hook 'before-init-hook 'dos-reevaluate-defcustoms) -(define-obsolete-variable-alias - 'register-name-alist 'dos-register-name-alist "24.1") - (defvar dos-register-name-alist '((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5) (cflag . 6) (flags . 7) @@ -243,8 +240,6 @@ returned unaltered." (defun dos-make-register () (make-vector 8 0)) -(define-obsolete-function-alias 'make-register 'dos-make-register "24.1") - (defun dos-register-value (regs name) (let ((where (cdr (assoc name dos-register-name-alist)))) (cond ((consp where) @@ -256,8 +251,6 @@ returned unaltered." (aref regs where)) (t nil)))) -(define-obsolete-function-alias 'register-value 'dos-register-value "24.1") - (defun dos-set-register-value (regs name value) (and (numberp value) (>= value 0) @@ -274,9 +267,6 @@ returned unaltered." (aset regs where (logand value 65535)))))) regs) -(define-obsolete-function-alias - 'set-register-value 'dos-set-register-value "24.1") - (defsubst dos-intdos (regs) "Issue the DOS Int 21h with registers REGS. @@ -284,8 +274,6 @@ REGS should be a vector produced by `dos-make-register' and `dos-set-register-value', which see." (int86 33 regs)) -(define-obsolete-function-alias 'intdos 'dos-intdos "24.1") - ;; Backward compatibility for obsolescent functions which ;; set screen size. @@ -294,8 +282,6 @@ and `dos-set-register-value', which see." (interactive) (set-frame-size (selected-frame) 80 25)) -(define-obsolete-function-alias 'mode25 'dos-mode25 "24.1") - (defun dos-mode4350 () "Change the number of rows to 43 or 50. Emacs always tries to set the screen height to 50 rows first. @@ -307,8 +293,6 @@ that your video hardware might not support 50-line mode." nil ; the original built-in function returned nil (set-frame-size (selected-frame) 80 43))) -(define-obsolete-function-alias 'mode4350 'dos-mode4350 "24.1") - (provide 'dos-fns) ;;; dos-fns.el ends here diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5ef517d7e32..8df4133b6b0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -244,11 +244,6 @@ the functions you loaded will not be able to run.") (make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1") ;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp) -(defvar byte-compile-disable-print-circle nil - "If non-nil, disable `print-circle' on printing a byte-compiled code.") -(make-obsolete-variable 'byte-compile-disable-print-circle nil "24.1") -;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) - (defcustom byte-compile-dynamic-docstrings t "If non-nil, compile doc strings for lazy access. We bury the doc strings of functions and variables inside comments in @@ -2423,8 +2418,7 @@ Call from the source buffer." (print-level nil) (print-quoted t) (print-gensym t) - (print-circle ; Handle circular data structures. - (not byte-compile-disable-print-circle))) + (print-circle t)) ; Handle circular data structures. (if (and (memq (car-safe form) '(defvar defvaralias defconst autoload custom-declare-variable)) (stringp (nth 3 form))) @@ -2482,8 +2476,7 @@ list that represents a doc string reference. (print-level nil) (print-quoted t) (print-gensym t) - (print-circle ; Handle circular data structures. - (not byte-compile-disable-print-circle))) + (print-circle t)) ; Handle circular data structures. (if preface (progn ;; FIXME: We don't handle uninterned names correctly. diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 29fbcce7734..716b236d3ab 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -63,7 +63,6 @@ (eval-when-compile (require 'cl-generic)) ;;; Code: -(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1") (defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.") (defvar-local chart-local-object nil diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index d9864e6965d..25f2dd40980 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -24,8 +24,8 @@ ;;; Commentary: ;; ;; The "core" part of EIEIO is the implementation for the object -;; system (such as eieio-defclass, or eieio-defmethod) but not the -;; base classes for the object system, which are defined in EIEIO. +;; system (such as eieio-defclass-internal, or cl-defmethod) but not +;; the base classes for the object system, which are defined in EIEIO. ;; ;; See the commentary for eieio.el for more about EIEIO itself. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index de18adff5b8..ae72a47c2fc 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -158,9 +158,6 @@ test for `called-interactively' in the command will fail." (run-hooks 'pre-command-hook) (setq return-value (apply (car command) (cdr command))) (run-hooks 'post-command-hook) - (and (boundp 'deferred-action-list) - deferred-action-list - (run-hooks 'deferred-action-function)) (setq real-last-command (car command) last-command this-command) (when (boundp 'last-repeatable-command) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 641ce0d5c02..4b85414943a 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -943,14 +943,7 @@ character." (defun field-complete (table &optional predicate) (declare (obsolete completion-in-region "24.4")) (let ((minibuffer-completion-table table) - (minibuffer-completion-predicate predicate) - ;; This made sense for lisp-complete-symbol, but for - ;; field-complete, this is out of place. --Stef - ;; (completion-annotate-function - ;; (unless (eq predicate 'fboundp) - ;; (lambda (str) - ;; (if (fboundp (intern-soft str)) " ")))) - ) + (minibuffer-completion-predicate predicate)) (call-interactively 'minibuffer-complete))) (defun lisp-complete-symbol (&optional _predicate) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c8b66675970..8d0d5d57a22 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3520,9 +3520,6 @@ The full list of keys can be viewed with \\[describe-mode]." (message (mapconcat #'package--prettify-quick-help-key package--quick-help-keys "\n"))) -(define-obsolete-function-alias - 'package-menu-view-commentary 'package-menu-describe-package "24.1") - (defun package-menu-get-status () "Return status text of package at point in Package Menu." (package--ensure-package-menu-mode) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 7377ac94039..c2f6c162269 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -275,10 +275,9 @@ If `current-prefix-arg' is non-nil, also read a buffer and a \"context\" (list (read-buffer "Output to buffer" trace-buffer) (let ((exp - (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Context expression: " - nil read-expression-map t - 'read-expression-history)))) + (read-from-minibuffer "Context expression: " + nil read-expression-map t + 'read-expression-history))) (lambda () (let ((print-circle t) (print-escape-newlines t)) diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 3d2eda99a9c..1818e22a923 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -88,9 +88,6 @@ The functions get one argument, the first locked buffer found." :group 'emacs-lock :version "24.3") -(define-obsolete-variable-alias 'emacs-lock-from-exiting - 'emacs-lock-mode "24.1") - (defvar-local emacs-lock-mode nil "If non-nil, the current buffer is locked. It can be one of the following values: @@ -247,14 +244,6 @@ some major modes from being locked under some circumstances." ;; continue standard unloading nil)) -;;; Compatibility - -(defun toggle-emacs-lock () - "Toggle `emacs-lock-from-exiting' for the current buffer." - (declare (obsolete emacs-lock-mode "24.1")) - (interactive) - (call-interactively 'emacs-lock-mode)) - (provide 'emacs-lock) ;;; emacs-lock.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 239d8ebdcb6..0a16831fba3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4566,8 +4566,6 @@ This places `point' just after the prompt, or at the beginning of the line." (defun erc-complete-word-at-point () (run-hook-with-args-until-success 'erc-complete-functions)) -(define-obsolete-function-alias 'erc-complete-word #'completion-at-point "24.1") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; IRC SERVER INPUT HANDLING diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index f4c1302629b..822cc941491 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -158,14 +158,6 @@ to writing a completion function." (eshell-cmpl--custom-variable-docstring 'pcomplete-autolist) :type (get 'pcomplete-autolist 'custom-type)) -(defcustom eshell-cmpl-suffix-list (list ?/ ?:) - (eshell-cmpl--custom-variable-docstring 'pcomplete-suffix-list) - :type (get 'pcomplete-suffix-list 'custom-type) - :group 'pcomplete) -;; Only labeled obsolete in 26.1, but all it does it set -;; pcomplete-suffix-list, which is itself obsolete since 24.1. -(make-obsolete-variable 'eshell-cmpl-suffix-list nil "24.1") - (defcustom eshell-cmpl-recexact nil (eshell-cmpl--custom-variable-docstring 'pcomplete-recexact) :type (get 'pcomplete-recexact 'custom-type)) @@ -262,9 +254,6 @@ to writing a completion function." eshell-cmpl-ignore-case) (setq-local pcomplete-autolist eshell-cmpl-autolist) - (if (boundp 'pcomplete-suffix-list) - (setq-local pcomplete-suffix-list - eshell-cmpl-suffix-list)) (setq-local pcomplete-recexact eshell-cmpl-recexact) (setq-local pcomplete-man-function diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 6b864983995..5144e305121 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -301,15 +301,6 @@ Prepend remote identification of `default-directory', if any." (setq text (replace-match " " t t text))) text)) -(defmacro eshell-for (for-var for-list &rest forms) - "Iterate through a list." - (declare (obsolete dolist "24.1") (indent 2)) - `(let ((list-iter ,for-list)) - (while list-iter - (let ((,for-var (car list-iter))) - ,@forms) - (setq list-iter (cdr list-iter))))) - (define-obsolete-function-alias 'eshell-flatten-list #'flatten-tree "27.1") (defun eshell-stringify (object) diff --git a/lisp/files-x.el b/lisp/files-x.el index 8224a574507..da1e44e2504 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -81,8 +81,7 @@ Intended to be used in the `interactive' spec of (let ((default (format "%S" (cond ((eq variable 'unibyte) t) ((boundp variable) - (symbol-value variable))))) - (minibuffer-completing-symbol t)) + (symbol-value variable)))))) (read-from-minibuffer (format "Add %s with value: " variable) nil read-expression-map t 'set-variable-value-history diff --git a/lisp/files.el b/lisp/files.el index 992f9879437..2ea9d1e4673 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3161,9 +3161,6 @@ major mode MODE. See also `auto-mode-alist'.") -(define-obsolete-variable-alias 'inhibit-first-line-modes-regexps - 'inhibit-file-local-variables-regexps "24.1") - ;; TODO really this should be a list of modes (eg tar-mode), not regexps, ;; because we are duplicating info from auto-mode-alist. ;; TODO many elements of this list are also in auto-coding-alist. @@ -3184,9 +3181,6 @@ member files with their own local variable sections, which are not appropriate for the containing file. The function `inhibit-local-variables-p' uses this.") -(define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes - 'inhibit-local-variables-suffixes "24.1") - (defvar inhibit-local-variables-suffixes nil "List of regexps matching suffixes to remove from file names. The function `inhibit-local-variables-p' uses this: when checking diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 17a87134be0..3fc5ce2408a 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -52,24 +52,6 @@ method to use when posting." (const current) (sexp :tag "Methods" ,gnus-select-method))) -(defcustom gnus-outgoing-message-group nil - "All outgoing messages will be put in this group. -If you want to store all your outgoing mail and articles in the group -\"nnml:archive\", you set this variable to that value. This variable -can also be a list of group names. - -If you want to have greater control over what group to put each -message in, you can set this variable to a function that checks the -current newsgroup name and then returns a suitable group name (or list -of names)." - :group 'gnus-message - :type '(choice (const nil) - (function) - (string :tag "Group") - (repeat :tag "List of groups" (string :tag "Group")))) - -(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1") - (defcustom gnus-mailing-list-groups nil "If non-nil a regexp matching groups that are really mailing lists. This is useful when you're reading a mailing list that has been @@ -215,30 +197,6 @@ use this option with care." :parameter-document "\ List of charsets that are permitted to be unencoded.") -(defcustom gnus-debug-files - '("gnus.el" "gnus-sum.el" "gnus-group.el" - "gnus-art.el" "gnus-start.el" "gnus-async.el" - "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" - "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el" - "mm-util.el" "mm-decode.el" "nnmail.el" "message.el") - "Files whose variables will be reported in `gnus-bug'." - :version "22.1" - :group 'gnus-message - :type '(repeat file)) - -(make-obsolete-variable 'gnus-debug-files "it is no longer used." "24.1") - -(defcustom gnus-debug-exclude-variables - '(mm-mime-mule-charset-alist - nnmail-split-fancy message-minibuffer-local-map) - "Variables that should not be reported in `gnus-bug'." - :version "22.1" - :group 'gnus-message - :type '(repeat variable)) - -(make-obsolete-variable - 'gnus-debug-exclude-variables "it is no longer used." "24.1") - (defcustom gnus-discouraged-post-methods '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir) "A list of back ends that are not used in \"real\" newsgroups. @@ -1665,7 +1623,7 @@ this is a reply." (defun gnus-inews-insert-gcc (&optional group) "Insert the Gcc to say where the article is to be archived." (let* ((group (or group gnus-newsgroup-name)) - (var (or gnus-outgoing-message-group gnus-message-archive-group)) + (var gnus-message-archive-group) (gcc-self-val (and group (not (gnus-virtual-group-p group)) (gnus-group-find-parameter group 'gcc-self t))) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 8cefb09b66a..ceeb1848542 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1004,9 +1004,6 @@ Uses `gnus-registry-marks' to find what shortcuts to install." nil (cons "Registry Marks" gnus-registry-misc-menus))))) -(define-obsolete-function-alias 'gnus-registry-user-format-function-M - #'gnus-registry-article-marks-to-chars "24.1") - ;; use like this: ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars) (defun gnus-registry-article-marks-to-chars (headers) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 2119e68509e..7eea08f1744 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1130,16 +1130,6 @@ you could set this variable: :group 'gnus-server :type '(repeat gnus-select-method)) -(defcustom gnus-local-domain nil - "Local domain name without a host name. -The DOMAINNAME environment variable is used instead if it is defined. -If the function `system-name' returns the full Internet name, there is -no need to set this variable." - :group 'gnus-message - :type '(choice (const :tag "default" nil) - string)) -(make-obsolete-variable 'gnus-local-domain nil "24.1") - ;; Customization variables (defcustom gnus-refer-article-method 'current @@ -2316,11 +2306,6 @@ automatically cache the article in the agent cache." (defvar gnus-server-method-cache nil) (defvar gnus-extended-servers nil) -;; The carpal mode has been removed, but define the variable for -;; backwards compatibility. -(defvar gnus-carpal nil) -(make-obsolete-variable 'gnus-carpal nil "24.1") - (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index c629cb85d96..746109f26fa 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -95,9 +95,6 @@ Uses the same syntax as `nnmail-split-methods'.") (defvoo nnimap-unsplittable-articles '(%Deleted %Seen) "Articles with the flags in the list will not be considered when splitting.") -(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'." - "24.1") - (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. Possible choices are nil (use default methods), `anonymous', diff --git a/lisp/iimage.el b/lisp/iimage.el index 8a765d5e5d5..baeb4bb6a7b 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -87,9 +87,6 @@ Examples of image filename patterns to match: (iimage-mode-buffer t) (recenter-top-bottom arg)) -;;;###autoload -(define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1") - (defun turn-off-iimage-mode () "Unconditionally turn off iimage mode." (interactive) diff --git a/lisp/image.el b/lisp/image.el index e90cccaa096..bdaaec608ef 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -446,15 +446,6 @@ type if we can't otherwise guess it." (error "Invalid image type `%s'" type)) type) - -(if (fboundp 'image-metadata) ; eg not --without-x - (define-obsolete-function-alias 'image-extension-data - 'image-metadata "24.1")) - -(define-obsolete-variable-alias - 'image-library-alist - 'dynamic-library-alist "24.1") - ;;;###autoload (defun image-type-available-p (type) "Return t if image type TYPE is available. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 9d2e20ae04b..d743802eade 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -42,9 +42,6 @@ :group 'maint :group 'mail) -(define-obsolete-variable-alias 'report-emacs-bug-pretest-address - 'report-emacs-bug-address "24.1") - (defcustom report-emacs-bug-no-confirmation nil "If non-nil, suppress the confirmations asked for the sake of novice users." :type 'boolean) diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index 952970d07c0..9ea2cc92e94 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -239,12 +239,8 @@ comma-separated list, and return the pruned list." ;; Or just set the default directly in the defcustom. (if (null mail-dont-reply-to-names) (setq mail-dont-reply-to-names - ;; `rmail-default-dont-reply-to-names' is obsolete. - (let ((a (bound-and-true-p rmail-default-dont-reply-to-names)) - (b (if (> (length user-mail-address) 0) - (concat "\\`" (regexp-quote user-mail-address) "\\'")))) - (cond ((and a b) (concat a "\\|" b)) - ((or a b)))))) + (if (> (length user-mail-address) 0) + (concat "\\`" (regexp-quote user-mail-address) "\\'")))) ;; Split up DESTINATIONS and match each element separately. (let ((start-pos 0) (cur-pos 0) (case-fold-search t)) @@ -281,9 +277,6 @@ comma-separated list, and return the pruned list." (substring destinations (match-end 0)) destinations)) -;; Legacy name -(define-obsolete-function-alias 'rmail-dont-reply-to #'mail-dont-reply-to "24.1") - ;;;###autoload (defun mail-fetch-field (field-name &optional last all list delete) diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index ba7cf58d383..c97786190c3 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -72,8 +72,7 @@ When t this still needs to be initialized.") ) "Alist of header field and expression to return alist for completion. The expression may reference the variable `pattern' -which will hold the string being completed. -If not on matching header, `mail-complete-function' gets called instead." +which will hold the string being completed." :type 'alist :group 'mailalias) (put 'mail-complete-alist 'risky-local-variable t) @@ -90,13 +89,6 @@ If `angles', they look like: :type '(choice (const angles) (const parens) (const nil)) :group 'mailalias) -(defcustom mail-complete-function 'ispell-complete-word - "Function to call when completing outside `mail-complete-alist'-header." - :type '(choice function (const nil)) - :group 'mailalias) -(make-obsolete-variable 'mail-complete-function - 'completion-at-point-functions "24.1") - (defcustom mail-directory-function nil "Function to get completions from directory service or nil for none. See `mail-directory-requery'." @@ -433,25 +425,6 @@ For use on `completion-at-point-functions'." (let ((pattern prefix)) (eval list-exp)))))) (list beg end table))))) -;;;###autoload -(defun mail-complete (arg) - "Perform completion on header field or word preceding point. -Completable headers are according to `mail-complete-alist'. If none matches -current header, calls `mail-complete-function' and passes prefix ARG if any." - (declare (obsolete mail-completion-at-point-function "24.1")) - (interactive "P") - ;; Read the defaults first, if we have not done so. - (sendmail-sync-aliases) - (if (eq mail-aliases t) - (progn - (setq mail-aliases nil) - (if (file-exists-p mail-personal-alias-file) - (build-mail-aliases)))) - (let ((data (mail-completion-at-point-function))) - (if data - (apply #'completion-in-region data) - (funcall mail-complete-function arg)))) - (defun mail-completion-expand (table) "Build new completion table that expands aliases. Completes like TABLE except that if the completion is a valid alias, diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index b2b21b88ef8..467375dbe1f 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -314,20 +314,6 @@ Setting this variable has an effect only before reading a mail." :group 'rmail-retrieve :version "21.1") -;;;###autoload -(define-obsolete-variable-alias 'rmail-dont-reply-to-names - 'mail-dont-reply-to-names "24.1") - -;; Prior to 24.1, this used to contain "\\`info-". -;;;###autoload -(defvar rmail-default-dont-reply-to-names nil - "Regexp specifying part of the default value of `mail-dont-reply-to-names'. -This is used when the user does not set `mail-dont-reply-to-names' -explicitly.") -;;;###autoload -(make-obsolete-variable 'rmail-default-dont-reply-to-names - 'mail-dont-reply-to-names "24.1") - ;;;###autoload (defcustom rmail-ignored-headers (purecopy diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index c55cdc8412a..6afadca6bb3 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -430,20 +430,6 @@ support Delivery Status Notification." (const :tag "Success" success))) :version "22.1") -;; Note: could use /usr/ucb/mail instead of sendmail; -;; options -t, and -v if not interactive. -(defvar mail-mailer-swallows-blank-line nil - "Set this non-nil if the system's mailer runs the header and body together. -The actual value should be an expression to evaluate that returns -non-nil if the problem will actually occur. -\(As far as we know, this is not an issue on any system still supported -by Emacs.)") - -(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled -(make-obsolete-variable 'mail-mailer-swallows-blank-line - "no need to set this on any modern system." - "24.1" 'set) - (defvar mail-mode-syntax-table ;; define-derived-mode will make it inherit from text-mode-syntax-table. (let ((st (make-syntax-table))) @@ -1309,8 +1295,6 @@ external program defined by `sendmail-program'." ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) - (if (eval mail-mailer-swallows-blank-line) - (newline)) ;; Find and handle any Fcc fields. (goto-char (point-min)) (if (re-search-forward "^Fcc:" delimline t) @@ -1495,28 +1479,6 @@ just append to the file, in Babyl format if necessary." (with-current-buffer buffer (set-visited-file-modtime))))))))) -(defun mail-sent-via () - "Make a Sent-via header line from each To or Cc header line." - (declare (obsolete "nobody can remember what it is for." "24.1")) - (interactive) - (save-excursion - ;; put a marker at the end of the header - (let ((end (copy-marker (mail-header-end))) - (case-fold-search t)) - (goto-char (point-min)) - ;; search for the To: lines and make Sent-via: lines from them - ;; search for the next To: line - (while (re-search-forward "^\\(to\\|cc\\):" end t) - ;; Grab this line plus all its continuations, sans the `to:'. - (let ((to-line - (buffer-substring (point) - (progn - (if (re-search-forward "^[^ \t\n]" end t) - (backward-char 1) - (goto-char end)) - (point))))) - ;; Insert a copy, with altered header field name. - (insert-before-markers "Sent-via:" to-line)))))) (defun mail-to () "Move point to end of To field, creating it if necessary." @@ -1839,8 +1801,6 @@ If the current line has `mail-yank-prefix', insert it on the new line." (or (bolp) (newline)) (goto-char start)))) -(define-obsolete-function-alias 'mail-attach-file #'mail-insert-file "24.1") - (declare-function mml-attach-file "mml" (file &optional type description disposition)) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index da786dec004..8cba2b14e14 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -342,8 +342,6 @@ for `smtpmail-try-auth-method'.") ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) - (if (eval mail-mailer-swallows-blank-line t) - (newline)) ;; Find and handle any Fcc fields. (goto-char (point-min)) (if (re-search-forward "^Fcc:" delimline t) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index a134654a020..12a0b4d328f 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -584,9 +584,6 @@ menu)) -(define-obsolete-function-alias - 'menu-bar-kill-ring-save 'kill-ring-save "24.1") - ;; These are alternative definitions for the cut, paste and copy ;; menu items. Use them if your system expects these to use the clipboard. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index e029dfe4147..9d2abbd1180 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2225,25 +2225,6 @@ These include: `exact' - text is a valid completion but may be further completed.") -(defvar completion-annotate-function - nil - ;; Note: there's a lot of scope as for when to add annotations and - ;; what annotations to add. E.g. completing-help.el allowed adding - ;; the first line of docstrings to M-x completion. But there's - ;; a tension, since such annotations, while useful at times, can - ;; actually drown the useful information. - ;; So completion-annotate-function should be used parsimoniously, or - ;; else only used upon a user's request (e.g. we could add a command - ;; to completion-list-mode to add annotations to the current - ;; completions). - "Function to add annotations in the *Completions* buffer. -The function takes a completion and should either return nil, or a string that -will be displayed next to the completion. The function can access the -completion table and predicates via `minibuffer-completion-table' and related -variables.") -(make-obsolete-variable 'completion-annotate-function - 'completion-extra-properties "24.1") - (defun completion--done (string &optional finished message) (let* ((exit-fun (plist-get completion-extra-properties :exit-function)) (pre-msg (and exit-fun (current-message)))) @@ -2314,8 +2295,7 @@ variables.") minibuffer-completion-predicate)) (ann-fun (or (completion-metadata-get all-md 'annotation-function) (plist-get completion-extra-properties - :annotation-function) - completion-annotate-function)) + :annotation-function))) (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) @@ -2790,9 +2770,6 @@ Gets combined either with `minibuffer-local-completion-map' or with `minibuffer-local-must-match-map'." "SPC" nil) -(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) -(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1") - (defvar-keymap minibuffer-local-ns-map :doc "Local keymap for the minibuffer when spaces are not allowed." :parent minibuffer-local-map diff --git a/lisp/msb.el b/lisp/msb.el index 616799f067b..19f0afed738 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -353,9 +353,6 @@ This is instead of the groups in `msb-menu-cond'." :type 'boolean :set #'msb-custom-set) -(define-obsolete-variable-alias 'msb-after-load-hooks - 'msb-after-load-hook "24.1") - (defcustom msb-after-load-hook nil "Hook run after the msb package has been loaded." :type 'hook diff --git a/lisp/obsolete/eieio-compat.el b/lisp/obsolete/eieio-compat.el index b31bde4efba..2ac75293fcc 100644 --- a/lisp/obsolete/eieio-compat.el +++ b/lisp/obsolete/eieio-compat.el @@ -248,21 +248,6 @@ Summary: (message "next-method-p called outside of a primary or around method") nil) -;;;###autoload -(defun eieio-defmethod (method args) - "Obsolete work part of an old version of the `defmethod' macro." - (declare (obsolete cl-defmethod "24.1")) - (eval `(defmethod ,method ,@args)) - method) - -;;;###autoload -(defun eieio-defgeneric (method doc-string) - "Obsolete work part of an old version of the `defgeneric' macro." - (declare (obsolete cl-defgeneric "24.1")) - (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string)))) - ;; Return the method - 'method) - ;;;###autoload (defun eieio-defclass (cname superclasses slots options) (declare (obsolete eieio-defclass-internal "25.1")) diff --git a/lisp/obsolete/info-edit.el b/lisp/obsolete/info-edit.el index 6c1be1078ff..6c4c10ca6c2 100644 --- a/lisp/obsolete/info-edit.el +++ b/lisp/obsolete/info-edit.el @@ -33,7 +33,6 @@ (make-obsolete-variable 'Info-edit-mode-hook "editing Info nodes by hand is not recommended." "24.4") -(define-obsolete-variable-alias 'Info-edit-map 'Info-edit-mode-map "24.1") (defvar Info-edit-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map text-mode-map) (define-key map "\C-c\C-c" #'Info-cease-edit) diff --git a/lisp/obsolete/starttls.el b/lisp/obsolete/starttls.el index 6f0685d3dda..2f1f0e9773c 100644 --- a/lisp/obsolete/starttls.el +++ b/lisp/obsolete/starttls.el @@ -287,9 +287,6 @@ GnuTLS requires a port number." starttls-gnutls-program starttls-program)))) -(define-obsolete-function-alias 'starttls-any-program-available - #'starttls-available-p "24.1") - (provide 'starttls) ;;; starttls.el ends here diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 00348ac0bb9..32031d19462 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -793,14 +793,6 @@ bundle agent rcfiles (cdr (assq 'functions cfengine3-fallback-syntax))) 'symbols)) -(defcustom cfengine-mode-abbrevs nil - "Abbrevs for CFEngine2 mode." - :type '(repeat (list (string :tag "Name") - (string :tag "Expansion") - (choice :tag "Hook" (const nil) function)))) - -(make-obsolete-variable 'cfengine-mode-abbrevs 'edit-abbrevs "24.1") - ;; Taken from the doc for pre-release 2.1. (eval-and-compile (defconst cfengine2-actions @@ -1409,7 +1401,6 @@ to the action header." (setq-local outline-regexp "[ \t]*\\(\\sw\\|\\s_\\)+:+") (setq-local outline-level #'cfengine2-outline-level) (setq-local fill-paragraph-function #'cfengine-fill-paragraph) - (define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs) (setq font-lock-defaults '(cfengine2-font-lock-keywords nil nil nil beginning-of-line)) ;; Fixme: set the args of functions in evaluated classes to string diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 971e3f6174d..03469b9f55b 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -180,9 +180,6 @@ C++ modes are included." (cwarn-font-lock-keywords cwarn-mode) (font-lock-flush)) -;;;###autoload -(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") - ;;}}} ;;{{{ Help functions diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 91307f6c09f..bd01786e08c 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1170,7 +1170,6 @@ and adds all qualifying names to the list of known targets." (goto-char (match-end 0)) (insert suffix)))))))) -(define-obsolete-function-alias 'makefile-complete 'completion-at-point "24.1") ;; Backslashification. Stolen from cc-mode.el. diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 34288e0e4fb..f0fd23f3bc3 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -438,8 +438,6 @@ If the list was changed, sort the list and remove duplicates first." (insert close))))))) (nth 1 entry)))) -(define-obsolete-function-alias 'meta-complete-symbol - 'completion-at-point "24.1") ;;; Indentation. @@ -803,7 +801,6 @@ The environment marked is the one that contains point or follows point." st) "Syntax table used in Metafont or MetaPost mode.") -(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1") (defvar meta-common-mode-map (let ((map (make-sparse-keymap))) ;; Comment Paragraphs: diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 351ea6e3a99..8d3194e6a47 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -239,14 +239,6 @@ will do all lineups." (const :tag "Declarations" declaration) (const :tag "Case statements" case))) -(defvar pascal-toggle-completions nil - "If non-nil, `pascal-complete-word' tries all possible completions. -Repeated use of \\[pascal-complete-word] then shows all -completions in turn, instead of displaying a list of all possible -completions.") -(make-obsolete-variable 'pascal-toggle-completions - 'completion-cycle-threshold "24.1") - (defcustom pascal-type-keywords '("array" "file" "packed" "char" "integer" "real" "string" "record") "Keywords for types used when completing a word in a declaration or parmlist. @@ -1297,13 +1289,6 @@ indent of the current line in parameterlist." (when (> e b) (list b e #'pascal-completion)))) -(define-obsolete-function-alias 'pascal-complete-word - 'completion-at-point "24.1") - -(define-obsolete-function-alias 'pascal-show-completions - 'completion-help-at-point "24.1") - - (defun pascal-get-default-symbol () "Return symbol around current point as a string." (save-excursion diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 9598209f5e5..5aba95d4c79 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -742,14 +742,6 @@ Relevant only when `prolog-imenu-flag' is non-nil." :group 'prolog-other :type 'boolean) -(defcustom prolog-char-quote-workaround nil - "If non-nil, declare 0 as a quote character to handle 0'. -This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." - :version "24.1" - :group 'prolog-other - :type 'boolean) -(make-obsolete-variable 'prolog-char-quote-workaround nil "24.1") - ;;------------------------------------------------------------------- ;; Internal variables @@ -1303,7 +1295,7 @@ To find out what version of Prolog mode you are running, enter (t t))) ;; This statement was missing in Emacs 24.1, 24.2, 24.3. -(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1") +(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1") ; "24.4" ; for grep ;;;###autoload (defun run-prolog (arg) "Run an inferior Prolog process, input and output via buffer *prolog*. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f1191b8faab..1c99937c4b9 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -248,7 +248,6 @@ (eval-when-compile (require 'subr-x)) ;For `string-empty-p'. ;; Avoid compiler warnings -(defvar view-return-to-alist) (defvar compilation-error-regexp-alist) (defvar outline-heading-end-regexp) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 3c8d4f43dbc..2e8e8d23192 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -234,9 +234,6 @@ It creates the Imenu index for the buffer, if necessary." (setq which-func-mode nil) (error "Error in which-func-update: %S" info)))))) -;;;###autoload -(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1") - (defvar which-func-update-timer nil) (unless (or (assq 'which-func-mode mode-line-misc-info) diff --git a/lisp/simple.el b/lisp/simple.el index 66640916a25..1d251dbf5e6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1732,8 +1732,6 @@ from Lisp." words (if (= words 1) "" "s") chars (if (= chars 1) "" "s")))) -(define-obsolete-function-alias 'count-lines-region 'count-words-region "24.1") - (defun what-line () "Print the current buffer line number and narrowed line number of point." (interactive) @@ -1951,10 +1949,6 @@ Such arguments are used as in `read-from-minibuffer'.)" ;; Used for interactive spec `X'. (eval (read--expression prompt initial-contents))) -(defvar minibuffer-completing-symbol nil - "Non-nil means completing a Lisp symbol in the minibuffer.") -(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1" 'get) - (defvar minibuffer-default nil "The current default value or list of default values in the minibuffer. The functions `read-from-minibuffer' and `completing-read' bind @@ -2015,20 +2009,19 @@ display the result of expression evaluation." PROMPT and optional argument INITIAL-CONTENTS do the same as in function `read-from-minibuffer'." - (let ((minibuffer-completing-symbol t)) - (minibuffer-with-setup-hook - (lambda () - ;; FIXME: instead of just applying the syntax table, maybe - ;; use a special major mode tailored to reading Lisp - ;; expressions from the minibuffer? (`emacs-lisp-mode' - ;; doesn't preserve the necessary keybindings.) - (set-syntax-table emacs-lisp-mode-syntax-table) - (add-hook 'completion-at-point-functions - #'elisp-completion-at-point nil t) - (run-hooks 'eval-expression-minibuffer-setup-hook)) - (read-from-minibuffer prompt initial-contents - read-expression-map t - 'read-expression-history)))) + (minibuffer-with-setup-hook + (lambda () + ;; FIXME: instead of just applying the syntax table, maybe + ;; use a special major mode tailored to reading Lisp + ;; expressions from the minibuffer? (`emacs-lisp-mode' + ;; doesn't preserve the necessary keybindings.) + (set-syntax-table emacs-lisp-mode-syntax-table) + (add-hook 'completion-at-point-functions + #'elisp-completion-at-point nil t) + (run-hooks 'eval-expression-minibuffer-setup-hook)) + (read-from-minibuffer prompt initial-contents + read-expression-map t + 'read-expression-history))) (defun read--expression-try-read () "Try to read an Emacs Lisp expression in the minibuffer. diff --git a/lisp/speedbar.el b/lisp/speedbar.el index da85d548637..9184d6c5254 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -703,8 +703,6 @@ If you want to change this while speedbar is active, either use (defvar speedbar-update-flag-disable nil "Permanently disable changing of the update flag.") -(define-obsolete-variable-alias - 'speedbar-syntax-table 'speedbar-mode-syntax-table "24.1") (defvar speedbar-mode-syntax-table (let ((st (make-syntax-table))) ;; Turn off paren matching around here. @@ -719,8 +717,6 @@ If you want to change this while speedbar is active, either use st) "Syntax-table used on the speedbar.") - -(define-obsolete-variable-alias 'speedbar-key-map 'speedbar-mode-map "24.1") (defvar speedbar-mode-map (let ((map (make-keymap))) (suppress-keymap map t) diff --git a/lisp/strokes.el b/lisp/strokes.el index 376cbc0cfee..d7a95393166 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1031,8 +1031,6 @@ o Strokes are a bit computer-dependent in that they depend somewhat on (help-mode) (help-print-return-message))) -(define-obsolete-function-alias 'strokes-report-bug #'report-emacs-bug "24.1") - (defun strokes-window-configuration-changed-p () "Non-nil if the `strokes-window-configuration' frame properties changed. This is based on the last time `strokes-window-configuration' was updated." diff --git a/lisp/subr.el b/lisp/subr.el index 6bf12fd7577..f8b386e5631 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1856,8 +1856,6 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Obsolescence declarations for variables, and aliases. (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") -(make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1") -(make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1") (make-obsolete-variable 'redisplay-dont-pause nil "24.5") (make-obsolete 'window-redisplay-end-trigger nil "23.1") (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") @@ -4707,9 +4705,6 @@ even if this catches the signal." ,@(cdr handler))) handlers))) -(define-obsolete-function-alias 'condition-case-no-debug - 'condition-case-unless-debug "24.1") - (defmacro with-demoted-errors (format &rest body) "Run BODY and demote any errors to simple messages. FORMAT is a string passed to `message' to format any error message. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 84c5b087b9a..e26191b33b4 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -97,8 +97,6 @@ The properties returned may include `top', `left', `height', and `width'." ;;;; Keyboard mapping. -(define-obsolete-variable-alias 'ns-alternatives-map 'x-alternatives-map "24.1") - ;; Here are some Nextstep-like bindings for command key sequences. (define-key global-map [?\s-,] 'customize) (define-key global-map [?\s-'] 'next-window-any-frame) @@ -682,10 +680,6 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;;;; Pasteboard support. -(define-obsolete-function-alias 'ns-store-cut-buffer-internal - 'gui-set-selection "24.1") - - (defun ns-copy-including-secondary () (interactive) (call-interactively 'kill-ring-save) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 7eaa6047763..993f1d43208 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -81,7 +81,6 @@ (&optional frame exclude-proportional)) (defvar w32-color-map) ;; defined in w32fns.c -(make-obsolete 'w32-default-color-map nil "24.1") (declare-function w32-send-sys-command "w32fns.c") (declare-function set-message-beep "w32fns.c") diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 7c88c85ceff..3a0bd65f29c 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1171,9 +1171,6 @@ as returned by `x-server-vendor'." ;;;; Selections -(define-obsolete-function-alias 'x-cut-buffer-or-selection-value - 'x-selection-value "24.1") - ;; Arrange for the kill and yank functions to set and check the clipboard. (defun x-clipboard-yank () diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 544e0da8276..6763da046ff 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -316,8 +316,6 @@ If parsing fails, try to set this variable to nil." (option (choice :tag "Alternative" :value nil (const nil) integer))))))) -(define-obsolete-variable-alias 'bibtex-entry-field-alist - 'bibtex-BibTeX-entry-alist "24.1") (defcustom bibtex-BibTeX-entry-alist '(("Article" "Article in Journal" (("author") @@ -3673,14 +3671,6 @@ if that value is non-nil. (if (not (consp (nth 1 (car entry-alist)))) ;; new format entry-alist - ;; Convert old format of `bibtex-entry-field-alist' - (unless (get var 'entry-list-format) - (put var 'entry-list-format "pre-24") - (message "Old format of `%s' (pre GNU Emacs 24). -Please convert to the new format." - (if (eq (indirect-variable 'bibtex-entry-field-alist) var) - 'bibtex-entry-field-alist var)) - (sit-for 3)) (let (lst) (dolist (entry entry-alist) (let ((fl (nth 1 entry)) req xref opt) @@ -5318,7 +5308,6 @@ entries from minibuffer." (goto-char (point-max)) (message "Buffer is now parsable. Please save it."))) -(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1") (defun bibtex-completion-at-point-function () (let ((pnt (point)) (case-fold-search t) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index aeae389da64..b517cc16634 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -269,8 +269,6 @@ will prompt for other arguments." (and newtag (cdr cell) (not (member newtag (cdr cell))) (push newtag (cdr cell))))) -(define-obsolete-variable-alias - 'reftex-index-map 'reftex-index-mode-map "24.1") (defvar reftex-index-mode-map (let ((map (make-sparse-keymap))) ;; Index map @@ -1198,8 +1196,6 @@ This gets refreshed in every phrases command.") '((reftex-index-phrases-font-lock-keywords) nil t nil beginning-of-line) "Font lock defaults for `reftex-index-phrases-mode'.") -(define-obsolete-variable-alias - 'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1") (defvar reftex-index-phrases-mode-map (let ((map (make-sparse-keymap))) ;; Keybindings and Menu for phrases buffer diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index d77411483f7..5942801a8a9 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -59,8 +59,6 @@ (define-key map [follow-link] 'mouse-face) map)) -(define-obsolete-variable-alias - 'reftex-select-label-map 'reftex-select-label-mode-map "24.1") (defvar reftex-select-label-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map reftex-select-shared-map) @@ -109,8 +107,6 @@ During a selection process, these are the local bindings. ;; We do not set a local map - reftex-select-item does this. ) -(define-obsolete-variable-alias - 'reftex-select-bib-map 'reftex-select-bib-mode-map "24.1") (defvar reftex-select-bib-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map reftex-select-shared-map) diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 89c734a0d76..5599eaee024 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -28,7 +28,6 @@ (require 'reftex) ;;; -(define-obsolete-variable-alias 'reftex-toc-map 'reftex-toc-mode-map "24.1") (defvar reftex-toc-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 964baed03c7..f6bbda02e6a 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -3584,125 +3584,46 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too." :version "24.1" :group 'rst-faces) -(defcustom rst-block-face 'rst-block - "All syntax marking up a special block." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-block-face - "customize the face `rst-block' instead." - "24.1") - (defface rst-external '((t :inherit font-lock-type-face)) "Face used for field names and interpreted text." :version "24.1" :group 'rst-faces) -(defcustom rst-external-face 'rst-external - "Field names and interpreted text." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-external-face - "customize the face `rst-external' instead." - "24.1") - (defface rst-definition '((t :inherit font-lock-function-name-face)) "Face used for all other defining constructs." :version "24.1" :group 'rst-faces) -(defcustom rst-definition-face 'rst-definition - "All other defining constructs." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-definition-face - "customize the face `rst-definition' instead." - "24.1") - (defface rst-directive '((t :inherit font-lock-builtin-face)) "Face used for directives and roles." :version "24.1" :group 'rst-faces) -(defcustom rst-directive-face 'rst-directive - "Directives and roles." - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-directive-face - "customize the face `rst-directive' instead." - "24.1") - (defface rst-comment '((t :inherit font-lock-comment-face)) "Face used for comments." :version "24.1" :group 'rst-faces) -(defcustom rst-comment-face 'rst-comment - "Comments." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-comment-face - "customize the face `rst-comment' instead." - "24.1") - (defface rst-emphasis1 '((t :inherit italic)) "Face used for simple emphasis." :version "24.1" :group 'rst-faces) -(defcustom rst-emphasis1-face 'rst-emphasis1 - "Simple emphasis." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-emphasis1-face - "customize the face `rst-emphasis1' instead." - "24.1") - (defface rst-emphasis2 '((t :inherit bold)) "Face used for double emphasis." :version "24.1" :group 'rst-faces) -(defcustom rst-emphasis2-face 'rst-emphasis2 - "Double emphasis." - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-emphasis2-face - "customize the face `rst-emphasis2' instead." - "24.1") - (defface rst-literal '((t :inherit font-lock-string-face)) "Face used for literal text." :version "24.1" :group 'rst-faces) -(defcustom rst-literal-face 'rst-literal - "Literal text." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-literal-face - "customize the face `rst-literal' instead." - "24.1") - (defface rst-reference '((t :inherit font-lock-variable-name-face)) "Face used for references to a definition." :version "24.1" :group 'rst-faces) -(defcustom rst-reference-face 'rst-reference - "References to a definition." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-reference-face - "customize the face `rst-reference' instead." - "24.1") - (defface rst-transition '((t :inherit font-lock-keyword-face)) "Face used for a transition." :package-version '(rst . "1.3.0") @@ -3794,23 +3715,23 @@ of your own." ;; `Bullet Lists`_ ;; FIXME: A bullet directly after a field name is not recognized. (,(rst-re 'lin-beg '(:grp bul-sta)) - 1 rst-block-face) + 1 'rst-block) ;; `Enumerated Lists`_ (,(rst-re 'lin-beg '(:grp enmany-sta)) - 1 rst-block-face) + 1 'rst-block) ;; `Definition Lists`_ ;; FIXME: missing. ;; `Field Lists`_ (,(rst-re 'lin-beg '(:grp fld-tag) 'bli-sfx) - 1 rst-external-face) + 1 'rst-external) ;; `Option Lists`_ (,(rst-re 'lin-beg '(:grp opt-tag (:shy optsep-tag opt-tag) "*") '(:alt "$" (:seq hws-prt "\\{2\\}"))) - 1 rst-block-face) + 1 'rst-block) ;; `Line Blocks`_ ;; Only for lines containing no more bar - to distinguish from tables. (,(rst-re 'lin-beg '(:grp "|" bli-sfx) "[^|\n]*$") - 1 rst-block-face) + 1 'rst-block) ;; `Tables`_ ;; FIXME: missing @@ -3818,22 +3739,22 @@ of your own." ;; All the `Explicit Markup Blocks`_ ;; `Footnotes`_ / `Citations`_ (,(rst-re 'lin-beg 'fnc-sta-2) - (1 rst-definition-face) - (2 rst-definition-face)) + (1 'rst-definition) + (2 'rst-definition)) ;; `Directives`_ / `Substitution Definitions`_ (,(rst-re 'lin-beg 'dir-sta-3) - (1 rst-directive-face) - (2 rst-definition-face) - (3 rst-directive-face)) + (1 'rst-directive) + (2 'rst-definition) + (3 'rst-directive)) ;; `Hyperlink Targets`_ (,(rst-re 'lin-beg '(:grp exm-sta "_" (:alt (:seq "`" ilcbkqdef-tag "`") (:seq (:alt "[^:\\\n]" "\\\\.") "+")) ":") 'bli-sfx) - 1 rst-definition-face) + 1 'rst-definition) (,(rst-re 'lin-beg '(:grp "__") 'bli-sfx) - 1 rst-definition-face) + 1 'rst-definition) ;; All `Inline Markup`_ ;; Most of them may be multiline though this is uninteresting. @@ -3841,16 +3762,16 @@ of your own." ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented ;; `Strong Emphasis`_. (,(rst-re 'ilm-pfx '(:grp "\\*\\*" ilcast-tag "\\*\\*") 'ilm-sfx) - 1 rst-emphasis2-face) + 1 'rst-emphasis2) ;; `Emphasis`_ (,(rst-re 'ilm-pfx '(:grp "\\*" ilcast-tag "\\*") 'ilm-sfx) - 1 rst-emphasis1-face) + 1 'rst-emphasis1) ;; `Inline Literals`_ (,(rst-re 'ilm-pfx '(:grp "``" ilcbkq-tag "``") 'ilm-sfx) - 1 rst-literal-face) + 1 'rst-literal) ;; `Inline Internal Targets`_ (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx) - 1 rst-definition-face) + 1 'rst-definition) ;; `Hyperlink References`_ ;; FIXME: `Embedded URIs and Aliases`_ not considered. ;; FIXME: Directly adjacent marked up words are not fontified correctly @@ -3858,28 +3779,28 @@ of your own." (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`") (:seq "\\sw" (:alt "\\sw" "-") "+\\sw")) "__?") 'ilm-sfx) - 1 rst-reference-face) + 1 'rst-reference) ;; `Interpreted Text`_ (,(rst-re 'ilm-pfx '(:grp (:shy ":" sym-tag ":") "?") '(:grp "`" ilcbkq-tag "`") '(:grp (:shy ":" sym-tag ":") "?") 'ilm-sfx) - (1 rst-directive-face) - (2 rst-external-face) - (3 rst-directive-face)) + (1 'rst-directive) + (2 'rst-external) + (3 'rst-directive)) ;; `Footnote References`_ / `Citation References`_ (,(rst-re 'ilm-pfx '(:grp fnc-tag "_") 'ilm-sfx) - 1 rst-reference-face) + 1 'rst-reference) ;; `Substitution References`_ ;; FIXME: References substitutions like |this|_ or |this|__ are not ;; fontified correctly. (,(rst-re 'ilm-pfx '(:grp sub-tag) 'ilm-sfx) - 1 rst-reference-face) + 1 'rst-reference) ;; `Standalone Hyperlinks`_ ;; FIXME: This takes it easy by using a whitespace as delimiter. (,(rst-re 'ilm-pfx '(:grp uri-tag ":\\S +") 'ilm-sfx) - 1 rst-definition-face) + 1 'rst-definition) (,(rst-re 'ilm-pfx '(:grp sym-tag "@" sym-tag ) 'ilm-sfx) - 1 rst-definition-face) + 1 'rst-definition) ;; Do all block fontification as late as possible so 'append works. @@ -3906,18 +3827,18 @@ of your own." ;; `Comments`_ ;; This is multiline. (,(rst-re 'lin-beg 'cmt-sta-1) - (1 rst-comment-face) + (1 'rst-comment) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit (match-end 1)) nil - (0 rst-comment-face append))) + (0 'rst-comment append))) (,(rst-re 'lin-beg '(:grp exm-tag) '(:grp hws-tag) "$") - (1 rst-comment-face) - (2 rst-comment-face) + (1'rst-comment) + (2'rst-comment) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit 'next) nil - (0 rst-comment-face append))) + (0 'rst-comment append))) ;; FIXME: This is not rendered as comment:: ;; .. .. list-table:: @@ -3941,11 +3862,11 @@ of your own." ;; `Indented Literal Blocks`_ ;; This is multiline. (,(rst-re 'lin-beg 'lit-sta-2) - (2 rst-block-face) + (2 'rst-block) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit t) nil - (0 rst-literal-face append))) + (0 'rst-literal append))) ;; FIXME: `Quoted Literal Blocks`_ missing. ;; This is multiline. @@ -3972,8 +3893,8 @@ of your own." ;; ;; Indentation is not required for doctest blocks. (,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+")) - (1 rst-block-face) - (2 rst-literal-face))) + (1 'rst-block) + (2 'rst-literal))) "Keywords to highlight in rst mode.") (defvar font-lock-beg) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 46e40f29c02..80508570f32 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -556,15 +556,6 @@ this function." templates)))) -;; toggle-read-only is obsolete since 24.3, but since vc-t-r-o was made -;; obsolete earlier, it is ok for the latter to be an alias to the former, -;; since the latter will be removed first. We can't just make it -;; an alias for read-only-mode, since that is not 100% the same. -(defalias 'vc-toggle-read-only 'toggle-read-only) -(make-obsolete 'vc-toggle-read-only - "use `read-only-mode' instead (or `toggle-read-only' in older versions of Emacs)." - "24.1") - (defun vc-default-make-version-backups-p (_backend _file) "Return non-nil if unmodified versions should be backed up locally. The default is to switch off this feature." diff --git a/lisp/view.el b/lisp/view.el index 17bc46d4c46..287112f2d44 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -112,18 +112,6 @@ If nil that means use half the window size.") (defvar-local view-last-regexp nil) ; Global is better??? -(defvar-local view-return-to-alist nil - "What to do with used windows and where to go when finished viewing buffer. -This is local in each buffer being viewed. -It is added to by `view-mode-enter' when starting to view a buffer and -subtracted from by `view-mode-exit' when finished viewing the buffer. - -See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of -`view-return-to-alist'.") -(make-obsolete-variable - 'view-return-to-alist "this variable is no longer used." "24.1") -(put 'view-return-to-alist 'permanent-local t) - (defvar-local view-exit-action nil "If non-nil, a function called when finished viewing. The function should take one argument (a buffer). @@ -476,40 +464,6 @@ Entry to view-mode runs the normal hook `view-mode-hook'." (if buffer-read-only (setq buffer-read-only view-old-buffer-read-only))) -;;;###autoload -(defun view-return-to-alist-update (buffer &optional item) - "Update `view-return-to-alist' of buffer BUFFER. -Remove from `view-return-to-alist' all entries referencing dead -windows. Optional argument ITEM non-nil means add ITEM to -`view-return-to-alist' after purging. For a description of items -that can be added see the RETURN-TO-ALIST argument of the -function `view-mode-exit'. If `view-return-to-alist' contains an -entry for the selected window, purge that entry from -`view-return-to-alist' before adding ITEM." - (declare (obsolete "this function has no effect." "24.1")) - (with-current-buffer buffer - (when view-return-to-alist - (let* ((list view-return-to-alist) - entry entry-window last) - (while list - (setq entry (car list)) - (setq entry-window (car entry)) - (if (and (windowp entry-window) - (or (and item (eq entry-window (selected-window))) - (not (window-live-p entry-window)))) - ;; Remove that entry. - (if last - (setcdr last (cdr list)) - (setq view-return-to-alist - (cdr view-return-to-alist))) - ;; Leave entry alone. - (setq last entry)) - (setq list (cdr list))))) - ;; Add ITEM. - (when item - (setq view-return-to-alist - (cons item view-return-to-alist))))) - ;;;###autoload (defun view-mode-enter (&optional quit-restore exit-action) "Enter View mode and set up exit from view mode depending on optional arguments. diff --git a/src/keyboard.c b/src/keyboard.c index 84a7a0a38a5..a520e533979 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1305,9 +1305,6 @@ command_loop_1 (void) /* If there are warnings waiting, process them. */ if (!NILP (Vdelayed_warnings_list)) safe_run_hooks (Qdelayed_warnings_hook); - - if (!NILP (Vdeferred_action_list)) - safe_run_hooks (Qdeferred_action_function); } /* Do this after running Vpost_command_hook, for consistency. */ @@ -1537,8 +1534,6 @@ command_loop_1 (void) if (!NILP (Vdelayed_warnings_list)) safe_run_hooks (Qdelayed_warnings_hook); - safe_run_hooks (Qdeferred_action_function); - kset_last_command (current_kboard, Vthis_command); kset_real_last_command (current_kboard, Vreal_this_command); if (!CONSP (last_command_event)) @@ -12089,7 +12084,6 @@ syms_of_keyboard (void) DEFSYM (Qundo_auto__undoably_changed_buffers, "undo-auto--undoably-changed-buffers"); - DEFSYM (Qdeferred_action_function, "deferred-action-function"); DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook"); DEFSYM (Qfunction_key, "function-key"); @@ -12807,17 +12801,6 @@ This keymap works like `input-decode-map', but comes after `function-key-map'. Another difference is that it is global rather than terminal-local. */); Vkey_translation_map = Fmake_sparse_keymap (Qnil); - DEFVAR_LISP ("deferred-action-list", Vdeferred_action_list, - doc: /* List of deferred actions to be performed at a later time. -The precise format isn't relevant here; we just check whether it is nil. */); - Vdeferred_action_list = Qnil; - - DEFVAR_LISP ("deferred-action-function", Vdeferred_action_function, - doc: /* Function to call to handle deferred actions, after each command. -This function is called with no arguments after each command -whenever `deferred-action-list' is non-nil. */); - Vdeferred_action_function = Qnil; - DEFVAR_LISP ("delayed-warnings-list", Vdelayed_warnings_list, doc: /* List of warnings to be displayed after this command. Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]), @@ -13072,7 +13055,6 @@ syms_of_keyboard_for_pdumper (void) PDUMPER_RESET (num_input_keys, 0); PDUMPER_RESET (num_nonmacro_input_events, 0); PDUMPER_RESET_LV (Vlast_event_frame, Qnil); - PDUMPER_RESET_LV (Vdeferred_action_list, Qnil); PDUMPER_RESET_LV (Vdelayed_warnings_list, Qnil); /* Create the initial keyboard. Qt means 'unset'. */ diff --git a/src/w32fns.c b/src/w32fns.c index 468073c9170..51540e1880c 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -797,13 +797,6 @@ w32_default_color_map (void) return (cmap); } -DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, - 0, 0, 0, doc: /* Return the default color map. */) - (void) -{ - return w32_default_color_map (); -} - static Lisp_Object w32_color_map_lookup (const char *colorname) { @@ -10879,7 +10872,6 @@ keys when IME input is received. */); /* W32 specific functions */ defsubr (&Sw32_define_rgb_color); - defsubr (&Sw32_default_color_map); defsubr (&Sw32_display_monitor_attributes_list); defsubr (&Sw32_send_sys_command); defsubr (&Sw32_shell_execute); -- cgit v1.2.3 From 2a05479c221d4a13b15ed731e4eb1c0de99e97ed Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 14 Jul 2022 11:55:52 +0200 Subject: ; Fix typos: prefer American spelling --- doc/lispref/commands.texi | 2 +- doc/lispref/modes.texi | 2 +- doc/misc/eshell.texi | 2 +- doc/misc/modus-themes.org | 8 ++++---- etc/NEWS | 6 +++--- etc/images/README | 2 +- etc/themes/leuven-dark-theme.el | 2 +- lisp/dnd.el | 8 ++++---- lisp/emacs-lisp/byte-opt.el | 2 +- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/macroexp.el | 2 +- lisp/erc/erc-backend.el | 2 +- lisp/files.el | 2 +- lisp/icomplete.el | 8 ++++---- lisp/jsonrpc.el | 12 ++++++------ lisp/net/eudc-capf.el | 2 +- lisp/net/eudc.el | 2 +- lisp/org/org-plot.el | 6 +++--- lisp/textmodes/texinfo.el | 2 +- src/haiku_support.cc | 2 +- src/keyboard.c | 2 +- src/lread.c | 2 +- src/nsselect.m | 2 +- .../lisp/erc/resources/base/assoc/bouncer-history/barnet.eld | 2 +- test/lisp/erc/resources/base/assoc/reconplay/foonet.eld | 2 +- test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld | 2 +- test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld | 2 +- test/lisp/erc/resources/base/netid/bouncer/foonet.eld | 2 +- .../erc/resources/base/renick/queries/bouncer-barnet.eld | 2 +- .../lisp/erc/resources/base/reuse-buffers/channel/barnet.eld | 4 ++-- .../erc/resources/base/upstream-reconnect/soju-barnet.eld | 2 +- test/lisp/erc/resources/erc-d/resources/incremental.eld | 2 +- test/lisp/erc/resources/erc-d/resources/no-block.eld | 2 +- test/src/keymap-tests.el | 8 ++++---- 34 files changed, 56 insertions(+), 56 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 1718978a395..865fa26b275 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2977,7 +2977,7 @@ returns the key sequence as a vector, never as a string. If an input character is upper-case (or has the shift modifier) and has no key binding, but its lower-case equivalent has one, then @code{read-key-sequence} converts the character to lower case. (This -behaviour can be disabled by setting the +behavior can be disabled by setting the @code{translate-upper-case-key-bindings} user option to @code{nil}.) Note that @code{lookup-key} does not perform case conversion in this way. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 2ba37e413c0..e94093318fc 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -271,7 +271,7 @@ normal-mode}), but tries to force it not to choose any modes in @defun clean-mode Changing the major mode clears out most local variables, but it -doesn't remove all artefacts in the buffer (like text properties and +doesn't remove all artifacts in the buffer (like text properties and overlays). It's rare to change a buffer from one major mode to another (except from @code{fundamental-mode} to everything else), so this is usually not a concern. It can sometimes be convenient (mostly diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index f6ec1e268a0..963657f102a 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1597,7 +1597,7 @@ integration: using the remote shell's pipelining avoids copying the data which will flow through the pipeline to local Emacs buffers and then right back again. -Eshell recognises a special syntax to make it easier to convert +Eshell recognizes a special syntax to make it easier to convert pipelines so as to bypass Eshell's pipelining. Prefixing at least one @code{|}, @code{<} or @code{>} with an asterisk marks a command as intended for the operating system shell. To make it harder to invoke diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 4770e3a5191..d0d985705f1 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -4542,7 +4542,7 @@ The =git-gutter= and =git-gutter-fr= packages default to drawing bitmaps for the indicators they display (e.g. bitmap of a plus sign for added lines). In Doom Emacs, these bitmaps are replaced with contiguous lines which may look nicer, but require a change to the foreground of the -relevant faces to yield the desired colour combinations. +relevant faces to yield the desired color combinations. Since this is Doom-specific, we urge users to apply changes in their local setup. Below is some sample code, based on what we cover at @@ -5519,7 +5519,7 @@ interface virtually unusable. [[#h:5808be52-361a-4d18-88fd-90129d206f9b][Option for links]]. -Again, one must exercise judgement in order to avoid discrimination, +Again, one must exercise judgment in order to avoid discrimination, where "discrimination" refers to: + The treatment of substantially different magnitudes as if they were of @@ -5535,11 +5535,11 @@ usability beyond matters of color---they would be making a not-so-obvious error of treating different cases as if they were the same. -The Modus themes prioritise "thematic consistency" over abstract harmony +The Modus themes prioritize "thematic consistency" over abstract harmony or regularity among their applicable colors. In concrete terms, we do not claim that, say, our yellows are the best complements for our blues because we generally avoid using complementary colors side-by-side, so -it is wrong to optimise for a decontextualised blue+yellow combination. +it is wrong to optimize for a decontextualised blue+yellow combination. Not to imply that our colors do not work well together because they do, just to clarify that consistency of context is what themes must strive for, and that requires widening the scope of the design beyond the diff --git a/etc/NEWS b/etc/NEWS index 19f6879a8c7..57845df9792 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -876,7 +876,7 @@ are met. The conditions are given by the argument, which can be +++ *** New user option 'rcirc-cycle-completion-flag'. Rcirc will use the default 'completion-at-point' mechanism. The -conventional IRC behaviour of completing by cycling through the +conventional IRC behavior of completing by cycling through the available options can be restored by enabling this option. ** Imenu @@ -1221,7 +1221,7 @@ longer available after exiting the recursive edit. This user option controls whether the 'e' (in a "*Backtrace*" buffer or while edebugging) and 'C-x C-e' (while edebugging) commands lead to a (further) backtrace. By default, this variable is nil, -which is a change in behaviour from previous Emacs versions. +which is a change in behavior from previous Emacs versions. +++ *** 'e' in edebug can now take a prefix arg to pretty-print the results. @@ -1452,7 +1452,7 @@ header before sending a message. ** Texinfo Mode --- -*** 'texinfo-mode' now has a specialised 'narrow-to-defun' definition. +*** 'texinfo-mode' now has a specialized 'narrow-to-defun' definition. It narrows to the current node. ** EUDC diff --git a/etc/images/README b/etc/images/README index 72da92427b4..858f33e40ba 100644 --- a/etc/images/README +++ b/etc/images/README @@ -112,7 +112,7 @@ GNOME project). They are not part of Emacs, but are distributed and used by Emacs. They are licensed under either the GNU LGPL v3 or the Creative Commons Attribution-Share Alike 3.0 United States License. -To view a copy of the CC-BY-SA licence, visit +To view a copy of the CC-BY-SA license, visit http://creativecommons.org/licenses/by-sa/3.0/ or send a letter to Creative Commons, 171 Second Street, Suite 300, San Francisco, California 94105, USA. diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el index 3fbb9d6c995..0e162c8bab9 100644 --- a/etc/themes/leuven-dark-theme.el +++ b/etc/themes/leuven-dark-theme.el @@ -792,7 +792,7 @@ more...") `(org-example ((,class (:foreground "#ffff0b" :background "#38203d")))) `(org-footnote ((,class (:underline t :foreground "#ff7138")))) `(org-formula ((,class (:foreground "#0680e1")))) - ;; org-habit colours are thanks to zenburn + ;; org-habit colors are thanks to zenburn `(org-habit-ready-face ((t :background "#7F9F7F"))) ; ,zenburn-green `(org-habit-alert-face ((t :background "#E0CF9F" :foreground "#3F3F3F"))) ; ,zenburn-yellow-1 fg ,zenburn-bg `(org-habit-clear-face ((t :background "#5C888B"))) ; ,zenburn-blue-3 diff --git a/lisp/dnd.el b/lisp/dnd.el index ade61917e96..70852885a86 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -327,7 +327,7 @@ in that list instead." "Begin dragging TEXT from FRAME. Initate a drag-and-drop operation allowing the user to drag text from Emacs to another program (the drop target), then block until -the drop is completed or is cancelled. +the drop is completed or is canceled. If the drop completed, return the action that the drop target actually performed, which can be one of the following symbols: @@ -341,7 +341,7 @@ actually performed, which can be one of the following symbols: - `private', which means the drop target chose to perform an unspecified action. -Return nil if the drop was cancelled. +Return nil if the drop was canceled. TEXT is a string containing text that will be inserted by the program where the drop happened. FRAME is the frame where the @@ -383,7 +383,7 @@ currently being held down. It should only be called upon a "Begin dragging FILE from FRAME. Initate a drag-and-drop operation allowing the user to drag a file from Emacs to another program (the drop target), then block until -the drop happens or is cancelled. +the drop happens or is canceled. Return the action that the drop target actually performed, which can be one of the following symbols: @@ -399,7 +399,7 @@ can be one of the following symbols: - `private', which means the drop target chose to perform an unspecified action. -Return nil if the drop was cancelled. +Return nil if the drop was canceled. FILE is the file name that will be sent to the program where the drop happened. If it is a remote file, Emacs will make a diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d8a96b3f020..a24a5044562 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -425,7 +425,7 @@ for speeding up processing.") ;; `unwind-protect' is a special form which here takes the shape ;; (unwind-protect EXPR :fun-body UNWIND-FUN). ;; We can treat it as if it were a plain function at this point, - ;; although there are specific optimisations possible. + ;; although there are specific optimizations possible. ;; In particular, the return value of UNWIND-FUN is never used ;; so its body should really be compiled for-effect, but we ;; don't do that right now. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 8df4133b6b0..86681cf4dd4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4229,7 +4229,7 @@ This function is never called when `lexical-binding' is nil." (byte-defop-compiler-1 quote) (defun byte-compile-setq (form) - (cl-assert (= (length form) 3)) ; normalised in macroexp + (cl-assert (= (length form) 3)) ; normalized in macroexp (let ((var (nth 1 form)) (expr (nth 2 form))) (byte-compile-form expr) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 4db50bbaa9b..6a193a56d2d 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -378,7 +378,7 @@ Assumes the caller has bound `macroexpand-all-environment'." form `(,fn ,var ,new-expr)))) (`(setq . ,args) - ;; Normalise to a sequence of (setq SYM EXPR). + ;; Normalize to a sequence of (setq SYM EXPR). ;; Malformed code is translated to code that signals an error ;; at run time. (let ((nargs (length args))) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bc7a7d14dc2..8be4894ecbb 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1644,7 +1644,7 @@ Then display the welcome message." "Return list of unescaped components from an \"ISUPPORT\" VALUE." ;; https://tools.ietf.org/html/draft-brocklesby-irc-isupport-03#section-2 ;; - ;; > The server SHOULD send "X", not "X="; this is the normalised form. + ;; > The server SHOULD send "X", not "X="; this is the normalized form. ;; ;; Note: for now, assume the server will only send non-empty values, ;; possibly with printable ASCII escapes. Though in practice, the diff --git a/lisp/files.el b/lisp/files.el index bdceaefb0ff..25b58423649 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8000,7 +8000,7 @@ If RESTART, restart Emacs after killing the current Emacs process." ("Close Without Saving" . no-save) ("Save All" . save-all) ("Cancel" . cancel))) - ('cancel (user-error "Exit cancelled")) + ('cancel (user-error "Exit canceled")) ('save-all (save-some-buffers t))) (save-some-buffers arg t))) (let ((confirm confirm-kill-emacs)) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 381ad5466f5..b1fcf9ae712 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -840,13 +840,13 @@ by `group-function''s second \"transformation\" protocol." while (listp r) count 1)) repeat total-space - for neighbour = nil + for neighbor = nil if (and preds (> space-above 0)) do - (push (setq neighbour (pop preds)) scroll-above) + (push (setq neighbor (pop preds)) scroll-above) (cl-decf space-above) else if (consp succs) collect - (setq neighbour (pop succs)) into scroll-below-aux - while neighbour + (setq neighbor (pop succs)) into scroll-below-aux + while neighbor finally (setq scroll-below scroll-below-aux)) ;; Halfway there... (let* ((selected (propertize (car comps) 'icomplete-selected t)) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index b84e9b74b1f..90833e1c1d7 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -277,7 +277,7 @@ the function is waiting, then it exits immediately, returning CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are ignored." (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer - cancelled + canceled (retval (unwind-protect (catch tag @@ -287,26 +287,26 @@ ignored." #'jsonrpc--async-request-1 connection method params :success-fn (lambda (result) - (unless cancelled + (unless canceled (throw tag `(done ,result)))) :error-fn (jsonrpc-lambda (&key code message data) - (unless cancelled + (unless canceled (throw tag `(error (jsonrpc-error-code . ,code) (jsonrpc-error-message . ,message) (jsonrpc-error-data . ,data))))) :timeout-fn (lambda () - (unless cancelled + (unless canceled (throw tag '(error (jsonrpc-error-message . "Timed out"))))) `(,@(when deferred `(:deferred ,deferred)) ,@(when timeout `(:timeout ,timeout))))) (cond (cancel-on-input (unwind-protect (let ((inhibit-quit t)) (while (sit-for 30))) - (setq cancelled t)) - `(cancelled ,cancel-on-input-retval)) + (setq canceled t)) + `(canceled ,cancel-on-input-retval)) (t (while t (accept-process-output nil 30))))) ;; In normal operation, cancellation is handled by the ;; timeout function and response filter, but we still have diff --git a/lisp/net/eudc-capf.el b/lisp/net/eudc-capf.el index 68cbfd93ffe..92f0c80493d 100644 --- a/lisp/net/eudc-capf.el +++ b/lisp/net/eudc-capf.el @@ -71,7 +71,7 @@ ;; setting. ;; ;; The value of the variable `eudc-capf-modes' indicates which -;; major modes do such a setup as part of their initialisation +;; major modes do such a setup as part of their initialization ;; code. ;;; Code: diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 9208e40a730..5cfd4e25ec0 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -926,7 +926,7 @@ non-nil, collect results from all servers." `eudc-inline-expansion-format' is expected to return a list.") nil)))) - ;; fallback behaviour (nil function, or non-matching type) + ;; fallback behavior (nil function, or non-matching type) (t (let ((fname (cdr (assq (nth 0 query-attrs) res))) (lname (cdr (assq (nth 1 query-attrs) res))) diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 4507fbe7ddc..7cce678a81b 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -272,10 +272,10 @@ argument for the FUNCTION." for k in keys collect (cons k (funcall function (lookup k alist1) (lookup k alist2)))))) -(defun org--plot/item-frequencies (values &optional normalise) +(defun org--plot/item-frequencies (values &optional normalize) "Return an alist indicating the frequency of values in VALUES list. -When NORMALISE is non-nil, the count is divided by the number of values." - (let ((normaliser (if normalise (float (length values)) 1))) +When NORMALIZE is non-nil, the count is divided by the number of values." + (let ((normaliser (if normalize (float (length values)) 1))) (cl-loop for (n . m) in (seq-group-by #'identity values) collect (cons n (/ (length m) normaliser))))) diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 5d6f5deae1b..1ac59ddc5fb 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -401,7 +401,7 @@ REPORT-FN is the callback function." source beg end type msg) into diags finally (funcall report-fn diags))) - (flymake-log :warning "Cancelling obsolete check %s" + (flymake-log :warning "Canceling obsolete check %s" proc)) (kill-buffer (process-buffer proc))))))) (process-send-region texinfo--flymake-proc (point-min) (point-max)) diff --git a/src/haiku_support.cc b/src/haiku_support.cc index a3d3b7a17d3..1f7f372a9b4 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -142,7 +142,7 @@ enum struct font_selection_dialog_message { - /* Whether or not font selection was cancelled. */ + /* Whether or not font selection was canceled. */ bool_bf cancel : 1; /* Whether or not a size was explicitly specified. */ diff --git a/src/keyboard.c b/src/keyboard.c index c729d5dfb3e..2863058d633 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12982,7 +12982,7 @@ Emacs allows binding both upper and lower case key sequences to commands. However, if there is a lower case key sequence bound to a command, and the user enters an upper case key sequence that is not bound to a command, Emacs will use the lower case binding. Setting -this variable to nil inhibits this behaviour. */); +this variable to nil inhibits this behavior. */); translate_upper_case_key_bindings = true; DEFVAR_BOOL ("input-pending-p-filter-events", diff --git a/src/lread.c b/src/lread.c index 759cc08946d..0b46a2e4ee5 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4276,7 +4276,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* Catch silly games like #1=#1# */ invalid_syntax ("nonsensical self-reference", readcharfun); - /* Optimisation: since the placeholder is already + /* Optimization: since the placeholder is already a cons, repurpose it as the actual value. This allows us to skip the substitution below, since the placeholder is already referenced diff --git a/src/nsselect.m b/src/nsselect.m index c46bfeaf42a..5b47d746122 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -724,7 +724,7 @@ Return the action that the drop target actually chose to perform, or nil if no action was performed (either because there was no drop target, or the drop was rejected). If RETURN-FRAME is the symbol `now', also return any frame that mouse moves into during the -drag-and-drop operation, whilst simultaneously cancelling it. Any +drag-and-drop operation, whilst simultaneously canceling it. Any other non-nil value means to do the same, but to wait for the mouse to leave FRAME first. diff --git a/test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld b/test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld index 4b6ccfff38a..35a9a570b6d 100644 --- a/test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld +++ b/test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld @@ -37,7 +37,7 @@ ((mode 6 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1619593200") - (0.25 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defence, by mercy, 'tis most just.") + (0.25 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defense, by mercy, 'tis most just.") (0.25 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :joe: The Marshal of France, Monsieur la Far.") (0.25 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :mike: And bide the penance of each three years' day.") (0.25 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :joe: Madam, within; but never man so chang'd.") diff --git a/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld b/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld index 6f50ecca4ef..f916fea2374 100644 --- a/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld +++ b/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld @@ -28,7 +28,7 @@ (0.0 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:35:55] alice: This is but a custom in your tongue; you bear a graver purpose, I hope.") (0.0 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:16] bob: To imitate them; faults that are rich are fair.") (0.0 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:18] alice: Our Romeo hath not been in bed to-night.") - (0.0 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:21] bob: But, in defence, by mercy, 'tis most just.") + (0.0 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:21] bob: But, in defense, by mercy, 'tis most just.") (0.0 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:25] alice: Younger than she are happy mothers made.") (0.0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.") (0.0 ":irc.foonet.org 305 tester :You are no longer marked as being away")) diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld index 766035a524c..e2fe1430283 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld @@ -41,7 +41,7 @@ ((mode 5 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1620805269") - (0.1 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defence, by mercy, 'tis most just.") + (0.1 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defense, by mercy, 'tis most just.") (0.1 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :joe: The Marshal of France, Monsieur la Far.") (0.1 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :mike: And bide the penance of each three years' day.") (0.1 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :joe: Madam, within; but never man so chang'd.") diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld index e3c41e2133a..b99621cc311 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld @@ -36,7 +36,7 @@ (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: More evident than this; for this was stol'n.") (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Sell when you can; you are not for all markets.") (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: There's the fool hangs on your back already.") - (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Why, if you have a stomach to't, monsieur, if you think your mystery in stratagem can bring this instrument of honour again into its native quarter, be magnanimous in the enterprise and go on; I will grace the attempt for a worthy exploit: if you speed well in it, the duke shall both speak of it, and extend to you what further becomes his greatness, even to the utmost syllable of your worthiness.") + (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Why, if you have a stomach to't, monsieur, if you think your mystery in stratagem can bring this instrument of honor again into its native quarter, be magnanimous in the enterprise and go on; I will grace the attempt for a worthy exploit: if you speed well in it, the duke shall both speak of it, and extend to you what further becomes his greatness, even to the utmost syllable of your worthiness.") (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: For he hath still been tried a holy man.") (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: To have the touches dearest priz'd.") (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: And must advise the emperor for his good.") diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld index c241c59bb88..b0964fb9537 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld @@ -36,7 +36,7 @@ (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: More evident than this; for this was stol'n.") (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Sell when you can; you are not for all markets.") (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: There's the fool hangs on your back already.") - (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Why, if you have a stomach to't, monsieur, if you think your mystery in stratagem can bring this instrument of honour again into its native quarter, be magnanimous in the enterprise and go on; I will grace the attempt for a worthy exploit: if you speed well in it, the duke shall both speak of it, and extend to you what further becomes his greatness, even to the utmost syllable of your worthiness.") + (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Why, if you have a stomach to't, monsieur, if you think your mystery in stratagem can bring this instrument of honor again into its native quarter, be magnanimous in the enterprise and go on; I will grace the attempt for a worthy exploit: if you speed well in it, the duke shall both speak of it, and extend to you what further becomes his greatness, even to the utmost syllable of your worthiness.") (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: For he hath still been tried a holy man.") (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: To have the touches dearest priz'd.") (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: And must advise the emperor for his good.") diff --git a/test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld b/test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld index fc6cdaafe91..0c8cdac0379 100644 --- a/test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld +++ b/test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld @@ -35,7 +35,7 @@ ((mode 5 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1622538742") - (0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: By favours several which they did bestow.") + (0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: By favors several which they did bestow.") (0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: You, Roderigo! come, sir, I am for you.")) ((privmsg-a 5 "PRIVMSG rando :Linda said you were gonna kill me.") diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld index 82700c5912c..efc2506fd6f 100644 --- a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld +++ b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld @@ -27,7 +27,7 @@ (0 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:16] joe: Tush! none but minstrels like of sonneting.") (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:19] mike: Prithee, nuncle, be contented; 'tis a naughty night to swim in. Now a little fire in a wide field were like an old lecher's heart; a small spark, all the rest on's body cold. Look! here comes a walking fire.") (0 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:22] joe: My name is Edgar, and thy father's son.") - (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:26] mike: Good my lord, be good to me; your honour is accounted a merciful man; good my lord.") + (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:26] mike: Good my lord, be good to me; your honor is accounted a merciful man; good my lord.") (0 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:31] joe: Thy child shall live, and I will see it nourish'd.") (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:33] mike: Quick, quick; fear nothing; I'll be at thy elbow.") (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.") @@ -38,7 +38,7 @@ (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1620205534") (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: That will be given to the loudest noise we make.") - (0.1 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: If it please your honour, I am the poor duke's constable, and my name is Elbow: I do lean upon justice, sir; and do bring in here before your good honour two notorious benefactors.") + (0.1 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: If it please your honor, I am the poor duke's constable, and my name is Elbow: I do lean upon justice, sir; and do bring in here before your good honor two notorious benefactors.") (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Following the signs, woo'd but the sign of she.") (0.5 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: That, sir, which I will not report after her.") (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Boyet, prepare: I will away to-night.") diff --git a/test/lisp/erc/resources/base/upstream-reconnect/soju-barnet.eld b/test/lisp/erc/resources/base/upstream-reconnect/soju-barnet.eld index b8fc45e57b5..3711eb8f8e6 100644 --- a/test/lisp/erc/resources/base/upstream-reconnect/soju-barnet.eld +++ b/test/lisp/erc/resources/base/upstream-reconnect/soju-barnet.eld @@ -36,7 +36,7 @@ (0.06 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Once more I'll read the ode that I have writ.") (0.06 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: This is the foul fiend Flibbertigibbet: he begins at curfew, and walks till the first cock; he gives the web and the pin, squints the eye, and makes the harelip; mildews the white wheat, and hurts the poor creature of earth.") (0.06 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Sir, I praise the Lord for you, and so may my parishioners; for their sons are well tutored by you, and their daughters profit very greatly under you: you are a good member of the commonwealth.") - (0.08 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: If it please your honour, I know not well what they are; but precise villains they are, that I am sure of, and void of all profanation in the world that good Christians ought to have.") + (0.08 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: If it please your honor, I know not well what they are; but precise villains they are, that I am sure of, and void of all profanation in the world that good Christians ought to have.") ;; Unexpected disconnect (0.03 ":BouncerServ!BouncerServ@BouncerServ NOTICE tester :disconnected from barnet: failed to handle messages: failed to read IRC command: read tcp [::1]:54990->[::1]:6668: read: software caused connection abort") ;; Eventual reconnect diff --git a/test/lisp/erc/resources/erc-d/resources/incremental.eld b/test/lisp/erc/resources/erc-d/resources/incremental.eld index ab940fe6129..a1b48495ec3 100644 --- a/test/lisp/erc/resources/erc-d/resources/incremental.eld +++ b/test/lisp/erc/resources/erc-d/resources/incremental.eld @@ -30,7 +30,7 @@ ((mode 3 "MODE #foo") (0.0 ":irc.foo.net 324 tester #foo +Cint") (0.0 ":irc.foo.net 329 tester #foo 1519850102") - (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: But, in defence, by mercy, 'tis most just.") + (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: But, in defense, by mercy, 'tis most just.") (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: Grows, lives, and dies, in single blessedness.") (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :Look for me.") (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.") diff --git a/test/lisp/erc/resources/erc-d/resources/no-block.eld b/test/lisp/erc/resources/erc-d/resources/no-block.eld index 1b1f3965637..2811923d8ac 100644 --- a/test/lisp/erc/resources/erc-d/resources/no-block.eld +++ b/test/lisp/erc/resources/erc-d/resources/no-block.eld @@ -36,7 +36,7 @@ ((mode-foo 1.2 "MODE #foo") (0.0 ":irc.example.org 324 tester #foo +Cint") (0.0 ":irc.example.org 329 tester #foo 1519850102") - (-0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: But, in defence, by mercy, 'tis most just.") + (-0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: But, in defense, by mercy, 'tis most just.") (-0.2 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: Grows, lives, and dies, in single blessedness.") (-0.3 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: For these two hours, Rosalind, I will leave thee.") (-0.4 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.") diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index de3012b5764..b0876664ed1 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -135,7 +135,7 @@ (should (eq (lookup-key map [menu-bar I-bar]) 'foo)))) (ert-deftest keymap-lookup-key/mixed-case-multibyte () - "Backwards compatibility behaviour (Bug#50752)." + "Backwards compatibility behavior (Bug#50752)." (let ((map (make-keymap))) ;; (downcase "Åäö") => "åäö" (define-key map [menu-bar åäö bar] 'foo) @@ -153,19 +153,19 @@ (should (eq (lookup-key map [menu-bar buffer 1]) 'foo)))) (ert-deftest keymap-lookup-keymap/with-spaces () - "Backwards compatibility behaviour (Bug#50752)." + "Backwards compatibility behavior (Bug#50752)." (let ((map (make-keymap))) (define-key map [menu-bar foo-bar] 'foo) (should (eq (lookup-key map [menu-bar Foo\ Bar]) 'foo)))) (ert-deftest keymap-lookup-keymap/with-spaces-multibyte () - "Backwards compatibility behaviour (Bug#50752)." + "Backwards compatibility behavior (Bug#50752)." (let ((map (make-keymap))) (define-key map [menu-bar åäö-bar] 'foo) (should (eq (lookup-key map [menu-bar Åäö\ Bar]) 'foo)))) (ert-deftest keymap-lookup-keymap/with-spaces-multibyte-lang-env () - "Backwards compatibility behaviour (Bug#50752)." + "Backwards compatibility behavior (Bug#50752)." (let ((lang-env current-language-environment)) (set-language-environment "Turkish") (let ((map (make-keymap))) -- cgit v1.2.3 From 3d6cfdf1c51794b8db39ed8dae7cad7c9263f601 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 23 Jul 2022 11:04:28 +0200 Subject: ; * lisp/emacs-lisp/bytecomp.el: comment cleanup --- lisp/emacs-lisp/bytecomp.el | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 86681cf4dd4..b4954eee9ff 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -846,6 +846,8 @@ the unwind-action") (byte-defop 178 -1 byte-stack-set) ; Stack offset in following one byte. (byte-defop 179 -1 byte-stack-set2) ; Stack offset in following two bytes. +;; unused: 180-181 + ;; If (following one byte & 0x80) == 0 ;; discard (following one byte & 0x7F) stack entries ;; else @@ -2077,7 +2079,6 @@ value is `no-byte-compile'. See also `emacs-lisp-byte-compile-and-load'." (declare (advertised-calling-convention (filename) "28.1")) -;; (interactive "fByte compile file: \nP") (interactive (let ((file buffer-file-name) (file-dir nil)) @@ -3759,7 +3760,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (put 'byte-insertN 'byte-opcode-invert 'insert) (byte-defop-compiler point 0) -;;(byte-defop-compiler mark 0) ;; obsolete (byte-defop-compiler point-max 0) (byte-defop-compiler point-min 0) (byte-defop-compiler following-char 0) @@ -3770,8 +3770,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler bolp 0) (byte-defop-compiler bobp 0) (byte-defop-compiler current-buffer 0) -;;(byte-defop-compiler read-char 0) ;; obsolete -;; (byte-defop-compiler interactive-p 0) ;; Obsolete. (byte-defop-compiler widen 0) (byte-defop-compiler end-of-line 0-1) (byte-defop-compiler forward-char 0-1) @@ -3792,7 +3790,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler goto-char 1) (byte-defop-compiler char-after 0-1) (byte-defop-compiler set-buffer 1) -;;(byte-defop-compiler set-mark 1) ;; obsolete (byte-defop-compiler forward-word 0-1) (byte-defop-compiler char-syntax 1) (byte-defop-compiler nreverse 1) @@ -3845,7 +3842,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler (+ byte-plus) byte-compile-variadic-numeric) (byte-defop-compiler (* byte-mult) byte-compile-variadic-numeric) -;;####(byte-defop-compiler move-to-column 1) (byte-defop-compiler-1 interactive byte-compile-noop) @@ -4800,8 +4796,6 @@ binding slots have been popped." (byte-defop-compiler-1 save-excursion) (byte-defop-compiler-1 save-current-buffer) (byte-defop-compiler-1 save-restriction) -;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro. -;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro. (defun byte-compile-catch (form) (byte-compile-form (car (cdr form))) -- cgit v1.2.3 From a5adcbdf28eb8ad376a1004f4a6c9eda1f1447fb Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 30 Jul 2022 12:02:28 +0000 Subject: Handle the optional argument of 'narrow-to-region' in byte-compiled code. * lisp/emacs-lisp/bytecomp.el: Adapt the specifications. * src/bytecode.c (exec_byte_code): Get the optional argument. --- lisp/emacs-lisp/bytecomp.el | 4 ++-- src/bytecode.c | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b4954eee9ff..1ecd77f7517 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -767,7 +767,7 @@ Each element is (INDEX . VALUE)") (byte-defop 122 0 byte-char-syntax) (byte-defop 123 -1 byte-buffer-substring) (byte-defop 124 -1 byte-delete-region) -(byte-defop 125 -1 byte-narrow-to-region) +(byte-defop 125 -2 byte-narrow-to-region) (byte-defop 126 1 byte-widen) (byte-defop 127 0 byte-end-of-line) @@ -3833,7 +3833,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler setcdr 2) (byte-defop-compiler buffer-substring 2) (byte-defop-compiler delete-region 2) -(byte-defop-compiler narrow-to-region 2) +(byte-defop-compiler narrow-to-region 2-3) (byte-defop-compiler (% byte-rem) 2) (byte-defop-compiler aset 3) diff --git a/src/bytecode.c b/src/bytecode.c index 241cbaf04f6..2b1eccdc518 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1480,8 +1480,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Bnarrow_to_region): { - Lisp_Object v1 = POP; - TOP = Fnarrow_to_region (TOP, v1, Qnil); + Lisp_Object v2 = POP, v1 = POP; + TOP = Fnarrow_to_region (TOP, v1, v2); NEXT; } -- cgit v1.2.3