Fellow hackers, The attached patch improves the Org Attach dispatcher with:
- simpler wording and consistent capitalization - fontified key bindings and attachment directory - scrolling with standard motion keys and mouse wheel Rudy
>From 32bdc28c141215b4106d7e5e5e075f94457a6a35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rudolf=20Adamkovi=C4=8D?= <[email protected]> Date: Tue, 11 Nov 2025 15:52:58 +0100 Subject: [PATCH] org-attach: Improve Org Attach user interface * lisp/org-attach.el (org-attach-commands): Simplify descriptions, harmonize terminology, re-capitalize, indicate "more input" with ellipsis, and re-group slightly for clarity. (org-attach): Add support for scrolling with standard motion keys and mouse; re-capitalize for consistency; fontify the attachment directory and key bindings; harmonize terminology, like "Folder" vs "Directory", and remove the superfluous "Select an Attachment Command" heading. (org-attach-delete-all): Harmonize "remove" versus "delete" terms, matching both the function name and `org-attach-commands'. * lisp/org-macs.el (org-scroll): Make scrolling with standard motion keys and mouse available to all callers (see below). * lisp/ox.el (org-export--dispatch-action): Extract handling of standard motion keys and mouse wheel to `org-macs', replace magic numbers with readable key bindings, and improve commentary. --- etc/ORG-NEWS | 7 +++ lisp/org-attach.el | 111 ++++++++++++++++++++++++++------------------- lisp/org-macs.el | 26 +++++++---- lisp/ox.el | 35 +++++++------- 4 files changed, 108 insertions(+), 71 deletions(-) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 3cfc2b011..d67922b48 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -818,6 +818,13 @@ known to contain headlines with IDs. You can use new option ~org-id-completion-targets~ to change where the candidates are searched. +*** Attachment dispatcher is more readable and supports motion keys + +The ~org-attach~ dispatcher user interface was updated with more +consistent wording and capitalization, standard motion keys (~C-n~, +~C-p~, arrows, mouse), and fontified key bindings and attachment +directory. + * Version 9.7 ** Important announcements and breaking changes diff --git a/lisp/org-attach.el b/lisp/org-attach.el index 21b1e14c6..f8df03841 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -234,42 +234,40 @@ (defvar org-attach-open-hook nil (defcustom org-attach-commands '(((?a ?\C-a) org-attach-attach - "Select a file and attach it to the task, using `org-attach-method'.") + "Attach File...") ((?c ?\C-c) org-attach-attach-cp - "Attach a file using copy method.") + "Attach File Using Copy Method...") ((?m ?\C-m) org-attach-attach-mv - "Attach a file using move method.") + "Attach File Using Move Method...") ((?l ?\C-l) org-attach-attach-ln - "Attach a file using link method.") + "Attach File Using Link Method...") ((?y ?\C-y) org-attach-attach-lns - "Attach a file using symbolic-link method.") + "Attach File Using Symbolic-Link Method...") ((?u ?\C-u) org-attach-url - "Attach a file from URL (downloading it).") + "Attach File Downloaded From URL...\n") ((?b) org-attach-buffer - "Select a buffer and attach its contents to the task.") + "Attach Buffer Content...") ((?n ?\C-n) org-attach-new - "Create a new attachment, as an Emacs buffer.") - ((?z ?\C-z) org-attach-sync - "Synchronize the current node with its attachment\n directory, in case \ -you added attachments yourself.\n") + "Attach New Buffer Content...\n") ((?o ?\C-o) org-attach-open - "Open current node's attachments.") + "Open Attachment...") ((?O) org-attach-open-in-emacs - "Like \"o\", but force opening in Emacs.") + "Open Attachment in Emacs...") ((?f ?\C-f) org-attach-reveal - "Open current node's attachment directory. Create if missing.") + "Open Attachment Directory") ((?F) org-attach-reveal-in-emacs - "Like \"f\", but force using Dired in Emacs.\n") + "Open Attachment Directory in Dired\n") ((?d ?\C-d) org-attach-delete-one - "Delete one attachment, you will be prompted for a file name.") + "Delete Attachment...") ((?D) org-attach-delete-all - "Delete all of a node's attachments. A safer way is\n to open the \ -directory in dired and delete from there.\n") + "Delete All Attachments...\n") + ((?z ?\C-z) org-attach-sync + "Synchronize Attachments After Manual Updates\n") ((?s ?\C-s) org-attach-set-directory - "Set a specific attachment directory for this entry. Sets DIR property.") + "Set Attachment Directory...") ((?S ?\C-S) org-attach-unset-directory - "Unset the attachment directory for this entry. Removes DIR property.") - ((?q) (lambda () (interactive) (message "Abort")) "Abort.")) + "Unset Attachment Directory...\n") + ((?q) (lambda () (interactive) (message "Quit")) "Quit")) "The list of commands for the attachment dispatcher. Each entry in this list is a list of three elements: - A list of keys (characters) to select the command (the fist @@ -322,40 +320,59 @@ (defun org-attach () (unless org-attach-expert (switch-to-buffer-other-window "*Org Attach*") (erase-buffer) - (setq cursor-type nil - header-line-format "Use C-v, M-v, C-n or C-p to navigate.") + (setq cursor-type nil) + (setq header-line-format + (apply #'format + "Use %s, %s, %s, and %s to navigate." + (mapcar (lambda (key-binding) + (propertize key-binding 'face 'help-key-binding)) + '("C-v" "M-v" "C-n" "C-p")))) (insert - (concat "Attachment folder:\n" - (or dir - "Can't find an existing attachment-folder") + (concat "Attachment Directory:\n\n" + (or (and dir (propertize dir 'face 'dired-directory)) + "Can't find attachment directory") (unless (and dir (file-directory-p dir)) "\n(Not yet created)") "\n\n" - (format "Select an Attachment Command:\n\n%s" - (mapconcat - (lambda (entry) - (pcase entry - (`((,key . ,_) ,_ ,docstring) - (format "%c %s" - key - (replace-regexp-in-string "\n\\([\t ]*\\)" - " " - docstring - nil nil 1))) - (_ - (user-error - "Invalid `org-attach-commands' item: %S" - entry)))) - org-attach-commands - "\n")))) + (mapconcat + (lambda (entry) + (pcase entry + (`((,key . ,_) ,_ ,docstring) + (format "%s %s" + (propertize (string key) 'face 'help-key-binding) + (replace-regexp-in-string "\n\\([\t ]*\\)" + " " + docstring + nil nil 1))) + (_ + (user-error + "Invalid `org-attach-commands' item: %S" + entry)))) + org-attach-commands + "\n"))) (goto-char (point-min))) (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) (unwind-protect (let ((msg (format "Select command: [%s]" (concat (mapcar #'caar org-attach-commands))))) (message msg) - (while (and (setq c (read-char-exclusive)) - (memq c '(?\C-n ?\C-p ?\C-v ?\M-v))) + (while (and (setq c (pcase (read-key) + (`(,key . ,_) key) + (key key))) + (memq c '(?\C-n + down + wheel-down + double-wheel-down + triple-wheel-down + ?\C-p + up + wheel-up + double-wheel-up + triple-wheel-up + ?\s + ?\C-v + ?\d + ?\M-v))) (org-scroll c t))) (when-let* ((window (get-buffer-window "*Org Attach*" t))) (quit-window 'kill window)) @@ -704,11 +721,11 @@ (defun org-attach-delete-all (&optional force) (let ((attach-dir (org-attach-dir))) (when (and attach-dir (or force - (yes-or-no-p "Really remove all attachments of this entry? "))) + (yes-or-no-p "Really delete all attachments of this entry? "))) (delete-directory attach-dir (or force (yes-or-no-p "Recursive?")) t) - (message "Attachment directory removed") + (message "Attachment directory delete") (run-hook-with-args 'org-attach-after-change-hook attach-dir) (org-attach-untag)))) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index c3be41d02..ddca1d9c1 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -1652,14 +1652,24 @@ (defun org-scroll (key &optional additional-keys) (let ((scrlup (if additional-keys '(?\s ?\C-v) ?\C-v)) (scrldn (if additional-keys `(?\d ?\M-v) ?\M-v))) (pcase key - (?\C-n (if (not (pos-visible-in-window-p (point-max))) - (ignore-errors (scroll-up 1)) - (message "End of buffer") - (sit-for 1))) - (?\C-p (if (not (pos-visible-in-window-p (point-min))) - (ignore-errors (scroll-down 1)) - (message "Beginning of buffer") - (sit-for 1))) + ((or ?\C-n + 'down + 'wheel-down + 'double-wheel-down + 'triple-wheel-down) + (if (not (pos-visible-in-window-p (point-max))) + (ignore-errors (scroll-up 1)) + (message "End of buffer") + (sit-for 1))) + ((or ?\C-p + 'up + 'wheel-up + 'double-wheel-up + 'triple-wheel-up) + (if (not (pos-visible-in-window-p (point-min))) + (ignore-errors (scroll-down 1)) + (message "Beginning of buffer") + (sit-for 1))) ;; SPC or ((guard (memq key scrlup)) (if (not (pos-visible-in-window-p (point-max))) diff --git a/lisp/ox.el b/lisp/ox.el index b3e698ba5..704c1c1d1 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -7448,23 +7448,26 @@ (defun org-export--dispatch-action ;; Scrolling: When in non-expert mode, act on motion keys (C-n, ;; C-p, SPC, DEL), and translate down/up arrow keys and scroll ;; wheel to C-n/C-p, respectively. - (while (and (setq key - (pcase (read-event prompt) - ((or 'up - `(wheel-up . ,_) - `(double-wheel-up . ,_) - `(triple-wheel-up . ,_)) - ?\C-p) - ((or 'down - `(wheel-down . ,_) - `(double-wheel-down . ,_) - `(triple-wheel-down . ,_)) - ?\C-n) - (event event))) + (while (and (setq key (pcase (read-key prompt) + (`(,key . ,_) key) + (key key))) (not expertp) - ;; FIXME: Don't use C-v (22) here, as it is used as a - ;; modifier key in the export dispatch. - (memq key '(14 16 ?\s ?\d 134217846))) + (memq key '(?\C-n + down + wheel-down + double-wheel-down + triple-wheel-down + ?\C-p + up + wheel-up + double-wheel-up + triple-wheel-up + ?\s + ;; ?\C-v excluded deliberately, as it is + ;; used as a modifier key in the export + ;; dispatch. + ?\d + ?\M-v))) (org-scroll key t)) (cond ;; Ignore undefined associations. -- 2.39.5 (Apple Git-154)
-- "It is far better to have a question that can't be answered than an answer that can't be questioned." --- Carl Sagan Rudolf Adamkovič <[email protected]> [he/him] http://adamkovic.org
