Hi! Sorry, this mess stemmes from my failings with email drafts, I will not try this in the future.
Ihor Radchenko <[email protected]> writes: > Tor-björn Claesson <[email protected]> writes: > >>>> 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. >>> >>> Good question. >>> The dumbest thing we can do here is simply >>> >>> (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--old-org-attach-menu-system nil nil) >>> :override org-attach--old-org-attach-menu-system) >>> >> >> My feeling is that that solution is less nice than just enabling >> org-menu by default. The default behaviour we are protecting by leaving >> it disabled is that citations automatically open to the bibliography >> file. I do not think this is very useful? > > I agree that enabling org-menu by default will be cleaner. > I think I know now why I feel friction about this idea - we need > per-menu setting to suppress org-menu-mode effects. That way, we will > not be stuck with org-menu being all-or-nothing for all the commands that > have capability to display the menu. > >> If a command can not use alternative menu systems, what is the benefit >> of porting it to org-menu? If there is any case where this makes sense, >> then org-menu-disable-overrides has to go, but otherwise I like the >> option of guaranteeing that all menus are presented in the same way. > > Thinking about, I agree. > We already have a way to transform actions into transient and other menu > systems, so once command support transient, it should also support other > systems. > > However, what I do not like about the above is that we have two global > defcustoms, while also having per-command actions/default-action as > separate defcustom for each command. > > What about making an override a defcustom - > org-<command>-overriding-menu? Then, users can set it to nil per > command, thus allowing the effects of org-menu-disable-overrides and > org-menu-system-overrides into a single place. I implemented this (also removing the global override alist, and making org-menu-mode on by default). It feels clean and seems to work. I think we should keep org-menu-disable-overrides. As we convert menus to org-menu, there will be a lot of places where the overrides would have to be disabled otherwise. Also, I really must thank you again for all the help and guidance in this project. I work in a specialised non technical field and often get to mentor beginners or visiting fellows. Now I sometimes think that I should try to do this as well as Ihor :-) Cheers, Tor-björn
>From d651b9725773dcb0300add096b917be9725307df Mon Sep 17 00:00:00 2001 From: Torbjorn Claesson <[email protected]> Date: Sat, 31 Jan 2026 19:47:51 +0200 Subject: [PATCH] lisp/org-attach.el: Convert org-attach to an org-menu * etc/ORG_NEWS: Mention 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/org-agenda.el | 3 ++- lisp/org-attach.el | 45 ++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 46 insertions(+), 2 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index dd86a716a..aad54bab4 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -73,7 +73,8 @@ (declare-function calendar-julian-date-string "cal-julian" (&optional date)) (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) (declare-function calendar-persian-date-string "cal-persia" (&optional date)) -(declare-function calendar-check-holidays "holidays" (date)) +(declare-function calendar-check-holidays "holidays" (date)) +(declare-function org-attach "org-attach" ()) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) 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.54.0
>From d189c36af1416591279e5b15116fa90fefe70194 Mon Sep 17 00:00:00 2001 From: Torbjorn Claesson <[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 | 18 ++- lisp/oc-basic.el | 75 ++++++++-- lisp/om.el | 375 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 458 insertions(+), 10 deletions(-) create mode 100644 lisp/om.el diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 472f7ef76..b6c1c0740 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -40,6 +40,23 @@ into a "Tags" section and a "Priorities" section. Priorities can now be increased, decreased, set to the default, and set interactively from the priority context menus. +*** 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~. This can be overriden +using menu specific override options. 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 # Changes dealing with changing default values of customizations, @@ -338,7 +355,6 @@ 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 - ** New and changed options # Changes dealing with changing default values of customizations, 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..654d61d0d --- /dev/null +++ b/lisp/om.el @@ -0,0 +1,375 @@ +;;; 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 . "10.0") + :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 . "10.0") + :type 'sexp) + +(defcustom org-menu-disable-overrides nil + "If this is true, any per menu overrides will be ignored." + :group 'org-menu + :package-version '(Org . "10.0") + :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 1 + :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))) + +(defmacro org-menu--defcustom-override + (override menu-name value) + "Define a OVERRIDE option for MENU-NAME with default VALUE. + +If non-nil, this will override `org-menu-system'." + `(progn (defcustom ,override ,(if value + `(function ,value) + nil) + ,(concat "If non-nil, override `org-menu-system' for `" + (symbol-name menu-name) "'. +This should be a org menu system.") + :group 'org-menu + :type 'sexp) + (put ',override '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)) + (let ((menu-default-action + (intern (concat (symbol-name name) "-default-action"))) + (menu-override + (intern (concat (symbol-name name) "-override"))) + (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-override ,menu-override ,name ,override) + (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) + ,menu-override) + (funcall + ,menu-override + ,(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.54.0
