summaryrefslogtreecommitdiff
path: root/lisp/subr.el
diff options
context:
space:
mode:
authorGerd Möllmann <gerd@gnu.org>2022-12-31 09:04:56 +0100
committerGerd Möllmann <gerd@gnu.org>2022-12-31 09:04:56 +0100
commit716d676747119f9950861f9a64a8e7871b0082d4 (patch)
treeb71f94b50896736a007d6977c97679e1abd895a6 /lisp/subr.el
parent54ec3973e298c3d2b3d81484f80053d881694f88 (diff)
parent7493b4026fc74a51c76c5b614bc83b864af9bc31 (diff)
downloademacs-scratch/pkg.tar.gz
Merge remote-tracking branch 'origin/master' into scratch/pkgscratch/pkg
Diffstat (limited to 'lisp/subr.el')
-rw-r--r--lisp/subr.el72
1 files changed, 44 insertions, 28 deletions
diff --git a/lisp/subr.el b/lisp/subr.el
index e142eaa8104..69e6198e1bd 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 "`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 "`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,23 @@ 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 "`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 "`ignore-error' with empty body"
+ nil '(empty-body ignore-error) t condition))))
+
;;;; Basic Lisp functions.
@@ -1576,16 +1596,18 @@ in the current Emacs session, then this function may return nil."
;; Use `window-point' for the case when the current buffer
;; is temporarily switched to some other buffer (bug#50256)
(let* ((pos (window-point))
- (posn (posn-at-point pos)))
- (if (null posn) ;; `pos' is "out of sight".
- (list (selected-window) pos '(0 . 0) 0)
- ;; If `pos' is inside a chunk of text hidden by an `invisible'
- ;; or `display' property, `posn-at-point' returns the position
- ;; that *is* visible, whereas `event--posn-at-point' is used
- ;; when we have a keyboard event, whose position is `point' even
- ;; if that position is invisible.
- (setf (nth 5 posn) pos)
- posn)))
+ (posn (posn-at-point pos (if (minibufferp (current-buffer))
+ (minibuffer-window)))))
+ (cond ((null posn) ;; `pos' is "out of sight".
+ (setq posn (list (selected-window) pos '(0 . 0) 0)))
+ ;; If `pos' is inside a chunk of text hidden by an `invisible'
+ ;; or `display' property, `posn-at-point' returns the position
+ ;; that *is* visible, whereas `event--posn-at-point' is used
+ ;; when we have a keyboard event, whose position is `point' even
+ ;; if that position is invisible.
+ ((> (length posn) 5)
+ (setf (nth 5 posn) pos)))
+ posn))
(defun event-start (event)
"Return the starting position of EVENT.
@@ -4848,6 +4870,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)))))
@@ -4858,7 +4881,9 @@ 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
+ "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.
@@ -6084,14 +6109,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
@@ -6909,11 +6928,8 @@ sentence (see Info node `(elisp) Documentation Tips')."
(defun json-available-p ()
"Return non-nil if Emacs has libjansson support."
- (and (fboundp 'json-serialize)
- (condition-case nil
- (json-serialize t)
- (:success t)
- (json-unavailable nil))))
+ (and (fboundp 'json--available-p)
+ (json--available-p)))
(defun ensure-list (object)
"Return OBJECT as a list.