From ce51325b85b993dc6877e6cd2228be44b3e5f201 Mon Sep 17 00:00:00 2001 From: Roshan Shariff Date: Mon, 4 Jul 2022 07:46:11 -0600 Subject: [PATCH] Refactor caching, API (#634) Sorry for this breaking change, but I wanted to get the foundations right before tagging 1.0. This completely restructures the core of citar so that now: - the API in general is (again) citekey-based - the note API is improved, and configured by plist - the cache auto-invalidates when files change See documentation for details. As a result, we remove some redundant code: - citar-filenotify.el - the rebuild cache hook, etc. There are also a number of code refinements. Co-authored-by: Bruce D'Arcus --- .dir-locals.el | 20 +- .github/workflows/check.yml | 7 +- CONTRIBUTING.org | 45 +- Eldev | 15 +- README.org | 77 +- citar-cache.el | 300 ++++++++ citar-capf.el | 8 +- citar-citeproc.el | 15 +- citar-embark.el | 131 ++++ citar-file.el | 363 ++++----- citar-filenotify.el | 202 ----- citar-format.el | 173 +++++ citar-latex.el | 9 +- citar-markdown.el | 11 +- citar-org.el | 24 +- citar.el | 1403 ++++++++++++++++++----------------- test/citar-file-test.el | 107 +++ test/citar-format-test.el | 56 ++ test/manual/citar.el | 6 +- test/manual/install.el | 11 +- 20 files changed, 1780 insertions(+), 1203 deletions(-) create mode 100644 citar-cache.el create mode 100644 citar-embark.el delete mode 100644 citar-filenotify.el create mode 100644 citar-format.el create mode 100644 test/citar-file-test.el create mode 100644 test/citar-format-test.el diff --git a/.dir-locals.el b/.dir-locals.el index 57444ef8..729ba419 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,9 +1,11 @@ -((emacs-lisp-mode - (fill-column . 110) - (indent-tabs-mode . nil) - (elisp-lint-indent-specs . ((describe . 1) - (it . 1) - (thread-first . 0) - (cl-flet . 1) - (sentence-end-double-space . nil) - (cl-flet* . 1))))) +;;; Directory Local Variables +;;; For more information see (info "(emacs) Directory Variables") + +((emacs-lisp-mode . ((sentence-end-double-space . nil) + (fill-column . 110) + (indent-tabs-mode . nil) + (elisp-lint-indent-specs . ((describe . 1) + (it . 1) + (thread-first . 0) + (cl-flet . 1) + (cl-flet* . 1)))))) diff --git a/.github/workflows/check.yml b/.github/workflows/check.yml index 7c689ce1..15b9e2ff 100644 --- a/.github/workflows/check.yml +++ b/.github/workflows/check.yml @@ -17,6 +17,7 @@ on: jobs: check: runs-on: ubuntu-latest + continue-on-error: ${{ matrix.emacs_version == 'snapshot' }} strategy: fail-fast: false matrix: @@ -28,6 +29,9 @@ jobs: - compile - test - lint + exclude: + - emacs_version: snapshot + action: compile steps: - name: Set up Emacs ${{matrix.emacs_version}} uses: purcell/setup-emacs@master @@ -63,5 +67,6 @@ jobs: eldev --color lint re - name: Lint package metadata if: ${{ matrix.action == 'lint' }} + continue-on-error: true run: | - eldev --color lint package || true + eldev --color lint package diff --git a/CONTRIBUTING.org b/CONTRIBUTING.org index 91e140c7..14bfb9d4 100644 --- a/CONTRIBUTING.org +++ b/CONTRIBUTING.org @@ -5,31 +5,49 @@ If you would like to contribute, details: -- For more signifiant potential changes, file an issue first to get feedback on the basic idea. +- For more significant potential changes, file an issue first to get feedback on the basic idea. - If you do submit a PR, follow the [[https://github.com/bbatsov/emacs-lisp-style-guide][elisp style guide]], and [[https://cbea.ms/git-commit/][these suggestions]] on git commit messages. - For working on lists and such, we primarily use the =seq= functions, and occassionally ~dolist~. +** Basic Architecture + +Citar uses a cache, which stores two hash tables for each bibliography file: + +- entries :: as returned by =parsebib-parse=, keys are citekeys, values are alists of entry fields +- pre-formatted :: values are partially-formatted completion strings + +The =citar--ref-completion-table= function returns a hash table from the bibliographic cache, and ~citar--get-entry~ and ~-citar--get-value~ provide access to those data. +Most user-accessible citar functions take an argument ~key~ or ~keys~. +Some functions also take an ~entry~ argument, and ~citar--get-value~ takes either. +When using these functions, you should keep in mind that unless you pass an entry alist to ~citar--get-value~, and instead use a key, each call to that function will query the cache. +This, therefore, is a better pattern to use: + +#+begin_src emacs-lisp + +(let* ((entry (citar--get-entry key)) + (title (citar--get-value entry "title"))) + (message title)) + +#+end_src + + ** Extending citar -Most user-accessible citar functions take an argument ~key-entry~ or ~keys-entries~. -These expect, respectively, a cons cell of a citation key (a string like "SmithWritingHistory1987") and the corresponding bibliography entry for that citation, or a list of such cons cells. -If you wish to extend citar at the user-action level, perhaps by adding a function to one of the embark keymaps, you will find it easiest to reproduce this pattern. -If you need to build the cons cells manually, this can be accomplished via ~citar--get-entry~. -So, for example, to insert the annotations from a pdf into a buffer, the following pair of functions might be used: +You can use ~citar-select-ref~ or ~citar-select-refs~ to write custom commands. +An example: #+begin_src emacs-lisp -(defun my/citar-insert-annots (keys-entries) +(defun my/citar-insert-annots (keys) "insert annotations as org text from KEYS-ENTRIES" - (interactive (list (citar-select-refs - :rebuild-cache current-prefix-arg))) + (interactive (list (citar-select-refs))) (let* ((files - (seq-mapcat (lambda (key-entry) + (seq-mapcat (lambda (key) (citar-file--files-for-entry - (car key-entry) (cdr key-entry) + key (citar--get-entry key) '("/") '("pdf"))) - keys-entries )) + keys )) (output (seq-map (lambda (file) (pdf-annot-markups-as-org-text ;; you'll still need to write this function! @@ -44,8 +62,7 @@ So, for example, to insert the annotations from a pdf into a buffer, the followi (defun my/independent-insert-annots (key) "helper function to insert annotations without the bibtex-actins apparatus" - (let ((key-entry (cons key (citar--get-entry key)))) - (my/citar-insert-annots (list key-entry)))) + (my/citar-insert-annots (list key))) #+end_src diff --git a/Eldev b/Eldev index 70f206ce..32678d37 100755 --- a/Eldev +++ b/Eldev @@ -8,18 +8,21 @@ (eldev-use-plugin 'autoloads) -(setf eldev-standard-excludes `(:or ,eldev-standard-excludes "./test/manual/" "./citar-capf.el")) +;; TODO what to do with these excluded files? +(setf eldev-standard-excludes `(:or ,eldev-standard-excludes "./test/manual/" "./citar-capf.el" "./citar-filenotify.el")) ;; (setf eldev-test-fileset '("./test/" "!./test/manual/")) -;; (eldev-add-extra-dependencies 'test 'embark 'consult 'marginalia 'vertico 'auctex) +(eldev-add-extra-dependencies '(build test lint) 'embark 'auctex) ;; allow to load test helpers ;; (eldev-add-loading-roots 'test "test/utils") +;;; Linting settings + ;; Tell checkdoc not to demand two spaces after a period. (setq sentence-end-double-space nil) - -(setf eldev-lint-default '(elisp)) +(setq eldev-lint-default '(elisp)) +(setq eldev-lint-stop-mode 'linter) (with-eval-after-load 'elisp-lint ;; Used eldev lint package | checkdoc @@ -28,3 +31,7 @@ ;; Emacs 29 snapshot has new indentation convention for cl-letf (when (> emacs-major-version 28) (push "indent" elisp-lint-ignored-validators))) + +;; Currently, package-lint has no other way of ignoring checks. +;; See https://github.com/purcell/package-lint/issues/125 +(advice-add #'package-lint--check-eval-after-load :override #'ignore) diff --git a/README.org b/README.org index 492b6cab..98693dd2 100644 --- a/README.org +++ b/README.org @@ -17,8 +17,6 @@ :CUSTOM_ID: features :END: -Note: this package was formerly called "bibtex-actions." - This package provides a completing-read front-end to browse and act on BibTeX, BibLaTeX, and CSL JSON bibliographic data, and LaTeX, markdown, and org-cite editing support. When used with vertico, embark, and marginalia, it provides similar functionality to helm-bibtex and ivy-bibtex: quick filtering and selecting of bibliographic entries from the minibuffer, and the option to run different commands against them. @@ -50,6 +48,8 @@ In addition, the following packages are strongly recommended for the best experi 3. [[https://github.com/oantolin/embark][Embark]] (contextual actions) 4. [[https://github.com/minad/marginalia][Marginalia]] (annotations, and also candidate classification for Embark) +We also recommend Emacs 28, as this package relies on two of its features, that greatly enhance the UI. + ** Configuration :PROPERTIES: :CUSTOM_ID: configuration @@ -73,9 +73,16 @@ This is the minimal configuration, and will work with any completing-read compli *** Embark -Citar will automatically integrate with Embark if it is installed, offering contextual access to actions in the minibuffer and at-point. +The =citar-embark= package adds contextual access actions in the minibuffer and at-point via the ~citar-embark-mode~ minor mode. When using Embark, the Citar actions are generic, and work the same across org, markdown, and latex modes. +#+BEGIN_SRC emacs-lisp +(use-package citar-embark + :after citar embark + :no-require + :config (citar-embark-mode)) +#+END_SRC + *** Org-Cite #+CAPTION: org-cite at-point integration with =embark-act= @@ -216,65 +223,17 @@ You can save this history across sessions by adding =citar-history= to =savehist :CUSTOM_ID: refreshing-the-library-display :END: -=citar= uses two caches to speed up library display; one for the global bibliography, and another for local files specific to a buffer. -This is great for performance, but means the data can become stale if you modify it. - -The =citar-refresh= command will reload the caches, and you can call this manually. -You can also call any of the =citar= commands with a prefix argument: =C-u M-x citar-insert-key=. - -Although not default, =citar= also provides convenience functions for auto-refreshing cache when bib files change using filenotify. -The simplest use of this functionality is - -#+BEGIN_SRC emacs-lisp -(citar-filenotify-setup '(LaTeX-mode-hook org-mode-hook)) -#+END_SRC - -This will add watches for the global bib files and in addition add a hook to =LaTeX-mode-hook= and =org-mode-hook= to add watches for local bibliographic files. -By default this will invalidate the cache if a bib file changes. If the bib files change rarely, a more suitable option is to refresh the cache. -This can be achieved by - -#+BEGIN_SRC emacs-lisp -(setq citar-filenotify-callback 'refresh-cache) -#+END_SRC - -The behavior can be tweaked more thoroughly by setting ~citar-filenotify-callback~ to a function. -See its documentation for details. -Watches can be also placed on additional files. -This is controlled by the variable ~citar-filenotify-files~. - -Another option to make the completion interface more seamless is to add a hook which generates the cache after a buffer is opened. -This can be done when emacs has been idle (half a second in the example below) with something like this: - -#+BEGIN_SRC emacs-lisp -(defun gen-bib-cache-idle () - "Generate bib item caches with idle timer" - (run-with-idle-timer 0.5 nil #'citar-refresh)) - -(add-hook 'LaTeX-mode-hook #'gen-bib-cache-idle) -(add-hook 'org-mode-hook #'gen-bib-cache-idle) -#+END_SRC - -For additional configuration options on this, see [[https://github.com/bdarcus/citar/wiki/Configuration#automating-path-watches][the wiki]]. +Citar uses a cache to speed up library display. +If a bib file changes, the cache will automatically update the next time you run a Citar command. +Note that cached data preformatted completion candidates are independently tracked by file. +So, for example, if you have one very large bibliography file that changes a lot, you might consider splitting into one large file that is more stable, and one-or-more smaller ones that change more frequently. ** Notes -Citar provides a ~citar-create-note-function~ variable, and a default function for org, which also works well with org-roam (v2 now supports org-cite). -You can configure the title display using the "note" template. - -You can also use the ~citar-open-note-functions~ variable to replace or augment the default with another; for example from org-roam-bibtex: - -#+BEGIN_SRC emacs-lisp -(setq citar-open-note-functions '(orb-citar-edit-note)) -#+END_SRC - -Since ~citar-open-note-functions~ is a list, you can also include multiple functions, to handle different note scenarios. - -Please note that if you choose to use org-roam-bibtex using the above configuration, you will need to set ~:immediate-finish t~ in the template that you use for bibliography notes in ~org-roam-capture-templates~. -Since ~citar-open-note-functions~ attempts multiple functions one after the other, this is needed to ensure the ~org-capture~ returns immediately without waiting for further user input. - -Citar also includes a ~citar-has-notes-functions~ variable, which specifies a list of functions, each of which returns a predicate function to test whether a reference has associated notes. -This function allows Citar to correctly format the completion UI candidates. -The default function only supports one-file-per-key notes. +Citar offers configurable note-taking and access integration. +The ~citar-notes-sources~ variable configures note backends, and ~citar-notes-source~ activates your chosen backend. +A backend primarily specifies functions to update the Citar display, to create the completion candidates, and to open existing and new notes. +See the ~citar-notes-sources~ docstring for details, and the =citar-register-note-source= and =citar-remove-note-source= convenience functions. ** Files, file association and file-field parsing diff --git a/citar-cache.el b/citar-cache.el new file mode 100644 index 00000000..78dc4dab --- /dev/null +++ b/citar-cache.el @@ -0,0 +1,300 @@ +;;; citar-cache.el --- Cache functions for citar -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2022 Bruce D'Arcus, Roshan Shariff +;; +;; 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 . +;; +;;; Commentary: +;; +;; Functions for caching bibliography files. +;; +;;; Code: + +(eval-when-compile + (require 'cl-lib)) +(require 'parsebib) +(require 'citar-format) +(require 'seq) +(require 'map) + +(declare-function citar--get-template "citar") +(declare-function citar--fields-to-parse "citar") + +(defvar citar-ellipsis) + +;;; Variables: + + +(defvar citar-cache--bibliographies (make-hash-table :test 'equal) + "Cache for parsed bibliography files. +This is a hash table with keys being file names and the values +being `citar-cache--bibliography' objects.") + + +;;; Bibliography objects + + +(cl-defstruct (citar-cache--bibliography + (:constructor citar-cache--make-bibliography (filename)) + (:copier nil)) + "Cached bibliography file." + (filename + nil + :read-only t + :documentation + "True filename of a bibliography, as returned by `file-truename'.") + (buffers + nil + :documentation + "List of buffers that require this bibliography.") + (props + nil + :documentation + "Plist with keys :size, :mtime, :hash, and :fields; attributes + of the cached file and the fields parsed from it.") + (entries + (make-hash-table :test 'equal) + :documentation + "Hash table mapping citation keys to bibliography entries, + as returned by `parsebib-parse'.") + (format-string + nil + :documentation + "Format string used to generate pre-formatted strings.") + (preformatted + (make-hash-table :test 'equal) + :documentation + "Pre-formatted strings used to display bibliography entries; + see `citar--preformatter'.")) + + +(defun citar-cache--get-bibliographies (filenames &optional buffer) + "Return cached bibliographies for FILENAMES and associate them with BUFFER. +FILENAMES is a list of bibliography file names. If BUFFER is nil, +use the current buffer. Otherwise, BUFFER should be a buffer +object or name that requires these bibliographies, or a symbol +like `global'. + +Remove any existing associations between BUFFER and cached files +not included in FILENAMES. Release cached files that are no +longer needed by any other buffer. + +Return a list of `citar--bibliography' objects, one for each +element of FILENAMES." + (citar-cache--release-bibliographies filenames buffer) + (let ((buffer (citar-cache--canonicalize-buffer buffer))) + (mapcar + (lambda (filename) + (let ((bib (citar-cache--get-bibliography filename))) + (prog1 bib + ;; Associate buffer with this bibliography: + (cl-pushnew buffer (citar-cache--bibliography-buffers bib)) + ;; Release bibliography when buffer is killed or changes major mode: + (when (bufferp buffer) + (with-current-buffer buffer + (dolist (hook '(change-major-mode-hook kill-buffer-hook)) + (add-hook hook #'citar-cache--release-bibliographies 0 'local))))))) + filenames))) + +(defun citar-cache--entry (key bibs) + "Find the first entry for KEY in the bibliographies BIBS. +BIBS should be a list of `citar-cache--bibliography' objects." + (catch :found + (dolist (bib bibs) + (let* ((entries (citar-cache--bibliography-entries bib)) + (entry (gethash key entries))) + (when entry (throw :found entry)))))) + +(defun citar-cache--entries (bibs) + "Return hash table containing merged entries of BIBS. +BIBS should be a list of `citar-cache--bibliography' objects. If +a key is present in multiple bibliographies in BIBS, keep the +entry that appears first. Return a hash table mapping the keys of +all BIBS to their entries." + (apply #'map-merge '(hash-table :test equal) + (nreverse (mapcar #'citar-cache--bibliography-entries bibs)))) + +(defun citar-cache--preformatted (bibs) + "Return hash table containing pre-formatted strings from BIBS." + (apply #'map-merge '(hash-table :test equal) + (nreverse (mapcar #'citar-cache--bibliography-preformatted bibs)))) + + +;;; Creating and deleting bibliography caches + + +(defun citar-cache--get-bibliography (filename &optional force-update) + "Return cached bibliography for FILENAME. + +If FILENAME is not already cached, read and cache it. If +FORCE-UPDATE is non-nil, re-read the bibliography even if it is +has not changed. + +Note: This function should not be called directly; use +`citar-get-bibliographies' instead. This function adds a +bibliography to the cache without associating it with any buffer, +so it will never be evicted from the cache. Use +`citar-cache--get-bibliographies' to ensure that the cached +bibliographies are removed when the associated buffers no longer +need them." + (let* ((cached (gethash filename citar-cache--bibliographies)) + (cachedprops (and cached (citar-cache--bibliography-props cached))) + (cachedfmtstr (and cached (citar-cache--bibliography-format-string cached))) + (props (citar-cache--get-bibliography-props filename cachedprops)) + (fmtstr (citar--get-template 'completion)) + (bib (or cached (citar-cache--make-bibliography filename)))) + (prog1 bib + ;; Set the format string so it's correct when updating bibliography + (setf (citar-cache--bibliography-format-string bib) fmtstr) + ;; Update bibliography if needed or forced + (if (or force-update + (citar-cache--update-bibliography-p cachedprops props)) + (citar-cache--update-bibliography bib props) + ;; Otherwise, update props anyway in case mtime has changed: + (setf (citar-cache--bibliography-props bib) props) + ;; Pre-format if format string has changed even though bibliography hasn't + (unless (equal-including-properties fmtstr cachedfmtstr) + (citar-cache--preformat-bibliography bib))) + ;; Add bibliography to cache: + (unless cached + (puthash filename bib citar-cache--bibliographies))))) + + +(defun citar-cache--release-bibliographies (&optional keep-filenames buffer) + "Dissociate BUFFER from cached bibliographies. +If BUFFER is nil, use the current buffer. Otherwise, BUFFER +should be a buffer object, buffer name, or a symbol like +`global'. KEEP-FILENAMES is a list of file names that are not +dissociated from BUFFER. + +Remove any bibliographies from the cache that are no longer +needed by any other buffer." + (let ((buffer (citar-cache--canonicalize-buffer buffer))) + (maphash + (lambda (filename bib) + (unless (member filename keep-filenames) + (cl-callf2 delq buffer (citar-cache--bibliography-buffers bib)) + (unless (citar-cache--bibliography-buffers bib) + (citar-cache--remove-bibliography filename)))) + citar-cache--bibliographies))) + + +(defun citar-cache--remove-bibliography (filename) + "Remove bibliography cache entry for FILENAME." + ;; TODO Perform other needed actions, like removing filenotify watches + (remhash filename citar-cache--bibliographies)) + + +;;; Updating bibliographies + +(defun citar-cache--get-bibliography-props (filename &optional oldprops) + "Return attributes to decide if bibliography FILENAME needs to be updated. +Return a plist with keys :size, :mtime, :hash, and :fields. +OLDPROPS, if given, should be a plist with the same keys. If +FILENAME has the same size and modification time as in OLDPROPS, +then assume that the hash value is also the same without +re-hashing the file contents." + (let* ((remote-file-name-inhibit-cache t) + (attr (file-attributes filename 'integer)) + (size (file-attribute-size attr)) + (mtime (file-attribute-modification-time attr)) + (fields (citar--fields-to-parse)) + (oldhash (plist-get oldprops :hash)) + (hash (if (and (stringp oldhash) + (equal size (plist-get oldprops :size)) + (equal mtime (plist-get oldprops :mtime))) + oldhash ; if size and mtime are unchanged, assume hash is the same + (with-temp-buffer + (insert-file-contents filename) + (buffer-hash))))) + `(:size ,size :mtime ,mtime :hash ,hash :fields ,fields))) + +(defun citar-cache--update-bibliography-p (oldprops newprops) + "Return whether bibliography needs to be updated. +Compare NEWPROPS with OLDPROPS and decide whether the file +contents have changed or the list of bibliography fields to be +parsed is different." + (not (and (equal (plist-get oldprops :size) (plist-get newprops :size)) + (equal (plist-get oldprops :hash) (plist-get newprops :hash)) + (equal (plist-get oldprops :fields) (plist-get newprops :fields))))) + +(defun citar-cache--update-bibliography (bib &optional props) + "Update the bibliography BIB from the original file. + +PROPS should be a plist returned by +`citar-cache--get-bibliography-props'; if PROPS is unspecified; +use the value returned by that function. This argument is +provided in case that function has already been called so that +its return value can be reused. + +Only the bibliography fields listed in the :fields value of PROPS +are parsed. After updating, the `props' slot of BIB is set to +PROPS." + (let* ((filename (citar-cache--bibliography-filename bib)) + (props (or props (citar-cache--get-bibliography-props filename))) + (entries (citar-cache--bibliography-entries bib)) + (messagestr (format "Updating bibliography %s" (abbreviate-file-name filename))) + (starttime (current-time))) + (message "%s..." messagestr) + (redisplay) ; Make sure message is displayed before Emacs gets busy parsing + (clrhash entries) + (parsebib-parse filename :entries entries :fields (plist-get props :fields)) + (setf (citar-cache--bibliography-props bib) props) + (citar-cache--preformat-bibliography bib) + (message "%s...done (%.3f seconds)" messagestr (float-time (time-since starttime))))) + + +(defun citar-cache--preformat-bibliography (bib) + "Updated pre-formatted strings in BIB." + (let* ((entries (citar-cache--bibliography-entries bib)) + (formatstr (citar-cache--bibliography-format-string bib)) + (fieldspecs (citar-format--parse formatstr)) + (preformatted (citar-cache--bibliography-preformatted bib))) + (clrhash preformatted) + (maphash + (lambda (citekey entry) + (let* ((preformat (citar-format--preformat fieldspecs entry + t citar-ellipsis)) + ;; CSL-JSON lets citekey be an arbitrary string. Quote it if... + (keyquoted (if (or (string-empty-p citekey) ; ... it's empty, + (= ?\" (aref citekey 0)) ; ... starts with ", + (seq-contains-p citekey ?\s #'=)) ; ... or has a space + (prin1-to-string citekey) + citekey)) + (prefix (propertize (concat keyquoted (when (cdr preformat) " ")) + 'invisible t))) + (setcdr preformat (cons (concat prefix (cadr preformat)) + (cddr preformat))) + (puthash citekey preformat preformatted))) + entries))) + + +;;; Utility functions: + + +(defun citar-cache--canonicalize-buffer (buffer) + "Return buffer object or symbol denoted by BUFFER. +If BUFFER is nil, return the current buffer. Otherwise, BUFFER +should be a buffer object or name, or a symbol like `global'. If +it is a buffer object or symbol, it is returned as-is. Otherwise, +return the buffer object whose name is BUFFER." + (cond ((null buffer) (current-buffer)) + ((symbolp buffer) buffer) + (t (get-buffer buffer)))) + + +(provide 'citar-cache) +;;; citar-cache.el ends here diff --git a/citar-capf.el b/citar-capf.el index c6dc6d4c..3dcc19f7 100644 --- a/citar-capf.el +++ b/citar-capf.el @@ -25,10 +25,10 @@ (declare-function org-element-type "ext:org-element") (declare-function org-element-context "ext:org-element") ;; Declare function from citar -;; (declare-function citar--ref-completion-table "citar") ;; pending cache revisions +(declare-function citar--ref-completion-table "citar") ;; pending cache revisions ;; Define vars for capf -(defvar citar-capf--candidates (or (citar--get-candidates) +(defvar citar-capf--candidates (or (citar--ref-completion-table) (user-error "No bibliography set")) "Completion candidates for `citar-capf'.") @@ -41,12 +41,12 @@ (defun citar-capf--exit (str _status) "Return key for STR from CANDIDATES hash." (delete-char (- (length str))) - (insert (cadr (assoc str citar-capf--candidates)))) + (insert (gethash str citar-capf--candidates))) ;;;; Citar-Capf ;;;###autoload (defun citar-capf () - "Citation key `completion-at-point` for org, markdown, or latex." + "Citation key `completion-at-point' for org, markdown, or latex." (let ((citar-capf-latex-regexp "\\(?:cite\\(?:\\(?:[pt]\\*\\|[pt]\\)?{\\)\\)\\([[:alnum:]_-]*,\\)*\\([[:alnum:]_-]*\\)") (citar-capf-markdown-regexp diff --git a/citar-citeproc.el b/citar-citeproc.el index 3a6acab4..02d96bbb 100644 --- a/citar-citeproc.el +++ b/citar-citeproc.el @@ -65,7 +65,7 @@ :type 'directory) (defvar citar-citeproc-csl-style nil - "CSL style file to be used with `citar-citeproc-format-reference`. + "CSL style file to be used with `citar-citeproc-format-reference'. If file is located in the directory set to `citar-citeproc-csl-styles-dir', only the filename itself is @@ -82,7 +82,7 @@ accepted.") ;;;###autoload (defun citar-citeproc-select-csl-style () - "Select CSL style to be used with `citar-citeproc-format-reference`." + "Select CSL style to be used with `citar-citeproc-format-reference'." (interactive) (unless citar-citeproc-csl-styles-dir (error "Be sure to set 'citar-citeproc-csl-styles-dir' to your CSL styles directory")) @@ -96,9 +96,9 @@ accepted.") (setq citar-citeproc-csl-style file))) ;;;###autoload -(defun citar-citeproc-format-reference (keys-entries) - "Return formatted reference(s) for KEYS-ENTRIES via `citeproc-el`. -Formatting follows CSL style set in `citar-citeproc-csl-style`. +(defun citar-citeproc-format-reference (keys) + "Return formatted reference(s) for KEYS via `citeproc-el'. +Formatting follows CSL style set in `citar-citeproc-csl-style'. With prefix-argument, select CSL style." (when (or (eq citar-citeproc-csl-style nil) current-prefix-arg) @@ -108,10 +108,7 @@ With prefix-argument, select CSL style." (let* ((style (if (string-match-p "/" citar-citeproc-csl-style) citar-citeproc-csl-style (expand-file-name citar-citeproc-csl-style citar-citeproc-csl-styles-dir))) - (keys (citar--extract-keys keys-entries)) - (bibs (flatten-list - (list citar-bibliography - (citar--major-mode-function 'local-bib-files #'ignore)))) + (bibs (citar--bibliography-files)) (proc (citeproc-create style (citeproc-hash-itemgetter-from-any bibs) (citeproc-locale-getter-from-dir citar-citeproc-csl-locales-dir) diff --git a/citar-embark.el b/citar-embark.el new file mode 100644 index 00000000..1e5fd965 --- /dev/null +++ b/citar-embark.el @@ -0,0 +1,131 @@ +;;; citar-embark.el --- Citar/Embark integration -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2022 Bruce D'Arcus +;; +;; Author: Bruce D'Arcus +;; Maintainer: Bruce D'Arcus +;; Created: June 22, 2022 +;; Modified: June 22, 2022 +;; Version: 1.0 +;; Keywords: bib extensions +;; Homepage: https://github.com/emacs-citar/citar-embark +;; Package-Requires: ((emacs "27.2") (embark "0.17") (citar "0.9.5")) +;; +;; This file is not part of GNU Emacs. +;; +;;; Commentary: +;; +;; Description +;; +;;; Code: + +(require 'citar) +(require 'embark) + +;;;; Keymaps + +(defvar citar-embark-map (make-composed-keymap citar-map embark-general-map) + "Keymap for Embark actions on Citar references.") + +;; TODO should this also inherit from `embark-general-map'? +(defvar citar-embark-citation-map (make-composed-keymap citar-citation-map nil) + "Keymap for Embark actions on Citar citations and keys.") + +;;;; Variables + +(defvar citar-embark--target-finders + (list #'citar-embark--key-finder + #'citar-embark--citation-finder)) + +(defvar citar-embark--candidate-collectors + (list #'citar-embark--selected)) + +(defvar citar-embark--transformer-alist + (list (cons 'citar-candidate #'citar-embark--candidate-transformer))) + +(defvar citar-embark--keymap-alist + '((citar-reference . citar-embark-map) ; minibuffer candidates + (citar-key . citar-embark-citation-map) ; at-point keys + (citar-citation . citar-embark-citation-map))) ; at-point citations + +(defvar citar-embark--multitarget-actions + (list #'citar-open #'citar-open-files #'citar-attach-files #'citar-open-links + #'citar-insert-bibtex #'citar-insert-citation #'citar-insert-reference + #'citar-copy-reference #'citar-insert-keys #'citar-run-default-action)) + +(defvar citar-embark--target-injection-hooks + (list (list #'citar-insert-edit #'embark--ignore-target))) + +;;;; At-point functions for Embark + +(defun citar-embark--key-finder () + "Return the citation key at point." + (when-let ((key (and (not (minibufferp)) (citar--key-at-point)))) + (cons 'citar-key key))) + +(defun citar-embark--citation-finder () + "Return the keys of the citation at point." + (when-let ((citation (and (not (minibufferp)) (citar--citation-at-point)))) + `(citar-citation ,(citar--stringify-keys (car citation)) . ,(cdr citation)))) + +(defun citar-embark--candidate-transformer (_type target) + "Look up key for a citar-reference TYPE and TARGET." + (cons 'citar-reference (citar--extract-candidate-citekey target))) + +(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))) + +;;;; Enable and disable Citar/Embark integration + +(defun citar-embark--enable () + "Add Citar-specific functions and keymaps to Embark." + (mapc (apply-partially #'add-hook 'embark-target-finders) + (reverse citar-embark--target-finders)) + (mapc (apply-partially #'add-hook 'embark-candidate-collectors) + (reverse citar-embark--candidate-collectors)) + (pcase-dolist (`(,type . ,transformer) citar-embark--transformer-alist) + (setf (alist-get type embark-transformer-alist) transformer)) + (pcase-dolist (`(,type . ,keymap) citar-embark--keymap-alist) + (setf (alist-get type embark-keymap-alist) keymap)) + (cl-callf cl-union embark-multitarget-actions citar-embark--multitarget-actions) + (pcase-dolist (`(,action . ,hooks) citar-embark--target-injection-hooks) + (cl-callf cl-union (alist-get action embark-target-injection-hooks) hooks))) + +(defun citar-embark--disable () + "Undo the effects of `citar-embark--enable'." + (mapc (apply-partially #'remove-hook 'embark-target-finders) + citar-embark--target-finders) + (mapc (apply-partially #'remove-hook 'embark-candidate-collectors) + citar-embark--candidate-collectors) + (cl-callf cl-set-difference embark-transformer-alist citar-embark--transformer-alist :test #'equal) + (cl-callf cl-set-difference embark-keymap-alist citar-embark--keymap-alist :test #'equal) + (cl-callf cl-set-difference embark-multitarget-actions citar-embark--multitarget-actions) + (pcase-dolist (`(,action . ,hooks) citar-embark--target-injection-hooks) + (when-let ((alistentry (assq action embark-target-injection-hooks))) + (cl-callf cl-set-difference (cdr alistentry) hooks) + (unless (cdr alistentry) ; if no other hooks, remove alist entry + (cl-callf2 remq alistentry embark-target-injection-hooks))))) + +;;;###autoload +(define-minor-mode citar-embark-mode + "Toggle integration between Citar and Embark." + :group 'citar + :global t + :init-value nil + :lighter " citar-embark" + (if citar-embark-mode + (citar-embark--enable) + (citar-embark--disable))) + +(provide 'citar-embark) +;;; citar-embark.el ends here diff --git a/citar-file.el b/citar-file.el index 9c8e88fc..7e68759b 100644 --- a/citar-file.el +++ b/citar-file.el @@ -27,7 +27,7 @@ (require 'cl-lib) (require 'subr-x)) (require 'seq) -(make-obsolete 'citar-format-note-function 'citar-create-note-function "1.0") +(require 'map) ;;; pre-1.0 API cleanup @@ -38,10 +38,10 @@ (make-obsolete-variable 'citar-file-extensions 'citar-library-file-extensions "1.0") -(declare-function citar--get-entry "citar") -(declare-function citar--get-value "citar") -(declare-function citar--get-template "citar") -(declare-function citar--format-entry-no-widths "citar") +(declare-function citar-get-value "citar") +(declare-function citar--bibliography-files "citar") +(declare-function citar--check-configuration "citar") +(declare-function citar--get-notes-config "citar") ;;;; File related variables @@ -67,10 +67,11 @@ :group 'citar :type '(function)) +;; TODO move this to citar.el for consistency with `citar-library-file-extensions'? (defcustom citar-file-note-extensions '("org" "md") "List of file extensions to filter for notes. -These are the extensions the `citar-open-note-function` +These are the extensions the `citar-open-note-function' will open, via `citar-open-notes'." :group 'citar :type '(repeat string)) @@ -105,57 +106,119 @@ separator that does not otherwise occur in citation keys." (if (stringp file-paths) ;; If path is a string, return as a list. (list (file-truename file-paths)) - (delete-dups - (mapcar - (lambda (p) (file-truename p)) file-paths)))) - -(defun citar-file--parser-default (dirs file-field) - "Return a list of files from DIRS and FILE-FIELD." - (let ((files (split-string file-field "[:;]"))) - (delete-dups - (seq-mapcat - (lambda (dir) - (mapcar - (lambda (file) - (expand-file-name file dir)) files)) - dirs)))) - -(defun citar-file--parser-triplet (dirs file-field) + (delete-dups (mapcar #'file-truename file-paths)))) + +;;;; Parsing file fields + +(defun citar-file--parser-default (file-field) + "Split FILE-FIELD by `;'." + (seq-remove + #'string-empty-p + (mapcar + #'string-trim + (citar-file--split-escaped-string file-field ?\;)))) + +(defun citar-file--parser-triplet (file-field) "Return a list of files from DIRS and a FILE-FIELD formatted as a triplet. This is file-field format seen in, for example, Calibre and Mendeley. Example: ':/path/to/test.pdf:PDF'." - (let ((parts (split-string file-field "[,;]" 'omit-nulls))) - (seq-mapcat - (lambda (part) - (let ((fn (car (split-string part ":" 'omit-nulls)))) - (mapcar (apply-partially #'expand-file-name fn) dirs))) - parts))) - -(defun citar-file--extension-p (filename extensions) - "Return non-nil if FILENAME extension is among EXTENSIONS." - (member (file-name-extension filename) extensions)) - -(defun citar-file--parse-file-field (entry fieldname &optional dirs extensions) - "Return files listed in FIELDNAME of ENTRY. -File names are expanded relative to the elements of DIRS. - -Filter by EXTENSIONS when present." - (unless dirs (setq dirs (list "/"))) ; make sure DIRS is non-nil - (let* ((filefield (citar--get-value fieldname entry)) - (files - (when filefield - (delete-dups - (seq-mapcat - (lambda (parser) - (funcall parser dirs filefield)) - citar-file-parser-functions))))) - (if extensions - (seq-filter - (lambda (fn) - (citar-file--extension-p fn extensions)) files) - files))) + (let (filenames) + (dolist (sepchar '(?\; ?,)) ; Mendeley and Zotero use ;, Calibre uses , + (dolist (substring (citar-file--split-escaped-string file-field sepchar)) + (let* ((triplet (citar-file--split-escaped-string substring ?:)) + (len (length triplet))) + (when (>= len 3) + ;; If there are more than three components, we probably split on unescaped : in the filename. + ;; Take all but the first and last components of TRIPLET and join them with : + (let* ((escaped (string-join (butlast (cdr triplet)) ":")) + (filename (replace-regexp-in-string "\\\\\\(.\\)" "\\1" escaped))) + ;; Calibre doesn't escape file names in BIB files, so try both + ;; See https://github.com/kovidgoyal/calibre/blob/master/src/calibre/library/catalogs/bibtex.py + (push filename filenames) + (push escaped filenames)))))) + (nreverse filenames))) + +(defun citar-file--parse-file-field (entry dirs &optional citekey) + "Return files found in file field of ENTRY. +Relative file names are expanded from the first directory in DIRS +in which they are found. Omit non-existing absolute file names +and relative file names not found in DIRS. On failure, print a +message explaining the cause; CITEKEY is included in this failure +message." + (when-let* ((fieldname citar-file-variable) + (fieldvalue (citar-get-value fieldname entry))) + (if-let ((files (delete-dups (mapcan (lambda (parser) + (funcall parser fieldvalue)) + citar-file-parser-functions)))) + (if-let ((foundfiles (citar-file--find-files-in-dirs files dirs))) + (if (null citar-library-file-extensions) + foundfiles + (or (seq-filter (lambda (file) + (member (file-name-extension file) citar-library-file-extensions)) + foundfiles) + (ignore + (message "No files for `%s' with `citar-library-file-extensions': %S" + citekey foundfiles)))) + (ignore + (message (concat "None of the files for `%s' exist; check `citar-library-paths' and " + "`citar-file-parser-functions': %S") + citekey files))) + (ignore + (if (string-empty-p (string-trim fieldvalue)) + (message "Empty `%s' field: %s" fieldname citekey) + (message "Could not parse `%s' field of `%s'; check `citar-file-parser-functions': %s" + fieldname citekey fieldvalue)))))) + +(defun citar-file--has-file-field (entries) + "Return predicate to test if bibliography entry in ENTRIES has a file field. +Note: this function is intended to be used in +`citar-has-files-functions'. Use `citar-has-files' to test +whether entries have associated files." + (when-let ((filefield citar-file-variable)) + (lambda (key) + (when-let ((entry (gethash key entries))) + (citar-get-value filefield entry))))) + +(defun citar-file--get-from-file-field (keys entries) + "Return list of FILES for KEYS given in ENTRIES. + +Parse and return files given in the bibliography field named by +`citar-file-variable'. + +Note: this function is intended to be used in +`citar-get-files-functions'. Use `citar-get-files' to get all +files associated with KEYS." + (when citar-file-variable + (citar--check-configuration 'citar-library-paths 'citar-library-file-extensions + 'citar-file-parser-functions) + (let ((dirs (append citar-library-paths + (mapcar #'file-name-directory (citar--bibliography-files))))) + (mapcan + (lambda (citekey) + (when-let ((entry (gethash citekey entries))) + (citar-file--parse-file-field entry dirs citekey))) + keys)))) + +;;;; Scanning library directories + +(defun citar-file--has-library-files (&optional _entries) + "Return predicate testing whether cite key has library files." + (citar--check-configuration 'citar-library-paths 'citar-library-file-extensions) + (let ((files (citar-file--directory-files + citar-library-paths nil citar-library-file-extensions + citar-file-additional-files-separator))) + (lambda (key) + (gethash key files)))) + +(defun citar-file--get-library-files (keys &optional _entries) + "Return list of files for KEYS in ENTRIES." + (citar--check-configuration 'citar-library-paths) + (let ((files (citar-file--directory-files citar-library-paths keys + citar-library-file-extensions + citar-file-additional-files-separator))) + (mapcan (lambda (key) (gethash key files)) keys))) (defun citar-file--make-filename-regexp (keys extensions &optional additional-sep) "Regexp matching file names starting with KEYS and ending with EXTENSIONS. @@ -164,20 +227,15 @@ that separates the key from optional additional text that follows it in matched file names. The returned regexp captures the key as group 1, the extension as group 2, and any additional text following the key as group 3." - (let* ((entry (when keys - (citar--get-entry (car keys)))) - (xref (citar--get-value "crossref" entry))) - (unless (or (null xref) (string-empty-p xref)) - (push xref keys)) - (when (and (null keys) (string-empty-p additional-sep)) - (setq additional-sep nil)) - (concat - "\\`" - (if keys (regexp-opt keys "\\(?1:") "\\(?1:[^z-a]*?\\)") - (when additional-sep (concat "\\(?3:" additional-sep "[^z-a]*\\)?")) - "\\." - (if extensions (regexp-opt extensions "\\(?2:") "\\(?2:[^.]*\\)") - "\\'"))) + (when (and (null keys) (string-empty-p additional-sep)) + (setq additional-sep nil)) + (concat + "\\`" + (if keys (regexp-opt keys "\\(?1:") "\\(?1:[^z-a]*?\\)") + (when additional-sep (concat "\\(?3:" additional-sep "[^z-a]*\\)?")) + "\\." + (if extensions (regexp-opt extensions "\\(?2:") "\\(?2:[^.]*\\)") + "\\'")) (defun citar-file--directory-files (dirs &optional keys extensions additional-sep) "Return files in DIRS starting with KEYS and ending with EXTENSIONS. @@ -198,15 +256,25 @@ separating the key from the additional text. When KEYS is nil and ADDITIONAL-SEP is non-nil, each file name is stored in the hash table under two keys: the base name of the -file and the portion of the file name preceding the first match +file; and the portion of the file name preceding the first match of ADDITIONAL-SEP. +When KEYS is nil, if ADDITIONAL-SEP is empty then it is treated +as being nil. In other words, this function can only scan a +directory for file names matching unknown keys if either + +1. The key is not followed by any additional text except for the + file extension. + +2. There is a non-empty ADDITIONAL-SEP between the key and any + following text. + Note: when KEYS and EXTENSIONS are non-nil and ADDITIONAL-SEP is nil, this function has an optimized implementation; it checks for existing files named \"KEY.EXT\" in DIRS, with KEY and EXT being the elements of KEYS and EXTENSIONS, respectively. It does not need to scan the contents of DIRS in this case." - (let ((files (make-hash-table :test #'equal)) + (let ((files (make-hash-table :test 'equal)) (filematch (unless (and keys extensions (not additional-sep)) (citar-file--make-filename-regexp keys extensions additional-sep)))) (prog1 files @@ -215,8 +283,7 @@ need to scan the contents of DIRS in this case." (if filematch ;; Use regexp to scan directory (dolist (file (directory-files dir nil filematch)) - (let ((key (if keys (car keys) - (and (string-match filematch file) (match-string 1 file)))) + (let ((key (and (string-match filematch file) (match-string 1 file))) (filename (expand-file-name file dir)) (basename (file-name-base file))) (push filename (gethash key files)) @@ -233,103 +300,6 @@ need to scan the contents of DIRS in this case." (puthash key (nreverse filelist) files)) files)))) -(defun citar-file--has-file-notes-hash () - "Return a hash of keys and file paths for notes." - (citar-file--directory-files - citar-notes-paths nil citar-file-note-extensions - citar-file-additional-files-separator)) - -(defun citar-file--has-library-files-hash () - "Return a hash of keys and file paths for library files." - (citar-file--directory-files - citar-library-paths nil citar-library-file-extensions - citar-file-additional-files-separator)) - -(defun citar-file--keys-with-file-notes () - "Return a list of keys with file notes." - (hash-table-keys (citar-file--has-file-notes-hash))) - -(defun citar-file--keys-with-library-files () - "Return a list of keys with file notes." - (hash-table-keys (citar-file--has-library-files-hash))) - -(defun citar-file-has-notes () - "Return a predicate testing whether a reference has associated notes." - (citar-file--has-file citar-notes-paths - citar-file-note-extensions)) - -(defun citar-file--has-file (dirs extensions &optional entry-field) - "Return predicate testing whether a key and entry have associated files. - -Files are found in two ways: - -- By scanning DIRS for files with EXTENSIONS using - `citar-file--directory-files`, which see. Its ADDITIONAL-SEP - argument is taken from `citar-file-additional-files-separator`. - -- When ENTRY-FIELD is non-nil, by parsing the entry field it - names using `citar-file--parse-file-field`; see its - documentation. DIRS is used to resolve relative paths and - non-existent files are ignored. - -Note: for performance reasons, this function should be called -once per command; the function it returns can be called -repeatedly." - (let ((files (citar-file--directory-files dirs nil extensions - citar-file-additional-files-separator))) - (lambda (key entry) - (let* ((xref (citar--get-value "crossref" entry)) - (cached (if (and xref - (not (eq 'unknown (gethash xref files 'unknown)))) - (gethash xref files 'unknown) - (gethash key files 'unknown)))) - (if (not (eq cached 'unknown)) - cached - ;; KEY has no files in DIRS, so check the ENTRY-FIELD field of - ;; ENTRY. This will run at most once for each KEY; after that, KEY - ;; in hash table FILES will either contain nil or a file name found - ;; in ENTRY. - (puthash key - (seq-some - #'file-exists-p - (citar-file--parse-file-field entry entry-field dirs extensions)) - files)))))) - -(defun citar-file--files-for-entry (key entry dirs extensions) - "Find files related to bibliography item KEY with metadata ENTRY. -See `citar-file--files-for-multiple-entries` for details on DIRS, -EXTENSIONS, and how files are found." - (citar-file--files-for-multiple-entries (list (cons key entry)) dirs extensions)) - -(defun citar-file--files-for-multiple-entries (key-entry-alist dirs extensions) - "Find files related to bibliography items in KEYS-ENTRIES. - -KEY-ENTRY-ALIST is a list of (KEY . ENTRY) pairs. Return a list -of files found in two ways: - -- By scanning directories in DIRS for files starting with keys in - KEYS-ENTRIES and having extensions in EXTENSIONS. The files - may also have additional text after the key, separated by the - value of `citar-file-additional-files-separator`. The scanning - is performed by `citar-file--directory-files`, which see. - -- By parsing the field named by `citar-file-variable` of the - entries in KEYS-ENTRIES. DIRS is used to resolve relative - paths and non-existent files are ignored; see - `citar-file--parse-file-field`." - (let* ((keys (seq-map #'car key-entry-alist)) - (files (citar-file--directory-files dirs keys extensions - citar-file-additional-files-separator))) - (delete-dups - (seq-mapcat - (lambda (key-entry) - (append - (gethash (car key-entry) files) - (seq-filter - #'file-exists-p - (citar-file--parse-file-field (cdr key-entry) citar-file-variable dirs extensions)))) - key-entry-alist)))) - ;;;; Opening and creating files functions (defun citar-file-open (file) @@ -351,6 +321,21 @@ of files found in two ways: nil 0 nil file))) +;;;; Note files + +(defun citar-file--get-notes-hash (&optional keys) + "Return hash-table with KEYS with file notes." + (citar-file--directory-files + citar-notes-paths keys citar-file-note-extensions + citar-file-additional-files-separator)) + +(defun citar-file-has-notes (&optional _entries) + "Return predicate testing whether cite key has associated notes." + ;; REVIEW why this optional arg when not needed? + (let ((files (citar-file--get-notes-hash))) + (lambda (key) + (gethash key files)))) + (defun citar-file--open-note (key entry) "Open a note file from KEY and ENTRY." (if-let* ((file (citar-file--get-note-filename key @@ -359,10 +344,16 @@ of files found in two ways: (file-exists (file-exists-p file))) (find-file file) (if (and (null citar-notes-paths) - (equal citar-create-note-function + (equal (citar--get-notes-config :action) 'citar-org-format-note-default)) (error "You must set 'citar-notes-paths'") - (funcall citar-create-note-function key entry file)))) + (funcall + (citar--get-notes-config :create) key entry)))) + +(defun citar-file--get-note-files (keys) + "Return list of notes associated with KEYS." + (let ((notehash (citar-file--get-notes-hash keys))) + (flatten-list (map-values notehash)))) (defun citar-file--get-note-filename (key dirs extensions) "Return existing or new filename for KEY in DIRS with extension in EXTENSIONS. @@ -379,5 +370,39 @@ function that will open a new file if the note is not present." (ext (car extensions))) (expand-file-name (concat key "." ext) dir))))) +;;;; Utility functions + +(defun citar-file--split-escaped-string (string sepchar) + "Split STRING into substrings at unescaped occurrences of SEPCHAR. +A character is escaped in STRING if it is preceded by `\\'. The +`\\' character can also escape itself. Return a list of +substrings of STRING delimited by unescaped occurrences of +SEPCHAR." + (let ((skip (format "^\\\\%c" sepchar)) + strings) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (progn (skip-chars-forward skip) (< (point) (point-max))) + (if (= ?\\ (following-char)) + (ignore-error 'end-of-buffer (forward-char 2)) + (push (delete-and-extract-region (point-min) (point)) strings) + (delete-char 1))) + (push (buffer-string) strings)) + (nreverse strings))) + +(defun citar-file--find-files-in-dirs (files dirs) + "Expand file names in FILES in DIRS and keep the ones that exist." + (let (foundfiles) + (dolist (file files) + (if (file-name-absolute-p file) + (when (file-exists-p file) (push (expand-file-name file) foundfiles)) + (when-let ((filepath (seq-some (lambda (dir) + (let ((filepath (expand-file-name file dir))) + (when (file-exists-p filepath) filepath))) + dirs))) + (push filepath foundfiles)))) + (nreverse foundfiles))) + (provide 'citar-file) ;;; citar-file.el ends here diff --git a/citar-filenotify.el b/citar-filenotify.el deleted file mode 100644 index d2ffc431..00000000 --- a/citar-filenotify.el +++ /dev/null @@ -1,202 +0,0 @@ -;;; citar-filenotify.el --- Filenotify functions for citar -*- lexical-binding: t; -*- -;; -;; Copyright (C) 2021 Bruce D'Arcus -;; -;; 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 . -;; -;;; Commentary: -;; -;; A companion to the citar for auto-invalidation and auto-refreshing -;; of cache when a bib file or a related file such notes directory or library -;; changes. Uses filenotify api to acheive this. -;; -;;; Code: - -(require 'filenotify) -(require 'files) -(require 'citar) - -(declare-function citar-refresh "citar") -(declare-function citar--local-files-to-cache "citar") -(declare-function citar-file--normalize-paths "citar-file") -(declare-function reftex-access-scan-info "ext:reftex") -(declare-function file-notify-add-watch "ext:file-notify") -(declare-function file-notify-rm-watch "ext:file-notify") - -;;;; Variables - -(defcustom citar-filenotify-callback 'invalidate-cache - "The callback that is run when the bibliography related files change. - -Its value can be either `invalidate-cache', `refresh-cache' or else a function. - -The function takes two arguments. - -The first is the scope, which is `global' when the changed file -is in `citar-filenotify-files' and `local' otherwise. - -The second is the change that occured. This is the argument that -the callback of `file-notify-add-watch' accepts, and is optional. -The callback is called without it when -`citar-filenotify-refresh' is run" - :group 'citar - :type '(choice (const invalidate-cache) - (const refresh-cache) - function)) - -(defcustom citar-filenotify-files '(bibliography) - "The files to watch using filenotify." - :group 'citar - :type '(repeat (choice (const bibliogrpahy) - (const library) - (const notes) - string))) - - -(defvar-local citar-filenotify--local-watches 'uninitialized) -(defvar citar-filenotify--global-watches nil) - -;;; Filenotify functions - -(defun citar-filenotify--invalidate-cache (&optional scope) - "Invalidate local or global caches according to SCOPE. -If it is other than `global' or `local' invalidate both." - (unless (eq 'local scope) - (setq citar--candidates-cache 'uninitialized)) - (unless (eq 'global scope) - (setq citar--local-candidates-cache 'uninitialized))) - -(defun citar-filenotify--make-default-callback (func scope &optional change) - "The callback FUNC by SCOPE used to update cache for default options. - -CHANGE refers to the notify argument." - (pcase (cadr change) - ((or 'nil 'changed) (funcall func scope)) - ((or 'created 'deleted 'renamed) - (if (member - (nth 2 change) - (seq-concatenate 'list - (citar-file--normalize-paths citar-bibliography) - (citar--local-files-to-cache))) - (citar-filenotify-refresh scope) - (funcall func scope))))) - -(defun citar-filenotify--callback (scope &optional change) - "A by SCOPE callback according to `citar-filenotify-callback'. - -This callback can be passed to the `file-notify-add-watch'. - -CHANGE refers to the filenotify argument." - (pcase citar-filenotify-callback - ('invalidate-cache (citar-filenotify--make-default-callback - #'citar-filenotify--invalidate-cache scope change)) - ('refresh-cache (citar-filenotify--make-default-callback - (lambda (x) (citar-refresh nil x)) scope change)) - (_ (funcall citar-filenotify-callback scope change)))) - -(defun citar-filenotify--add-local-watches () - "Add watches for the files that contribute to the local cache." - (let ((buffer (buffer-name))) - (setq citar-filenotify--local-watches - (seq-map - (lambda (bibfile) - (file-notify-add-watch - bibfile '(change) - (lambda (x) - (with-current-buffer buffer - (citar-filenotify--callback 'local x))))) - (citar--local-files-to-cache))))) - -(defun citar-filenotify-rm-local-watches () - "Delete the filenotify watches for the local bib files." - (mapc #'file-notify-rm-watch citar-filenotify--local-watches) - (setq citar-filenotify--local-watches 'uninitialized)) - -(defun citar-filenotify-local-watches () - "Hook to add and remove watches on local bib files. - -The watches are added only if `citar--local-watches' has the -default value `uninitialized'. This is to ensure that duplicate -watches aren't added. This means a mode hook containing this -function can run several times without adding duplicate watches." - (when (eq 'uninitialized citar-filenotify--local-watches) - (citar-filenotify--add-local-watches)) - (add-hook 'kill-buffer-hook #'citar-filenotify-rm-local-watches nil t)) - -(defun citar-filenotify--files () - "Get the list of files to watch from `citar-filenotify-files'." - (seq-mapcat (lambda (x) - (citar-file--normalize-paths - (pcase x - ('bibliography citar-bibliography) - ('library citar-library-paths) - ('notes citar-notes-paths) - (_ x)))) - citar-filenotify-files)) - -(defun citar-filenotify-global-watches () - "Add watches on the global files in `citar-filenotify-files'. - -Unlike `citar-filenotify-local-watches' these -watches have to be removed manually. To remove them call -`citar-rm-global-watches'" - (setq citar-filenotify--global-watches - (seq-map - (lambda (bibfile) - (file-notify-add-watch - bibfile '(change) - (lambda (x) - (citar-filenotify--callback 'global x)))) - (citar-filenotify--files)))) - -(defun citar-filenotify-rm-global-watches () - "Remove the watches on global bib files." - (interactive) - (mapc #'file-notify-rm-watch citar-filenotify--global-watches) - (setq citar-filenotify--global-watches nil)) - -(defun citar-filenotify-refresh (&optional scope) - "Refresh the watches by SCOPE on the bib files. - -This function only needs to be called if a bib file has been added or removed." - (interactive) - (unless (eq 'global scope) - (seq-map #'file-notify-rm-watch citar-filenotify--local-watches) - (reftex-access-scan-info t) - (citar-filenotify--add-local-watches) - (citar-filenotify--callback 'local)) - (unless (eq 'local scope) - (citar-filenotify-rm-global-watches) - (citar-filenotify-global-watches) - (citar-filenotify--callback 'global))) - -;;;; Interactive filenoify commands - -;;;###autoload -(defun citar-filenotify-setup (mode-hooks) - "Setup filenotify watches for local and global bibliography related files. - -This functions adds watches to the files in -`citar-filenotify-files' and adds a hook to the -major mode hooks in 'MODE-HOOKS' which adds watches for the -local bib files. These local watches are removed when the buffer -closes." - (citar-filenotify-global-watches) - (dolist (mode mode-hooks) - (add-hook mode #'citar-filenotify-local-watches))) - -(provide 'citar-filenotify) -;;; citar-filenotify.el ends here diff --git a/citar-format.el b/citar-format.el new file mode 100644 index 00000000..f7a5ca82 --- /dev/null +++ b/citar-format.el @@ -0,0 +1,173 @@ +;;; citar-format.el --- Formatting functions for citar -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2022 Bruce D'Arcus, Roshan Shariff +;; +;; 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 . +;; +;;; Commentary: +;; +;; Functions for formatting bibliography entries. +;; +;;; Code: + +(eval-when-compile + (require 'cl-lib)) + +(declare-function citar-get-display-value "citar") + + +;;; Formatting bibliography entries + + +(cl-defun citar-format--entry (format-string entry &optional width + &key hide-elided ellipsis) + "Format ENTRY according to FORMAT-STRING." + (let* ((fieldspecs (citar-format--parse format-string)) + (preform (citar-format--preformat fieldspecs entry + hide-elided ellipsis))) + (if width + (citar-format--star-widths (- width (car preform)) (cdr preform) + hide-elided ellipsis) + (apply #'concat (cdr preform))))) + + +;;; Pre-formatting bibliography entries + + +(defun citar-format--preformat (fieldspecs entry hide-elided ellipsis) + "Pre-format ENTRY using parsed format string FIELDSPECS. +FIELDSPECS should be the result of `citar-format--parse'. See the +documentation of `citar-format--string' for the meaning of +HIDE-ELIDED and ELLIPSIS." + (let ((preformatted nil) + (fields "") + (width 0)) + (dolist (fieldspec fieldspecs) + (pcase fieldspec + ((pred stringp) + (cl-callf concat fields fieldspec) + (cl-incf width (string-width fieldspec))) + (`(,props . ,fieldnames) + (let* ((fieldwidth (plist-get props :width)) + (textprops (plist-get props :text-properties)) + (value (citar-get-display-value fieldnames entry)) + (display (citar-format--string value + :width fieldwidth + :text-properties textprops + :hide-elided hide-elided + :ellipsis ellipsis))) + (cond + ((eq '* fieldwidth) + (push fields preformatted) + (setq fields "") + (push display preformatted)) + (t + (cl-callf concat fields display) + (cl-incf width (if (numberp fieldwidth) + fieldwidth + (string-width value))))))))) + (unless (string-empty-p fields) + (push fields preformatted)) + (cons width (nreverse preformatted)))) + + +;;; Internal implementation functions + + +(cl-defsubst citar-format--string (string + &key width text-properties hide-elided ellipsis) + "Truncate STRING to WIDTH and apply TEXT-PROPERTIES. +If HIDE-ELIDED is non-nil, the truncated part of STRING is +covered by a display property that makes it invisible, instead of +being deleted. ELLIPSIS, when non-nil, specifies a string to +display instead of the truncated part of the text." + (when text-properties + (setq string (apply #'propertize string text-properties))) + (when (numberp width) + (setq string (truncate-string-to-width string width 0 ?\s ellipsis hide-elided))) + string) + + +(defun citar-format--star-widths (alloc strings &optional hide-elided ellipsis) + "Concatenate STRINGS and truncate every other element to fit in ALLOC. +Use this function along with `citar-format--preformat' to fit a +formatted string to a desired display width; see +`citar-format--entry' for how to do this. + +Return a string consisting of the concatenated elements of +STRINGS. The odd-numbered elements are included as-is, while the +even-numbered elements are padded or truncated to a total width +of ALLOC, which must be an integer. All these odd-numbered +elements are allocated close-to-equal widths. + +Perform the truncation using `citar-format--string', which see +for the meaning of HIDE-ELIDED and ELLIPSIS." + (let ((nstars (/ (length strings) 2))) + (if (= 0 nstars) + (or (car strings) "") + (cl-loop + with alloc = (max 0 alloc) + with starwidth = (/ alloc nstars) + with remainder = (% alloc nstars) + with formatted = (car strings) + for (starstring following) on (cdr strings) by #'cddr + for nthstar from 1 + do (let* ((starwidth (if (> nthstar remainder) starwidth + (1+ starwidth))) + (starstring (citar-format--string + starstring + :width starwidth + :hide-elided hide-elided :ellipsis ellipsis))) + (cl-callf concat formatted starstring following)) + finally return formatted)))) + + +;;; Parsing format strings + + +(defun citar-format--parse (format-string) + "Parse FORMAT-STRING." + (let ((regex (concat "\\${" ; ${ + "\\(.*?\\)" ; field names + "\\(?::[[:blank:]]*" ; : + space + "\\(.*?\\)" ; format spec + "[[:blank:]]*\\)?}")) ; space + } + (position 0) + (fieldspecs nil)) + (while (string-match regex format-string position) + (let* ((begin (match-beginning 0)) + (end (match-end 0)) + (textprops (text-properties-at begin format-string)) + (fieldnames (match-string-no-properties 1 format-string)) + (spec (match-string-no-properties 2 format-string)) + (width (cond + ((or (null spec) (string-empty-p spec)) nil) + ((string-equal spec "*") '*) + (t (string-to-number spec))))) + (when (< position begin) + (push (substring format-string position begin) fieldspecs)) + (push (cons (nconc (when width `(:width ,width)) + (when textprops `(:text-properties ,textprops))) + (split-string-and-unquote fieldnames)) + fieldspecs) + (setq position end))) + (when (< position (length format-string)) + (push (substring format-string position) fieldspecs)) + (nreverse fieldspecs))) + + +(provide 'citar-format) +;;; citar-format.el ends here diff --git a/citar-latex.el b/citar-latex.el index 7466c2a6..8b1ba3a8 100644 --- a/citar-latex.el +++ b/citar-latex.el @@ -172,7 +172,7 @@ whether or not to prompt. The availiable commands and how to provide them arguments are configured by `citar-latex-cite-commands'. -If `citar-latex-prompt-for-extra-arguments' is `nil`, every +If `citar-latex-prompt-for-extra-arguments' is nil, every command is assumed to have a single argument into which keys are inserted." (when keys @@ -203,11 +203,10 @@ inserted." (skip-chars-forward "^}") (forward-char 1))) ;;;###autoload -(defun citar-latex-insert-edit (&optional arg) +(defun citar-latex-insert-edit (&optional _arg) "Prompt for keys and call `citar-latex-insert-citation. With ARG non-nil, rebuild the cache before offering candidates." - (citar-latex-insert-citation - (citar--extract-keys (citar-select-refs :rebuild-cache arg)))) + (citar-latex-insert-citation (citar-select-refs))) (defun citar-latex--select-command () "Complete a citation command for LaTeX." @@ -218,7 +217,7 @@ With ARG non-nil, rebuild the cache before offering candidates." citar-latex-default-cite-command nil)) (defun citar-latex--is-a-cite-command (command) - "Return element of `citar-latex-cite-commands` containing COMMAND." + "Return element of `citar-latex-cite-commands' containing COMMAND." (seq-find (lambda (x) (member command (car x))) citar-latex-cite-commands)) diff --git a/citar-markdown.el b/citar-markdown.el index 8d706e08..f10300c2 100644 --- a/citar-markdown.el +++ b/citar-markdown.el @@ -66,7 +66,7 @@ If point is immediately after the opening \[, add new keys to the beginning of the citation. If INVERT-PROMPT is non-nil, invert the meaning of -`citar-markdown-prompt-for-extra-arguments`." +`citar-markdown-prompt-for-extra-arguments'." (let* ((citation (citar-markdown-citation-at-point)) (keys (if citation (seq-difference keys (car citation)) keys)) (keyconcat (mapconcat (lambda (k) (concat "@" k)) keys "; ")) @@ -86,18 +86,17 @@ If INVERT-PROMPT is non-nil, invert the meaning of (insert "; " keyconcat)))))) ;;;###autoload -(defun citar-markdown-insert-edit (&optional arg) +(defun citar-markdown-insert-edit (&optional _arg) "Prompt for keys and call `citar-markdown-insert-citation. With ARG non-nil, rebuild the cache before offering candidates." - (citar-markdown-insert-citation - (citar--extract-keys (citar-select-refs :rebuild-cache arg)))) + (citar-markdown-insert-citation (citar-select-refs))) ;;;###autoload (defun citar-markdown-key-at-point () "Return citation key at point (with its bounds) for pandoc markdown citations. Returns (KEY . BOUNDS), where KEY is the citation key at point and BOUNDS is a pair of buffer positions. Citation keys are -found using `citar-markdown-citation-key-regexp`. Returns nil if +found using `citar-markdown-citation-key-regexp'. Returns nil if there is no key at point." (interactive) (when (thing-at-point-looking-at citar-markdown-citation-key-regexp) @@ -109,7 +108,7 @@ there is no key at point." "Return keys of citation at point. Find balanced expressions starting and ending with square brackets and containing at least one citation key (matching -`citar-markdown-citation-key-regexp`). Return (KEYS . BOUNDS), +`citar-markdown-citation-key-regexp'). Return (KEYS . BOUNDS), where KEYS is a list of the found citation keys and BOUNDS is a pair of buffer positions indicating the start and end of the citation." diff --git a/citar-org.el b/citar-org.el index b04327d5..3e621bfb 100644 --- a/citar-org.el +++ b/citar-org.el @@ -163,8 +163,8 @@ With PROC list, limit to specific processor(s)." (defun citar-org-select-key (&optional multiple) "Return a list of keys when MULTIPLE, or else a key string." (if multiple - (citar--extract-keys (citar-select-refs)) - (car (citar-select-ref)))) + (citar-select-refs) + (citar-select-ref))) ;;;###autoload (defun citar-org-insert-citation (keys &optional style) @@ -197,7 +197,7 @@ With PROC list, limit to specific processor(s)." ;;;###autoload (defun citar-org-insert-edit (&optional arg) - "Run `org-cite-insert` with citar insert processor. + "Run `org-cite-insert' with citar insert processor. ARG is used as the prefix argument." (let ((org-cite-insert-processor 'citar)) (org-cite-insert arg))) @@ -263,12 +263,12 @@ strings by style." ;;; Org note function (defun citar-org--id-get-create (&optional force) - "Call `org-id-get-create` while maintaining point. + "Call `org-id-get-create' while maintaining point. If point is at the beginning of the buffer and a new properties drawer is created, move point after the drawer. -More generally, if `org-id-get-create` inserts text at point, +More generally, if `org-id-get-create' inserts text at point, move point after the insertion. With optional argument FORCE, force the creation of a new ID." @@ -289,14 +289,14 @@ With optional argument FORCE, force the creation of a new ID." (ignore-errors (org-roam-ref-add (concat "@" key))))) ;;;###autoload -(defun citar-org-format-note-default (key entry filepath) - "Format a note FILEPATH from KEY and ENTRY." +(defun citar-org-format-note-default (key entry) + "Format a note from KEY and ENTRY." (let* ((template (citar--get-template 'note)) - (note-meta - (when template - (citar--format-entry-no-widths - entry - template))) + (note-meta (when template + (citar-format--entry template entry))) + (filepath (expand-file-name + (concat key ".org") + (car citar-notes-paths))) (buffer (find-file filepath))) (with-current-buffer buffer ;; This just overrides other template insertion. diff --git a/citar.el b/citar.el index 8260ae39..85dd8b3a 100644 --- a/citar.el +++ b/citar.el @@ -41,49 +41,49 @@ (require 'subr-x)) (require 'seq) (require 'browse-url) +(require 'citar-cache) +(require 'citar-format) (require 'citar-file) -(require 'parsebib) -(require 'crm) ;;; pre-1.0 API cleanup ;; make public ;; (make-obsolete 'citar--get-candidates 'citar-get-candidates "1.0") +;; Renamed in 1.0 +(make-obsolete 'citar-has-file #'citar-has-files "1.0") +(make-obsolete 'citar-has-note #'citar-has-notes "1.0") +(make-obsolete 'citar-open-library-file #'citar-open-files "1.0") +(make-obsolete 'citar-attach-library-file #'citar-attach-files "1.0") +(make-obsolete 'citar-open-link #'citar-open-links "1.0") +(make-obsolete 'citar-get-link #'citar-get-links "1.0") ; now returns list +(make-obsolete 'citar-display-value 'citar-get-display-value "1.0") + ;; make all these private +(make-obsolete 'citar-clean-string 'citar--clean-string "1.0") +(make-obsolete 'citar-shorten-names 'citar--shorten-names "1.0") (make-obsolete 'citar-get-template 'citar--get-template "1.0") -(make-obsolete 'citar-get-link 'citar--get-link "1.0") -(make-obsolete 'citar-get-value 'citar--get-value "1.0") -(make-obsolete 'citar-display-value 'citar--display-value "1.0") (make-obsolete 'citar-open-multi 'citar--open-multi "1.0") (make-obsolete 'citar-select-group-related-resources 'citar--select-group-related-resources "1.0") (make-obsolete 'citar-select-resource 'citar--select-resource "1.0") ;; also rename -(make-obsolete 'citar-has-a-value 'citar--field-with-value "1.0") +(make-obsolete 'citar-has-a-value 'citar-get-field-with-value "0.9.5") ; now returns cons pair +(make-obsolete 'citar-field-with-value 'citar-get-field-with-value "1.0") ; now returns cons pair (make-obsolete 'citar--open-note 'citar-file--open-note "1.0") -(make-obsolete-variable - 'citar-format-note-function 'citar-create-note-function "1.0") +;;(make-obsolete-variable 'citar-format-note-function "1.0") ;;; Declare variables and functions for byte compiler -(defvar embark-keymap-alist) -(defvar embark-target-finders) -(defvar embark-pre-action-hooks) -(defvar embark-general-map) -(defvar embark-meta-map) -(defvar embark-transformer-alist) -(defvar embark-multitarget-actions) (defvar embark-default-action-overrides) -(defvar embark-candidate-collectors) - -(declare-function embark--target-buffer "ext:embark") -(declare-function embark--metadata "ext:embark") +(declare-function citar-org-format-note-default "citar-org") ;;; Variables +;;;; Faces + (defgroup citar nil "Citations and bibliography management." :group 'editing) @@ -103,6 +103,8 @@ "Face used for the currently selected candidates." :group 'citar) +;;;; Bibliography, file, and note paths + (defcustom citar-bibliography nil "A list of bibliography files." :group 'citar @@ -128,7 +130,18 @@ When nil, the function will not filter the list of files." :group 'citar :type '(repeat directory)) -(defcustom citar-additional-fields '("doi" "url" "crossref") +(defcustom citar-crossref-variable "crossref" + "The bibliography field to look for cross-referenced entries. + +When non-nil, find associated files and notes not only in the +original entry, but also in entries specified in the field named +by this variable." + :group 'citar + :type '(choice (const "crossref") + (string :tag "Field name") + (const :tag "Ignore cross-references" nil))) + +(defcustom citar-additional-fields '("doi" "url" "pmcid" "pmid") "A list of fields to add to parsed data. By default, citar filters parsed data based on the fields @@ -137,6 +150,8 @@ to include." :group 'citar :type '(repeat string)) +;;;; Displaying completions and formatting + (defcustom citar-templates '((main . "${author editor:30} ${date year issued:4} ${title:48}") (suffix . " ${=key= id:15} ${=type=:12} ${tags keywords keywords:*}") @@ -152,6 +167,19 @@ for the title field for new notes." :value-type string :options (main suffix preview note))) +(defcustom citar-ellipsis nil + "Ellipsis string to mark ending of truncated display fields. + +If t, use the value of `truncate-string-ellipsis'. If nil, no +ellipsis will be used. Otherwise, this should be a non-empty +string specifying the ellipsis." + :group 'citar + :type '(choice (const :tag "Use `truncate-string-ellipsis'" t) + (const :tag "No ellipsis" nil) + (const "…") + (const "...") + (string :tag "Ellipsis string"))) + (defcustom citar-format-reference-function #'citar-format-reference "Function used to render formatted references. @@ -171,8 +199,8 @@ references as a string." (defcustom citar-display-transform-functions ;; TODO change this name, as it might be confusing? - '((t . citar-clean-string) - (("author" "editor") . citar-shorten-names)) + '((t . citar--clean-string) + (("author" "editor") . citar--shorten-names)) "Configure transformation of field display values from raw values. All functions that match a particular field are run in order." @@ -201,14 +229,7 @@ the same width." :group 'citar :type 'string) -(defcustom citar-force-refresh-hook nil - "Hook run when user forces a (re-) building of the candidates cache. -This hook is only called when the user explicitly requests the -cache to be rebuilt. It is intended for \"heavy\" operations -which recreate entire bibliography files using an external -reference manager like Zotero or JabRef." - :group 'citar - :type 'hook) +;;;; Citar actions and other miscellany (defcustom citar-default-action #'citar-open "The default action for the `citar-at-point' command. @@ -232,46 +253,54 @@ If nil, single resources will open without prompting." :group 'citar :type '(boolean)) -;;; Note-handling setup +;;;; File, note, and URL handling -(defcustom citar-open-note-functions - '(citar-file--open-note) - "List of functions to open a note." +(defcustom citar-has-files-functions (list #'citar-file--has-file-field + #'citar-file--has-library-files) + "List of functions to test if an entry has associated files." :group 'citar - :type '(function)) - -(defcustom citar-has-note-functions - '(citar-file-has-notes) - "Functions used for displaying note indicators. + :type '(repeat function)) -Such functions must take arguments KEY and ENTRY and return -non-nil when the reference has associated notes." +(defcustom citar-get-files-functions (list #'citar-file--get-from-file-field + #'citar-file--get-library-files) + "List of functions to find files associated with entries." :group 'citar - :type '(function)) + :type '(repeat function)) -(defcustom citar-open-note-function - 'citar--open-note - "Function to open a new or existing note. +(defcustom citar-notes-sources + `((citar-file . + ,(list :name "Notes" + :category 'file + :hasnote #'citar-file-has-notes + :action #'citar-file--open-note + :create #'citar-org-format-note-default ; TODO remove? + :items #'citar-file--get-note-files))) + "The alist of notes backends available for configuration. -A note function must take two arguments: +The format of the cons should be (NAME . PLIST), where the +plist has the following properties: -KEY: a string to represent the citekey -ENTRY: an alist with the structured data (title, author, etc.)" - :group 'citar - :type 'function) + :name the group display name + + :category the completion category + + :hasnote function to test for keys with notes -(defcustom citar-create-note-function - 'citar-org-format-note-default - "Function to create a new note. + :action function to open a given note candidate -A note function must take three arguments: + :items function to return candidate strings for keys -KEY: a string to represent the citekey -ENTRY: an alist with the structured data (title, author, etc.) -FILEPATH: the file name." + :annotate annotation function (optional)" :group 'citar - :type 'function) + :type '(alist :key-type symbol :value-type plist)) + +(defcustom citar-notes-source 'citar-file + "The notes backend." + :group 'citar + :type 'symbol) +;; TODO Move this to `citar-org', since it's only used there? +;; Otherwise it seems to overlap with `citar-default-action' (defcustom citar-at-point-function #'citar-dwim "The function to run for `citar-at-point'." :group 'citar @@ -339,7 +368,7 @@ of all citations in the current buffer." :group 'citar :type 'alist) -;;; History, including future history list. +;;;; History, including future history list. (defvar citar-history nil "Search history for `citar'.") @@ -349,7 +378,13 @@ of all citations in the current buffer." :group 'citar :type '(repeat string)) -;;; Keymaps +(defcustom citar-select-multiple t + "Use `completing-read-multiple' for selecting citation keys. +When nil, all citar commands will use `completing-read'." + :type 'boolean + :group 'citar) + +;;;; Keymaps (defvar citar-map (let ((map (make-sparse-keymap))) @@ -360,9 +395,9 @@ of all citations in the current buffer." (define-key map (kbd "b") #'citar-insert-bibtex) (define-key map (kbd "o") #'citar-open) (define-key map (kbd "e") #'citar-open-entry) - (define-key map (kbd "l") #'citar-open-link) + (define-key map (kbd "l") #'citar-open-links) (define-key map (kbd "n") #'citar-open-notes) - (define-key map (kbd "f") #'citar-open-library-file) + (define-key map (kbd "f") #'citar-open-files) (define-key map (kbd "RET") #'citar-run-default-action) map) "Keymap for Embark minibuffer actions.") @@ -372,54 +407,74 @@ of all citations in the current buffer." (define-key map (kbd "i") #'citar-insert-edit) (define-key map (kbd "o") #'citar-open) (define-key map (kbd "e") #'citar-open-entry) - (define-key map (kbd "l") #'citar-open-link) + (define-key map (kbd "l") #'citar-open-links) (define-key map (kbd "n") #'citar-open-notes) - (define-key map (kbd "f") #'citar-open-library-file) + (define-key map (kbd "f") #'citar-open-files) (define-key map (kbd "r") #'citar-copy-reference) (define-key map (kbd "RET") #'citar-run-default-action) map) "Keymap for Embark citation-key actions.") -;;; Completion functions +;;; Bibliography cache + +(defun citar--bibliography-files (&rest buffers) + "Bibliography file names for BUFFERS. +The elements of BUFFERS are either buffers or the symbol 'global. +Returns the absolute file names of the bibliographies in all +these contexts. + +When BUFFERS is nil, return local bibliographies for the current +buffer and global bibliographies." + (citar-file--normalize-paths + (mapcan (lambda (buffer) + (if (eq buffer 'global) + (if (listp citar-bibliography) citar-bibliography + (list citar-bibliography)) + (with-current-buffer buffer + (citar--major-mode-function 'local-bib-files #'ignore)))) + (or buffers (list (current-buffer) 'global))))) + +(defun citar--bibliographies (&rest buffers) + "Return bibliographies for BUFFERS." + (delete-dups + (mapcan + (lambda (buffer) + (citar-cache--get-bibliographies (citar--bibliography-files buffer) buffer)) + (or buffers (list (current-buffer) 'global))))) -(defcustom citar-select-multiple t - "Use `completing-read-multiple' for selecting citation keys. -When nil, all citar commands will use `completing-read`." - :type 'boolean - :group 'citar) +;;; Completion functions (defun citar--completion-table (candidates &optional filter &rest metadata) "Return a completion table for CANDIDATES. -CANDIDATES is an alist with entries (CAND KEY . ENTRY), where - CAND is a display string for the bibliography item given - by (KEY . ENTRY). +CANDIDATES is a hash with references CAND as key and CITEKEY as value, + where CAND is a display string for the bibliography item. FILTER, if non-nil, should be a predicate function taking - arguments KEY and ENTRY. Only candidates for which this - function returns non-nil will be offered for completion. + argument KEY. Only candidates for which this function returns + non-nil will be offered for completion. By default the metadata of the table contains the category and affixation function. METADATA are extra entries for metadata of the form (KEY . VAL). -The returned completion table can be used with `completing-read` +The returned completion table can be used with `completing-read' and other completion functions." - (let ((metadata `(metadata . ((category . citar-reference) - . ((affixation-function . ,#'citar--affixation) + (let ((metadata `(metadata . ((category . citar-candidate) + . ((affixation-function . ,#'citar--ref-affix) . ,metadata))))) (lambda (string predicate action) (if (eq action 'metadata) metadata + ;; REVIEW this now works, but probably needs refinement (let ((predicate (when (or filter predicate) - (lambda (cand-key-entry) - (pcase-let ((`(,cand ,key . ,entry) cand-key-entry)) - (and (or (null filter) (funcall filter key entry)) - (or (null predicate) (funcall predicate cand)))))))) + (lambda (_ key) + (and (or (null filter) (funcall filter key)) + (or (null predicate) (funcall predicate string))))))) (complete-with-action action candidates string predicate)))))) -(cl-defun citar-select-ref (&optional &key rebuild-cache multiple filter) +(cl-defun citar-select-refs (&key (multiple t) filter) "Select bibliographic references. A wrapper around `completing-read' that returns (KEY . ENTRY), @@ -429,9 +484,6 @@ data. Takes the following optional keyword arguments: -REBUILD-CACHE: if t, forces rebuilding the cache before offering - the selection candidates. - MULTIPLE: if t, calls `completing-read-multiple' and returns an alist of (KEY . ENTRY) pairs. @@ -440,49 +492,30 @@ FILTER: if non-nil, should be a predicate function taking function returns non-nil will be offered for completion. For example: - (citar-select-ref :filter (citar-has-file)) - (citar-select-ref :filter (citar-has-note)) - (citar-select-ref - :filter (lambda (_key entry) - (when-let ((keywords (assoc-default \"keywords\" entry))) - (string-match-p \"foo\" keywords))))" - (let* ((candidates (citar--get-candidates rebuild-cache)) + (citar-select-ref :filter (citar-has-file))" + (let* ((candidates (or (citar--format-candidates) + (user-error "No bibliography set"))) (chosen (if (and multiple citar-select-multiple) (citar--select-multiple "References: " candidates filter 'citar-history citar-presets) (completing-read "Reference: " (citar--completion-table candidates filter) - nil nil nil 'citar-history citar-presets nil))) - (notfound nil) - (keyentries - (seq-mapcat - ;; Find citation key-entry of selected candidate. - ;; CHOICE is either the formatted candidate string, or the citation - ;; key when called through `embark-act`. To handle both cases, test - ;; CHOICE against the first two elements of the entries of - ;; CANDIDATES. See - ;; https://github.com/bdarcus/citar/issues/233#issuecomment-901536901 - (lambda (choice) - (if-let ((cand (seq-find - (lambda (cand) (member choice (seq-take cand 2))) - candidates))) - (list (cdr cand)) - ;; If not found, add CHOICE to NOTFOUND and return nil - (push choice notfound) - nil)) - (if (listp chosen) chosen (list chosen))))) - (when notfound - (message "Keys not found: %s" (mapconcat #'identity notfound "; "))) - (if multiple keyentries (car keyentries)))) - -(cl-defun citar-select-refs (&optional &key rebuild-cache filter) + nil nil nil 'citar-history citar-presets nil)))) + ;; Return a list of keys regardless of 1 or many + (if (stringp chosen) + (list (gethash chosen candidates)) + (seq-map + (lambda (choice) + (gethash choice candidates)) + chosen)))) + +(cl-defun citar-select-ref (&key filter) "Select bibliographic references. -Call `citar-select-ref' with argument `:multiple'; see its -documentation for the return value and the meaning of -REBUILD-CACHE and FILTER." - (citar-select-ref :rebuild-cache rebuild-cache :multiple t :filter filter)) +Call 'citar-select-ref' with argument ':multiple, and optional +FILTER; see its documentation for the return value." + (car (citar-select-refs :multiple nil :filter filter))) (defun citar--multiple-completion-table (selected-hash candidates filter) "Return a completion table for multiple selection. @@ -530,7 +563,7 @@ HISTORY is the `completing-read' history argument." (completing-read (format "%s (%s/%s): " prompt (hash-table-count selected-hash) - (length candidates)) + (hash-table-count candidates)) (citar--multiple-completion-table selected-hash candidates filter) nil t nil history `("" . ,def))))) (unless (equal item "") @@ -543,38 +576,162 @@ HISTORY is the `completing-read' history argument." (equal item ""))))) (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 - (lambda (cand) - (abbreviate-file-name cand)) - files)) - (resources (append files (remq nil links)))) - (dolist (item resources) - (cond ((string-match "http" item 0) - (push (propertize item 'multi-category `(url . ,item)) resources)) - (t - (push (propertize item 'multi-category `(file . ,item)) resources)))) - (completing-read - "Select resource: " - (lambda (string predicate action) - (if (eq action 'metadata) - `(metadata - (group-function . citar--select-group-related-resources) - (category . multi-category)) - (complete-with-action action (delete-dups resources) string predicate)))))) +(defun citar--add-notep-prop (candidate) + "Add a note resource CANDIDATE with 'notep t'." + (propertize candidate 'notep t)) + +(cl-defun citar--get-resource-candidates (keys &key files notes links) + "Return related resource candidates for KEYS. + +Optionally constrain to FILES, NOTES, and/or LINKS." + (let* ((filesource + (when files + (cons 'file + (let ((citar-library-file-extensions nil)) + (citar-get-files keys))))) + (linksource + (when links + (cons 'url (citar-get-links keys)))) + (notesource + (when notes + (let* ((cat (citar--get-notes-config :category)) + (items (citar--get-notes-config :items)) + (items (if (functionp items) (funcall items keys) items)) + (items (mapcar #'citar--add-notep-prop items))) + (cons cat items)))) + (sources (list filesource linksource notesource)) + (candidates (list)) + ;; REVIEW initially I deleted nil sources, but I think that's overkill? + (multicat (< 1 (length sources)))) + (progn + (dolist (source sources) + (let ((cat (car source))) + (dolist (cand (cdr source)) + (push + (if multicat + (propertize cand 'multi-category (cons cat cand)) cand) + candidates)))) + candidates))) + +(defun citar--multi-annotate (cand) + "Annotate candidate CAND with `consult--multi' type." + ;; Adapted from 'consult' + (let* ((nodecat (car (get-text-property 0 'multi-category cand))) + (notecat (citar--get-notes-config :category)) + (annotate (citar--get-notes-config :annotate)) + (ann (when (and annotate (string= nodecat notecat)) + (funcall annotate (cdr (get-text-property 0 'multi-category cand)))))) + ann)) + +(cl-defun citar--select-resource (keys &optional &key files notes links) + ;; FIX the arg list above is not smart + "Select related FILES, NOTES, or LINKS resource for KEYS." + (if-let ((resources + (citar--get-resource-candidates + keys :files files :notes notes :links links))) + (completing-read + "Select resource: " + (lambda (string predicate action) + (if (eq action 'metadata) + `(metadata + (group-function . citar--select-group-related-resources) + (annotation-function . citar--multi-annotate) + (category . multi-category)) + (complete-with-action action resources string predicate)))))) (defun citar--select-group-related-resources (resource transform) "Group RESOURCE by type or TRANSFORM." - (let ((extension (file-name-extension resource))) - (if transform - (if (file-regular-p resource) - (file-name-nondirectory resource) - resource) - (cond - ((member extension citar-file-note-extensions) "Notes") - ((string-match "http" resource 0) "Links") - (t "Library Files"))))) + (if transform + (if (file-regular-p resource) + (file-name-nondirectory resource) + resource) + (let ((cat (car (get-text-property 0 'multi-category resource))) + (notep (get-text-property 0 'notep resource))) + ;; If note, assign to note group; otherwise use completion category. + (if notep (citar--get-notes-config :name) + (pcase cat + ('file "Library Files") + ('url "Links")))))) + +(cl-defun citar--format-candidates (&key (bibs (citar--bibliographies)) + (entries (citar-cache--entries bibs))) + "Format completion candidates for ENTRIES. + +BIBS should be a list of `citar-cache--bibliography' objects that +are the source of ENTRIES. Use the pre-formatted strings in BIBS +to format candidates. + +Return a hash table with the keys being completion candidate +strings and values being citation keys. Return nil if BIBS is +nil." + ;; Populate bibliography cache. + (when bibs + (let* ((preformatted (citar-cache--preformatted bibs)) + (hasfilesp (citar-has-files :entries entries)) + (hasnotesp (citar-has-notes :entries entries)) + (haslinksp (citar-has-links :entries entries)) + (hasfilestag (propertize " has:files" 'invisible t)) + (hasnotestag (propertize " has:notes" 'invisible t)) + (haslinkstag (propertize " has:links" 'invisible t)) + (symbolswidth (string-width (citar--symbols-string t t t))) + (width (- (frame-width) symbolswidth 2)) + (completions (make-hash-table :test 'equal :size (hash-table-count entries)))) + (maphash + (lambda (citekey _entry) + (let* ((hasfiles (and hasfilesp (funcall hasfilesp citekey))) + (hasnotes (and hasnotesp (funcall hasnotesp citekey))) + (haslinks (and haslinksp (funcall haslinksp citekey))) + (preform (or (gethash citekey preformatted) + (error "No preformatted candidate string: %s" citekey))) + (display (citar-format--star-widths + (- width (car preform)) (cdr preform) + t citar-ellipsis)) + (tagged (if (not (or hasfiles hasnotes haslinks)) + display + (concat display + (when hasfiles hasfilestag) + (when hasnotes hasnotestag) + (when haslinks haslinkstag))))) + (puthash tagged citekey completions))) + entries) + completions))) + +(defun citar--extract-candidate-citekey (candidate) + "Extract the citation key from string CANDIDATE." + (unless (string-empty-p candidate) + (if (= ?\" (aref candidate 0)) + (read candidate) + (substring-no-properties candidate 0 (seq-position candidate ?\s #'=))))) + +(defun citar--key-at-point () + "Return bibliography key at point in current buffer, along with its bounds. +Return (KEY . BOUNDS), where KEY is a string and BOUNDS is either +nil or a (BEG . END) pair indicating the location of KEY in the +buffer. Return nil if there is no key at point or the current +major mode is not supported." + (citar--major-mode-function 'key-at-point #'ignore)) + +(defun citar--citation-at-point () + "Return citation at point in current buffer, along with its bounds. +Return (KEYS . BOUNDS), where KEYS is a list of citation keys and +BOUNDS is either nil or a (BEG . END) pair indicating the +location of the citation in the buffer. Return nil if there is no +citation at point or the current major mode is not supported." + (citar--major-mode-function 'citation-at-point #'ignore)) + +(defun citar-key-at-point () + "Return the citation key at point in the current buffer. +Return nil if there is no key at point or the major mode is not +supported." + (car (citar--key-at-point))) + +(defun citar-citation-at-point () + "Return a list of keys comprising the citation at point in the current buffer. +Return nil if there is no citation at point or the major mode is +not supported." + (car (citar--citation-at-point))) + +;;; Major-mode functions (defun citar--get-major-mode-function (key &optional default) "Return function associated with KEY in `major-mode-functions'. @@ -583,10 +740,9 @@ return DEFAULT." (alist-get key (cdr (seq-find - (lambda (modefns) - (let ((modes (car modefns))) - (or (eq t modes) - (apply #'derived-mode-p (if (listp modes) modes (list modes)))))) + (pcase-lambda (`(,modes . ,_functions)) + (or (eq t modes) + (apply #'derived-mode-p (if (listp modes) modes (list modes))))) citar-major-mode-functions)) default)) @@ -595,43 +751,230 @@ return DEFAULT." If no function is found, the DEFAULT function is called." (apply (citar--get-major-mode-function key default) args)) -(defun citar--local-files-to-cache () - "The local bibliographic files not included in the global bibliography." - ;; We cache these locally to the buffer. - (seq-difference (citar-file--normalize-paths - (citar--major-mode-function 'local-bib-files #'ignore)) - (citar-file--normalize-paths - citar-bibliography))) - -(defun citar--get-value (field entry) - "Return the FIELD value for ENTRY." - (cdr (assoc-string field entry 'case-fold))) - -(defun citar--field-with-value (fields entry) - "Return the first field that has a value in ENTRY among FIELDS ." - (seq-find (lambda (field) (citar--get-value field entry)) fields)) - -(defun citar--display-value (fields entry) - "Return the first non nil value for ENTRY among FIELDS . +;;; Data access functions + +(defun citar-get-entry (key) + "Return entry for reference KEY, as an association list. +Note: this function accesses the bibliography cache and should +not be used for retreiving a large number of entries. Instead, +prefer `citar--get-entries'." + (citar-cache--entry key (citar--bibliographies))) + +(defun citar-get-entries () + "Return all entries for currently active bibliographies. +Return a hash table whose keys are citation keys and values are +the corresponding entries." + (citar-cache--entries (citar--bibliographies))) + +(defun citar-get-value (field key-or-entry) + "Return value of FIELD in reference KEY-OR-ENTRY. +KEY-OR-ENTRY should be either a string key, or an entry alist as +returned by `citar-get-entry'. Return nil if the FIELD is not +present in KEY-OR-ENTRY." + (let ((entry (if (stringp key-or-entry) + (citar-get-entry key-or-entry) + key-or-entry))) + (cdr (assoc-string field entry)))) + +(defun citar-get-field-with-value (fields key-or-entry) + "Find the first field among FIELDS that has a value in KEY-OR-ENTRY. +Return (FIELD . VALUE), where FIELD is the element of FIELDS that +was found to have a value, and VALUE is its value." + (let ((entry (if (stringp key-or-entry) + (citar-get-entry key-or-entry) + key-or-entry))) + (seq-some (lambda (field) + (when-let ((value (citar-get-value field entry))) + (cons field value))) + fields))) + +(defun citar-get-display-value (fields key-or-entry) + "Return the first non nil value for KEY-OR-ENTRY among FIELDS . The value is transformed using `citar-display-transform-functions'" - (let ((field (citar--field-with-value fields entry))) + (let ((fieldvalue (citar-get-field-with-value fields key-or-entry))) (seq-reduce (lambda (string fun) (if (or (eq t (car fun)) - (member field (car fun))) + (seq-contains-p (car fun) (car fieldvalue) #'string=)) (funcall (cdr fun) string) string)) citar-display-transform-functions ;; Make sure we always return a string, even if empty. - (or (citar--get-value field entry) "")))) + (or (cdr fieldvalue) "")))) + +;;;; File, notes, and links + +(defun citar--get-notes-config (property) + "Return PROPERTY value for configured notes backend." + (plist-get + (alist-get citar-notes-source citar-notes-sources) property)) + +(defun citar-register-notes-source (name config) + "Register note backend. + +NAME is a symbol, and CONFIG is a plist." + (add-to-list 'citar-notes-sources (cons name config))) + +(defun citar-remove-notes-source (name) + "Remove note backend NAME." + (assoc-delete-all name citar-notes-sources)) + +(defun citar-get-notes (keys) + "Return list of notes associated with KEYS." + (funcall (citar--get-notes-config :items) keys)) + +(cl-defun citar-get-files (key-or-keys &key (entries (citar-get-entries))) + "Return list of files associated with KEY-OR-KEYS in ENTRIES. + +ENTRIES should be a hash table mapping elements of KEYS to +bibliography entries. ENTRIES should also contain any items that +are potentially cross-referenced from elements of KEYS. + +Find files using `citar-get-files-functions'." + (when-let ((keys (citar--with-crossref-keys key-or-keys entries))) + (delete-dups (mapcan (lambda (fn) (funcall fn keys entries)) citar-get-files-functions)))) + + +(cl-defun citar-get-links (key-or-keys &key (entries (citar-get-entries))) + "Return list of links associated with KEY-OR-KEYS in ENTRIES. + +ENTRIES should be a hash table mapping elements of KEYS to +bibliography entries. ENTRIES should also contain any items that +are potentially cross-referenced from elements of KEYS." + (delete-dups + (mapcan + (lambda (key) + (when-let ((entry (gethash key entries))) + (mapcan + (pcase-lambda (`(,fieldname . ,baseurl)) + (when-let ((fieldvalue (citar-get-value fieldname entry))) + (list (concat baseurl fieldvalue)))) + '((doi . "https://doi.org/") + (pmid . "https://www.ncbi.nlm.nih.gov/pubmed/") + (pmcid . "https://www.ncbi.nlm.nih.gov/pmc/articles/") + (url . nil))))) + (citar--with-crossref-keys key-or-keys entries)))) + + +(cl-defun citar-has-files (&key (entries (citar-get-entries))) + "Return predicate testing whether entry has associated files. + +Return a function that takes KEY and returns non-nil when the +corresponding entry in ENTRIES has associated files. ENTRIES +should be a hash table mapping citation keys to entries, as +returned by `citar-get-entries'. The returned predicated may by +nil if no entries have associated files. + +For example, to test whether KEY has associated files: + + (when-let ((hasfilesp (citar-has-files))) + (funcall hasfilesp KEY)) + +When testing many keys, call this function once and use the +returned predicate repeatedly. + +Files are detected using `citar-has-files-functions', which see. +Also check any bibliography entries that are cross-referenced +from the given KEY; see `citar-crossref-variable'. + +Note: All the potentially cross-referenced entries should be +present in ENTRIES. In most cases, ENTRIES should be its default +value (the result of `citar-get-entries') rather than some +smaller subset." + (citar--has-resources-for-entries + entries + (mapcar (lambda (fn) (funcall fn entries)) + citar-has-files-functions))) + + +(cl-defun citar-has-notes (&key (entries (citar-get-entries))) + "Return predicate testing whether entry has associated notes. + +Return a function that takes KEY and returns non-nil when the +corresponding entry in ENTRIES has associated notes. ENTRIES +should be a hash table mapping citation keys to entries, as +returned by `citar-get-entries'. The returned predicate may be +nil if no entries have associated notes. + +For example, to test whether KEY has associated notes: + + (let ((hasnotesp (citar-has-notes))) + (funcall hasnotesp KEY)) + +When testing many keys, call this function once and use the +returned predicate repeatedly. + +Notes are detected using `citar-has-notes-functions', which see. +Also check any bibliography entries that are cross-referenced +from the given KEY; see `citar-crossref-variable'. + +Note: All the potentially cross-referenced entries should be +present in ENTRIES. In most cases, ENTRIES should be its default +value (the result of `citar-get-entries') rather than some +smaller subset." + (citar--has-resources-for-entries + entries + (funcall + (citar--get-notes-config :hasnote) entries))) + + +(cl-defun citar-has-links (&key (entries (citar-get-entries))) + "Return predicate testing whether entry has links. + +Return a function that takes KEY and returns non-nil when the +corresponding entry in ENTRIES has associated links. See the +documentation of `citar-has-files' and `citar-has-notes', which +have similar usage." + (citar--has-resources-for-entries + entries + (lambda (key) + (when-let ((entry (gethash key entries))) + (citar-get-field-with-value '(doi pmid pmcid url) entry))))) + + +(defun citar--has-resources-for-entries (entries predicates) + "Return predicate combining results of calling FUNCTIONS. + +PREDICATES should be a list of functions that take a bibliography +KEY and return non-nil if the item has a resource. It may also be +a single such function. + +Return a predicate that returns non-nil for a given KEY when any +of the elements of PREDICATES return non-nil for that KEY. If +PREDICATES is empty or all its elements are nil, then the +returned predicate is nil. + +When `citar-crossref-variable' is the name of a crossref field, +the returned predicate also tests if an entry cross-references +another entry in ENTRIES that has associated resources." + (when-let ((hasresourcep (if (functionp predicates) + predicates + (let ((predicates (remq nil predicates))) + (if (null (cdr predicates)) + ;; optimization for single predicate; just use it directly + (car predicates) + ;; otherwise, call all predicates until one returns non-nil + (lambda (citekey) + (seq-some (lambda (predicate) + (funcall predicate citekey)) + predicates))))))) + (if-let ((xref citar-crossref-variable)) + (lambda (citekey) + (or (funcall hasresourcep citekey) + (when-let ((entry (gethash citekey entries)) + (xkey (citar-get-value xref entry))) + (funcall hasresourcep xkey)))) + hasresourcep))) + +;;; Format and display field values ;; Lifted from bibtex-completion -(defun citar-clean-string (s) +(defun citar--clean-string (s) "Remove quoting brackets and superfluous whitespace from string S." (replace-regexp-in-string "[\n\t ]+" " " (replace-regexp-in-string "[\"{}]+" "" s))) -(defun citar-shorten-names (names) +(defun citar--shorten-names (names) "Return a list of family names from a list of full NAMES. To better accommodate corporate names, this will only shorten @@ -646,10 +989,8 @@ personal names of the form \"family, given\"." (defun citar--fields-for-format (template) "Return list of fields for TEMPLATE." - (let* ((regexp "\\(?:\\`\\|}\\|:\\)[^{]*\\(?:\\${\\|\\'\\)\\|[[:space:]]+")) - ;; The readable version of regexp is: - ;; (rx (or (seq (or bos "}" ":") (0+ (not "{")) (or "${" eos)) (1+ space))) - (split-string template regexp t))) + (mapcan (lambda (fieldspec) (when (consp fieldspec) (cdr fieldspec))) + (citar-format--parse template))) (defun citar--fields-in-formats () "Find the fields to mentioned in the templates." @@ -661,107 +1002,57 @@ personal names of the form \"family, given\"." (defun citar--fields-to-parse () "Determine the fields to parse from the template." - (seq-concatenate - 'list - (citar--fields-in-formats) - (list citar-file-variable) - citar-additional-fields)) - -(defun citar-has-file () - "Return predicate testing whether entry has associated files. - -Return a function that takes arguments KEY and ENTRY and returns -non-nil when the entry has associated files, either in -`citar-library-paths` or the field named in -`citar-file-variable`. - -Note: for performance reasons, this function should be called -once per command; the function it returns can be called -repeatedly." - (citar-file--has-file citar-library-paths - citar-library-file-extensions - citar-file-variable)) - -(defun citar-has-note () - "Return predicate testing whether entry has associated notes. - -Return a function that takes arguments KEY and ENTRY and returns -non-nil when the entry has associated notes in `citar-notes-paths`. - -Note: for performance reasons, this function should be called -once per command; the function it returns can be called -repeatedly." - ;; Call each function in `citar-has-note-functions` to get a list of predicates - (let ((preds (mapcar #'funcall citar-has-note-functions))) - ;; Return a predicate that checks if `citekey` and `entry` have a note - (lambda (citekey entry) - ;; Call each predicate with `citekey` and `entry`; return the first non-nil result - (seq-some (lambda (pred) (funcall pred citekey entry)) preds)))) - -(defun citar--format-candidates (bib-files &optional context) - "Format candidates from BIB-FILES, with optional hidden CONTEXT metadata. -This both propertizes the candidates for display, and grabs the -key associated with each one." - (let* ((candidates nil) - (raw-candidates - (parsebib-parse bib-files :fields (citar--fields-to-parse))) - (hasfilep (citar-has-file)) - (hasnotep (citar-has-note)) - (main-width (citar--format-width (citar--get-template 'main))) - (suffix-width (citar--format-width (citar--get-template 'suffix))) - (symbols-width (string-width (citar--symbols-string t t t))) - (star-width (- (frame-width) (+ 2 symbols-width main-width suffix-width)))) - (maphash - (lambda (citekey entry) - (let* ((files (when (funcall hasfilep citekey entry) " has:files")) - (notes (when (funcall hasnotep citekey entry) " has:notes")) - (link (when (citar--field-with-value '("doi" "url") entry) "has:link")) - (candidate-main - (citar--format-entry - entry - star-width - (citar--get-template 'main))) - (candidate-suffix - (citar--format-entry - entry - star-width - (citar--get-template 'suffix))) - ;; We display this content already using symbols; here we add back - ;; text to allow it to be searched, and citekey to ensure uniqueness - ;; of the candidate. - (candidate-hidden (string-join (list files notes link context citekey) " "))) - (when files (push (cons "has-file" t) entry)) - (when notes (push (cons "has-note" t) entry)) - (push - (cons - ;; If we don't trim the trailing whitespace, - ;; 'completing-read-multiple' will get confused when there are - ;; multiple selected candidates. - (string-trim-right - (concat - ;; We need all of these searchable: - ;; 1. the 'candidate-main' variable to be displayed - ;; 2. the 'candidate-suffix' variable to be displayed with a different face - ;; 3. the 'candidate-hidden' variable to be hidden - (propertize candidate-main 'face 'citar-highlight) " " - (propertize candidate-suffix 'face 'citar) " " - (propertize candidate-hidden 'invisible t))) - (cons citekey entry)) - candidates))) - raw-candidates) - candidates)) - -(defun citar--affixation (cands) + (delete-dups `(,@(citar--fields-in-formats) + ,@(when citar-file-variable + (list citar-file-variable)) + ,@(when citar-crossref-variable + (list citar-crossref-variable)) + . ,citar-additional-fields))) + +(defun citar--with-crossref-keys (key-or-keys entries) + "Return KEY-OR-KEYS augmented with cross-referenced items in ENTRIES. + +KEY-OR-KEYS is either a list KEYS or a single key, which is +converted into KEYS. Return a list containing the elements of +KEYS, with each element followed by the corresponding +cross-referenced key in ENTRIES, if any. + +ENTRIES should be a hash table mapping elements of KEYS to +bibliography entries. ENTRIES should also contain any items that +are potentially cross-referenced from elements of KEYS." + (let ((xref citar-crossref-variable) + (keys (if (listp key-or-keys) key-or-keys (list key-or-keys)))) + (if (not xref) + keys + (mapcan (lambda (key) + (cons key (if-let* ((entry (gethash key entries)) + (xkey (citar-get-value xref entry))) + (list xkey)))) + keys)))) + +;;; Affixations and annotations + +(defun citar--ref-affix (cands) "Add affixation prefix to CANDS." (seq-map (lambda (candidate) - (let ((candidate-symbols (citar--symbols-string - (string-match "has:files" candidate) - (string-match "has:notes" candidate) - (string-match "has:link" candidate)))) - (list candidate candidate-symbols ""))) + (let ((symbols (citar--ref-make-symbols candidate))) + (list candidate symbols ""))) cands)) +(defun citar--ref-make-symbols (cand) + "Make CAND annotation or affixation string for has-symbols." + (let ((candidate-symbols (citar--symbols-string + (string-match-p "has:files" cand) + (string-match-p "has:notes" cand) + (string-match-p "has:links" cand)))) + candidate-symbols)) + +(defun citar--ref-annotate (cand) + "Add annotation to CAND." + ;; REVIEW/TODO we don't currently use this, but could, for Emacs 27. + (citar--ref-make-symbols cand)) + (defun citar--symbols-string (has-files has-note has-link) "String for display from booleans HAS-FILES HAS-LINK HAS-NOTE." (cl-flet ((thing-string (has-thing thing-symbol) @@ -782,147 +1073,14 @@ key associated with each one." "") ""))) -(defvar citar--candidates-cache 'uninitialized - "Store the global candidates list. - -Default value of `uninitialized' is used to indicate that cache -has not yet been created.") - -(defvar-local citar--local-candidates-cache 'uninitialized - ;; We use defvar-local so can maintain per-buffer candidate caches. - "Store the local (per-buffer) candidates list.") - -;;;###autoload -(defun citar-refresh (&optional force-rebuild-cache scope) - "Reload the candidates cache. - -If called interactively with a prefix or if FORCE-REBUILD-CACHE -is non-nil, also run the `citar-before-refresh-hook' hook. - -If SCOPE is `global' only global cache is refreshed, if it is -`local' only local cache is refreshed. With any other value both -are refreshed." - (interactive (list current-prefix-arg nil)) - (when force-rebuild-cache - (run-hooks 'citar-force-refresh-hook)) - (unless (eq 'local scope) - (setq citar--candidates-cache - (citar--format-candidates - (citar-file--normalize-paths citar-bibliography)))) - (unless (eq 'global scope) - (setq citar--local-candidates-cache - (citar--format-candidates - (citar--local-files-to-cache) "is:local")))) - (defun citar--get-template (template-name) "Return template string for TEMPLATE-NAME." - (let ((template - (cdr (assoc template-name citar-templates)))) - (unless template - (error "No template for \"%s\" - check variable 'citar-templates'" template-name)) - template)) - -(defun citar--get-candidates (&optional force-rebuild-cache filter) - "Get the cached candidates. - -If the cache is unintialized, this will load the cache. - -If FORCE-REBUILD-CACHE is t, force reload the cache. - -If FILTER, use the function to filter the candidate list." - (when force-rebuild-cache - (citar-refresh force-rebuild-cache)) - (when (eq 'uninitialized citar--candidates-cache) - (citar-refresh nil 'global)) - (when (eq 'uninitialized citar--local-candidates-cache) - (citar-refresh nil 'local)) - (let ((candidates - (seq-concatenate 'list - citar--local-candidates-cache - citar--candidates-cache))) - (if candidates - (if filter - (seq-filter - (pcase-lambda (`(_ ,citekey . ,entry)) - (funcall filter citekey entry)) - candidates) - candidates) - (unless (or citar--candidates-cache citar--local-candidates-cache) - (error "Make sure to set citar-bibliography and related paths")) ))) - -(defun citar--get-entry (key) - "Return the cached entry for KEY." - (cddr (seq-find - (lambda (entry) - (string-equal key (cadr entry))) - (citar--get-candidates)))) - -(defun citar--get-link (entry) - "Return a link for an ENTRY." - (let* ((field (citar--field-with-value '(doi pmid pmcid url) entry)) - (base-url (pcase field - ('doi "https://doi.org/") - ('pmid "https://www.ncbi.nlm.nih.gov/pubmed/") - ('pmcid "https://www.ncbi.nlm.nih.gov/pmc/articles/")))) - (when field - (concat base-url (citar--get-value field entry))))) - -(defun citar--extract-keys (keys-entries) - "Extract list of keys from KEYS-ENTRIES. - -Each element of KEYS-ENTRIES should be either a (KEY . ENTRY) -pair or a string KEYS. - -- If it is a (KEY . ENTRY) pair, it is replaced by KEY in the - returned list. - -- Otherwise, it should be a string KEYS consisting of multiple - keys separated by \" & \". The string is split and the - separated keys are included in the returned list. - -Return a list containing only KEY strings." - (seq-mapcat - (lambda (key-entry) - (if (consp key-entry) - (list (car key-entry)) - (split-string key-entry " & "))) - keys-entries)) - -(defun citar--ensure-entries (keys-entries) - "Return copy of KEYS-ENTRIES with every element a (KEY . ENTRY) pair. - -Each element of KEYS-ENTRIES should be either a (KEY . ENTRY) -pair or a string KEYS. - -- If it is a (KEY . ENTRY) pair, it is included in the returned - list. - -- Otherwise, it should be a string KEYS consisting of multiple - keys separated by \" & \". Look up the corresponding ENTRY for - each KEY and, if found, include the (KEY . ENTRY) pairs in the - returned list. - -Return a list containing only (KEY . ENTRY) pairs." - (if (seq-every-p #'consp keys-entries) - keys-entries - ;; Get candidates only if some key has a missing entry, to avoid nasty - ;; recursion issues like https://github.com/bdarcus/citar/issues/286. Also - ;; avoids lots of memory allocation in the common case when all entries are - ;; present. - (let ((candidates (citar--get-candidates))) - (seq-mapcat - (lambda (key-entry) - (if (consp key-entry) - (list key-entry) - (seq-remove ; remove keys not found in CANDIDATES - #'null - (seq-map - (lambda (key) - (cdr (seq-find (lambda (cand-key-entry) - (string= key (cadr cand-key-entry))) - candidates))) - (split-string key-entry " & "))))) - keys-entries)))) + (or + (cdr (assq template-name citar-templates)) + (when (eq template-name 'completion) + (concat (propertize (citar--get-template 'main) 'face 'citar-highlight) + (propertize (citar--get-template 'suffix) 'face 'citar))) + (error "No template for \"%s\" - check variable 'citar-templates'" template-name))) ;;;###autoload (defun citar-insert-preset () @@ -934,159 +1092,23 @@ Return a list containing only (KEY . ENTRY) pairs." (search (completing-read "Preset: " citar-presets))) (insert search))) -;;; Formatting functions - -(defun citar--format-width (format-string) - "Calculate minimal width needed by the FORMAT-STRING." - (let ((content-width (apply #'+ - (seq-map #'string-to-number - (split-string format-string ":")))) - (whitespace-width (string-width (citar--format format-string - (lambda (_) ""))))) - (+ content-width whitespace-width))) - -(defun citar--fit-to-width (value width) - "Propertize the string VALUE so that only the WIDTH columns are visible." - (let* ((truncated-value (truncate-string-to-width value width)) - (display-value (truncate-string-to-width truncated-value width 0 ?\s))) - (if (> (string-width value) width) - (concat display-value (propertize (substring value (length truncated-value)) - 'invisible t)) - display-value))) - -(defun citar--format (template replacer) - "Format TEMPLATE with the function REPLACER. -The templates are of form ${foo} for variable foo. -REPLACER takes an argument of the format variable. -Adapted from `org-roam-format-template'." - (replace-regexp-in-string - "\\${\\([^}]+\\)}" - (lambda (md) - (save-match-data - (if-let ((text (funcall replacer (match-string 1 md)))) - text - (signal 'citar-format-resolve md)))) - template - ;; Need literal to make sure it works - t t)) - -(defun citar--format-entry (entry width format-string) - "Formats a BibTeX ENTRY for display in results list. -WIDTH is the width for the * field, and the display format is governed by -FORMAT-STRING." - (citar--format - format-string - (lambda (raw-field) - (let* ((field (split-string raw-field ":")) - (field-names (split-string (car field) "[ ]+")) - (field-width (string-to-number (cadr field))) - (display-width (if (> field-width 0) - ;; If user specifies field width of "*", use - ;; WIDTH; else use the explicit 'field-width'. - field-width - width)) - ;; Make sure we always return a string, even if empty. - (display-value (citar--display-value field-names entry))) - (citar--fit-to-width display-value display-width))))) - -(defun citar--format-entry-no-widths (entry format-string) - "Format ENTRY for display per FORMAT-STRING." - (citar--format - format-string - (lambda (raw-field) - (let ((field-names (split-string raw-field "[ ]+"))) - (citar--display-value field-names entry))))) - -;;; At-point functions for Embark - -;;;###autoload -(defun citar-key-finder () - "Return the citation key at point." - (when-let (key (and (not (minibufferp)) - (citar--major-mode-function 'key-at-point #'ignore))) - (cons 'citar-key key))) - -;;;###autoload -(defun citar-citation-finder () - "Return the keys of the citation at point." - (when-let (citation (and (not (minibufferp)) - (citar--major-mode-function 'citation-at-point #'ignore))) - `(citar-citation ,(citar--stringify-keys (car citation)) . ,(cdr citation)))) - (defun citar--stringify-keys (keys) - "Return a list of KEYS as a crm-string for `embark'." - (if (listp keys) (string-join keys " & ") keys)) - -(defun citar--reference-transformer (type target) - "Look up key for a citar-reference TYPE and TARGET." - (cons type (or (cadr (assoc target - (with-current-buffer (embark--target-buffer) - (citar--get-candidates))))))) - -(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))) + "Encode a list of KEYS as a single string." + (combine-and-quote-strings (if (listp keys) keys (list keys)) " & ")) -;;;###autoload -(with-eval-after-load 'embark - (add-to-list 'embark-target-finders 'citar-citation-finder) - (add-to-list 'embark-transformer-alist - '(citar-reference . citar--reference-transformer)) - (add-to-list 'embark-target-finders 'citar-key-finder) - (add-to-list 'embark-candidate-collectors #'citar--embark-selected)) - -(with-eval-after-load 'embark - (set-keymap-parent citar-map embark-general-map) - (add-to-list 'embark-keymap-alist '(citar-reference . citar-map)) - (add-to-list 'embark-keymap-alist '(citar-key . citar-citation-map)) - (add-to-list 'embark-keymap-alist '(citar-citation . citar-citation-map)) - (add-to-list (if (boundp 'embark-allow-edit-actions) - 'embark-pre-action-hooks - 'embark-target-injection-hooks) - '(citar-insert-edit embark--ignore-target)) - (when (boundp 'embark-multitarget-actions) - (dolist (command (list #'citar-insert-bibtex #'citar-insert-citation - #'citar-insert-reference #'citar-copy-reference - #'citar-insert-keys #'citar-run-default-action)) - (add-to-list 'embark-multitarget-actions command)))) +(defun citar--unstringify-keys (keystring) + "Split KEYSTRING into a list of keys." + (split-string-and-unquote keystring " & ")) ;;; Commands ;;;###autoload -(defun citar-open (keys-entries) - "Open related resources (links or files) for KEYS-ENTRIES." - (interactive (list - (list (citar-select-ref - :rebuild-cache current-prefix-arg)))) - (when (and citar-library-paths - (stringp citar-library-paths)) - (message "Make sure 'citar-library-paths' is a list of paths")) - (let* ((embark-default-action-overrides - '((multi-category . citar--open-multi) - (file . citar-file-open) - (url . browse-url))) - (key-entry-alist (citar--ensure-entries keys-entries)) - (files - (citar-file--files-for-multiple-entries - key-entry-alist - (append citar-library-paths citar-notes-paths) - ;; find files with any extension: - nil)) - (links - (seq-map - (lambda (key-entry) - (citar--get-link (cdr key-entry))) - key-entry-alist)) - (resource-candidates (delete-dups (append files (remq nil links))))) +(defun citar-open (keys) + "Open related resources (links or files) for KEYS." + (interactive (list (citar-select-refs))) + (let ((resource-candidates + (citar--get-resource-candidates + keys :files t :notes t :links t))) (cond ((eq nil resource-candidates) (error "No associated resources")) @@ -1094,7 +1116,7 @@ FORMAT-STRING." (eq 1 (length resource-candidates))) (citar--open-multi (car resource-candidates))) (t (citar--open-multi - (citar--select-resource files links)))))) + (citar--select-resource keys :files t :notes t :links t)))))) (defun citar--open-multi (selection) "Act appropriately on SELECTION when type is `multi-category'. @@ -1107,89 +1129,77 @@ For use with `embark-act-all'." (find-file selection)) (t (citar-file-open selection)))) -(defun citar--library-file-action (key-entry action) - "Run ACTION on file associated with KEY-ENTRY." - (let* ((fn (pcase action - ('open 'citar-file-open) - ('attach 'mml-attach-file))) - (ke (citar--ensure-entries key-entry)) - (key (caar ke)) - (entry (cdar ke)) - (files - (citar-file--files-for-entry - key - entry - citar-library-paths - citar-library-file-extensions)) - (file - (pcase (length files) - (1 (car files)) - ((guard (> 1)) - (citar--select-resource files))))) - (if file - (funcall fn file) - (message "No associated file")))) +;; TODO Rename? This also opens files in bib field, not just library files +;;;###autoload +(defun citar-open-files (key-or-keys) + "Open library file associated with KEY-OR-KEYS." + (interactive (list (citar-select-refs))) + ;; TODO filter to refs have files? + (let ((embark-default-action-overrides '((file . citar-file-open)))) + (citar--library-file-action key-or-keys #'citar-file-open))) ;;;###autoload -(defun citar-open-library-file (key-entry) - "Open library file associated with the KEY-ENTRY. +(defun citar-attach-files (key-or-keys) + "Attach library file associated with KEY-OR-KEYS to outgoing MIME message." + (interactive (list (citar-select-ref))) + (let ((embark-default-action-overrides '((file . mml-attach-file)))) + (citar--library-file-action key-or-keys #'mml-attach-file))) + +(defun citar--library-file-action (key-or-keys action) + "Run ACTION on file associated with KEY-OR-KEYS." + (let ((entries (citar-get-entries))) + (if-let ((files (citar-get-files key-or-keys :entries entries))) + (funcall action (if (null (cdr files)) + (car files) + ;; REVIEW this function will return files for keys + ;; also, candidates are mult-category, even though only one + (citar--select-resource key-or-keys :files t))) + (ignore + ;; If some key had files according to `citar-has-files', but `citar-get-files' returned nothing, then + ;; don't print the following message. The appropriate function in `citar-get-files-functions' is + ;; responsible for telling the user why it failed, and we want that explanation to appear in the echo + ;; area. + (let ((keys (if (listp key-or-keys) key-or-keys (list key-or-keys))) + (hasfilep (citar-has-files :entries entries))) + (unless (and hasfilep (seq-some hasfilep keys)) + (message "No associated files for %s" key-or-keys))))))) -With prefix, rebuild the cache before offering candidates." - (interactive (list (citar-select-ref - :rebuild-cache current-prefix-arg))) - (let ((embark-default-action-overrides '((file . citar-file-open)))) - (when (and citar-library-paths - (stringp citar-library-paths)) - (error "Make sure 'citar-library-paths' is a list of paths")) - (citar--library-file-action key-entry 'open))) +;;;###autoload +(defun citar-open-notes (keys) + "Open notes associated with the KEYS." + (interactive (list (citar-select-refs))) + (dolist (key keys) + (let ((entry (citar-get-entry key))) + (funcall + (citar--get-notes-config :action) key entry)))) ;;;###autoload -(defun citar-open-notes (key-entry) - "Open notes associated with the KEY-ENTRY. -With prefix, rebuild the cache before offering candidates." - (interactive (list (citar-select-ref - :rebuild-cache current-prefix-arg))) - (let* ((embark-default-action-overrides '((file . find-file))) - (key (car key-entry)) - (entry (cdr key-entry))) - (if (listp citar-open-note-functions) - (citar--open-notes key entry) - (error "Please change the value of 'citar-open-note-functions' to a list")))) - -(defun citar--open-notes (key entry) - "Open note(s) associated with KEY and ENTRY." - (or (seq-some - (lambda (opener) - (funcall opener key entry)) citar-open-note-functions) - (funcall citar-create-note-function key entry))) +(defun citar-open-links (keys) + "Open URL or DOI link associated with KEYS in a browser." + (interactive (list (citar-select-refs))) + ;; REVIEW this works, but should check for nil on select-resource + (if-let ((link (citar--select-resource keys :links t))) + (browse-url link) + (message "No link found for %s" keys))) ;;;###autoload -(defun citar-open-entry (key-entry) - "Open bibliographic entry associated with the KEY-ENTRY. -With prefix, rebuild the cache before offering candidates." - (interactive (list (citar-select-ref - :rebuild-cache current-prefix-arg))) - (when-let* ((key (car key-entry)) - (bibtex-files - (seq-concatenate - 'list - citar-bibliography - (citar--local-files-to-cache)))) +(defun citar-open-entry (key) + "Open bibliographic entry associated with the KEY." + (interactive (list (citar-select-ref))) + (when-let ((bibtex-files (citar--bibliography-files))) (bibtex-search-entry key t nil t))) ;;;###autoload -(defun citar-insert-bibtex (keys-entries) - "Insert bibliographic entry associated with the KEYS-ENTRIES. -With prefix, rebuild the cache before offering candidates." - (interactive (list (citar-select-refs - :rebuild-cache current-prefix-arg))) - (dolist (key (citar--extract-keys keys-entries)) +(defun citar-insert-bibtex (keys) + "Insert bibliographic entry associated with the KEYS." + (interactive (list (citar-select-refs))) + (dolist (key keys) (citar--insert-bibtex key))) (defun citar--insert-bibtex (key) "Insert the bibtex entry for KEY at point." (let* ((bibtex-files - (seq-concatenate 'list citar-bibliography (citar--local-files-to-cache))) + (citar--bibliography-files)) (entry (with-temp-buffer (bibtex-set-dialect) @@ -1218,41 +1228,26 @@ directory as current buffer." (citar--insert-bibtex key))))) ;;;###autoload -(defun citar-open-link (key-entry) - "Open URL or DOI link associated with the KEY-ENTRY in a browser. - -With prefix, rebuild the cache before offering candidates." - (interactive (list (citar-select-ref - :rebuild-cache current-prefix-arg))) - (let ((link (citar--get-link (cdr key-entry)))) - (if link - (browse-url link) - (message "No link found for %s" (car key-entry))))) - -;;;###autoload -(defun citar-insert-citation (keys-entries &optional arg) - "Insert citation for the KEYS-ENTRIES. +(defun citar-insert-citation (keys &optional arg) + "Insert citation for the KEYS. Prefix ARG is passed to the mode-specific insertion function. It should invert the default behaviour for that mode with respect to citation styles. See specific functions for more detail." (interactive - (if (member major-mode (mapcar - 'caar - (butlast citar-major-mode-functions))) - (list (citar-select-refs) ; key-entries - current-prefix-arg) ; arg + (if (citar--get-major-mode-function 'insert-citation) + (list (citar-select-refs) current-prefix-arg) (error "Citation insertion is not supported for %s" major-mode))) (citar--major-mode-function 'insert-citation #'ignore - (citar--extract-keys keys-entries) + keys arg)) (defun citar-insert-edit (&optional arg) "Edit the citation at point. ARG is forwarded to the mode-specific insertion function given in -`citar-major-mode-functions`." +`citar-major-mode-functions'." (interactive "P") (citar--major-mode-function 'insert-edit @@ -1261,67 +1256,49 @@ ARG is forwarded to the mode-specific insertion function given in arg)) ;;;###autoload -(defun citar-insert-reference (keys-entries) - "Insert formatted reference(s) associated with the KEYS-ENTRIES." +(defun citar-insert-reference (keys) + "Insert formatted reference(s) associated with the KEYS." (interactive (list (citar-select-refs))) - (let ((key-entry-alist (citar--ensure-entries keys-entries))) - (insert (funcall citar-format-reference-function key-entry-alist)))) + (insert (funcall citar-format-reference-function keys))) ;;;###autoload -(defun citar-copy-reference (keys-entries) - "Copy formatted reference(s) associated with the KEYS-ENTRIES." +(defun citar-copy-reference (keys) + "Copy formatted reference(s) associated with the KEYS." (interactive (list (citar-select-refs))) - (let* ((key-entry-alist (citar--ensure-entries keys-entries)) - (references (funcall citar-format-reference-function key-entry-alist))) + (let ((references (funcall citar-format-reference-function keys))) (if (not (equal "" references)) (progn (kill-new references) (message (format "Copied:\n%s" references))) (message "Key not found.")))) -(defun citar-format-reference (key-entry-alist) - "Return formatted reference(s) for the elements of KEY-ENTRY-ALIST." - (let* ((template (citar--get-template 'preview)) - (references - (with-temp-buffer - (dolist (key-entry key-entry-alist) - (when template - (insert (citar--format-entry-no-widths (cdr key-entry) template)))) - (buffer-string)))) - references)) +(defun citar-format-reference (keys) + "Return formatted reference(s) for the elements of KEYS." + (let* ((entries (mapcar #'citar-get-entry keys)) + (template (citar--get-template 'preview))) + (with-temp-buffer + (dolist (entry entries) + (insert (citar-format--entry template entry))) + (buffer-string)))) ;;;###autoload -(defun citar-insert-keys (keys-entries) - "Insert KEYS-ENTRIES citekeys. -With prefix, rebuild the cache before offering candidates." - (interactive (list (citar-select-refs - :rebuild-cache current-prefix-arg))) +(defun citar-insert-keys (keys) + "Insert KEYS citekeys." + (interactive (list (citar-select-refs))) (citar--major-mode-function 'insert-keys #'citar--insert-keys-comma-separated - (citar--extract-keys keys-entries))) + keys)) (defun citar--insert-keys-comma-separated (keys) "Insert comma separated KEYS." (insert (string-join keys ", "))) -;;;###autoload -(defun citar-attach-library-file (key-entry) - "Attach library file associated with KEY-ENTRY to outgoing MIME message. - -With prefix, rebuild the cache before offering candidates." - (interactive (list (citar-select-ref - :rebuild-cache current-prefix-arg))) - (let ((embark-default-action-overrides '((file . mml-attach-file)))) - (when (and citar-library-paths - (stringp citar-library-paths)) - (error "Make sure 'citar-library-paths' is a list of paths")) - (citar--library-file-action key-entry 'attach))) - (defun citar--add-file-to-library (key) "Add a file to the library for KEY. The FILE can be added from an open buffer, a file path, or a URL." + (citar--check-configuration 'citar-library-paths) (let* ((source (char-to-string (read-char-choice @@ -1350,27 +1327,51 @@ URL." (url-copy-file url (concat file-path extension) 1))))))) ;;;###autoload -(defun citar-add-file-to-library (key-entry) - "Add a file to the library for KEY-ENTRY. +(defun citar-add-file-to-library (key) + "Add a file to the library for KEY. The FILE can be added either from an open buffer, a file, or a URL." - (interactive (list (citar-select-ref - :rebuild-cache current-prefix-arg))) - (citar--add-file-to-library (car key-entry))) + ;; Why is there a separate citar--add-file-to-library? + (interactive (list (citar-select-ref))) + (citar--add-file-to-library key)) ;;;###autoload -(defun citar-run-default-action (keys-entries) - "Run the default action `citar-default-action' on KEYS-ENTRIES." - (funcall citar-default-action keys-entries)) +(defun citar-run-default-action (keys) + "Run the default action `citar-default-action' on KEYS." + (funcall citar-default-action keys)) ;;;###autoload (defun citar-dwim () "Run the default action on citation keys found at point." (interactive) - (if-let ((keys (or (car (citar--major-mode-function 'citation-at-point #'ignore)) - (car (citar--major-mode-function 'key-at-point #'ignore))))) + (if-let ((keys (or (citar-key-at-point) (citar-citation-at-point)))) (citar-run-default-action (if (listp keys) keys (list keys))) (user-error "No citation keys found"))) +(defun citar--check-configuration (&rest variables) + "Signal error if any VARIABLES have values of the wrong type. +VARIABLES should be the names of Citar customization variables." + (dolist (variable variables) + (unless (boundp variable) + (error "Unbound variable in citar--check-configuration: %s" variable)) + (let ((value (symbol-value variable))) + (pcase variable + ((or 'citar-library-paths 'citar-notes-paths) + (unless (and (listp value) + (seq-every-p #'stringp value)) + (error "`%s' should be a list of directories: %S" variable `',value))) + ((or 'citar-library-file-extensions) + (unless (and (listp value) + (seq-every-p #'stringp value)) + (error "`%s' should be a list of strings: %S" variable `',value))) + ((or 'citar-has-files-functions 'citar-get-files-functions + ; (citar--get-notes-config :hasnote) + ; (citar--get-notes-config :action) + 'citar-file-parser-functions) + (unless (and (listp value) (seq-every-p #'functionp value)) + (error "`%s' should be a list of functions: %S" variable `',value))) + (_ + (error "Unknown variable in citar--check-configuration: %s" variable)))))) + (provide 'citar) ;;; citar.el ends here diff --git a/test/citar-file-test.el b/test/citar-file-test.el new file mode 100644 index 00000000..789fefb0 --- /dev/null +++ b/test/citar-file-test.el @@ -0,0 +1,107 @@ +;;; citar-file-test.el --- Tests for citar-file.el -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'seq) +(require 'citar) + +(ert-deftest citar-file-test--parser-default () + + (should-not (citar-file--parser-default " ")) + (should (equal '("foo") (delete-dups (citar-file--parser-default "foo")))) + (should (equal '("foo" "bar") (delete-dups (citar-file--parser-default "foo;bar")))) + (should (equal '("foo" "bar") (delete-dups (citar-file--parser-default " foo ; bar ; ")))) + (should (equal '("foo:bar" "baz") (delete-dups (citar-file--parser-default "foo:bar;baz")))) + + ;; Test escaped delimiters + (should (equal '("foo\\;bar") (delete-dups (citar-file--parser-default "foo\\;bar")))) + (should (equal '("foo" "bar\\") (delete-dups (citar-file--parser-default "foo;bar\\")))) + (should (equal '("foo\\;bar" "baz") + (delete-dups (citar-file--parser-default "foo\\;bar;baz"))))) + +(ert-deftest citar-file-test--parser-triplet () + + (should-not (citar-file--parser-triplet "foo.pdf")) + + (should (equal '("foo.pdf") (delete-dups (citar-file--parser-triplet ":foo.pdf:PDF")))) + (should (equal '("foo.pdf:PDF,:bar.pdf" "foo.pdf" "bar.pdf") + (delete-dups (citar-file--parser-triplet ":foo.pdf:PDF,:bar.pdf:PDF")))) + + ;; Don't trim spaces in triplet parser since file is delimited by : + (should (equal '(" foo.pdf :PDF, : bar.pdf " " foo.pdf " " bar.pdf ") + (delete-dups (citar-file--parser-triplet ": foo.pdf :PDF, : bar.pdf :PDF")))) + + ;; Test escaped delimiters + (should (equal '("title.pdf") + (delete-dups (citar-file--parser-triplet "Title\\: Subtitle:title.pdf:application/pdf")))) + (should (equal '("C:\\title.pdf" "C\\:\\\\title.pdf") + (delete-dups (citar-file--parser-triplet "Title\\: Subtitle:C\\:\\\\title.pdf:PDF")))) + + ;; Calibre doesn't escape any special characters in filenames, so try that + (should (equal '("C:title.pdf" "C:\\title.pdf") + (delete-dups (citar-file--parser-triplet "Title\\: Subtitle:C:\\title.pdf:PDF"))))) + +(ert-deftest citar-file-test--parse-file-field () + + (let* ((fieldname "file") + (citekey "foo") + (entry '((file . "foo.pdf"))) + (dirs '("/home/user/library/")) + (citar-file-variable fieldname) + (citar-file-parser-functions (list #'citar-file--parser-default)) + lastmessage) + + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq lastmessage (apply #'format-message format-string args)))) + ((symbol-function 'current-message) + (lambda () + (prog1 lastmessage (setq lastmessage nil)))) + ;; Pretend that all .pdf files under /home/user/library/ exist: + ((symbol-function 'file-exists-p) + (lambda (filename) + (and (equal "pdf" (file-name-extension filename)) + (member (file-name-directory filename) dirs))))) + + (should-not (citar-file--parse-file-field '((file . " ")) dirs citekey)) + (should (string= + (current-message) + (format-message "Empty `%s' field: %s" fieldname citekey))) + + (let ((citar-file-parser-functions nil)) + (should-not (citar-file--parse-file-field entry dirs citekey)) + (should (string= + (current-message) + (format-message + "Could not parse `%s' field of `%s'; check `citar-file-parser-functions': %s" + fieldname citekey (alist-get 'file entry))))) + + (should-not (citar-file--parse-file-field '((file . "foo.html")) dirs citekey)) + (should (string= + (current-message) + (format-message + (concat "None of the files for `%s' exist; check `citar-library-paths' and " + "`citar-file-parser-functions': %S") + citekey '("foo.html")))) + + (let ((citar-library-file-extensions '("html"))) + (should-not (citar-file--parse-file-field entry dirs citekey)) + (should (string= + (current-message) + (format-message + "No files for `%s' with `citar-library-file-extensions': %S" + citekey '("/home/user/library/foo.pdf"))))) + + (let ((citar-library-file-extensions nil)) + (should (equal (citar-file--parse-file-field entry dirs citekey) + '("/home/user/library/foo.pdf")))) + + (let ((citar-library-file-extensions '("pdf" "html"))) + (should (equal (citar-file--parse-file-field entry dirs citekey) + '("/home/user/library/foo.pdf"))))))) + +(provide 'citar-file-test) +;;; citar-file-test.el ends here diff --git a/test/citar-format-test.el b/test/citar-format-test.el new file mode 100644 index 00000000..30b62f19 --- /dev/null +++ b/test/citar-format-test.el @@ -0,0 +1,56 @@ +;;; citar-format-test.el --- Tests for citar-format.el -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'citar-format) + +(ert-deftest citar-format-test--star-widths () + "Test `citar-format--star-widths'." + + (should (string-empty-p (citar-format--star-widths 80 nil))) + + ;; For single string, return the original string; not a copy + (let ((strings '("foo"))) + (should (eq (car strings) (citar-format--star-widths 80 strings)))) + + (let ((strings '("foo" "bar" "baz"))) + (should (equal "foobaz" (citar-format--star-widths 0 strings))) + (should (equal "foobabaz" (citar-format--star-widths 2 strings))) + (should (equal "foob…baz" (citar-format--star-widths 2 strings nil "…"))) + (should (equal "foobarbaz" (citar-format--star-widths 3 strings))) + (should (equal "foobar baz" (citar-format--star-widths 4 strings))) + + ;; When hide-elided is t, the actual string contents should be equal + (cl-loop for w from 0 to 3 + do (should (equal "foobarbaz" (citar-format--star-widths w strings t)))) + ;; ...unless the allocated width is greater than the string length + (should (equal "foobar baz" (citar-format--star-widths 4 strings))) + + ;; When hide-elided is t, the hidden text should have the 'display "" + ;; property. N.B. equal-including-properties is slightly broken; see + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581 + (should (ert-equal-including-properties #("foobarbaz" 5 6 (display "")) + (citar-format--star-widths 2 strings t))) + + ;; Test with ellipsis + (should (ert-equal-including-properties #("foobarbaz" 4 6 (display "…")) + (citar-format--star-widths 2 strings t "…")))) + + (let ((strings '("foo" "bar" "baz" "qux"))) + (should (equal "foobaz" (citar-format--star-widths 0 strings))) + (should (equal "foobbaz" (citar-format--star-widths 1 strings))) + (should (equal "foobbazq" (citar-format--star-widths 2 strings))) + (should (equal "foobabazq" (citar-format--star-widths 3 strings))) + (should (equal "foobabazqu" (citar-format--star-widths 4 strings))) + + ;; Test with ellipsis + (should (equal "foob…baz…" (citar-format--star-widths 3 strings nil "…"))) + (should (ert-equal-including-properties + #("foobarbazqux" 4 6 (display "…") 9 12 (display "…")) + (citar-format--star-widths 3 strings t "…"))))) + +(provide 'citar-format-test) +;;; citar-format-test.el ends here diff --git a/test/manual/citar.el b/test/manual/citar.el index cf8deabb..74bb4c42 100644 --- a/test/manual/citar.el +++ b/test/manual/citar.el @@ -10,7 +10,9 @@ ;; activate additional packages we need, including bibtex-actions (require 'embark) (require 'citar) -(require 'consult) +(require 'citar-embark) + +(citar-embark-mode 1) ;; set binding for Embark context menu (global-set-key (kbd "M-;") #'embark-act) @@ -25,7 +27,7 @@ org-cite-activate-processor 'citar)) ;; load the test bib file -(setq citar-bibliography '("test.bib")) +(setq citar-bibliography '("../test.bib")) (setq vertico-count 20) diff --git a/test/manual/install.el b/test/manual/install.el index f6ade1ab..6b4dbfa6 100644 --- a/test/manual/install.el +++ b/test/manual/install.el @@ -14,10 +14,8 @@ (package-install 'load-relative) (package-install 'parsebib) -(package-install 's) -;; completion system options -(package-install 'selectrum) +;; completion (package-install 'vertico) ;; completion style @@ -32,10 +30,11 @@ ;; citar ;; Modify load path so that requires in citar.el are handled -(add-to-list 'load-path "../") +(add-to-list 'load-path "../../") ;; we load this locally, to facilitate development testing on branches -(load-relative "../citar.el") -(load-relative "../citar-org.el") +(load-relative "../../citar.el") +(load-relative "../../citar-org.el") +(load-relative "../../citar-embark.el") ;; theme that supports selectrum and vertico (package-install 'modus-themes)