commit 6f2cc5417fc568edc719227019bfdc3cae205f6c Author: Stefan Monnier Date: Thu Jun 18 11:49:18 2026 -0400 gv.el (cond): Emit a warning if there's no default branch * lisp/emacs-lisp/gv.el (gv--cond-expander): New function, extracted from the `gv-expander` of `cond`. (cond) : Use it, and add a warning for missing default branch. diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 625eaedf844..74bafc6a294 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -532,37 +532,49 @@ See also `incf'." (put 'cond 'gv-expander (lambda (do &rest branches) - (if (or (not lexical-binding) ;The other code requires lexical-binding. - (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy)))) - ;; This duplicates the `do' code, which is a problem if that - ;; code is large, but otherwise results in more efficient code. - `(cond - ,@(mapcar (lambda (branch) - (if (cdr branch) - (cons (car branch) - (macroexp-unprogn - (gv-get (macroexp-progn (cdr branch)) do))) - (gv-get (car branch) do))) - branches)) - (let ((v (gensym "v"))) - (macroexp-let2 nil - gv `(cond - ,@(mapcar - (lambda (branch) - (if (cdr branch) - `(,(car branch) - ,@(macroexp-unprogn - (gv-letplace (getter setter) - (macroexp-progn (cdr branch)) - `(cons (lambda () ,getter) - (lambda (,v) ,(funcall setter v)))))) - (gv-letplace (getter setter) - (car branch) - `(cons (lambda () ,getter) - (lambda (,v) ,(funcall setter v)))))) - branches)) - (funcall do `(funcall (car ,gv)) - (lambda (v) `(funcall (cdr ,gv) ,v)))))))) + (let ((res (apply #'gv--cond-expander do branches)) + (last-test (caar (last branches)))) + (if (and (macroexp-const-p last-test) + (if (consp last-test) (cadr last-test) last-test)) + res + ;; There is no setter for the nil expression, so a missing default + ;; branch is a bug (bug#81217). Let's not signal an error, tho, + ;; for backward compatibility reasons. + (macroexp-warn-and-return "Missing default branch in cond" + res '(suspicious cond)))))) + +(defun gv--cond-expander (do &rest branches) + (if (or (not lexical-binding) ;The other code requires lexical-binding. + (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy)))) + ;; This duplicates the `do' code, which is a problem if that + ;; code is large, but otherwise results in more efficient code. + `(cond + ,@(mapcar (lambda (branch) + (if (cdr branch) + (cons (car branch) + (macroexp-unprogn + (gv-get (macroexp-progn (cdr branch)) do))) + (gv-get (car branch) do))) + branches)) + (let ((v (gensym "v"))) + (macroexp-let2 nil + gv `(cond + ,@(mapcar + (lambda (branch) + (if (cdr branch) + `(,(car branch) + ,@(macroexp-unprogn + (gv-letplace (getter setter) + (macroexp-progn (cdr branch)) + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v)))))) + (gv-letplace (getter setter) + (car branch) + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v)))))) + branches)) + (funcall do `(funcall (car ,gv)) + (lambda (v) `(funcall (cdr ,gv) ,v))))))) (put 'error 'gv-expander (lambda (do &rest args) commit f188e34d8193b9e9a848fb7a4253605f96a980b4 Author: Eli Zaretskii Date: Thu Jun 18 11:48:44 2026 +0300 ; (visual-wrap-tests/line-numbers-align-to-wrap-prefix): Simplify. diff --git a/test/lisp/visual-wrap-tests.el b/test/lisp/visual-wrap-tests.el index 818b834782f..a1408396b0f 100644 --- a/test/lisp/visual-wrap-tests.el +++ b/test/lisp/visual-wrap-tests.el @@ -206,7 +206,8 @@ property is installed on line 1. See bug#81039." (ert-deftest visual-wrap-tests/line-numbers-align-to-wrap-prefix () "With line numbers, `wrap-prefix' `:align-to' aligns from text start." - (skip-unless (not (frame-initial-p))) + ;; `posn-point' returns nil in batch sessions. + (skip-when (frame-initial-p)) (let ((buffer (generate-new-buffer " *visual-wrap-test*"))) (unwind-protect (let ((window (display-buffer buffer))) commit 5b8496400a8a9fc86f4226a9011328adb8c9dfe4 Author: Aaron Jensen Date: Thu Jun 18 06:54:12 2026 +0000 ; Make visual-wrap-tests work in interactive sessions * test/lisp/visual-wrap-tests.el (visual-wrap-tests--wrap-prefix) (visual-wrap-tests--string-with-properties): New wrapper functions. (visual-wrap-tests/simple, visual-wrap-tests/safe-display) (visual-wrap-tests/unsafe-display/within-line) (visual-wrap-tests/wrap-prefix-stickiness) (visual-wrap-tests/cleanup) (visual-wrap-tests/negative-extra-indent): Use the wrappers instead of hard-coded pixel values. (visual-wrap-tests/line-numbers-align-to-wrap-prefix): Don't skip on TTY frames in interactive sessions. (Bug#81253) diff --git a/test/lisp/visual-wrap-tests.el b/test/lisp/visual-wrap-tests.el index 6817e82bc8b..818b834782f 100644 --- a/test/lisp/visual-wrap-tests.el +++ b/test/lisp/visual-wrap-tests.el @@ -21,38 +21,56 @@ ;; Tests for `visual-wrap-prefix-mode'. ;; -;; Pixel values in these tests assume the batch-mode metric of one -;; pixel per canonical character column (`string-pixel-width " "' = 1). +;; Expected `wrap-prefix' values use `string-pixel-width', because +;; `visual-wrap--content-prefix' records the rendered width of the +;; prefix. This is 1 pixel per character cell in batch/TTY, but depends +;; on the selected frame font in graphical frames. ;;; Code: (require 'visual-wrap) (require 'ert) +(defun visual-wrap-tests--wrap-prefix (prefix &optional extra-indent) + "Return the expected `wrap-prefix' for PREFIX and EXTRA-INDENT." + `(space :align-to (+ (,(string-pixel-width prefix (current-buffer))) + (,(or extra-indent 0) . width)))) + +(defun visual-wrap-tests--string-with-properties (string ranges) + "Return STRING with RANGES of text properties added. +Each element in RANGES has the form (START END PROPERTIES)." + (let ((string (copy-sequence string))) + (dolist (range ranges string) + (add-text-properties (nth 0 range) (nth 1 range) (nth 2 range) + string)))) + ;;; Tests: (ert-deftest visual-wrap-tests/simple () "Test adding wrapping properties to text without display properties." (with-temp-buffer (insert "greetings\n* hello\n* hi") - (visual-wrap-prefix-function (point-min) (point-max)) - (should (equal-including-properties - (buffer-string) - #("greetings\n* hello\n* hi" - 10 17 (wrap-prefix (space :align-to (+ (2) (0 . width)))) - 18 22 (wrap-prefix (space :align-to (+ (2) (0 . width))))))))) + (let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* "))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + (visual-wrap-tests--string-with-properties + "greetings\n* hello\n* hi" + `((10 17 (wrap-prefix ,wrap-prefix)) + (18 22 (wrap-prefix ,wrap-prefix))))))))) (ert-deftest visual-wrap-tests/safe-display () "Test adding wrapping properties to text with safe display properties." (with-temp-buffer (insert #("* hello" 2 7 (display (raise 1)))) - (visual-wrap-prefix-function (point-min) (point-max)) - (should (equal-including-properties - (buffer-string) - #("* hello" - 0 2 (wrap-prefix (space :align-to (+ (2) (0 . width)))) - 2 7 (wrap-prefix (space :align-to (+ (2) (0 . width))) - display (raise 1))))))) + (let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* "))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + (visual-wrap-tests--string-with-properties + "* hello" + `((0 2 (wrap-prefix ,wrap-prefix)) + (2 7 (wrap-prefix ,wrap-prefix display (raise 1)))))))))) (ert-deftest visual-wrap-tests/unsafe-display/within-line () "Test adding wrapping properties to text with unsafe display properties. @@ -60,13 +78,15 @@ When these properties don't extend across multiple lines, `visual-wrap-prefix-mode' can still add wrapping properties." (with-temp-buffer (insert #("* [img]" 2 7 (display (image :type bmp)))) - (visual-wrap-prefix-function (point-min) (point-max)) - (should (equal-including-properties - (buffer-string) - #("* [img]" - 0 2 (wrap-prefix (space :align-to (+ (2) (0 . width)))) - 2 7 (wrap-prefix (space :align-to (+ (2) (0 . width))) - display (image :type bmp))))))) + (let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* "))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + (visual-wrap-tests--string-with-properties + "* [img]" + `((0 2 (wrap-prefix ,wrap-prefix)) + (2 7 (wrap-prefix ,wrap-prefix + display (image :type bmp)))))))))) (ert-deftest visual-wrap-tests/unsafe-display/spanning-lines () "Test adding wrapping properties to text with unsafe display properties. @@ -119,27 +139,31 @@ should *not* add wrapping properties to either block." See bug#76018." (with-temp-buffer (insert "* this zoo contains goats") - (visual-wrap-prefix-function (point-min) (point-max)) - (should (equal-including-properties - (buffer-string) - #("* this zoo contains goats" - 0 25 (wrap-prefix (space :align-to (+ (2) (0 . width))))))) - (let ((start (point))) - (insert-and-inherit "\n\nit also contains pandas") - (visual-wrap-prefix-function start (point-max))) - (should (equal-including-properties - (buffer-string) - #("* this zoo contains goats\n\nit also contains pandas" - 0 25 (wrap-prefix (space :align-to (+ (2) (0 . width))))))))) + (let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* "))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + (visual-wrap-tests--string-with-properties + "* this zoo contains goats" + `((0 25 (wrap-prefix ,wrap-prefix)))))) + (let ((start (point))) + (insert-and-inherit "\n\nit also contains pandas") + (visual-wrap-prefix-function start (point-max))) + (should (equal-including-properties + (buffer-string) + (visual-wrap-tests--string-with-properties + "* this zoo contains goats\n\nit also contains pandas" + `((0 25 (wrap-prefix ,wrap-prefix))))))))) (ert-deftest visual-wrap-tests/cleanup () "Test that deactivating `visual-wrap-prefix-mode' cleans up text properties." (with-temp-buffer (insert "* hello\n* hi") - (visual-wrap-prefix-function (point-min) (point-max)) - ;; Make sure we've added the visual-wrapping properties. - (should (equal (text-properties-at (point-min)) - '(wrap-prefix (space :align-to (+ (2) (0 . width)))))) + (let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* "))) + (visual-wrap-prefix-function (point-min) (point-max)) + ;; Make sure we've added the visual-wrapping properties. + (should (equal (text-properties-at (point-min)) + `(wrap-prefix ,wrap-prefix)))) (visual-wrap-prefix-mode -1) (should (equal-including-properties (buffer-string) @@ -153,11 +177,13 @@ at the left margin." (with-temp-buffer (setq-local visual-wrap-extra-indent -20) (insert "* hello") - (visual-wrap-prefix-function (point-min) (point-max)) - ;; The sum (+ (2) (-20 . width)) is negative in batch mode - ;; (2 - 20 = -18), but the display engine clamps to zero. - (should (equal (get-text-property (point-min) 'wrap-prefix) - '(space :align-to (+ (2) (-20 . width))))))) + (let ((wrap-prefix (visual-wrap-tests--wrap-prefix + "* " visual-wrap-extra-indent))) + (visual-wrap-prefix-function (point-min) (point-max)) + ;; The sum is negative in batch mode (2 - 20 = -18), but the + ;; display engine clamps to zero. + (should (equal (get-text-property (point-min) 'wrap-prefix) + wrap-prefix))))) (ert-deftest visual-wrap-tests/invisible-prefix () "Invisible prefix characters do not reserve column space. @@ -180,7 +206,7 @@ property is installed on line 1. See bug#81039." (ert-deftest visual-wrap-tests/line-numbers-align-to-wrap-prefix () "With line numbers, `wrap-prefix' `:align-to' aligns from text start." - (skip-unless (display-graphic-p)) + (skip-unless (not (frame-initial-p))) (let ((buffer (generate-new-buffer " *visual-wrap-test*"))) (unwind-protect (let ((window (display-buffer buffer)))