Add citar--select-multiple

citar-embark.el

@@ -0,0 +1,41 @@
+;;; citar-embark.el --- Embark support for citar -*- lexical-binding: t; -*-
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; This program 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.
+
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;  Provides functions for integrating Embark and Citar.
+;;
+;;; Code:
+(require 'embark)
+(require 'citar)
+
+;;;###autoload
+(defun citar--embark-selected ()
+  "Return selected candidates from `citar--select-multiple' for embark."
+  (when-let (((eq minibuffer-history-variable 'citar-history))
+             (metadata (embark--metadata))
+             (group-function (completion-metadata-get metadata 'group-function))
+             (cands (all-completions
+                     "" minibuffer-completion-table
+                     (lambda (cand)
+                       (and (equal "Selected" (funcall group-function cand nil))
+                            (or (not minibuffer-completion-predicate)
+                                (funcall minibuffer-completion-predicate cand)))))))
+    (cons (completion-metadata-get metadata 'category) cands)))
+
+(provide 'citar-embark)
+;;; citar-embark.el ends here

citar-vertico.el

@@ -0,0 +1,66 @@
+;;; citar-vertico.el --- Keybinding remapping for vertico -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2022 Bruce D'Arcus
+;;
+;;
+;; This file is not part of GNU Emacs.
+;;
+;;; Commentary:
+;;
+;;  Remaps keybindings for using 'citar--multiple-select' with vertico.
+;;
+;;; Code:
+
+(require 'vertico)
+
+(defvar vertico--input)
+(defvar vertico--history-hash)
+(defvar vertico--lock-candidate)
+(declare-function vertico--exhibit "ext:vertico")
+(declare-function vertico--candidate "ext:vertico")
+
+(defun citar-vertico--candidate ()
+  "Return current candidate for Consult preview."
+  (and vertico--input (vertico--candidate 'highlight)))
+
+(defun citar-vertico--refresh (&optional reset)
+  "Refresh completion UI, keep current candidate unless RESET is non-nil."
+  (when vertico--input
+    (setq vertico--input t)
+    (when reset
+      (setq vertico--history-hash nil
+            vertico--lock-candidate nil))
+    (vertico--exhibit)))
+
+(defun citar-vertico--crm-select ()
+  "Select/deselect candidate."
+  (interactive)
+  (when (let ((cand (vertico--candidate)))
+          (and (vertico--match-p cand) (not (equal cand ""))))
+    (vertico-exit)))
+
+(defun citar-vertico--crm-exit ()
+  "Select/deselect candidate and exit."
+  (interactive)
+  (when (let ((cand (vertico--candidate)))
+          (and (vertico--match-p cand) (not (equal cand ""))))
+    (run-at-time 0 nil #'exit-minibuffer))
+  (vertico-exit))
+
+(defvar citar-vertico--crm-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [remap vertico-insert] #'citar-vertico--crm-select)
+    (define-key map [remap exit-minibuffer] #'citar-vertico--crm-exit)
+    map))
+
+(defun citar-vertico--crm-setup ()
+  "Setup crm for Vertico."
+  (when vertico--input
+    (use-local-map (make-composed-keymap (list citar-vertico--crm-map) (current-local-map)))))
+
+(add-hook 'citar--completion-candidate-hook #'citar-vertico--candidate)
+(add-hook 'citar--completion-refresh-hook #'citar-vertico--refresh)
+(add-hook 'citar--crm-setup-hook #'citar-vertico--crm-setup)
+
+(provide 'citar-vertico)
+;;; citar-vertico.el ends here

citar.el

@@ -418,10 +418,8 @@ FILTER: if non-nil, should be a predicate function taking
                (string-match-p \"foo\" keywords))))"
   (let* ((candidates (citar--get-candidates rebuild-cache))
          (completions (citar--completion-table candidates filter))
-         (crm-separator "\\s-*&\\s-*")
          (chosen (if (and multiple citar-select-multiple)
-                     (completing-read-multiple "References: " completions nil nil nil
-                                               'citar-history citar-presets nil)
+                     (citar--select-multiple "References: " candidates 'citar-history)
                    (completing-read "Reference: " completions nil nil nil
                                     'citar-history citar-presets nil)))
          (notfound nil)
@@ -454,6 +452,53 @@ documentation for the return value and the meaning of
 REBUILD-CACHE and FILTER."
   (citar-select-ref :rebuild-cache rebuild-cache :multiple t :filter filter))
 
+(defun citar--sort-by-selection (selected-hash candidates)
+  "Sort the CANDIDATES by putting those in SELECTED-HASH first."
+  (let ((selected)
+        (others))
+    (dolist (cand candidates (nreverse (nconc others selected)))
+      (if (gethash (substring-no-properties cand) selected-hash)
+          (push cand selected)
+        (push cand others)))))
+
+(defun citar--select-multiple (prompt candidates &optional history)
+  "Select multiple CANDIDATES with PROMPT.
+HISTORY is the 'completing-read' history argument."
+  ;; Because completing-read-multiple just does not work for long candidate
+  ;; strings, and IMO is a poor UI.
+  (let ((selected-hash (make-hash-table :test #'equal)))
+    (while
+        (let ((item
+               (completing-read
+                (format "%s (%s/%s): " prompt
+                        (hash-table-count selected-hash)
+                        (length candidates))
+                (lambda (str pred action)
+                  (if (eq action 'metadata)
+                      `(metadata (display-sort-function . (lambda (cands) (citar--sort-by-selection ,selected-hash cands)))
+                                 (cycle-sort-function . ,#'identity)
+                                 (group-function
+                                  . ,(lambda (cand transform)
+                                       (pcase (list (not (not transform)) (gethash (substring-no-properties cand) selected-hash))
+                                         ('(nil nil) "Select Multiple")
+                                         ('(nil t)   "Selected")
+                                         ('(t   nil) cand)
+                                         ('(t   t  ) (propertize cand 'face 'highlight))))))
+                    (complete-with-action action candidates str pred)))
+                nil
+                t
+                nil
+                history ; FIX
+                "")))
+          (unless (equal item "")
+            (cond
+             ((gethash item selected-hash)
+              (remhash item selected-hash))
+             (t
+              (puthash item t selected-hash)))
+            t)))
+    (hash-table-keys selected-hash)))
+
 (defun citar--select-resource (files &optional links)
   "Select resource from a list of FILES, and optionally LINKS."
   (let* ((files (mapcar