summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBasil L. Contovounesios <contovob@tcd.ie>2020-06-26 09:28:38 +0100
committerBasil L. Contovounesios <contovob@tcd.ie>2020-06-26 09:28:38 +0100
commit2dbe3ccb1bc5e94188a3c180165198ad63c1f1f9 (patch)
tree225d2799009748eceb367fccc808b8b5a3a548e5
parent6c8fa1b4961e279ae63130902996c5f71a2e64e4 (diff)
parentc2cbbd99e2b6b9b79c15acec025333089dbea920 (diff)
downloadbog-2dbe3ccb1bc5e94188a3c180165198ad63c1f1f9.tar.gz
Merge branch 'blc/lex' [#12]
-rw-r--r--Makefile9
-rw-r--r--bog-tests.el150
-rw-r--r--bog.el105
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