diff options
Diffstat (limited to 'lisp/subr.el')
| -rw-r--r-- | lisp/subr.el | 61 |
1 files changed, 37 insertions, 24 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index 2de5b3766c2..056392a9266 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -78,8 +78,8 @@ If FORM does return, signal an error." (defmacro 1value (form) "Evaluate FORM, expecting a constant return value. -This is the global do-nothing version. There is also `testcover-1value' -that complains if FORM ever does return differing values." +If FORM returns differing values when running under Testcover, +Testcover will raise an error." (declare (debug t)) form) @@ -705,21 +705,29 @@ Non-strings in LIST are ignored." (setq list (cdr list))) list) -(defun assq-delete-all (key alist) - "Delete from ALIST all elements whose car is `eq' to KEY. +(defun assoc-delete-all (key alist &optional test) + "Delete from ALIST all elements whose car is KEY. +Compare keys with TEST. Defaults to `equal'. Return the modified alist. Elements of ALIST that are not conses are ignored." + (unless test (setq test #'equal)) (while (and (consp (car alist)) - (eq (car (car alist)) key)) + (funcall test (caar alist) key)) (setq alist (cdr alist))) (let ((tail alist) tail-cdr) (while (setq tail-cdr (cdr tail)) (if (and (consp (car tail-cdr)) - (eq (car (car tail-cdr)) key)) + (funcall test (caar tail-cdr) key)) (setcdr tail (cdr tail-cdr)) (setq tail tail-cdr)))) alist) +(defun assq-delete-all (key alist) + "Delete from ALIST all elements whose car is `eq' to KEY. +Return the modified alist. +Elements of ALIST that are not conses are ignored." + (assoc-delete-all key alist #'eq)) + (defun rassq-delete-all (value alist) "Delete from ALIST all elements whose cdr is `eq' to VALUE. Return the modified alist. @@ -1438,6 +1446,10 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete 'forward-point "use (+ (point) N) instead." "23.1") (make-obsolete 'buffer-has-markers-at nil "24.3") +(make-obsolete 'invocation-directory "use the variable of the same name." + "27.1") +(make-obsolete 'invocation-name "use the variable of the same name." "27.1") + ;; bug#23850 (make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1") (make-obsolete 'string-as-unibyte "use `encode-coding-string'." "26.1") @@ -1479,10 +1491,6 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete-variable 'command-debug-status "expect it to be removed in a future version." "25.2") -;; Lisp manual only updated in 22.1. -(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro - "before 19.34") - (define-obsolete-variable-alias 'x-lost-selection-hooks 'x-lost-selection-functions "22.1") (define-obsolete-variable-alias 'x-sent-selection-hooks @@ -1839,15 +1847,13 @@ if it is empty or a duplicate." (defvar delay-mode-hooks nil "If non-nil, `run-mode-hooks' should delay running the hooks.") -(defvar delayed-mode-hooks nil +(defvar-local delayed-mode-hooks nil "List of delayed mode hooks waiting to be run.") -(make-variable-buffer-local 'delayed-mode-hooks) (put 'delay-mode-hooks 'permanent-local t) -(defvar delayed-after-hook-functions nil +(defvar-local delayed-after-hook-functions nil "List of delayed :after-hook forms waiting to be run. These forms come from `define-derived-mode'.") -(make-variable-buffer-local 'delayed-after-hook-functions) (defvar change-major-mode-after-body-hook nil "Normal hook run in major mode functions, before the mode hooks.") @@ -1876,15 +1882,22 @@ running their FOO-mode-hook." (push hook delayed-mode-hooks)) ;; Normal case, just run the hook as before plus any delayed hooks. (setq hooks (nconc (nreverse delayed-mode-hooks) hooks)) + (and syntax-propertize-function + (not (local-variable-p 'parse-sexp-lookup-properties)) + ;; `syntax-propertize' sets `parse-sexp-lookup-properties' for us, but + ;; in order for the sexp primitives to automatically call + ;; `syntax-propertize' we need `parse-sexp-lookup-properties' to be + ;; set first. + (setq-local parse-sexp-lookup-properties t)) (setq delayed-mode-hooks nil) - (apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks)) + (apply #'run-hooks (cons 'change-major-mode-after-body-hook hooks)) (if (buffer-file-name) (with-demoted-errors "File local-variables error: %s" (hack-local-variables 'no-mode))) (run-hooks 'after-change-major-mode-hook) - (dolist (fun (nreverse delayed-after-hook-functions)) - (funcall fun)) - (setq delayed-after-hook-functions nil))) + (dolist (fun (prog1 (nreverse delayed-after-hook-functions) + (setq delayed-after-hook-functions nil))) + (funcall fun)))) (defmacro delay-mode-hooks (&rest body) "Execute BODY, but delay any `run-mode-hooks'. @@ -2573,7 +2586,7 @@ is nil and `use-dialog-box' is non-nil." ;;; Atomic change groups. (defmacro atomic-change-group (&rest body) - "Perform BODY as an atomic change group. + "Like `progn' but perform BODY as an atomic change group. This means that if BODY exits abnormally, all of its changes to the current buffer are undone. This works regardless of whether undo is enabled in the buffer. @@ -2596,8 +2609,8 @@ user can undo the change normally." ;; it enables undo if that was disabled; we need ;; to make sure that it gets disabled again. (activate-change-group ,handle) - ,@body - (setq ,success t)) + (prog1 ,(macroexp-progn body) + (setq ,success t))) ;; Either of these functions will disable undo ;; if it was disabled before. (if ,success @@ -4528,10 +4541,10 @@ EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'." (princ (if (plist-get flags :debug-on-exit) "* " " ")) (cond ((and evald (not debugger-stack-frame-as-list)) - (prin1 func) - (if args (prin1 args) (princ "()"))) + (cl-prin1 func) + (if args (cl-prin1 args) (princ "()"))) (t - (prin1 (cons func args)))) + (cl-prin1 (cons func args)))) (princ "\n")) (defun backtrace () |