Hi again!
Here are new patches implementing your idea. It works nicely of course.
I have one problem: when compiling org-mode, I get a
org-agenda.el:2499:46: Warning: the function ‘org-attach’ is not known
to be defined.
I'm not sure how I can tell the compiler that org-attach is defined?
Also, if we port org-attach to org-menu, should we enable org-menu-mode
by default? That will change the behaviour of the basic citation
handler, but this feels more like a feature enhancement than something
that would upset people.
Cheers
>From 1ad8c3d687d5cbb1b4f054e3f003dfc00259effa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tor-bj=C3=B6ron?= <[email protected]>
Date: Thu, 27 Feb 2025 20:30:07 +0200
Subject: [PATCH] lisp/om.el: Org-menu, a simple menu system for org.
* lisp/om.el: Add org-menu.
* lisp/oc-basic.el (require 'om): Pull in om.
(org-cite-basic-follow-actions): New customization option, that
specifies the contents of the transient menu.
(org-cite-basic-follow-default-action): New customization option,
the default action to be taken when following a citation object.
(org-cite-basic--get-key): New function. Get citation key from
citation or citation reference.
(org-cite-basic--get-url): New function. Get URL from citation or
citation reference.
(org-cite-basic--get-doi): New function. Get DOI from citation or
citation reference.
(org-cite-basic--browse): New function. Browse (using browse-url)
the URL or DOI-based URL of a citation or citation reference.
(org-cite-basic-goto): Use org-cite-basic--get-key.
(org-cite-basic-follow): Add a citation follower using org-menu.
(org-cite-register-processor 'basic): Update the basic citation
processor to follow citations using `org-cite-basic-follow'.
This change was co-authored with much support from Ihor Radchenko and
Jonas Bernoulli, thanks!
---
etc/ORG-NEWS | 16 ++
lisp/oc-basic.el | 75 ++++++++--
lisp/om.el | 371 +++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 453 insertions(+), 9 deletions(-)
create mode 100644 lisp/om.el
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index f2347a401..b7ed5493a 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -275,6 +275,22 @@ This results in an error such as:
Runtime error near line 2: attempt to write a readonly database (8)
[ Babel evaluation exited with code 1 ]
#+end_example
+*** Org menu
+Org menu is a flexible menu system, wich stores menus in a format similar to
+transient menus and can present them with different user interfaces.
+
+By disabling ~org-menu-mode~, a default action will be taken instead of
+showing a menu. This default action can be invoked when ~org-menu-mode~ is
+active (or the menu shown when ~org-menu-mode~ is inactive) by supplying a
+prefix argument specified in ~org-menu-switch~, by default C--.
+
+The menu frontend used is specified in ~org-menu-system~, and can be set on
+a per menu basis in ~org-menu-system-overrides~. To always use the frontend
+set in ~org-menu-system~, set ~org-menu-disable-overrides~ to a non-nil value.
+
+Org menus are implemented for ~org-cite-basic-follow~ and ~org-attach~. For
+~org-attach~, the menu system is by default overriden to use the original
+~org-attach~ function. The format of ~org-attach-commands~ remains unchanged.
** New and changed options
diff --git a/lisp/oc-basic.el b/lisp/oc-basic.el
index c57e8761e..8a05a9053 100644
--- a/lisp/oc-basic.el
+++ b/lisp/oc-basic.el
@@ -74,10 +74,12 @@
(require 'map)
(require 'oc)
(require 'seq)
+(require 'om)
(declare-function org-open-at-point "org" (&optional arg))
(declare-function org-open-file "org" (path &optional in-emacs line search))
+(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-create "org-element-ast" (type &optional props &rest children))
(declare-function org-element-set "org-element-ast" (old new &optional keep-props))
@@ -351,6 +353,41 @@ INFO is the export state, as a property list."
(map-keys entries))
(org-cite-basic--parse-bibliography)))
+(defun org-cite-basic--get-key (citation-or-citation-reference)
+ "Return citation key for CITATION-OR-CITATION-REFERENCE."
+ (if (org-element-type-p citation-or-citation-reference 'citation-reference)
+ (org-element-property :key citation-or-citation-reference)
+ (pcase (org-cite-get-references citation-or-citation-reference t)
+ (`(,key) key)
+ (keys
+ (or (completing-read "Select citation key: " keys nil t)
+ (user-error "Aborted"))))))
+
+(defun org-cite-basic--get-url (citation-or-citation-reference)
+ "Return URL for CITATION-OR-CITATION-REFERENCE."
+ (org-cite-basic--get-field
+ 'url
+ (org-cite-basic--get-key citation-or-citation-reference)))
+
+(defun org-cite-basic--get-doi (citation-or-citation-reference)
+ "Return DOI for CITATION-OR-CITATION-REFERENCE."
+ (org-cite-basic--get-field
+ 'doi
+ (org-cite-basic--get-key citation-or-citation-reference)))
+
+(defun org-cite-basic--browse (citation-or-citation-reference)
+ "Browse (using `browse-url') to the URL or DOI of CITATION-OR-CITATION-REFERENCE."
+ (let ((url (org-cite-basic--get-url citation-or-citation-reference))
+ (doi (org-cite-basic--get-doi citation-or-citation-reference)))
+ (cond ((org-string-nw-p url)
+ (browse-url url))
+ ((org-string-nw-p doi)
+ (if (string-match "^http" doi)
+ (browse-url doi)
+ (browse-url (format "http://dx.doi.org/%s"; doi))))
+ (t (user-error "No URL or DOI for `%s'"
+ (org-cite-basic--get-key citation-or-citation-reference))))))
+
(defun org-cite-basic--get-entry (key &optional info)
"Return BibTeX entry for KEY, as an association list.
When non-nil, INFO is the export state, as a property list."
@@ -830,14 +867,7 @@ export state, as a property list."
When DATUM is a citation reference, open bibliography entry referencing
the citation key. Otherwise, select which key to follow among all keys
present in the citation."
- (let* ((key
- (if (org-element-type-p datum 'citation-reference)
- (org-element-property :key datum)
- (pcase (org-cite-get-references datum t)
- (`(,key) key)
- (keys
- (or (completing-read "Select citation key: " keys nil t)
- (user-error "Aborted"))))))
+ (let* ((key (org-cite-basic--get-key datum))
(file
(pcase (seq-find (pcase-lambda (`(,_ . ,entries))
(gethash key entries))
@@ -857,6 +887,33 @@ present in the citation."
(bibtex-set-dialect)
(bibtex-search-entry key)))))
+(org-menu-define org-cite-basic-follow (citation-object &optional prefix-argument)
+ "Follow citation
+
+Open citations by applying the function in
+`org-cite-basic-follow-default-action'. "
+ :menu [["Open"
+ ("b" "Bibliography entry" (org-cite-basic-goto !citation-object !prefix-argument))
+ ("w" "Browse URL/DOI"
+ (org-cite-basic--browse !citation-object))]
+ ["Copy"
+ ("d" "DOI"
+ (let ((doi (org-cite-basic--get-doi !citation-object)))
+ (if (org-string-nw-p doi)
+ (kill-new doi)
+ (user-error "No DOI for `%s'" (org-cite-basic--get-key !citation-object)))))
+ ("u" "URL"
+ (let ((url (org-cite-basic--get-url !citation-object)))
+ (if (org-string-nw-p url)
+ (kill-new url)
+ (user-error "No URL for `%s'" (org-cite-basic--get-key !citation-object)))))]]
+ :default-action (org-cite-basic-goto !citation-object !prefix-argument)
+ (interactive
+ (list (let ((obj (org-element-context)))
+ (pcase (org-element-type obj)
+ ((or 'citation 'citation-reference) obj)
+ (_ (user-error "Wrong object type")))))))
+
;;; "Insert" capability
(defun org-cite-basic--complete-style (_)
@@ -1006,7 +1063,7 @@ Raise an error when no bibliography is set in the buffer."
:activate #'org-cite-basic-activate
:export-citation #'org-cite-basic-export-citation
:export-bibliography #'org-cite-basic-export-bibliography
- :follow #'org-cite-basic-goto
+ :follow #'org-cite-basic-follow
:insert (org-cite-make-insert-processor #'org-cite-basic--complete-key
#'org-cite-basic--complete-style)
:cite-styles
diff --git a/lisp/om.el b/lisp/om.el
new file mode 100644
index 000000000..ee38de7c5
--- /dev/null
+++ b/lisp/om.el
@@ -0,0 +1,371 @@
+;;; om.el --- Org Menu library -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Free Software Foundation, Inc.
+
+;; Author: Tor-björn Claesson <[email protected]>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides facilities for displaying menus in org mode.
+
+;;; Code:
+
+(require 'cl-macs)
+(require 'org-macs)
+(require 'transient)
+(require 'which-key)
+
+(org-assert-version)
+
+
+;;; Configuration variables
+(defgroup org-menu nil
+ "Options concerning menus in Org mode."
+ :group 'org
+ :tag "Org Menu")
+
+(defcustom org-menu-switch '-
+ "Prefix argument that inverts the behaviour of `org-menu-mode'."
+ :group 'org-menu
+ :package-version '(Org . "9.8")
+ :type 'sexp)
+
+(defcustom org-menu-system 'transient
+ "The menu system to use for displaying Org Menus.
+
+Unless equal to transient, it should be a function with the
+signature (specification), where SPECIFICATION is a menu definition as per
+`org-cite-basic-follow-actions'.
+
+org-menu includes the functions `org-menu-popup' and `org-menu-tmm-prompt',
+which are valid options for `org-menu-system'."
+ :group 'org-menu
+ :package-version '(Org . "9.8")
+ :type 'sexp)
+
+(defcustom org-menu-system-overrides '()
+ "An alist of overrides for org-menu menues.
+
+The first member of each pair is the menu to override, the second member is a
+`org-menu-system', which will always be used for the overriden menu. This
+is useful when replacing an old menu with org-menu, to retain the original
+behaviour."
+ :group 'org-menu
+ :package-version '(Org . "9.8")
+ :type 'sexp)
+
+(defcustom org-menu-disable-overrides nil
+ "If this is true, `org-menu-system-overrides' will be ignored."
+ :group 'org-menu
+ :package-version '(Org . "9.8")
+ :type 'boolean)
+
+
+;;; Minor mode
+(define-minor-mode org-menu-mode
+ "Org menu mode.
+When Org menu mode is enabled, a menu prompting the user for an action
+will be presented upon activating certain objects.
+
+New menus can be defined using `org-menu-define'.
+
+The menu system used can be customized in `org-menu-system'.
+
+When `org-menu-mode' is active, it can be transiently deactivated by
+the prefix argument specified in `org-menu-switch', and vice verse
+transiently activated when inactive."
+ :init-value nil
+ :lighter " OM")
+
+
+;;; Helper functions
+(defmacro org-menu--bind-specification (bindings specification)
+ "Make BINDINGS visible to commands in SPECIFICATION.
+
+BINDINGS is a list of the form ((binding value) ...).
+SPECIFICATION is an org menu as per `org-cite-basic-follow-actions'.
+
+This macro returns SPECIFICATION, with each action wrapped in
+a let exposing BINDINGS."
+ `(cl-map
+ 'vector
+ (lambda (group)
+ (cl-map
+ 'vector
+ (lambda (spec)
+ (pcase spec
+ (`(,key ,desc (lambda ,args . ,body) . ,other)
+ `(,key ,desc
+ (lambda ,args
+ ,(unless (and (listp (car body))
+ (equal (caar body)
+ 'interactive))
+ '(interactive))
+ (let ,,bindings
+ ,@body))
+ ,@other))
+ (`(,key ,desc (,fn . ,fn-args) . ,other)
+ `(,key ,desc
+ (lambda ()
+ (interactive)
+ (let ,,bindings
+ (,fn ,@fn-args)))
+ ,@other))
+ (other other)))
+ group))
+ ,specification))
+
+(cl-defmacro org-menu--with-arguments (arg-list &body body)
+ "Make the arguments in ARG-LIST, prefixed with !, visible to BODY."
+ `(dlet ,(mapcar (lambda (arg)
+ `(,(intern (concat "!" (symbol-name arg))) ,arg))
+ arg-list)
+ ,@body))
+
+(defun org-menu--specification-to-menu (description specification)
+ "Make a flattened menu keymap out of an org menu specification.
+SPECIFICATION should be of the form of `org-cite-basic-follow-actions'.
+The title of the menu keymap is DESCRIPTION."
+ (let ((new-map (make-sparse-keymap description))
+ (prev-item-was-header nil))
+ (letrec ((define-menu
+ (lambda (menu)
+ (seq-map
+ (lambda (item)
+ (message "%S" item)
+ (when prev-item-was-header
+ ;; Add separator in all but last header.
+ (setq prev-item-was-header nil)
+ (define-key new-map `[,(gensym "separator-")] '(menu-item "--")))
+ (pcase item
+ ((pred vectorp) (funcall define-menu item))
+ ((pred stringp)
+ ;; FIXME: Use `keymap-set' when we drop Emacs 28 support.
+ (define-key new-map `[,(gensym "header-")] `(menu-item ,item))
+ (setq prev-item-was-header t))
+ (`(,key ,desc ,function)
+ (define-key new-map key `(menu-item ,desc ,function)))))
+ (seq-reverse menu)))))
+ (funcall define-menu specification)
+ new-map)))
+
+
+;;; Menu systems
+(defun org-menu-popup (description specification &rest _)
+ "Show an org-menu using a `popup-menu'.
+
+This function is a valid value for `org-menu-system':
+DESCRIPTION is the title for the menu, while SPECIFICATION is an org-menu
+specification as per `org-cite-basic-follow-actions'.
+ARGS contains the arguments used to call the menu."
+ (let ((menu-keymap (org-menu--specification-to-menu description specification)))
+ (popup-menu menu-keymap)))
+
+(defun org-menu-tmm-prompt (description specification &rest _)
+ "Show an org-menu using a `tmm-prompt'.
+
+This function is a valid value for `org-menu-system':
+DESCRIPTION is the title for the menu, while SPECIFICATION is an org-menu
+specification as per `org-cite-basic-follow-actions'.
+ARGS contains the arguments used to call the menu."
+ (let ((menu-keymap (org-menu--specification-to-menu description specification)))
+ (tmm-prompt menu-keymap)))
+
+
+(defmacro org-menu--defcustom-actions (menu-actions value menu-name)
+ "Define MENU-ACTIONS option for MENU-NAME with default VALUE."
+ `(progn (defcustom ,menu-actions ,value
+ ,(concat "Actions in the `" (symbol-name menu-name) "' org menu.
+
+This option uses the same syntax as `transient-define-prefix', see
+Info node `(transient)Binding Suffix and Infix Commands'. In
+addition, it is possible to specify a function call for the COMMAND
+part, where ARGUMENTS can be used to access those values.
+
+For example:
+
+[[\"Open\"
+ (\"b\" \"bibliography entry\"
+ (org-cite-basic-goto !citation-object !prefix-argument))]]
+
+will create an entry labeled \"bibliography entry\", activated with the
+b key, that calls `org-cite-basic-goto' with citation-object and
+prefix-argument as arguments.")
+ :group 'org-menu
+ :type 'sexp)
+ (put ',menu-actions 'definition-name ',menu-name)))
+
+(defmacro org-menu--defcustom-default-action
+ (default-action value menu-name arglist)
+ "Define DEFAULT-ACTION option for MENU-NAME with default VALUE.
+The action will accept ARGLIST arguments."
+ `(progn (defcustom ,default-action ,value
+ ,(concat "Default action for `" (symbol-name menu-name)
+ (if (null arglist)
+ "This should be a function of zero arguments,"
+ "'.
+This should be a function accepting the arguments\n\=")
+ (prin1-to-string arglist)
+ ".")
+ :group 'org-menu
+ :type 'sexp)
+ (put ',default-action 'definition-name ',menu-name)))
+
+(defun org-menu--strip-argument-decorators (arglist)
+ "Return a copy of ARGLIST without &optional or &rest."
+ (seq-filter
+ (lambda (elt)
+ (not (or (eq elt '&optional)
+ (eq elt '&rest))))
+ arglist))
+
+;;; Main macro definition
+(cl-defmacro org-menu-define
+ (name arglist docstring &rest body &key menu default-action (override nil) &allow-other-keys)
+ "Define an org menu NAME.
+
+A function called NAME will be created to activate the menu, as well as
+variables called NAME-actions and NAME-default-action.
+
+ARGLIST is the argument list of the function NAME.
+
+DOCSTRING is the docstring for NAME. The first row is used as title for
+keymaps based on this menu. The rest of the DOCSTRING should describe what
+the default action does. A short description of `org-menu-mode' and the
+customization containing the menu definition will be appended.
+
+Following this, the function accepts the following keyword arguments:
+
+MENU is used to populate the NAME-actions variable. It can be either a
+function, which should return a vector, or a vactor. The vector follows the
+syntax decribed in `(transient)Binding Suffix and Infix Commands',
+with the addition that the arguments in ARGLIST are accessible
+prefixed with !. For an example, see `org-cite-basic-follow-actions'.
+
+DEFAULT-ACTION specifies the action to be taken, if org-menu is
+inactive (as determined by `org-menu-mode' and modified by a
+prefix argument set in `org-menu-switch'.
+It has the form of a function call, where the arguments in
+ARGLIST are accessible prefixed by !. For example, the default action
+of `org-cite-basic-follow', which is defined with n ARGLIST
+\\(citation-object prefix-argument), has the form
+\\(org-cite-basic-goto !citation-object !prefix-argument).
+
+OVERRIDE specifies an `org-menu-system' to use by default. Some examples of
+valid values for this parameter are \='transient or #\='org-menu-popup.
+
+BODY is optional and can be used to set up the interactive
+environment and validate arguments. The body will be evaluated on activation
+of the menu, also when the default action is called."
+ (declare (indent defun))
+ (when override
+ (setq org-menu-system-overrides
+ (cons `(,name . ,override)
+ (assq-delete-all name org-menu-system-overrides))))
+ (let ((menu-default-action
+ (intern (concat (symbol-name name) "-default-action")))
+ (menu-actions
+ (if (functionp menu)
+ `(,menu)
+ (intern (concat (symbol-name name) "-actions")))))
+ `(progn
+ ,(unless (functionp menu)
+ `(org-menu--defcustom-actions
+ ,menu-actions ',menu ,name))
+ (org-menu--defcustom-default-action
+ ,menu-default-action
+ ',default-action
+ ,name
+ ',arglist)
+ (transient-define-prefix
+ ,name ,arglist
+ ,(if (functionp menu)
+ docstring
+ (concat docstring
+ "
+
+If `org-menu-mode' is active, display the menu specified in
+`"
+ (symbol-name menu-actions)
+ "'.
+
+This behaviour can be inverted by giving the prefix argument in
+`org-menu-switch'. See `org-menu-mode' for more information."))
+ [:class
+ transient-columns
+ :setup-children
+ (lambda (_)
+ (transient-parse-suffixes
+ ',name
+ (org-menu--bind-specification
+ (transient-scope)
+ ,menu-actions)))
+ :pad-keys t]
+ ,@(let ((filtered-body (named-let filter-body ((elements body))
+ (cond ((null elements)
+ '())
+ ((member (car elements)
+ '(:menu :default-action :menu-system :override))
+ (filter-body (cddr elements)))
+ (t
+ (cons (car elements)
+ (filter-body (cdr elements))))))))
+ (if filtered-body
+ filtered-body
+ '((interactive))))
+ (let ((bound-arguments
+ (list ,@(mapcar
+ (lambda (param)
+ `(list
+ ',(intern (concat "!" (symbol-name param)))
+ `',,param))
+ (org-menu--strip-argument-decorators arglist)))))
+ ;; Should we display a menu? If so, how?
+ (cond
+ ((and (not org-menu-disable-overrides)
+ (assq ',name org-menu-system-overrides))
+ (funcall
+ (cdr (assq ',name org-menu-system-overrides))
+ ,(car (split-string docstring "[\n]"))
+ (org-menu--bind-specification
+ bound-arguments
+ ,menu-actions)
+ ,@(org-menu--strip-argument-decorators arglist)))
+ ((not (xor org-menu-mode
+ (eq current-prefix-arg org-menu-switch)))
+ ;; Call the default action
+ (org-menu--with-arguments
+ ,(org-menu--strip-argument-decorators arglist)
+ (eval ,menu-default-action)))
+ ((eq org-menu-system 'transient)
+ ;; Activate transient
+ (transient-setup
+ (quote ,name) nil nil
+ :scope bound-arguments))
+ (t
+ ;; Use the system specified in `org-menu-system'
+ (funcall
+ org-menu-system
+ ,(car (split-string docstring "[\n]"))
+ (org-menu--bind-specification
+ bound-arguments
+ ,menu-actions)
+ ,@(org-menu--strip-argument-decorators arglist)))))))))
+
+(provide 'om)
+;;; om.el ends here
--
2.52.0
>From 4ec2f2e2383274d66c1039973ddc91ae999964a8 Mon Sep 17 00:00:00 2001
From: hepp <tbc@localhost>
Date: Sat, 31 Jan 2026 19:47:51 +0200
Subject: [PATCH 2/2] lisp/org-attach.el: Convert org-attach to an org-menu
* lisp/org-attach.el: (require 'om): Pull in om.
(org-attach-at-destination): New macro. Performs an action at the
correct place if we are in org-agenda-mode.
(org-attach--commands-to-transient-specification): New
function. Creates a transient specification suitable for org-menu from
org-attach-commands.
(org-attach): Now implemented as a org-menu.
(org-attach-old): The previous implementation of org-attach.
(org-attach--old-org-attach-menu-system): Wrapper to make org-menu use
the old-org-attach function.
---
lisp/om.el | 46 ++++++++++++++++++++++++++++++++++++++++++++++
lisp/org-attach.el | 45 ++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 90 insertions(+), 1 deletion(-)
diff --git a/lisp/om.el b/lisp/om.el
index ee38de7c5..186a67c03 100644
--- a/lisp/om.el
+++ b/lisp/om.el
@@ -186,6 +186,52 @@ ARGS contains the arguments used to call the menu."
(let ((menu-keymap (org-menu--specification-to-menu description specification)))
(tmm-prompt menu-keymap)))
+(defun org-menu-attach-style-prompt (description specification &rest _)
+ "Show an org-menu in the style of `org-attach'.
+
+This function is a valid value for `org-menu-system':
+DESCRIPTION is the title for the menu, while SPECIFICATION is an org-menu
+specification as per `org-cite-basic-follow-actions'.
+ARGS contains the arguments used to call the menu."
+ (let (c
+ (command-list '())
+ (buffer-name (concat "*" description "*")))
+ (save-excursion
+ (save-window-excursion
+ (switch-to-buffer-other-window
+ buffer-name)
+ (erase-buffer)
+ (setq cursor-type nil
+ header-line-format "Use C-v, M-v, C-n or C-p to navigate.")
+ (insert "Select a Command:\n\n")
+ (cl-loop for submenu across specification do
+ (cl-loop for entry across submenu do
+ (pcase entry
+ (`(,key ,desc ,command)
+ (setq command-list (cons `(,key . ,command) command-list))
+ (insert (format "%s %s\n"
+ key
+ desc)))
+ (header
+ (insert (format "%s:\n" header))))))
+ (goto-char (point-min))
+ (org-fit-window-to-buffer (get-buffer-window buffer-name))
+ (unwind-protect
+ (let ((msg (format "Select command: [%s]"
+ (apply #'concat (mapcar #'car (reverse command-list))))))
+ (message msg)
+ (while (and (setq c (read-char-exclusive))
+ (memq c '(?\C-n ?\C-p ?\C-v ?\M-v)))
+ (org-scroll c t)))
+ (when-let* ((window (get-buffer-window "*Org Attach*" t)))
+ (quit-window 'kill window))
+ (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))))
+ (let* ((key (string c))
+ (command (cdr (assoc key command-list))))
+ (if (commandp command)
+ (command-execute command)
+ (error "No such command: \"%s\"" key)))))
+
(defmacro org-menu--defcustom-actions (menu-actions value menu-name)
"Define MENU-ACTIONS option for MENU-NAME with default VALUE."
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index 67b430e71..e28551a3a 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -40,6 +40,7 @@
(require 'cl-lib)
(require 'org)
(require 'ol)
+(require 'om)
(require 'org-id)
(declare-function dired-dwim-target-directory "dired-aux")
@@ -296,8 +297,28 @@ ask the user instead, else remove without asking."
(const :tag "Always delete" t)
(const :tag "Query the user" query)))
+(cl-defmacro org-attach-at-destination (&body body)
+ "If we are in agenda mode, evaluate BODY at the correct position."
+ `(let (marker)
+ (when (eq major-mode 'org-agenda-mode)
+ (setq marker (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker)))
+ (unless marker
+ (error "No item in current line")))
+ (print marker)
+ (org-with-point-at marker
+ (if (and (featurep 'org-inlinetask)
+ (not (org-inlinetask-in-task-p)))
+ (org-with-limited-levels
+ (org-back-to-heading-or-point-min t))
+ (if (and (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p))
+ (org-inlinetask-goto-beginning)
+ (org-back-to-heading-or-point-min t)))
+ ,@body)))
+
;;;###autoload
-(defun org-attach ()
+(defun old-org-attach ()
"The dispatcher for attachment commands.
Shows a list of commands and prompts for another key to execute a command."
(interactive)
@@ -367,6 +388,28 @@ Shows a list of commands and prompts for another key to execute a command."
(command-execute command)
(error "No such attachment command: %c" c)))))))
+(defun org-attach--commands-to-transient-specification ()
+ "Produces a transient menu specification from `org-attach-commands'."
+ `[["Select an Attachment Command:"
+ ,@(seq-map (lambda (item)
+ (pcase item
+ (`(,keys ,command ,docstring)
+ `(,(substring-no-properties (prin1-char (car keys)) 1)
+ ,docstring
+ (org-attach-at-destination (command-execute #',command))))))
+ org-attach-commands)]])
+
+(defun org-attach--old-org-attach-menu-system (_ _ &rest args)
+ "Org menu system wrapper around old org-attach."
+ (apply #'old-org-attach args))
+
+(org-menu-define org-attach ()
+ "The dispatcher for attachment commands.
+Shows a list of commands defined in `org-attach-commands' using `org-menu'."
+ :menu org-attach--commands-to-transient-specification
+ :default-action (org-attach-at-destination (command-execute #'org-attach-attach))
+ :override org-attach--old-org-attach-menu-system)
+
;;;###autoload
(defun org-attach-dir (&optional create-if-not-exists-p no-fs-check)
"Return the directory associated with the current outline node.
--
2.52.0
