> På 2026-01-31 14:53 EET skrev Ihor Radchenko <[email protected]>:
> That's what I actually had in mind and (maybe vaguely) mentioned in the
> past, when talking about custom menu system per menu command.
>
> More specifically, I thought that we need:
> 1. Custom menu systems that can be specified per-command, so that
> org-attach and others can still support existing menu UI
> 2. org-attach and other commands using their own menu system by default,
> even when org-menu-system is something else. Changing the menu system
> in other commands would require forcing it upon a given command.
>
> Does the above make sense?
>
I think of two ways to do this:
1. For each replaced command, we keep the old implementation and use this as an
override.
2. For each replaced command, we write a new custom menu system that emulates
the original behaviour and use this menu system as the override.
The difference is that the override alist stores commands in 1. and
menu-systems in 2.
I have attached an implementation of 1. Do you think this is the way to go?
About (interactive) as default body, you are correct - that was not the
problem, only forcing org-element-context. Now we have another problem: I think
we are required to provide an uneven number of &key and &rest arguments, so the
body can not be empty :-( Can we get around this in some way or do we have to
specify (interactive) as the body?
Cheers,
Tor-björn
From a546ddda60177e24177d2404dff7b4537b812d60 Mon Sep 17 00:00:00 2001
From: hepp <tbc@localhost>
Date: Sat, 31 Jan 2026 19:47:51 +0200
Subject: [PATCH] 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.
---
lisp/org-attach.el | 42 +++++++++++++++++++++++++++++++++++++++++-
1 file changed, 41 insertions(+), 1 deletion(-)
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index 881890b8b..384be9475 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,47 @@ 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)))
+
+(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)]])
+
+(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
+ (interactive))
+
;;;###autoload
-(defun org-attach ()
+(defun org-attach-old ()
"The dispatcher for attachment commands.
Shows a list of commands and prompts for another key to execute a command."
(interactive)
--
2.47.3
From 8d5d0f134f5e71358c2f7e1fbf2a3c7e5a8880dc 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!
---
lisp/oc-basic.el | 75 ++++++++--
lisp/om.el | 350 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 416 insertions(+), 9 deletions(-)
create mode 100644 lisp/om.el
diff --git a/lisp/oc-basic.el b/lisp/oc-basic.el
index fb6d9477a..1f90470f9 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..753ce44ce
--- /dev/null
+++ b/lisp/om.el
@@ -0,0 +1,350 @@
+;;; 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
+function to call when the menu is activated, instead of showing the menu. This
+is useful when replacing an old menu with org-menu, to retain the original
+behaviour.")
+
+
+;;; 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)))
+
+(defun org-menu-popup (description specification)
+ "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'."
+ (let ((menu-keymap (org-menu--specification-to-menu description specification)))
+ (popup-menu menu-keymap)))
+
+(defun org-menu-tmm-prompt (description specification)
+ "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'."
+ (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 (menu-system 'org-menu-system) (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).
+
+MENU-SYSTEM forces the use of a specific menu backend. 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
+ ((assq ',name org-menu-system-overrides)
+ (funcall (cdr (assq ',name org-menu-system-overrides))))
+ ((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 ,menu-system 'transient)
+ ;; Activate transient
+ (transient-setup
+ (quote ,name) nil nil
+ :scope bound-arguments))
+ (t
+ ;; Use the system specified in `org-menu-system'
+ (funcall
+ ,menu-system
+ ,(car (split-string docstring "[\n]"))
+ (org-menu--bind-specification
+ bound-arguments
+ ,menu-actions)))))))))
+
+(provide 'om)
+;;; om.el ends here
--
2.47.3
