Re: Org-cite: Replace basic follow-processor with transient menu?

["Tor-björn Claesson" <tclaesson@gmail.com>]

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 <tclaesson@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