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 96d7ac0aa00533371682854eb8aa9afa7eae33cc 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/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 | 62 ++++++++++--
lisp/om.el | 245 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 298 insertions(+), 9 deletions(-)
create mode 100644 lisp/om.el
diff --git a/lisp/oc-basic.el b/lisp/oc-basic.el
index 32a99e987..f163cfc31 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,45 @@ present in the citation."
(bibtex-set-dialect)
(bibtex-search-entry key)))))
+(org-menu-define org-cite-basic-follow (citation-object)
+ "Follow citation"
+ '[["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))))))]]
+ :display t
+ :default-action 'org-cite-basic-goto
+ :parameter-types ('citation 'citation-reference))
+
;;; "Insert" capability
(defun org-cite-basic--complete-style (_)
@@ -920,7 +964,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..e0dbd04f3
--- /dev/null
+++ b/lisp/om.el
@@ -0,0 +1,245 @@
+;;; 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-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."
+ :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, and depending on the settings for the specific
+menu in `org-menu-ask', a menu propting the user for an action to will be
+presented upon activating certain objects."
+ :init-value nil
+ :lighter " OM")
+
+
+;;; Helper functions
+;; (defmacro org-menu--generate-arg-bindings (args)
+;; `(,@(mapcar
+;; (lambda (arg) `(,(make-symbol (concat "!" (symbol-name arg)))
+;; (plist-get (transient-scope)
+;; ,(make-symbol (concat ":" (symbol-name arg))))))
+;; args)
+;; (!prefix (plist-get (transient-scope) :prefix))))
+
+
+;; (defmacro org-menu--bind-transient (keys args)
+;; `(let (,@(mapcar
+;; (lambda (key) `(,(make-symbol (concat "!" (symbol-name key)))
+;; (plist-get (transient-scope)
+;; ,(make-symbol (concat ":" (symbol-name key))))))
+;; keys)
+;; (!prefix (plist-get (transient-scope) :prefix))))
+;; args)
+
+;; (defmacro org-menu--make-scope (args)
+;; `(list ,@(mapcan (lambda (arg)
+;; (list (make-symbol
+;; (concat ":" (symbol-name arg)))
+;; arg))
+;; args)
+;; :prefix prefix))
+
+(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)
+ `(,(make-symbol (concat "!" (symbol-name arg)))
+ (plist-get (transient-scope)
+ ,(make-symbol (concat ":" (symbol-name arg))))))
+ arg-list))
+ ,@fn-args)
+ ,@other))
+ (`(,key ,desc (,fn . ,fn-args) . ,other)
+ `(,key ,desc
+ (lambda ()
+ (interactive)
+ (let ,(mapcar
+ (lambda (arg)
+ `(,(make-symbol (concat "!" (symbol-name arg)))
+ (plist-get (transient-scope)
+ ,(make-symbol (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 ((:display display) nil)
+ &key ((:default-action default-action) nil)
+ &key ((:parameter-types types) nil))
+ "Define an org menu."
+ (let ((menu-display-name
+ (make-symbol
+ (concat (symbol-name name)
+ "-display")))
+ (menu-default-actions-name
+ (make-symbol
+ (concat (symbol-name name)
+ "-display")))
+ (menu-actions
+ (make-symbol
+ (concat (symbol-name name)
+ "-actions")))
+ (menu-setup-children-name
+ (make-symbol
+ (concat (symbol-name name)
+ "--setup-children")))
+ (complete-arglist (cons 'prefix arglist)))
+ `(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-display-name ,display
+ ,(concat "Should `"
+ (symbol-name name)
+ "' be displayed?
+
+When this option is nil, `"
+ (symbol-name name)
+ "' performs the action specified
+in `"
+ (symbol-name menu-default-actions-name)
+ "'.
+Otherwise it will display a menu (of the type specified in `org-menu-system').
+This behaviour can be reversed by supplying the prefix argument specified in
+`org-menu-switch'.")
+ :group 'org-menu
+ :package-version '(Org . "9.8")
+ :type 'boolean)
+
+ (defcustom ,menu-default-actions-name ,default-action
+ ,(concat "The default action for `"
+ (symbol-name name)
+ "'.")
+ :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 ,menu-display-name
+ (equal prefix org-menu-switch)))
+ (funcall ,menu-default-actions-name citation-object prefix))
+ ((eq org-menu-system 'transient)
+ (transient-setup
+ (quote ,name) nil nil
+ :scope (list
+ ,@(mapcan (lambda (parameter)
+ (list (make-symbol
+ (concat ":"
+ (symbol-name parameter)))
+ parameter))
+ complete-arglist))
+ ))
+ (t
+ (message "TODO: dispatch to other menusystem")))))))
+
+(provide 'om)
+;;; om.el ends here
--
2.47.2
