Ihor Radchenko <[email protected]> writes: > One simple thing you can do to improve the docstrings further is M-x > checkdoc inside ol.el file. This will make Emacs check for typical > docstring conventions. The goal should be (1) having 0 checkdoc > warnings; (2) making sure that one does not need to read the function > body to understand what the inputs are and what the returned value is. > Thanks, I have gone throught the doc strings, and also fixed the specific problems you mentioned.
> > Also, looking at the above example, I feel like two strings in a row > appear confusing. Maybe we can have something more descriptive like > > (org-menu-define foo () > "Dummy menu" > :description "Dummy" > :menu [] > :default-action (message "Am I working?")) > > Description might probably be optional, using the first line from the > docstring by default. > >> (transient-setup >> (quote ,name) nil nil >> :scope (list >> ,@(mapcan (lambda (parameter) >> (list (intern >> (concat ":" >> (symbol-name parameter))) >> parameter)) >> (org-menu--strip-argument-decorators >> arglist)))) >> >> :setup-children >> (lambda (_) >> (transient-parse-suffixes >> ',name >> (org-menu--bind-specification >> (mapcar >> (lambda (arg) >> `(,(intern (concat "!" (symbol-name arg))) >> (plist-get (transient-scope) >> ,(intern (concat ":" (symbol-name arg)))))) >> `',@(org-menu--strip-argument-decorators ',arglist)) >> ,menu-actions))) > > We are doing a double duty here. Why not storing !argument in transient > scope from the very beginning? > Brilliant, thanks! >> (defun org-menu--strip-argument-decorators (arglist) >> "Return a copy of ARGLIST without &optional, &body, &key, &aux, or &rest." >> (seq-filter >> (lambda (elt) >> (not (or (eq elt '&optional) >> (eq elt '&body) >> (eq elt '&rest) >> (eq elt '&aux) >> (eq elt '&key)))) >> arglist)) > > I think we should not bother with &aux and &key - those can have funny > forms like &key (foo "default" aux), which will require more complicated > treatment. Let's not bother and stick to stock Elisp arglist format, > omitting cl style. > Ok, fixed! >> (org-menu--defcustom-default-action >> ,menu-default-action >> ',default-action >> ,name >> ',(org-menu--strip-argument-decorators arglist)) > > We do not need to strip decorators here I think. The whole purpose of > passing ARGLIST here is to make it appear in the docstring of the new > defined defcustom. &optional/&rest will actually be useful there. > Good catch, thanks! Fixed. >>> I think that we should also put group names like "Open" or "Copy" as >>> non-clickable (menu-item ITEM-NAME), maybe even adding a separator below. >> >> Good idea. I improved the function to produce a (flat) menu, with >> separator for all but the first heading. Should this be flat, or should >> we have submenues? This could maybe depend on how many entries there are. > > I am not sure yet. I want to try how the new menu system will work with > more complex menus like export dispatch. But let's do it later, after > cleaning up the existing code >> ;; Make sure we have an interactive body >> ,@(if (and (listp body) >> (and (listp (car body)) >> (eq (caar body) 'interactive))) >> body >> `((interactive (list (org-element-context))) >> ,@body)) > > Why do we force (org-element-context) as the default interactive > specification? What if someone does > > (org-menu-define foo () "Dummy menu" "Dummy" [] (message "Am I > working?")) This was added assuming that the menu would be invoked on something in an org document, similar to right clicking on something in many desktop environments. For this usecase, I think forcing (org-element-context) as the default interactive specification. Do we want to broaden the scope of this to more general menus (even dialog like, such as the export dispatcher where we must keep track of toggles like async export) or should this org-menu remain small in scope, relegating more demanding uses to e.g. transient? Please find attached a revised version of the patch. Cheers and thanks, Tor-björn
>From 8e6bbbaeafbea137945a125e57bfb29d967cc932 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--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-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 | 74 +++++++++-- lisp/om.el | 325 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 390 insertions(+), 9 deletions(-) create mode 100644 lisp/om.el diff --git a/lisp/oc-basic.el b/lisp/oc-basic.el index fb6d9477a..f789eb3bc 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,28 @@ 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-KEY." + (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-KEY." + (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-KEY." + (org-cite-basic--get-field + 'doi + (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 +854,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 +874,45 @@ present in the citation." (bibtex-set-dialect) (bibtex-search-entry key))))) +(org-menu-define org-cite-basic-follow (citation-object &optional prefix-argument) + "Basic citation follower. + +Open citations by applying the function in +`org-cite-basic-follow-default-action'. If `org-menu-mode' is active, display a +menu specified in `org-cite-basic-follow-actions'. This behaviour can be inverted +by giving the prefix argument in `org-menu-switch'. See `org-menu-mode' for more information." + "Follow citation" + [["Open" + ("b" "Bibliography entry" (org-cite-basic-goto !citation-object !prefix-argument)) + ("w" "Browse URL/DOI" + (let ((url (org-cite-basic--get-url !citation-object)) + (doi (org-cite-basic--get-doi !citation-object))) + (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-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)))))]] + (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 +1062,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..3f42aeec0 --- /dev/null +++ b/lisp/om.el @@ -0,0 +1,325 @@ +;;; 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'." + :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))) + (named-let populate-menu-keymap + ;; First, make a flat reversed list of menu items. Items have the forms: + ;; ("title" MENU-HEADING) or + ;; (KEY DESCRIPTION BINDING) + ((posts (named-let build-list ((menu specification)) + (if (equal menu []) + '() + (let ((first (aref menu 0)) + (rest (seq-subseq menu 1))) + (append (build-list rest) + (pcase first + ((pred vectorp) + (build-list first)) + ((pred stringp) + `(("title" ,first))) + (`(,key ,desc ,function) + `((,key ,desc ,function))))))))) + (row 0)) ;; Keep track of row number to give menu heading unique keys + (if (null posts) + new-map + (progn + (pcase (car posts) + (`("title" ,heading) + (define-key new-map `[,(make-symbol + (concat "header-" + (number-to-string row)))] + `(menu-item ,heading)) + (unless (null (cdr posts)) ;; No separator if first heading + (define-key new-map `[,(make-symbol + (concat "[separator-" + (number-to-string row) + "]"))] + '(menu-item "--")))) + (`(,key ,desc ,function) + (define-key new-map key `(menu-item ,desc ,function)))) + (populate-menu-keymap (cdr posts) (+ row 1))))))) + +(defun org-menu-popup (description specification) + "Show an org-menu using a `popup-menu'. + +This function is a valid value for `org-menu-system', which takes two arguments: +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', which takes two arguments: +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." + `(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)) + +(defun org-menu--strip-argument-decorators (arglist) + "Return a copy of ARGLIST without &optional, &body, &key, &aux, or &rest." + (seq-filter + (lambda (elt) + (not (or (eq elt '&optional) + (eq elt '&body) + (eq elt '&rest)))) + arglist)) + +(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." + `(defcustom ,default-action ,value + ,(concat "Default action for `" (symbol-name menu-name) "'. +This should be a function accepting the arguments\n\=" + (prin1-to-string arglist) + ".") + :group 'org-menu + :type 'sexp)) + +;;; Main macro definition +(cl-defmacro org-menu-define + (name arglist docstring description contents default-action &body body) + "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 list of arguments given to this function. + +DOCSTRING is the menu docstring. + +DESCRIPTION is a string with a short menu title, shown to explain the function +of the menu while in use. + +CONTENTS is the contents of the menu. It 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'. + +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). + +BODY is optional and can be used to set up the interactive +environment and validate arguments. An (interactive ...) form is allowed +in the body, but a default will be added if this is omitted. 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 + (intern (concat (symbol-name name) "-actions")))) + `(progn + (org-menu--defcustom-actions + ,menu-actions ',contents ,name) + (org-menu--defcustom-default-action + ,menu-default-action + ',default-action + ,name + ',arglist) + + (transient-define-prefix + ,name ,arglist + ,docstring + [:class + transient-columns + :setup-children + (lambda (_) + (transient-parse-suffixes + ',name + (org-menu--bind-specification + (transient-scope) + ,menu-actions))) + :pad-keys t] + ;; Make sure we have an interactive body + ,@(if (and (listp body) + (and (listp (car body)) + (eq (caar body) 'interactive))) + body + `((interactive (list (org-element-context))) + ,@body)) + ;; 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 org-menu-system 'transient) + ;; Activate transient + (transient-setup + (quote ,name) nil nil + :scope (list ,@(cl-mapcar + (lambda (param) + `(list + ',(intern (concat "!" (symbol-name param))) + `',,param)) + (org-menu--strip-argument-decorators arglist))))) + (t + ;; Use the system specified in `org-menu-system' + (funcall + org-menu-system + ,description + (org-menu--bind-specification + (list ,@(cl-mapcar + (lambda (param) + `(list + ',(intern (concat "!" (symbol-name param))) + `',,param)) + (org-menu--strip-argument-decorators arglist))) + ,menu-actions)))))))) + +(provide 'om) +;;; om.el ends here -- 2.47.3
