Thanks for the feedback, and sorry that my reply took a while. I had a deadline for submitting my thesis (written in org-mode) for preexamination last week, but now that that is done, I had some more time to look into this=)
Ihor Radchenko <[email protected]> writes: > Tor-björn Claesson <[email protected]> writes: > >> Ihor Radchenko <[email protected]> writes: >>> Maybe some menus can say :menu-systems '(transient) to force using >>> transient even when other menu-backend is specified by user. That option >>> might be exposed to users. Then, we can easily incorporate >>> transient-only menus or even menus that employ a completely custom menu >>> implementation. It feels like an easy generalization that does not >>> require too much effort. >> >> I did a very simple implementation of this, which allows specifying >> precisely one forced menu system, or also a variable where the menu >> system could be set (e.g. org-menu-system as default). > > With your code, if user changes org-menu-system value manually, at run > time, after some menu is loaded, the change will be ignored. > It works for me: I can open an article, follow a reference, change the value of org-menu-system to another function and the system uses this new value the next time I follow a citation. Did I misunderstand the problem? >>> Hmm. What about replacing :contents with :menu? >> Sure, maybe even menu-contents, but lets go with menu. >> >>> Also, :interactive-spec seems misleading. It is basically function body. >>> What about defining it as &body? It feels intuitive. >>> >> I'm feeling stupid about this - I have an unreasonably difficult time >> getting &key and &body to play well, so I chickened out and just renamed >> the interactive-spec keyword to body. > > I looked at it and again caught by this CL-specific convention. > The main issue you may be running into is the fact that &body, if > specified (and you have to add &allow-other-keys, to make &body combine > with &key), will not only include body, but also every keyword argument. > That was the right hint, thanks! >> Otherwise, does this start to be in such a shape that I should write >> the NEWS entry? > > I think we can. > > In addition, I would try to implement org-attach menu using the new > system. org-attach menu is more or less a keymap menu (with buffer > popup). It should be possible to translate to transient or simple menu. > But there is a twist - the attach keymap is dynamically generated from > (mapcar #'caar org-attach-commands). I did it so that org-menu-define can accept a function as the :menu parameter. This is another twist though - the naive implementation below works well for the simple case och attaching to a heading in an org document, but not for attaching to an org-agenda item: (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 (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 (command-execute #'org-attach-attach) (interactive)) `org-attach' uses `org-with-point-at' to move to the correct place, but we will have excited the body of `org-with-point-at' before we show the menu. I am not sure about the best solution, and would ask for some guidance. Would any of the below be good? 1. make a marker variable available to body (which means we will have to detect if the car of body is (interactive)) and wrap the rest of the transient body in an org-with-point-at. 2. write a function org-menu-preserve-excursion, that attaches a function to an org-menu-quit-hook that restores the point and buffer (possibly something else?) after the menu is done. org-menu-preserve-excursion would be called in the body of org-attach. 3. Is there some way to jump out of the body of org-with-point-at until the surrounding scope has exited? Cheers, Tor-björn
>From 034c4ab65853d8d32be6e5f79f519e503b9d51ea 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 | 335 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 401 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..51f25f8ce --- /dev/null +++ b/lisp/om.el @@ -0,0 +1,335 @@ +;;; 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) + + +;;; 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) &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)) + (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)) + (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 ((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
