Merge branch 'blc/lex' [#12]

3 files changed, 137 insertions, 127 deletions

diff --git a/Makefile b/Makefile
index e3d5987..d85bb40 100644
--- a/Makefile
+++ b/Makefile
@@ -1,17 +1,18 @@
 
+EMACS ?= emacs
 LOAD_PATH ?=
-BATCH = emacs -Q --batch $(LOAD_PATH)
+BATCH = $(EMACS) -Q --batch $(LOAD_PATH)
 
 all: bog.elc bog-autoloads.el
 
 .PHONY: test
-test: bog.elc
-	@$(BATCH) -L . -l bog-tests.el \
+test: bog.elc bog-tests.elc
+	@$(BATCH) -L . -l bog-tests.elc \
 	--eval "(ert-run-tests-batch-and-exit '(not (tag interactive)))"
 
 .PHONY: clean
 clean:
-	$(RM) bog.elc bog-autoloads.el
+	$(RM) bog.elc bog-autoloads.el bog-tests.elc
 
 %.elc: %.el
 	@$(BATCH) -L . -f batch-byte-compile $<
diff --git a/bog-tests.el b/bog-tests.el
index b1b2ea1..01c7f08 100644
--- a/bog-tests.el
+++ b/bog-tests.el
@@ -1,6 +1,7 @@
-;;; bog-tests.el --- Tests for Bog
+;;; bog-tests.el --- Tests for Bog -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2013-2016 Kyle Meyer <kyle@kyleam.com>
+;; Copyright (C) 2020 Basil L. Contovounesios <contovob@tcd.ie>
 
 ;; Author: Kyle Meyer <kyle@kyleam.com>
 
@@ -19,15 +20,17 @@
 
 ;;; Code:
 
+(require 'bog)
 (require 'ert)
 (require 'org)
-(require 'cl-lib)
-(require 'bog)
+
+(with-no-warnings ;; Silence "lacks a prefix" warning.
+  (defvar citekey))
 
 ;; Modified from magit-tests.el.
 (defmacro bog-tests-with-temp-dir (&rest body)
   (declare (indent 0) (debug t))
-  (let ((dir (cl-gensym)))
+  (let ((dir (make-symbol "dir")))
     `(let ((,dir (file-name-as-directory (make-temp-file "dir" t))))
        (unwind-protect
            (let ((default-directory ,dir)) ,@body)
@@ -44,21 +47,18 @@ value of the variable `citekey'.
 If the string \"<point>\" appears in TEXT then remove it and
 place the point there before running BODY, otherwise place the
 point at the beginning of the inserted text."
-  (declare (indent 1))
-  `(let* ((inside-text (if (stringp ,text) ,text (eval ,text)))
-          (is-citekey (string-match "<citekey>" inside-text)))
-     (when (and is-citekey citekey)
-       (setq inside-text (replace-match citekey nil nil inside-text)))
-     (with-temp-buffer
-       (org-mode)
-       (let ((point (string-match "<point>" inside-text)))
-         (if point
-             (progn
-               (insert (replace-match "" nil nil inside-text))
-               (goto-char (1+ (match-beginning 0))))
-           (insert inside-text)
-           (goto-char (point-min))))
-       ,@body)))
+  (declare (indent 1) (debug t))
+  `(with-temp-buffer
+     (org-mode)
+     (insert ,text)
+     (goto-char (point-min))
+     (when (and (bound-and-true-p citekey)
+                (search-forward "<citekey>" nil t))
+       (replace-match citekey t t))
+     (goto-char (point-min))
+     (when (search-forward "<point>" nil t)
+       (replace-match "" t t))
+     ,@body))
 
 
 ;;; Citekey functions
@@ -241,22 +241,22 @@ some text and <point><citekey>"
 
 (ert-deftest bog-citekeys-in-buffer ()
   (should (equal '("abc1900def" "ghi1950jkl" "mno2000pqr")
-           (bog-tests-with-temp-text
-            "
+                 (bog-tests-with-temp-text
+                     "
 * abc1900def
 ghi1950jkl
 * mno2000pqr
 * mno2000pqr"
-            (sort (bog-citekeys-in-buffer) #'string-lessp)))))
+                   (sort (bog-citekeys-in-buffer) #'string-lessp)))))
 
 (ert-deftest bog-heading-citekeys-in-buffer ()
   (should (equal '("abc1900def" "mno2000pqr")
-           (bog-tests-with-temp-text
-            "
+                 (bog-tests-with-temp-text
+                     "
 * abc1900def
 ghi1950jkl
 * mno2000pqr"
-            (bog-heading-citekeys-in-buffer)))))
+                   (bog-heading-citekeys-in-buffer)))))
 
 (ert-deftest bog-next-non-heading-citekey/default-arg ()
   (let ((citekey "name2010word"))
@@ -353,69 +353,71 @@ other2000key <citekey>"
 
 (ert-deftest bog-all-file-citekeys ()
   (bog-tests-with-temp-dir
-   (let ((bog-file-directory (expand-file-name "citekey-files")))
-     (make-directory bog-file-directory)
-     (let ((default-directory bog-file-directory))
-       (make-directory "key2000butdir"))
-     (write-region "" nil (expand-file-name "nokey.pdf" bog-file-directory))
-     (write-region "" nil (expand-file-name "one2010key.pdf" bog-file-directory))
-     (write-region "" nil (expand-file-name "two1980key.txt" bog-file-directory))
-     (should (equal (bog-all-file-citekeys)
-                    '("one2010key" "two1980key"))))))
+    (let ((bog-file-directory (expand-file-name "citekey-files")))
+      (make-directory bog-file-directory)
+      (let ((default-directory bog-file-directory))
+        (make-directory "key2000butdir"))
+      (write-region "" nil (expand-file-name "nokey.pdf" bog-file-directory))
+      (write-region "" nil (expand-file-name "one2010key.pdf"
+                                             bog-file-directory))
+      (write-region "" nil (expand-file-name "two1980key.txt"
+                                             bog-file-directory))
+      (should (equal (bog-all-file-citekeys)
+                     '("one2010key" "two1980key"))))))
 
 (ert-deftest bog-rename-staged-file-to-citekey/one-file ()
   (bog-tests-with-temp-dir
-   (let ((bog-stage-directory (expand-file-name "stage"))
-         (bog-file-directory (expand-file-name "citekey-files"))
-         (citekey "name2010word"))
-     (make-directory bog-stage-directory)
-     (make-directory bog-file-directory)
-     (write-region "" nil (expand-file-name "one.pdf" bog-stage-directory))
-     (bog-tests-with-temp-text
-         "
+    (let ((bog-stage-directory (expand-file-name "stage"))
+          (bog-file-directory (expand-file-name "citekey-files"))
+          (citekey "name2010word"))
+      (make-directory bog-stage-directory)
+      (make-directory bog-file-directory)
+      (write-region "" nil (expand-file-name "one.pdf" bog-stage-directory))
+      (bog-tests-with-temp-text
+          "
 * top level
 ** <point><citekey>
 some text"
-       (bog-rename-staged-file-to-citekey))
-     (should (file-exists-p (expand-file-name
-                             (concat citekey ".pdf") bog-file-directory)))
-     (should-not (file-exists-p (expand-file-name
-                                 "one.pdf" bog-stage-directory))))))
+        (bog-rename-staged-file-to-citekey))
+      (should (file-exists-p (expand-file-name
+                              (concat citekey ".pdf") bog-file-directory)))
+      (should-not (file-exists-p (expand-file-name
+                                  "one.pdf" bog-stage-directory))))))
 
 (ert-deftest bog-rename-staged-file-to-citekey/one-file-subdir ()
   (bog-tests-with-temp-dir
-   (let ((bog-stage-directory (expand-file-name "stage"))
-         (bog-file-directory (expand-file-name "citekey-files"))
-         (citekey "name2010word")
-         (bog-subdirectory-group 2))
-     (make-directory bog-stage-directory)
-     (make-directory bog-file-directory)
-     (write-region "" nil (expand-file-name "one.pdf" bog-stage-directory))
-     (bog-tests-with-temp-text
-         "
+    (let ((bog-stage-directory (expand-file-name "stage"))
+          (bog-file-directory (expand-file-name "citekey-files"))
+          (citekey "name2010word")
+          (bog-subdirectory-group 2))
+      (make-directory bog-stage-directory)
+      (make-directory bog-file-directory)
+      (write-region "" nil (expand-file-name "one.pdf" bog-stage-directory))
+      (bog-tests-with-temp-text
+          "
 * top level
 ** <point><citekey>
 some text"
-       (bog-rename-staged-file-to-citekey))
-     (should (file-exists-p (expand-file-name
-                             (concat "2010/" citekey ".pdf") bog-file-directory)))
-     (should-not (file-exists-p (expand-file-name
-                                 "one.pdf" bog-stage-directory))))))
+        (bog-rename-staged-file-to-citekey))
+      (should (file-exists-p (expand-file-name (concat "2010/" citekey ".pdf")
+                                               bog-file-directory)))
+      (should-not (file-exists-p (expand-file-name
+                                  "one.pdf" bog-stage-directory))))))
 
 (ert-deftest bog-file-citekeys/multiple-variants ()
   (bog-tests-with-temp-dir
-   (let* ((bog-file-directory (expand-file-name "citekey-files"))
-          (citekey "name2010word")
-          (variants (list (concat citekey ".pdf")
-                          (concat citekey ".txt")
-                          (concat citekey "_0.pdf")
-                          (concat citekey "-supplement.pdf")))
-          found-files)
-     (make-directory bog-file-directory)
-     (dolist (var variants)
-       (write-region "" nil (expand-file-name var bog-file-directory)))
-     (setq files-found (bog-citekey-files citekey))
-     (should (= (length files-found) 4)))))
+    (let* ((bog-file-directory (expand-file-name "citekey-files"))
+           (citekey "name2010word")
+           (variants (list (concat citekey ".pdf")
+                           (concat citekey ".txt")
+                           (concat citekey "_0.pdf")
+                           (concat citekey "-supplement.pdf")))
+           files-found)
+      (make-directory bog-file-directory)
+      (dolist (var variants)
+        (write-region "" nil (expand-file-name var bog-file-directory)))
+      (setq files-found (bog-citekey-files citekey))
+      (should (= (length files-found) 4)))))
 
 
 ;;; BibTeX functions
@@ -582,3 +584,5 @@ some text"
                  (sort (bog--find-duplicates
                         (list "a" "b" "c" "b" "a"))
                        #'string-lessp))))
+
+;;; bog-tests.el ends here
diff --git a/bog.el b/bog.el
index e7ceada..2e1d5d9 100644
--- a/bog.el
+++ b/bog.el
@@ -1,6 +1,7 @@
-;;; bog.el --- Extensions for research notes in Org mode
+;;; bog.el --- Extensions for research notes in Org mode -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2013-2016 Kyle Meyer <kyle@kyleam.com>
+;; Copyright (C) 2020 Basil L. Contovounesios <contovob@tcd.ie>
 
 ;; Author: Kyle Meyer <kyle@kyleam.com>
 ;; URL: https://github.com/kyleam/bog
@@ -133,7 +134,7 @@ non-nil."
 rename."
   :type 'directory)
 
-(defcustom bog-find-citekey-bib-func 'bog-find-citekey-bib-file
+(defcustom bog-find-citekey-bib-func #'bog-find-citekey-bib-file
   "Function used to find BibTeX entry for citekey.
 
 Default is `bog-find-citekey-bib-file', which locates single
@@ -180,7 +181,7 @@ files with the format <citekey>.* and <citekey><sep>*.<ext>,
 where <sep> is matched by this regular expression.."
   :type 'regexp)
 
-(defcustom bog-file-renaming-func 'bog-file-ask-on-conflict
+(defcustom bog-file-renaming-func #'bog-file-ask-on-conflict
   "Function used to rename staged files.
 This function should accept a file name and a citekey as
 arguments and return the name of the final file.  Currently the
@@ -348,8 +349,8 @@ Keys match values in `bog-use-citekey-cache'.")
   "Execute BODY, maybe using cached citekey values for KEY.
 Use cached values if `bog-use-citekey-cache' is non-nil for KEY.
 Cached values are updated to the return values of BODY."
-  (declare (indent 1))
-  (let ((use-cache-p (cl-gensym "use-cache-p")))
+  (declare (indent 1) (debug t))
+  (let ((use-cache-p (make-symbol "use-cache-p")))
     `(let* ((,use-cache-p (bog--use-cache-p ,key))
             (citekeys (or (and ,use-cache-p
                                (cdr (assq ,key bog--citekey-cache)))
@@ -463,11 +464,11 @@ behavior:
      ,(format "Select citekey with `%s'.
 Fall back on `%s'.
 If NO-CONTEXT is non-nil, immediately fall back."
-              (symbol-name context-method)
-              (symbol-name collection-method))
-      (or (and no-context (bog-select-citekey (,collection-method)))
-          (,context-method)
-          (bog-select-citekey (,collection-method)))))
+              context-method
+              collection-method)
+     (or (and no-context (bog-select-citekey (,collection-method)))
+         (,context-method)
+         (bog-select-citekey (,collection-method)))))
 
 (bog-selection-method "surroundings-or-files"
                       bog-citekey-from-surroundings
@@ -499,8 +500,10 @@ If NO-CONTEXT is non-nil, immediately fall back."
 ;;;; Other
 
 ;; `show-all' is obsolete as of Emacs 25.1.
-(unless (fboundp 'outline-show-all)
-  (defalias 'outline-show-all 'show-all))
+(defalias 'bog--outline-show-all
+  (if (fboundp 'outline-show-all)
+      #'outline-show-all
+    'show-all))
 
 (defun bog--set-difference (list1 list2)
   (let ((sdiff (cl-set-difference list1 list2 :test #'string=)))
@@ -532,7 +535,7 @@ file."
                             (mapconcat #'identity nohead-cks "\n"))))))
       (org-mode)
       (bog-mode 1)
-      (outline-show-all)
+      (bog--outline-show-all)
       (goto-char (point-min)))
     (pop-to-buffer bufname)))
 
@@ -1142,7 +1145,7 @@ If the citekey prompt is slow to appear, consider enabling the
          (citekey (bog-citekey-from-point-or-all-headings no-context))
          (marker (with-current-buffer (or (buffer-base-buffer)
                                           (current-buffer))
-                     (bog--find-citekey-heading-in-notes citekey))))
+                   (bog--find-citekey-heading-in-notes citekey))))
     (if marker
         (with-current-buffer (marker-buffer marker)
           (org-with-wide-buffer
@@ -1181,25 +1184,28 @@ level `bog-refile-maxlevel' are considered."
     (cdr (assoc-string (completing-read "File: " note-paths)
                        note-paths))))
 
+(defvar bog--agenda-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map org-agenda-mode-map)
+    (define-key map "r" 'bog-agenda-redo)
+    (define-key map "g" 'bog-agenda-redo)
+    map)
+  "Local keymap for Bog-related agendas.")
+
 (defmacro bog--with-search-lprops (&rest body)
   "Execute BODY with Bog-related agenda values.
 Restore the `org-lprops' property value for
 `org-agenda-redo-command' after executing BODY."
-  (declare (indent 0))
-  `(let ((org-lprops (get 'org-agenda-redo-command 'org-lprops))
-         (bog-lprops '((org-agenda-buffer-name "*Bog search*")
-                       (org-agenda-files (bog-notes))
-                       org-agenda-text-search-extra-files
-                       org-agenda-sticky)))
-     (put 'org-agenda-redo-command 'org-lprops bog-lprops)
-     (put 'org-agenda-files 'org-restrict nil)
-     (org-let bog-lprops ,@body)
-     (use-local-map (let ((map (make-sparse-keymap)))
-                      (set-keymap-parent map org-agenda-mode-map)
-                      (define-key map "r" 'bog-agenda-redo)
-                      (define-key map "g" 'bog-agenda-redo)
-                      map))
-     (put 'org-agenda-redo-command 'org-lprops org-lprops)))
+  (declare (indent 0) (debug t))
+  (let ((bog-lprops '((org-agenda-buffer-name "*Bog search*")
+                      (org-agenda-files (bog-notes))
+                      (org-agenda-text-search-extra-files ())
+                      (org-agenda-sticky nil))))
+    `(cl-letf (((get 'org-agenda-redo-command 'org-lprops) ',bog-lprops)
+               ,@bog-lprops)
+       (put 'org-agenda-files 'org-restrict nil)
+       ,@body
+       (use-local-map bog--agenda-map))))
 
 ;;;###autoload
 (defun bog-search-notes (&optional todo-only string)
@@ -1209,7 +1215,7 @@ STRING is non-nil, use it as the search term (instead of
 prompting for one)."
   (interactive "P")
   (bog--with-search-lprops
-    '(org-search-view todo-only string)))
+    (org-search-view todo-only string)))
 
 ;;;###autoload
 (defun bog-search-notes-for-citekey (&optional todo-only)
@@ -1230,7 +1236,7 @@ If the citekey prompt is slow to appear, consider enabling the
 (defun bog-agenda-redo (&optional all)
   (interactive "P")
   (bog--with-search-lprops
-    '(org-agenda-redo all)))
+    (org-agenda-redo all)))
 
 (defun bog-sort-topic-headings-in-buffer (&optional sorting-type)
   "Sort topic headings in this buffer.
@@ -1265,8 +1271,8 @@ argument CURRENT-BUFFER, limit to heading citekeys from the
 current buffer."
   (interactive "P")
   (let ((citekey-func (if current-buffer
-                          'bog-heading-citekeys-in-wide-buffer
-                        'bog-all-heading-citekeys)))
+                          #'bog-heading-citekeys-in-wide-buffer
+                        #'bog-all-heading-citekeys)))
     (insert (bog-select-citekey (funcall citekey-func)))))
 
 ;;;###autoload
@@ -1357,7 +1363,7 @@ Topic headings are determined by `bog-topic-heading-level'."
 ;;; Font-lock
 
 (defface bog-citekey-face
-  '((t (:inherit org-link :underline nil)))
+  '((t :inherit org-link :underline nil))
   "Face used to highlight text that matches `bog-citekey-format'.")
 
 (defun bog-fontify-non-heading-citekeys (limit)
@@ -1374,7 +1380,7 @@ Topic headings are determined by `bog-topic-heading-level'."
 (defvar bog-citekey-font-lock-keywords
   '((bog-fontify-non-heading-citekeys . bog-citekey-face)))
 
-(defvar bog-font-lock-function
+(defalias 'bog--font-lock-function
   (if (fboundp 'font-lock-flush)
       #'font-lock-flush
     #'font-lock-fontify-buffer))
@@ -1403,7 +1409,7 @@ Topic headings are determined by `bog-topic-heading-level'."
     (define-key map "v" 'bog-view-mode)
     (define-key map "y" 'bog-insert-heading-citekey)
     map)
-  "Map for Bog commands.
+  "Keymap for Bog commands.
 In Bog mode, these are under `bog-keymap-prefix'.
 `bog-command-map' can also be bound to a key outside of Bog
 mode.")
@@ -1426,20 +1432,19 @@ if ARG is omitted or nil.
 
 \\{bog-mode-map}"
   :lighter " Bog"
-  (progn
-    (cond
-     (bog-mode
-      (if (derived-mode-p 'org-mode)
-          (add-hook 'org-font-lock-hook 'bog-fontify-non-heading-citekeys)
-        (font-lock-add-keywords nil bog-citekey-font-lock-keywords)))
-     (t
-      (if (derived-mode-p 'org-mode)
-          (remove-hook 'org-font-lock-hook 'bog-fontify-non-heading-citekeys)
-        (font-lock-remove-keywords nil bog-citekey-font-lock-keywords))
-      (when (bound-and-true-p bog-view-mode)
-        (bog-view-mode -1))))
-    (when font-lock-mode
-      (funcall bog-font-lock-function))))
+  (cond
+   (bog-mode
+    (if (derived-mode-p 'org-mode)
+        (add-hook 'org-font-lock-hook #'bog-fontify-non-heading-citekeys nil t)
+      (font-lock-add-keywords nil bog-citekey-font-lock-keywords)))
+   (t
+    (if (derived-mode-p 'org-mode)
+        (remove-hook 'org-font-lock-hook #'bog-fontify-non-heading-citekeys t)
+      (font-lock-remove-keywords nil bog-citekey-font-lock-keywords))
+    (when (bound-and-true-p bog-view-mode)
+      (bog-view-mode -1))))
+  (when font-lock-mode
+    (bog--font-lock-function)))
 
 
 ;;; View minor mode