1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00

(define-ibuffer-op): Minor tweak to Shipmints's patch

* lisp/ibuf-macs.el (define-ibuffer-op): Evaluate `(active-)opstring`
args when defining the operation rather than every time the operation
is used.  Move the `:autoload-end` marker back to the level of `progn`.
This commit is contained in:
Stefan Monnier 2025-02-26 09:13:04 -05:00
parent 5d75c6e44d
commit 5815bd5227

View file

@ -221,19 +221,20 @@ buffer object.
(defalias ',(intern (concat (if (string-match "^ibuffer-do" (symbol-name op)) (defalias ',(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
"" "ibuffer-do-") "" "ibuffer-do-")
(symbol-name op))) (symbol-name op)))
(lambda ,args (let ((,opstring-sym ,opstring)
,(if (stringp documentation) (,active-opstring-sym ,active-opstring))
documentation (lambda ,args
(format "%s marked buffers." (if (functionp active-opstring) ,(if (stringp documentation)
(funcall active-opstring) documentation
active-opstring))) (format "%s marked buffers." (if (functionp active-opstring)
,(if (not (null interactive)) ;; FIXME: Unused?
`(interactive ,interactive) (funcall active-opstring)
'(interactive)) active-opstring)))
(cl-assert (derived-mode-p 'ibuffer-mode)) ,(if (not (null interactive))
(setq ibuffer-did-modification nil) `(interactive ,interactive)
(let ((,opstring-sym ,opstring) '(interactive))
(,active-opstring-sym ,active-opstring)) (cl-assert (derived-mode-p 'ibuffer-mode))
(setq ibuffer-did-modification nil)
(let ((marked-names (,(pcase mark (let ((marked-names (,(pcase mark
(:deletion (:deletion
'ibuffer-deletion-marked-buffer-names) 'ibuffer-deletion-marked-buffer-names)
@ -243,7 +244,8 @@ buffer object.
(cl-assert (get-text-property (line-beginning-position) (cl-assert (get-text-property (line-beginning-position)
'ibuffer-properties) 'ibuffer-properties)
nil "No buffer on this line") nil "No buffer on this line")
(setq marked-names (list (buffer-name (ibuffer-current-buffer)))) (setq marked-names
(list (buffer-name (ibuffer-current-buffer))))
(ibuffer-set-mark ,(pcase mark (ibuffer-set-mark ,(pcase mark
(:deletion (:deletion
'ibuffer-deletion-char) 'ibuffer-deletion-char)
@ -258,6 +260,7 @@ buffer object.
`((ibuffer-redisplay t) `((ibuffer-redisplay t)
(message (concat "Operation finished; " (message (concat "Operation finished; "
(if (functionp ,opstring-sym) (if (functionp ,opstring-sym)
;; FIXME: Unused?
(funcall ,opstring-sym) (funcall ,opstring-sym)
,opstring-sym) ,opstring-sym)
" %s %s") " %s %s")
@ -266,40 +269,42 @@ buffer object.
(inner-body (if complex (inner-body (if complex
`(progn ,@body) `(progn ,@body)
`(progn `(progn
(with-current-buffer buf (with-current-buffer buf
(save-excursion (save-excursion
,@body)) ,@body))
t))) t)))
(body `(let ((_ ,before) ; pre-operation form. (body
(count `(let ((_ ,before) ; pre-operation form.
(,(pcase mark (count
(:deletion (,(pcase mark
'ibuffer-map-deletion-lines) (:deletion
(_ 'ibuffer-map-deletion-lines)
'ibuffer-map-marked-lines)) (_
(lambda (buf mark) 'ibuffer-map-marked-lines))
;; Silence warning for code that doesn't (lambda (buf mark)
;; use `mark'. ;; Silence warning for code that doesn't
(ignore mark) ;; use `mark'.
,(if (eq modifier-p :maybe) (ignore mark)
`(let ((ibuffer-tmp-previous-buffer-modification ,(if (eq modifier-p :maybe)
(buffer-modified-p buf))) `(let ((ibuffer-tmp-previous-buffer-modification
(prog1 ,inner-body (buffer-modified-p buf)))
(when (not (eq ibuffer-tmp-previous-buffer-modification (prog1 ,inner-body
(buffer-modified-p buf))) (unless (eq ibuffer-tmp-previous-buffer-modification
(setq (buffer-modified-p buf))
ibuffer-did-modification t)))) (setq
inner-body))))) ibuffer-did-modification t))))
,finish))) inner-body)))))
,finish)))
(if dangerous (if dangerous
`(when (ibuffer-confirm-operation-on `(when (ibuffer-confirm-operation-on
(if (functionp ,active-opstring-sym) (if (functionp ,active-opstring-sym)
;; FIXME: Unused?
(funcall ,active-opstring-sym) (funcall ,active-opstring-sym)
,active-opstring-sym) ,active-opstring-sym)
marked-names) marked-names)
,body) ,body)
body)))) body))))))
:autoload-end))))) :autoload-end)))
;;;###autoload ;;;###autoload
(cl-defmacro define-ibuffer-filter (name documentation (cl-defmacro define-ibuffer-filter (name documentation