But that was not good enough - we do not cover the case of specifying
a lambda in org-cite-basic-follow-actions,
or passing other arguments to the function than citation, prefix or
citation key.
This updated version fixes this, so the action can be either
1. a suffix (as in transient-define-suffix)
2. a lambda form (as in (lambda (citation prefix) (interactive
(transient-scope)) ...))
3. a function call, which will be wrapped in the ugly dance-lambda and
where !citation, !prefix, and !citation-key
will be (recursively) substituted but other arguments preserved.
(defun org-cite-basic-follow--process-function-arguments (arguments)
(cond ((null arguments)
'())
((atom (car arguments))
(cons
(pcase (car arguments)
('!citation
'(car (transient-scope)))
('!prefix
'(cadr (transient-scope)))
('!citation-key
'(org-element-property :key (car (transient-scope))))
(argument
argument))
(org-cite-basic-follow--process-function-arguments (cdr arguments))))
(t
(cons
(org-cite-basic-follow--process-function-arguments (car arguments))
(org-cite-basic-follow--process-function-arguments (cdr
arguments))))))
(defun org-cite-basic-follow--parse-suffix-specification (specification)
(pcase specification
((and (pred stringp) label)
label)
(`(,key ,desc (lambda . ,fn-args) . ,other)
(list key desc `(lambda ,@fn-args) ,other))
(`(,key ,desc (,fn . ,fn-args) . ,other)
(let ((function-args
(org-cite-basic-follow--process-function-arguments
fn-args)))
`(,key ,desc
(lambda ()
(interactive)
(,fn ,@function-args))
,other)))
(`(,key ,desc ,suffix)
(list key desc suffix))))
(defun org-cite-basic-follow--setup (_)
(transient-parse-suffixes
'org-cite-basic-follow
(cl-map 'vector
(lambda (group)
(cl-map 'vector #'org-cite-basic-follow--parse-suffix-specification
group))
org-cite-basic-follow-actions)))
Cheers!
Tor-björn
Den tors 31 okt. 2024 kl 22:48 skrev Tor-björn Claesson <tclaes...@gmail.com>:
>
> Thanks!
>
> Here is another take=)
>
> (defcustom org-cite-basic-follow-actions
> '[["Open"
> ("b" "bibliography entry" (org-cite-basic-goto !citation !prefix))]
> ["Copy"
> ("d" "DOI" org-cite-basic-follow.copy-doi)]
> ["Browse"
> ("u" "url" org-cite-basic-follow.browse-url)]]
> "Hepp"
> :group 'org-cite
> :type 'sexp)
>
> (transient-define-prefix org-cite-basic-follow (citation &optional prefix)
> [:class transient-columns
> :setup-children org-cite-basic-follow--setup
> :pad-keys t]
> (interactive)
> (if (or org-cite-basic-follow-ask
> (eq prefix '(-4)))
> (transient-setup 'org-cite-basic-follow nil nil
> :scope (list citation prefix))
> (org-cite-basic-goto citation prefix)))
>
> (defun org-cite-basic-follow--parse-suffix-specification (specification)
> (pcase specification
> ((and (pred stringp) label)
> label)
> (`(,key ,desc (,fn . ,fn-args) . ,other)
> (let ((function-args
> (mapcar
> (lambda (arg)
> (pcase arg
> ('!citation
> '(car (transient-scope)))
> ('!prefix
> '(cadr (transient-scope)))
> ('!citation-key
> '(org-element-property :key (car (transient-scope))))))
> fn-args)))
> `(,key ,desc
> (lambda ()
> (interactive)
> (,fn ,@function-args))
> ,other)))
> (`(,key ,desc ,suffix)
> (list key desc suffix))))
>
> (defun org-cite-basic-follow--setup (_)
> (transient-parse-suffixes
> 'org-cite-basic-follow
> (cl-map 'vector
> (lambda (group)
> (cl-map 'vector
> #'org-cite-basic-follow--parse-suffix-specification
> group))
> org-cite-basic-follow-actions)))
>
> Cheers,
> Tor-björn
