;;; org-ref-glossary.el --- glossary support in org-ref -*- lexical-binding: t; -*- ;; Copyright (C) 2016-2024 John Kitchin ;; Author: John Kitchin ;; Keywords: ;; 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: ;; Provides Some acronym and glossary support for org-mode. Only export to LaTeX ;; is currently supported. The functionality is based on the LaTeX glossaries ;; package. See https://en.wikibooks.org/wiki/LaTeX/Glossary and ;; http://ctan.math.washington.edu/tex-archive/macros/latex/contrib/glossaries/glossaries-user.pdf ;; Put something like this in your org-file. ;; #+latex_header: \usepackage{glossaries} ;; #+latex_header: \makeglossaries ;; Put this where you want the glossaries to appear in your org-file. ;; [[printglossaries:]] ;; This is the preferred way to add glossary entries to an org-file. The table ;; must be named glossary. ;; ;; #+name: glossary ;; | label | name | description | ;; |-------+-------+---------------| ;; | tree | Tree | A woody plant | ;; | shrub | Shrub | A woody bush | ;; ;; This is the preferred way to add acronyms ;; #+name: acronyms ;; | key | abbreviation | full form | ;; |------+--------------+--------------------------------| ;; | mimo | mimo | multiple-input multiple output | ;; | qos | QoS | quality-of-service | ;; | bb | BB | branch and bound | ;; ;; Then add `org-ref-glossary-before-parsing' and ;; `org-ref-acronyms-before-parsing' to the `org-export-before-parsing-hook'. ;; See `org-ref-acronym-types' and `org-ref-glossary-gls-commands' for the types defined. ;; Use `org-ref-insert-glossary-link' and `org-ref-insert-acronym-link' to ;; insert a link with completion. ;; * Known limitations ;; ;; This only works well in a single file (i.e. you cannot include the tables ;; from another file). I tried implementing that once, and it was too slow. ;; * DEPRECATED way of adding entries ;; This is still supported but using the tables is preferred. ;; Add new glossary entries to your org-file like this. Enclose strings ;; containing a comma in {}. Multiline entries are supported. ;; #+latex_header_extra: \newglossaryentry{computer}{name=computer,description={A machine, that computes}} ;; #+latex_header_extra: \newglossaryentry{tree}{name=tree,description=a big plant} ;; #+latex_header_extra: \newglossaryentry{naiive} ;; #+latex_header_extra: { ;; #+latex_header_extra: name=na\"{\i}ve, ;; #+latex_header_extra: description={is a French loanword (adjective, form of naïf) ;; #+latex_header_extra: indicating having or showing a lack of experience, ;; #+latex_header_extra: understanding or sophistication} ;; #+latex_header_extra: } ;; Here is an example acronym definition ;; #+latex_header_extra: \newacronym{lvm}{LVM}{Logical Volume Manager} (require 'org-element) (require 'org-ref-utils) (require 'ox) (require 'org-ref-ref-links) ; For multi-file support utilities ;;; Code: (defgroup org-ref-glossary nil "Customization group for org-ref-glossary." :tag "Org Ref glossary" :group 'org) (defcustom org-ref-activate-glossary-links t "If non-nil activate acronym and glossary links. Checks in `org-ref-glossary-face-fn' and `org-ref-acronym-face-fn'. This is not always fast, so we provide a way to disable it." :type 'boolean :group 'org-ref-glossary) (defcustom org-ref-glossary-show-tooltips t "If non-nil, show tooltips when hovering over glossary and acronym links. When nil, tooltips are disabled entirely for glossary links, which can improve responsiveness if you find the tooltips distracting or slow. This is separate from `org-ref-activate-glossary-links' which controls whether links are fontified and clickable." :type 'boolean :group 'org-ref-glossary) (defcustom org-ref-glossary-enable-multi-file t "Enable scanning #+INCLUDE'd files for glossary/acronym definitions. When non-nil, glossary and acronym lookups will search in files included via #+INCLUDE directives, enabling multi-file document support. Uses timestamp-based caching to maintain performance. Only files that have changed since the last scan are re-parsed." :type 'boolean :group 'org-ref-glossary) (defcustom org-ref-glsentries '() "Variable to hold locations of glsentries load files.") (defvar-local org-ref-glossary-cache nil "Buffer-local variable for glossary entry cache.") (defvar-local org-ref-acronym-cache nil "Buffer-local variable for acronym entry cache.") (defvar org-ref-glossary-file-cache (make-hash-table :test 'equal) "Global cache of glossary entries per file. Maps file paths to lists of glossary entry plists. Used when `org-ref-glossary-enable-multi-file' is non-nil.") (defvar org-ref-acronym-file-cache (make-hash-table :test 'equal) "Global cache of acronym entries per file. Maps file paths to lists of acronym entry plists. Used when `org-ref-glossary-enable-multi-file' is non-nil.") (defun or-find-closing-curly-bracket (&optional limit) "Find closing bracket for the bracket at point and move point to it. Go up to LIMIT or `point-max'. This is a parsing function. I wrote this because using `forward-list' does not always work if there is an escaped \" for example. This seems pretty robust." (unless (looking-at "{") (error "Not at a curley bracket")) (let ((level 1)) (while (and (not (= 0 level)) (not (eobp)) (< (point) (or limit (point-max)))) (forward-char) (when (and (looking-at "{") (not (looking-back "\\\\" (- (point) 2)))) (cl-incf level)) (when (and (looking-at "}") (not (looking-back "\\\\" (- (point) 2)))) (cl-decf level))) (point))) ;;* Glossary (defun or-parse-glossary-entry (entry) "Parse a LaTeX glossary ENTRY definition to a p-list of key=value. ENTRY is the label we are looking for. Typically returns (:name name :description description) but there could be other :key value pairs. This is a source of performance loss, because this is search based and it is done on each fontification. It is easy to cache the results, but not easy to invalidate them, e.g. to reflect changes." (if (and org-ref-glossary-cache (gethash entry org-ref-glossary-cache)) ;; We have the cache, and an entry and use it (gethash entry org-ref-glossary-cache) ;; We don't have a cache, or an entry in it, so we find it. ;; No cache? we make one (unless org-ref-glossary-cache (setq-local org-ref-glossary-cache (make-hash-table :test 'equal))) ;; Now we search to get the data (save-excursion (goto-char (point-min)) (let* (end-of-entry data (external (when (re-search-forward "\\\\loadglsentries\\(\\[.*\\]\\)?{\\(?1:.*\\)}" nil t) (match-string 1))) (glsentries (and external (or (cdr (assoc external org-ref-glsentries)) (progn (cl-pushnew (cons external (string-trim (shell-command-to-string (format "kpsewhich tex %s" external)))) org-ref-glsentries) (cdr (assoc external org-ref-glsentries)))))) key value p1 p2 position) (setq data (catch 'data ;; look inside first for latex-headers (goto-char (point-min)) (when (re-search-forward (format "\\newglossaryentry{%s}" entry) nil t) (setq position (match-beginning 0)) (re-search-forward "{") (save-excursion (backward-char) (or-find-closing-curly-bracket) (setq end-of-entry (point))) (while (re-search-forward "\\(\\w+?\\)=" end-of-entry t) (setq key (match-string 1)) ;; get value (goto-char (+ 1 (match-end 1))) (setq p1 (point)) (if (looking-at "{") ;; value is wrapped in {} (progn (or-find-closing-curly-bracket) (setq p2 (point) value (buffer-substring (+ 1 p1) p2))) ;; value is up to the next comma (re-search-forward "," end-of-entry 'mv) (setq value (buffer-substring p1 (- (point) 1)))) ;; remove #+latex_header_extra: (setq value (replace-regexp-in-string "#\\+latex_header_extra: " "" value)) (setq value (replace-regexp-in-string "\n +" " " value)) (setq data (append data (list :label entry) (list (intern (format ":%s" key))) (list value) (list :position position)))) (throw 'data data)) ;; check for a glossary table (let* ((entries (save-excursion (catch 'found (org-element-map (org-element-parse-buffer) 'table (lambda (el) (when (string= "glossary" (org-element-property :name el)) (goto-char (org-element-property :contents-begin el)) (setq position (point)) (throw 'found (nthcdr 2 (org-babel-read-table))))))))) (result (assoc entry entries))) (when result (throw 'data (list :label entry :name (cl-second result) :description (cl-third result) :position position)))) ;; then external (when (and glsentries (file-exists-p glsentries)) (with-current-buffer (find-file-noselect glsentries) (goto-char (point-min)) (when (re-search-forward (format "\\newglossaryentry{%s}" entry) nil t) (re-search-forward "{") (save-excursion (backward-char) (or-find-closing-curly-bracket) (setq end-of-entry (point))) (while (re-search-forward "\\(\\w+?\\)=" end-of-entry t) (setq key (match-string 1)) ;; get value (goto-char (+ 1 (match-end 1))) (setq p1 (point)) (if (looking-at "{") ;; value is wrapped in {} (progn (or-find-closing-curly-bracket) (setq p2 (point) value (buffer-substring (+ 1 p1) p2))) ;; value is up to the next comma (re-search-forward "," end-of-entry 'mv) (setq value (buffer-substring p1 (- (point) 1)))) (setq data (append data (list :label entry) (list (intern (format ":%s" key))) (list value) (list :position nil)))) (throw 'data data)))))) (puthash entry data org-ref-glossary-cache) data)))) ;;** Multi-file glossary support (defun or-scan-file-for-glossary-table (file) "Scan FILE and return list of glossary entries from #+name: glossary table. Returns list of plists with :label, :name, :description, :file. Returns nil if no glossary table is found in FILE." (when (file-exists-p file) (with-temp-buffer (insert-file-contents file) (org-mode) (let ((entries '())) (or (catch 'found (org-element-map (org-element-parse-buffer) 'table (lambda (el) (when (string= "glossary" (org-element-property :name el)) (goto-char (org-element-property :contents-begin el)) (let ((table-data (nthcdr 2 (org-babel-read-table)))) ;; Convert table rows to plists (dolist (row table-data) (when (and (listp row) (= 3 (length row))) (push (list :label (nth 0 row) :name (nth 1 row) :description (nth 2 row) :file file) entries))) (throw 'found (nreverse entries))))))) entries))))) (defun or-scan-file-for-acronym-table (file) "Scan FILE and return list of acronym entries from #+name: acronyms table. Returns list of plists with :label, :abbrv, :full, :file. Returns nil if no acronym table is found in FILE." (when (file-exists-p file) (with-temp-buffer (insert-file-contents file) (org-mode) (let ((entries '())) (or (catch 'found (org-element-map (org-element-parse-buffer) 'table (lambda (el) (when (string= "acronyms" (org-element-property :name el)) (goto-char (org-element-property :contents-begin el)) (let ((table-data (nthcdr 2 (org-babel-read-table)))) ;; Convert table rows to plists (dolist (row table-data) (when (and (listp row) (= 3 (length row))) (push (list :label (nth 0 row) :abbrv (nth 1 row) :full (nth 2 row) :file file) entries))) (throw 'found (nreverse entries))))))) entries))))) (defun or-parse-glossary-entry-multi-file (label) "Find glossary LABEL in current file or included files. Uses timestamp-based caching to avoid re-scanning unchanged files. Returns plist with :label, :name, :description, :file." (when (and (boundp 'org-ref-glossary-enable-multi-file) org-ref-glossary-enable-multi-file (boundp 'org-ref-glossary-file-cache) (buffer-file-name)) (cl-block or-parse-glossary-entry-multi-file (let* ((current-file (buffer-file-name)) (included-files (org-ref-get-included-files)) (all-files (cons current-file included-files))) ;; Scan each file (with caching) (dolist (file all-files) ;; Scan if file changed OR if not in cache yet (when (or (org-ref-file-changed-p file) (not (gethash file org-ref-glossary-file-cache))) ;; File changed or not cached, scan it (let ((file-entries (or-scan-file-for-glossary-table file))) (puthash file file-entries org-ref-glossary-file-cache) (org-ref-mark-file-scanned file))) ;; Look for label in this file's cache (let ((entries (gethash file org-ref-glossary-file-cache))) (when entries (let ((entry (cl-find label entries :key (lambda (e) (plist-get e :label)) :test 'string=))) (when entry (cl-return-from or-parse-glossary-entry-multi-file entry)))))))))) (defun or-parse-acronym-entry-multi-file (label) "Find acronym LABEL in current file or included files. Uses timestamp-based caching to avoid re-scanning unchanged files. Returns plist with :label, :abbrv, :full, :file." (when (and (boundp 'org-ref-glossary-enable-multi-file) org-ref-glossary-enable-multi-file (boundp 'org-ref-acronym-file-cache) (buffer-file-name)) (cl-block or-parse-acronym-entry-multi-file (let* ((current-file (buffer-file-name)) (included-files (org-ref-get-included-files)) (all-files (cons current-file included-files))) ;; Scan each file (with caching) (dolist (file all-files) ;; Scan if file changed OR if not in cache yet (when (or (org-ref-file-changed-p file) (not (gethash file org-ref-acronym-file-cache))) ;; File changed or not cached, scan it (let ((file-entries (or-scan-file-for-acronym-table file))) (puthash file file-entries org-ref-acronym-file-cache) (org-ref-mark-file-scanned file))) ;; Look for label in this file's cache (let ((entries (gethash file org-ref-acronym-file-cache))) (when entries (let ((entry (cl-find label entries :key (lambda (e) (plist-get e :label)) :test 'string=))) (when entry (cl-return-from or-parse-acronym-entry-multi-file entry)))))))))) ;;** Glossary links (defun or-activate-glossary (start end path bracketp) "Activate function for a glossary link. set data on text with properties Set face property, and help-echo." (let ((data (or (or-parse-glossary-entry path) (or-parse-acronym-entry path) ;; Try multi-file lookup if enabled and not found in current buffer (or-parse-glossary-entry-multi-file path) (or-parse-acronym-entry-multi-file path)))) (add-text-properties start end (list 'or-glossary data 'face (if data 'org-ref-glossary-face 'font-lock-warning-face) ;; Suppress spell-checking with nospell property. ;; For jinx users: add 'nospell to jinx-exclude-properties: ;; (setq jinx-exclude-properties '((org-mode read-only nospell))) ;; Or exclude by face using jinx-exclude-faces: ;; (add-to-list 'jinx-exclude-faces 'org-ref-glossary-face) 'nospell t)))) (defface org-ref-glossary-face `((t (:inherit org-link :foreground "Mediumpurple3"))) "Face for glossary links.") (defun or-follow-glossary (entry) "Goto beginning of the glossary ENTRY. If entry is in an included file, opens that file and navigates to the glossary table." (org-mark-ring-push) (let* ((data (get-text-property (point) 'or-glossary)) (file (plist-get data :file)) (label (plist-get data :label)) (position (plist-get data :position))) (cond ;; Entry in current buffer (has position) (position (goto-char position)) ;; Entry in external file (file (find-file file) (goto-char (point-min)) (when (re-search-forward "^[ \t]*#\\+name:[ \t]+\\(glossary\\|acronyms\\)" nil t) (when (re-search-forward (regexp-quote label) nil t) (goto-char (line-beginning-position))))) ;; Fallback: search in current buffer (t (goto-char (point-min)) (when (re-search-forward "^[ \t]*#\\+name:[ \t]+\\(glossary\\|acronyms\\)" nil t) (when (re-search-forward (regexp-quote label) nil t) (goto-char (line-beginning-position)))))))) (defun or-glossary-tooltip (_window buffer position) "Return tooltip for the glossary entry. The entry is in WINDOW and OBJECT at POSITION. Used in fontification." (when org-ref-glossary-show-tooltips (with-current-buffer buffer (let ((data (get-text-property position 'or-glossary))) (if data (let ((name (or (plist-get data :name) (plist-get data :abbrv))) (description (or (plist-get data :description) (plist-get data :full)))) (when (and name description) (format "%s: %s" name (with-temp-buffer (insert (concat description ".")) (fill-paragraph) (buffer-string))))) ;; No data found - return helpful message or nil "This is not defined in this file."))))) (defvar org-ref-glossary-gls-commands '(("gls" "The term associated with the label") ("glspl" "The plural term") ("Gls" "The capitalized term") ("Glspl" "The plural capitalized term") ("glssymbol" "The symbol defined (only with latex definition)") ("Glssymbol" "The capitalized symbol defined (only with latex definition)") ("glsdesc" "The description associated with the label") ("Glsdesc" "The capitalized description associated with the label")) "An alist of (cmd description).") (dolist (command org-ref-glossary-gls-commands) (org-link-set-parameters (cl-first command) :follow #'or-follow-glossary :activate-func #'or-activate-glossary :help-echo 'or-glossary-tooltip :export (lambda (path _ format) (cond ((memq format '(latex beamer)) (format "\\%s{%s}" (cl-first command) path)) (t (format "%s" path)))))) (org-link-set-parameters "glslink" :follow #'or-follow-glossary :activate-func #'or-activate-glossary :face 'org-ref-glossary-face-fn :help-echo 'or-glossary-tooltip :export (lambda (path desc format) (cond ((memq format '(latex beamer)) (format "\\glslink{%s}{%s}" path desc)) (t (format "%s" path))))) ;; ** printglossaries links ;; There is a printglossary command in LaTeX, but I am not supporting it for now. (org-link-set-parameters "printglossaries" :export (lambda (path _desc format) (cond ((memq format '(latex beamer)) "\\printglossaries") (t (format "%s" path))))) ;; ** exporting with a glossary table (defun org-ref-glossary-before-parsing (_backend) "Function to preprocess a glossary table on export. This assumes a table like #+name: glossary | label | name | description | |-------+-------+---------------| | tree | Tree | A woody plant | | shrub | Shrub | A woody bush | is in the org-buffer, and will add the relevant latex_header items if there is. The table is deleted in a copy of the buffer before the export, so you can put it where you want. The column names are arbitrary, but three columns are expected, and the hline is expected. This is intended to be run in `org-export-before-parsing-hook'." (save-restriction (widen) (let* (begin end (entries (save-excursion (catch 'found (org-element-map (org-element-parse-buffer) 'table (lambda (el) (when (and (org-element-property :name el) (stringp (org-element-property :name el)) (string= "glossary" (org-element-property :name el))) (setq begin (org-element-property :begin el) end (org-element-property :end el)) (goto-char (org-element-property :contents-begin el)) (throw 'found (nthcdr 2 (org-babel-read-table)))))))))) ;; Delete the table (when entries (cl--set-buffer-substring begin end "")) (goto-char (point-min)) (cl-loop for (label name description) in entries do (insert (format "#+latex_header_extra: \\newglossaryentry{%s}{name=%s,description={{%s}}}\n" label name description)))))) ;;* Acronyms (defun or-parse-acronym-entry (label) "Parse an acronym entry LABEL to a plist. Returns (:abbrv abbrv :full full :label label) The plist maps to \newacronym{