Hi again!
Please find attached a new version of the patch for review.
Den lör 19 apr. 2025 kl 16:30 skrev Ihor Radchenko <yanta...@posteo.net>:
> Probably which-key (it is built-in).
>
I'm still a bit stuck with this. If org-menu-system is org-menu-which-key,
it will display a which-key menu, but I haven't gotten the keybindings to
work yet, I am probably making some silly mistake? After playing with this
for a day, I still can't get it to work in situ (I have had multiple
working toy examples, not sure how to proceed)
> +(org-menu-define org-cite-basic-follow (citation-object)
> > + "Follow citations"
>
> You can use (declare (indent defun)) in macro definition to make the
> indentation work as in defun. See various macros in org-macs.el as
> examples.
>
Ok, thanks and added!
> > + '[["Open"
>
> Is quote necessary here?
>
No, it isn't, removed.
>
> > + ("b" "bibliography entry" (org-cite-basic-goto
> !citation-object !prefix))]
> > ...
> > + :default-action 'org-cite-basic-goto
>
> There is inconsistency here.
> You can specify the exact arguments passed to menu-actions, but not to
> default action. I think that :default-action should follow a shortened
> menu-action spec.
>
Thanks for spotting this, it is now fixed.
>
> > + ["Copy"
> > + ("d" "DOI"
> > + (let ((doi (org-cite-basic--get-field
> > + 'doi
> > + (org-cite-basic--get-key
> !citation-object))))
> > + (if (not (s-blank? doi))
> > + (kill-new doi)
> > + (user-error "No DOI for `%s'"
> (org-cite-basic--get-key !citation-object)))))
>
> Anonymous action definition is good for testing, but we should factor it
> out to a separate function at the end
I have added getters for doi and url fields - should we also add functions
to copy and browse to those? I feel this is maybe a bit too much?
> .
>
> > + ["Browse"
> > + ("w" "Browse URL/DOI"
>
> Maybe it should be under "Open" section as well.
>
> > + :parameter-types ('citation 'citation-reference))
>
> I believe the :parameter-types is way too specific for menu system for
> be truly generic. Imagine if someone wants to have more than one
> argument in a menu: (org-menu-define test (arg1 arg2 &optional arg3)
> Rather than implicitly defining interactive spec as in
>
> > + (interactive
> > + (list (let ((obj (org-element-context)))
> > + (pcase (org-element-type obj)
> > + ((or ,@types) obj)
> > + (_ (user-error "Wrong object type"))))))
>
> you should let the caller handle interactive spec and other
> argument pre-processing.
>
> > +(cl-defmacro org-menu-define (name
> > + arglist
> > + docstring
> > + contents
> > + &key ((:default-action default-action)
> nil)
> > + &key ((:parameter-types types) nil))
>
> I suggest adding &rest body to the macro definition
> and then placing that body directly before
> > + (cond ((not (xor org-menu-mode
>
> WDYT?
>
I think this makes sense together with the argument list flexibility,
please find an attempt to implement this in the attached patch
>
> > +
> > +;;; Main macro definition
> > +(cl-defmacro org-menu-define (name
> > + arglist
> > + docstring
> > + contents
> > + &key ((:default-action default-action)
> nil)
> > + &key ((:parameter-types types) nil))
> > ...
> > + (complete-arglist (if (member 'prefix arglist)
> > + arglist
> > + `(,@arglist prefix))))
> > + `(progn
> > +
> > +;;; Local customization
>
> You are overdoing the page breaks and comments.
> Please do not split macro body with section comments and page breaks.
> Instead, I recommend defining a set of helper macros:
> 1. For each defcustom
> 2. For defun
> 3. for transient-define-suffic
>
> Then, you can easily separate code for and place comments without
> breaking a defmacro body.
>
I tried this, but felt it became harder to read, so I broke out some helper
functions but kept the defcustoms in the macro definition. Are you ok with
this?
>
> > + (defcustom ,menu-actions ,contents
> > + ,(concat "Actions in the `"
> > + (symbol-name 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.")
> > + :group 'org-menu
> > + :package-version '(Org . "9.8")
>
> :package-version makes no sense here.
>
> Also, it is a good idea to provide some examples in the docstring.
> For users and also to make sure that we understand the org-menu design
> ourselves :)
>
Nope, removed! I tried to flesh out the doc strings a bit.
Thanks again for all the help and guidance!
Cheers,
Tor-björn
From 6e4a300096b47f21880b949d17eed6929e63f2e5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tor-bj=C3=B6ron?= <tclaes...@gmail.com>
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 | 68 +++++++++--
lisp/om.el | 299 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 358 insertions(+), 9 deletions(-)
create mode 100644 lisp/om.el
diff --git a/lisp/oc-basic.el b/lisp/oc-basic.el
index 32a99e987..46fad5c52 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))
@@ -326,6 +328,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."
@@ -805,14 +829,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))
@@ -832,6 +849,39 @@ present in the citation."
(bibtex-set-dialect)
(bibtex-search-entry key)))))
+(org-menu-define org-cite-basic-follow (citation-object)
+ "Follow citations"
+ [["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 ((not (s-blank? url))
+ (browse-url url))
+ ((not (s-blank? 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 (not (s-blank? 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 (not (s-blank? 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 (_)
@@ -920,7 +970,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..5333407bc
--- /dev/null
+++ b/lisp/om.el
@@ -0,0 +1,299 @@
+;;; om.el --- Org Menu library -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Free Software Foundation, Inc.
+
+;; Author: Tor-björn Claesson <tclaes...@gmail.com>
+
+;; 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 for inverting the behaviour of Org menus with regards to
+`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 (actions arguments), where actions is a customization with
+the same form as `org-cite-basic-follow-actions' and arguments is an
+hash table where the key is the ! prefixed name of the argument and
+the value it's value."
+ :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
+(cl-defmacro org-menu--with-arguments (arg-list &body body)
+ "Makes the arguments, prefixed with !, visible to BODY."
+ `(dlet ,(mapcar (lambda (arg)
+ `(,(intern (concat "!" (symbol-name arg))) ,arg))
+ arg-list)
+ ,@body))
+
+(defun org-menu--actions-to-keymap (actions arg-list)
+ "Given ACTIONS (on the form of `org-cite-basic-follow-actions')
+and ARG-LIST (a hash table, whith keys and values to bind for the
+actions in ACTIONS), return a keymap with those bidings."
+ (let ((new-map (make-sparse-keymap)))
+ (cl-loop
+ for group across actions
+ do (cl-loop
+ for specification across group
+ do
+ (pcase specification
+ (`(,key ,desc (,fn . ,fn-args) . ,_)
+ (apply #'keymap-set
+ (list new-map
+ key
+ `(,desc .
+ ((dlet ,(mapcar (lambda (binding)
+ `(,(car binding)
+ ,(cadr binding)))
+ arg-list)
+ (interactive)
+ (,fn ,@fn-args))))))))))
+ new-map))
+
+(defun org-menu-which-key (actions arg-list)
+ "Show an org-menu using which-key.
+
+This function is a valid value for `org-menu-system'."
+ (interactive)
+ (which-key--show-keymap "hepp"
+ (org-menu--actions-to-keymap
+ actions arg-list)
+ nil t))
+
+(defun org-menu--setup-children (name actions arglist)
+ "Populate the menu of an org-menu transient."
+ (transient-parse-suffixes
+ name
+ (cl-map
+ 'vector
+ (lambda (group)
+ (cl-map
+ 'vector
+ (lambda (specification)
+ (org-menu--wrap-specification specification `(,@arglist)))
+ group))
+ (eval actions))))
+
+(defun org-menu--wrap-specification (specification arg-list)
+ "Handle special syntax for `org-cite-basic-follow-actions'.
+
+In addition to the syntax described in
+`(transient)Binding Suffix and Infix Commands', the names in arg-list,
+prefixed by `!', can be used to access those arguments."
+ (pcase specification
+ (`(,key ,desc (lambda ,args . ,fn-args) . ,other)
+ `(,key ,desc
+ (lambda ,args
+ ,(unless (and (listp (car fn-args))
+ (equal (caar fn-args)
+ 'interactive))
+ '(interactive))
+ (let ,(mapcar
+ (lambda (arg)
+ `(,(intern (concat "!" (symbol-name arg)))
+ (plist-get (transient-scope)
+ ,(intern (concat ":" (symbol-name arg))))))
+ arg-list))
+ ,@fn-args)
+ ,@other))
+ (`(,key ,desc (,fn . ,fn-args) . ,other)
+ `(,key ,desc
+ (lambda ()
+ (interactive)
+ (let ,(mapcar
+ (lambda (arg)
+ `(,(intern (concat "!" (symbol-name arg)))
+ (plist-get (transient-scope)
+ ,(intern (concat ":" (symbol-name arg))))))
+ arg-list)
+ (,fn ,@fn-args)))
+ ,@other))
+ (other other)))
+
+
+;;; Main macro definition
+(cl-defmacro org-menu-define (name
+ arglist
+ docstring
+ contents
+ default-action
+ &body body)
+ "Define an org menu.
+
+A function called NAME will be created to activate the menu.
+
+ARGLIST is the name of the arguments given to this function.
+Unless it ends in prefix-argument, this will be appended.
+
+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
+environemnt and validate arguments."
+ (declare (indent defun))
+ (let ((menu-default-actions-name
+ (intern
+ (concat (symbol-name name)
+ "-default-action")))
+ (menu-setup-children-name
+ (intern
+ (concat (symbol-name name)
+ "--setup-children")))
+ (menu-actions
+ (intern
+ (concat (symbol-name name)
+ "-actions")))
+ (complete-arglist (if (member 'prefix-argument arglist)
+ arglist
+ `(,@arglist prefix-argument))))
+ `(progn
+ (defcustom ,menu-actions ,contents
+ ,(concat "Actions in the `"
+ (symbol-name 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)
+
+ (defcustom ,menu-default-actions-name ',default-action
+ ,(concat "Default action for `"
+ (symbol-name name)
+ "'.
+This should be a function accepting the arguments
+"
+ (prin1-to-string complete-arglist)
+ ".")
+ :group 'org-menu
+ :type 'sexp)
+
+ (defun ,menu-setup-children-name (_)
+ ,(concat "Minimal wrapper to setup " (symbol-name name) ".")
+ (org-menu--setup-children ',name ',menu-actions ',complete-arglist))
+
+ (transient-define-prefix
+ ,name (,@arglist &optional prefix-argument)
+ ,docstring
+ [:class
+ transient-columns
+ :setup-children
+ ,menu-setup-children-name
+ :pad-keys t]
+ ;; Make sure we have an interactive body
+ ,@(pcase body
+ (`((interactive . ,interactive-spec) . ,body)
+ `((interactive ,@interactive-spec) ,body))
+ (_
+ `((interactive (list (org-element-context))) ,@body)))
+ ;; Should we display a menu? If so, how?
+ (cond ((not (xor org-menu-mode
+ (eq prefix-argument org-menu-switch)))
+ ;; Call the default action
+ (org-menu--with-arguments
+ ,complete-arglist
+ (eval ,menu-default-actions-name)))
+ ((eq org-menu-system 'transient)
+ ;; Activate transient
+ (transient-setup
+ (quote ,name) nil nil
+ :scope (list
+ ,@(mapcan (lambda (parameter)
+ (list (intern
+ (concat ":"
+ (symbol-name parameter)))
+ parameter))
+ complete-arglist))))
+ (t
+ ;; Use the system specified in `org-menu-system'
+ (funcall
+ org-menu-system
+ ,menu-actions
+ (list ,@(cl-mapcar (lambda (key value)
+ `(list
+ ',(intern (concat "!" (symbol-name key)))
+ ,value))
+ complete-arglist
+ complete-arglist)))))))))
+
+(provide 'om)
+;;; om.el ends here
--
2.47.2
