Hi again!
Here is attached a new version of the patch for review. NEWS, commit
message and docstrings are placeholders until we get the code right.
The parameters of the menu are now customiseable, we have org-menu-mode,
and I have been using the current version for a couple of days writing my
thesis-book without problem.
I have not tested using a menu system other than transient. What would be a
good candidate for this?
Does this look generally ok otherwise? If so I'll start fixing
documentation.
Cheers,
Tor-björn
Den sön 13 apr. 2025 kl 21:48 skrev Tor-björn Claesson <tclaes...@gmail.com
>:
> I just found intern. The problem was using make-symbol, which makes an
> uninterned symbol.
>
> I'll polish the patch a bit and get back, sorry for using the list as a
> rubber duck...
>
> Cheers,
> /Torbjörn
>
> Den sön 13 apr. 2025 20.00Tor-björn Claesson <tclaes...@gmail.com> skrev:
>
>> Hi again!
>>
>> I have been making slow progress, but also run into problems with
>> arbitrary argument lists for the menus - making the
>> !citation and !prefix things customizable.
>>
>> There is clearly something about elisp evaluation that I don't
>> understand. I have problems in two places:
>>
>> The first is in setting up the transient scope, where the code produced
>> by my macro looks just like the code I have working on my research machine,
>> but when activating the menu calls (transient-setup 'org-cite-basic-follow
>> nil nil :scope (list :prefix prefix :citation-object citation-object)), it
>> complains that Lisp error: (void-variable :prefix)
>>
>> If I copy-paste the line the macro expands into:
>> :scope (list :prefix prefix :citation-object citation-object)
>> and replaces the code used to generate it in the org-menu-define macro,
>> it works, but now I have trouble in org-menu--wrap-specification, which
>> gets stuck after choosing an action.
>>
>> From the backtrace:
>> (let ((!prefix (plist-get (transient-scope) :prefix))
>> (!citation-object (plist-get (transient-scope)
>> :citation-object)))
>> (org-cite-basic-goto !citation-object !prefix))
>> fails where (plist-get (transient-scope) :prefix) complains because
>> :prefix is a void-variable.
>>
>> I feel the two problems point to some lack of understanding on my part,
>> and I would be very grateful for some pointers on how to proceed. Why is
>> the literal :prefix different from the :prefix I generate with make-symbol?
>>
>> Cheers,
>> Tor-björn
>>
>
From 3b2005ed40a1dd09ed3f51e61726c038b78bc680 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/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-goto): Use org-cite-basic--get-key.
(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 | 61 +++++++++++---
lisp/om.el | 201 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 253 insertions(+), 9 deletions(-)
create mode 100644 lisp/om.el
diff --git a/lisp/oc-basic.el b/lisp/oc-basic.el
index 32a99e987..c72cfffd0 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,16 @@ 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-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 +817,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 +837,44 @@ 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))]
+ ["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)))))
+ ("u" "URL"
+ (let ((url (org-cite-basic--get-field
+ 'url
+ (org-cite-basic--get-key !citation-object))))
+ (if (not (s-blank? url))
+ (kill-new url)
+ (user-error "No URL for `%s'" (org-cite-basic--get-key !citation-object)))))]
+ ["Browse"
+ ("w" "Browse URL/DOI"
+ (let ((url (org-cite-basic--get-field
+ 'url
+ (org-cite-basic--get-key !citation-object)))
+ (doi (org-cite-basic--get-field
+ 'doi
+ (org-cite-basic--get-key !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))))))]]
+ :default-action 'org-cite-basic-goto
+ :parameter-types ('citation 'citation-reference))
+
;;; "Insert" capability
(defun org-cite-basic--complete-style (_)
@@ -920,7 +963,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..cc12c3182
--- /dev/null
+++ b/lisp/om.el
@@ -0,0 +1,201 @@
+;;; 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-lib)
+(require 'org-macs)
+(require 'transient)
+
+(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-display'."
+ :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 (menu-name parameter-names parameters)."
+ :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 propting the user for an action to
+will be presented upon activating certain objects."
+ :init-value nil
+ :lighter " OM")
+
+
+(defun org-menu--wrap-specification (specification arg-list)
+ "Handle special syntax for `org-cite-basic-follow-actions'."
+ (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
+ &key ((:default-action default-action) nil)
+ &key ((:parameter-types types) nil))
+ "Define an org menu."
+ (let ((menu-default-actions-name
+ (intern
+ (concat (symbol-name name)
+ "-default-action")))
+ (menu-actions
+ (intern
+ (concat (symbol-name name)
+ "-actions")))
+ (menu-setup-children-name
+ (intern
+ (concat (symbol-name name)
+ "--setup-children")))
+ (complete-arglist (if (member 'prefix arglist)
+ arglist
+ `(,@arglist prefix))))
+ `(progn
+
+;;; Local customization
+ (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")
+ :type 'sexp)
+
+ (defcustom ,menu-default-actions-name ,default-action
+ ,(concat "The default action for `"
+ (symbol-name name)
+ "'.
+This should be a function accepting the arguments "
+ (prin1-to-string complete-arglist)
+ ".")
+ :group 'org-menu
+ :package-version '(Org . "9.8")
+ :type 'sexp)
+
+
+;;; Helper functions
+ (defun ,menu-setup-children-name (_)
+ ,(concat "Populate the menu of `"
+ (symbol-name name)
+ "' based on the contents
+of `"
+ (symbol-name menu-actions)
+ "'.")
+ (transient-parse-suffixes
+ (quote ,name)
+ (cl-map
+ 'vector
+ (lambda (group)
+ (cl-map
+ 'vector
+ (lambda (specification)
+ (org-menu--wrap-specification specification '(,@complete-arglist)))
+ group))
+ ,menu-actions)))
+
+ (transient-define-prefix
+ ,name (,@arglist &optional prefix)
+ ,docstring
+ [:class
+ transient-columns
+ :setup-children
+ ,menu-setup-children-name
+ :pad-keys t]
+ (interactive
+ (list (let ((obj (org-element-context)))
+ (pcase (org-element-type obj)
+ ((or ,@types) obj)
+ (_ (user-error "Wrong object type"))))))
+ (cond ((not (xor org-menu-mode
+ (equal prefix org-menu-switch)))
+ (apply ,menu-default-actions-name (list ,@complete-arglist)))
+ ((eq org-menu-system 'transient)
+ (transient-setup
+ (quote ,name) nil nil
+ :scope (list
+ ,@(mapcan (lambda (parameter)
+ (list (intern
+ (concat ":"
+ (symbol-name parameter)))
+ parameter))
+ complete-arglist))))
+ (t
+ (funcall org-menu-system ',name ',complete-arglist (list ,@complete-arglist))))))))
+
+(provide 'om)
+;;; om.el ends here
--
2.47.2
