vc-do-async-command: Ellipse later lines in multiline arguments

* lisp/emacs-lisp/cl-print.el (cl-print-expand-ellipsis): Bind
inhibit-read-only to t.
* lisp/vc/vc-dispatcher.el (require): Require cl-print at
compile time.
(vc-do-async-command): When printing command arguments that
contain multiple lines, use cl-prin1 with cl-print-string-length
bound in order to ellipse lines other than the first.
Switch the outer quotation marks to single quotation marks.
This commit is contained in:
Sean Whitton 2025-04-12 10:05:57 +08:00
parent cc232bd7a1
commit 3b841700a8
2 changed files with 21 additions and 5 deletions

View file

@ -518,7 +518,9 @@ BUTTON can also be a buffer position or nil (to mean point)."
(user-error "No ellipsis to expand here")))
(let* ((end (next-single-property-change (point) 'cl-print-ellipsis))
(begin (previous-single-property-change end 'cl-print-ellipsis))
(value (get-text-property begin 'cl-print-ellipsis)))
(value (get-text-property begin 'cl-print-ellipsis))
;; Ensure clicking the button works even in read only buffers.
(inhibit-read-only t))
;; FIXME: Rather than `t' (i.e. reuse the print-length/level unchanged),
;; I think it would make sense to increase the level by 1 and to
;; double the length at each expansion step.

View file

@ -109,7 +109,9 @@
;; TODO:
;; - log buffers need font-locking.
(eval-when-compile (require 'cl-lib))
(eval-when-compile
(require 'cl-lib)
(require 'cl-print))
;; General customization
@ -473,10 +475,22 @@ Display the buffer in some window, but don't select it."
(unless (eq (point) (point-min))
(insert " \n"))
(setq new-window-start (point))
(insert "Running \"" cmd)
(insert "Running '" cmd)
(dolist (flag flags)
(insert " " flag))
(insert "\"...\n")
(let ((lines (string-lines flag)))
(insert " ")
;; If the argument has newlines in it (as a commit
;; message commonly will) then ellipse it down so
;; that the whole command is more readable.
(if (cdr lines)
(let ((flag (copy-sequence flag))
(cl-print-string-length (length
(car lines))))
(set-text-properties 0 (length flag) nil
flag)
(cl-prin1 flag buffer))
(insert flag))))
(insert "'...\n")
args))))
(setq proc (apply #'vc-do-command t 'async command nil args))))
(unless vc--inhibit-async-window