diff options
Diffstat (limited to 'lisp/subr.el')
| -rw-r--r-- | lisp/subr.el | 71 |
1 files changed, 45 insertions, 26 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index 0f754fcd31f..f909b63aabe 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -280,14 +280,20 @@ change the list." When COND yields non-nil, eval BODY forms sequentially and return value of last one, or nil if there are none." (declare (indent 1) (debug t)) - (list 'if cond (cons 'progn body))) + (if body + (list 'if cond (cons 'progn body)) + (macroexp-warn-and-return (format-message "`when' with empty body") + cond '(empty-body when) t))) (defmacro unless (cond &rest body) "If COND yields nil, do BODY, else return nil. When COND yields nil, eval BODY forms sequentially and return value of last one, or nil if there are none." (declare (indent 1) (debug t)) - (cons 'if (cons cond (cons nil body)))) + (if body + (cons 'if (cons cond (cons nil body))) + (macroexp-warn-and-return (format-message "`unless' with empty body") + cond '(empty-body unless) t))) (defsubst subr-primitive-p (object) "Return t if OBJECT is a built-in primitive function." @@ -380,9 +386,24 @@ without silencing all errors." "Execute BODY; if the error CONDITION occurs, return nil. Otherwise, return result of last form in BODY. -CONDITION can also be a list of error conditions." +CONDITION can also be a list of error conditions. +The CONDITION argument is not evaluated. Do not quote it." (declare (debug t) (indent 1)) - `(condition-case nil (progn ,@body) (,condition nil))) + (cond + ((and (eq (car-safe condition) 'quote) + (cdr condition) (null (cddr condition))) + (macroexp-warn-and-return + (format-message + "`ignore-error' condition argument should not be quoted: %S" + condition) + `(condition-case nil (progn ,@body) (,(cadr condition) nil)) + nil t condition)) + (body + `(condition-case nil (progn ,@body) (,condition nil))) + (t + (macroexp-warn-and-return (format-message "`ignore-error' with empty body") + nil '(empty-body ignore-error) t condition)))) + ;;;; Basic Lisp functions. @@ -510,8 +531,9 @@ This function is provided for compatibility. In new code, use `ash' instead." (declare (compiler-macro (lambda (form) - (macroexp-warn-and-return "avoid `lsh'; use `ash' instead" - form '(suspicious lsh) t form)))) + (macroexp-warn-and-return + (format-message "avoid `lsh'; use `ash' instead") + form '(suspicious lsh) t form)))) (when (and (< value 0) (< count 0)) (when (< value most-negative-fixnum) (signal 'args-out-of-range (list value count))) @@ -3282,7 +3304,7 @@ floating point support." (lambda (form) (if (not (or (numberp nodisp) obsolete)) form (macroexp-warn-and-return - "Obsolete calling convention for 'sit-for'" + (format-message "Obsolete calling convention for `sit-for'") `(,(car form) (+ ,seconds (/ (or ,nodisp 0) 1000.0)) ,obsolete) '(obsolete sit-for)))))) ;; This used to be implemented in C until the following discussion: @@ -4851,6 +4873,7 @@ but that should be robust in the unexpected case that an error is signaled." (declare (debug t) (indent 1)) (let* ((err (make-symbol "err")) (orig-body body) + (orig-format format) (format (if (and (stringp format) body) format (prog1 "Error: %S" (if format (push format body))))) @@ -4861,7 +4884,10 @@ but that should be robust in the unexpected case that an error is signaled." (if (eq orig-body body) exp ;; The use without `format' is obsolete, let's warn when we bump ;; into any such remaining uses. - (macroexp-warn-and-return "Missing format argument" exp nil nil format)))) + (macroexp-warn-and-return + (format-message "Missing format argument in `with-demote-errors'") + exp nil nil + orig-format)))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. @@ -4942,21 +4968,20 @@ the function `undo--wrap-and-run-primitive-undo'." beg (marker-position end-marker) #'undo--wrap-and-run-primitive-undo - beg (marker-position end-marker) buffer-undo-list)) + beg (marker-position end-marker) + ;; We will truncate this list by side-effect below. + buffer-undo-list)) (ptr buffer-undo-list)) (if (not (eq buffer-undo-list old-bul)) (progn (while (and (not (eq (cdr ptr) old-bul)) ;; In case garbage collection has removed OLD-BUL. - (cdr ptr)) - (if (and (consp (cdr ptr)) - (consp (cadr ptr)) - (eq (caadr ptr) t)) - ;; Don't include a timestamp entry. - (setcdr ptr (cddr ptr)) - (setq ptr (cdr ptr)))) - (unless (cdr ptr) - (message "combine-change-calls: buffer-undo-list broken")) + (or (cdr ptr) + (progn + (message "combine-change-calls: buffer-undo-list broken") + nil))) + (setq ptr (cdr ptr))) + ;; Truncate the list that's in the `apply' entry. (setcdr ptr nil) (push ap-elt buffer-undo-list) (setcdr buffer-undo-list old-bul))))) @@ -6087,14 +6112,8 @@ command is called from a keyboard macro?" ;; Skip special forms (from non-compiled code). (and frame (null (car frame))) ;; Skip also `interactive-p' (because we don't want to know if - ;; interactive-p was called interactively but if it's caller was) - ;; and `byte-code' (idem; this appears in subexpressions of things - ;; like condition-case, which are wrapped in a separate bytecode - ;; chunk). - ;; FIXME: For lexical-binding code, this is much worse, - ;; because the frames look like "byte-code -> funcall -> #[...]", - ;; which is not a reliable signature. - (memq (nth 1 frame) '(interactive-p 'byte-code)) + ;; interactive-p was called interactively but if it's caller was). + (eq (nth 1 frame) 'interactive-p) ;; Skip package-specific stack-frames. (let ((skip (run-hook-with-args-until-success 'called-interactively-p-functions |