Ihor Radchenko <[email protected]> writes: > I do not see anything attached here.
Now attached. :) >> - "Select a file and attach it to the task, using `org-attach-method'.") >> + "Attach File...") > > I am not sure if I like removing the reference to `org-attach-method'. > That reference might actually be useful. Fixed. >> - "Open current node's attachment directory. Create if missing.") >> + "Open Attachment Directory") > > I think "create if missing" is a useful clarification. Especially for > people concerned with file system "littering". Fixed. (Also for the "Open ... in Emacs" item.) >> - "Delete one attachment, you will be prompted for a file name.") >> + "Delete Attachment...") > > I'd say that the clarification about prompt was helpful. I think this one is obvious. The item has "...", which commonly implies "more question(s) will be asked", and with more attachments, it is obvious Org has to ask... Surely it will not delete one at random. :) >> + ((?z ?\C-z) org-attach-sync >> + "Synchronize Manual Attachment Updates\n") > > I have no idea what "manual attachment updates" mean. I misunderstood the functionality. My apologies! Fixed. >> ((?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") > > Note that attachment directory is not necessarily defined by DIR > property. So, the clarifications are important here. Someone may think > that it will ad//remove ID. Fixed. >> + (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))) > > This is getting out of control. > Maybe we can use `set-transient-map'? Just to be clear, Transient is now a go in Org? I remember there being some problems with Emacs compatibility in the past. If not, I would love to learn Transient and tackle the transition of various custom UIs in Org. Not soon, but at some point. But before I put that on my list, is Transient now a go? (By the way, I think that simplifying and harmonizing terminology before we go full-on Transient is still a "baby step" forward, ditto if nobody has the time to do that much more currently.) As for the refactoring in the patch, I just moved handling of the arrow keys and the mouse wheel from Org Export, where it does not belong, into the shared "Org Macs" library. Not Transient, but at least Org Export is simpler and Org Attach gets a free upgrade, for the time being. P.S. In this latest patch, I also added brackets around keys, to match `org-export-dispatch', `org-insert-structure-template', etc. >> - (message "Attachment directory removed") >> + (message "Attachment directory delete") > > *deleted Oops! Fixed. Rudy
>From 4081ac60e46e0bc1df2cd08b10a50d1d4bf8ed41 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, indicate "more input" with ellipsis, re-group slightly for clarity, and add brackets seen in other Org menus. (org-attach): Add support for scrolling with standard motion keys and mouse; 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 | 116 ++++++++++++++++++++++++++------------------- lisp/org-macs.el | 26 ++++++---- lisp/ox.el | 35 +++++++------- 4 files changed, 111 insertions(+), 73 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..d56a0495a 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -234,45 +234,44 @@ (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 using `org-attach-method'...") ((?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...\n") ((?u ?\C-u) org-attach-url - "Attach a file from URL (downloading it).") + "Fetch and attach file from URL...\n") ((?b) org-attach-buffer - "Select a buffer and attach its contents to the task.") + "Attach buffer contents...") ((?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 contents...\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...\n") ((?f ?\C-f) org-attach-reveal - "Open current node's attachment directory. Create if missing.") + "Open attachment directory (create if missing)") ((?F) org-attach-reveal-in-emacs - "Like \"f\", but force using Dired in Emacs.\n") + "Open attachment directory in Dired (create if missing)\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 current heading with attachment directory +(reflect externally added/removed attachments)\n") ((?s ?\C-s) org-attach-set-directory - "Set a specific attachment directory for this entry. Sets DIR property.") + "Set attachment directory as DIR property...") ((?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 as DIR property...\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 +- A list of keys (characters) to select the command (the first character in the list is shown in the attachment dispatcher's splash buffer and minibuffer prompt). - A command that is called interactively when one of these keys @@ -322,40 +321,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(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 +722,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 deleted") (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)
-- "Simplicity is complexity resolved." --- Constantin Brâncuși, 1876-1957 Rudolf Adamkovič <[email protected]> [he/him] http://adamkovic.org
