├── .gitignore ├── .mailmap ├── .dir-locals.el ├── example ├── notes │ ├── another-topic.org │ └── org-mode-pubs.org ├── stage │ ├── dowloaded-file.txt │ └── downloaded.bib └── bibs │ ├── dominik2010org.bib │ ├── schulte2011active.bib │ └── schulte2012multi.bib ├── Makefile ├── .github └── workflows │ └── test.yml ├── README.org ├── NEWS ├── bog-tests.el └── bog.el /.gitignore: -------------------------------------------------------------------------------- 1 | *-autoloads.el 2 | *.elc 3 | -------------------------------------------------------------------------------- /.mailmap: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil . ((sentence-end-double-space . t)))) 2 | -------------------------------------------------------------------------------- /example/notes/another-topic.org: -------------------------------------------------------------------------------- 1 | 2 | * subtopic 3 | 4 | ** name1990word 5 | -------------------------------------------------------------------------------- /example/stage/dowloaded-file.txt: -------------------------------------------------------------------------------- 1 | This file would usually be an associated PDF. 2 | -------------------------------------------------------------------------------- /example/bibs/dominik2010org.bib: -------------------------------------------------------------------------------- 1 | @book{dominik2010org, 2 | author = {Dominik, Carsten}, 3 | title = {The {O}rg Mode 7 Reference Manual - {O}rganize Your 4 | Life with {GNU} {E}macs}, 5 | publisher = {Network Theory Ltd.}, 6 | year = 2010 7 | } 8 | -------------------------------------------------------------------------------- /example/stage/downloaded.bib: -------------------------------------------------------------------------------- 1 | @article{hinsen2011data, 2 | author = {Hinsen, Konrad}, 3 | title = {A Data and Code Model for Reproducible Research and 4 | Executable Papers}, 5 | journal = {Procedia Computer Science}, 6 | year = 2011, 7 | volume = 4, 8 | pages = {579--588}, 9 | publisher = {Elsevier} 10 | } 11 | -------------------------------------------------------------------------------- /example/bibs/schulte2011active.bib: -------------------------------------------------------------------------------- 1 | @article{schulte2011active, 2 | author = {Schulte, Eric and Davison, Dan}, 3 | title = {Active Documents with {O}rg-mode}, 4 | journal = {Computing in Science \& Engineering}, 5 | year = 2011, 6 | volume = 13, 7 | number = 3, 8 | pages = {66--73}, 9 | publisher = {Institute of Electrical and Electronics Engineers, 10 | Inc.,| y USA USA} 11 | } 12 | -------------------------------------------------------------------------------- /example/bibs/schulte2012multi.bib: -------------------------------------------------------------------------------- 1 | @article{schulte2012multi, 2 | author = {Schulte, Eric and Davison, Dan and Dye, Thomas and 3 | Dominik, Carsten}, 4 | title = {A Multi-language Computing Environment for Literate 5 | Programming and Reproducible Research}, 6 | journal = {Journal of Statistical Software}, 7 | year = 2012, 8 | volume = 46, 9 | number = 3, 10 | pages = {1--24}, 11 | publisher = {American Statistical Association} 12 | } 13 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | EMACS ?= emacs 3 | LOAD_PATH ?= 4 | BATCH = $(EMACS) -Q --batch $(LOAD_PATH) 5 | 6 | all: bog.elc bog-autoloads.el 7 | 8 | .PHONY: test 9 | test: bog.elc bog-tests.elc 10 | @$(BATCH) -L . -l bog-tests.elc \ 11 | --eval "(ert-run-tests-batch-and-exit '(not (tag interactive)))" 12 | 13 | .PHONY: clean 14 | clean: 15 | $(RM) bog.elc bog-autoloads.el bog-tests.elc 16 | 17 | %.elc: %.el 18 | @$(BATCH) -L . -f batch-byte-compile $< 19 | 20 | bog-autoloads.el: bog.el 21 | @$(BATCH) -L . --eval \ 22 | "(let* ((default-directory (file-name-as-directory \"$(CURDIR)\")) \ 23 | (target (expand-file-name \"$@\")) \ 24 | (excludes (list \"bog-tests.el\")) \ 25 | (make-backup-files nil)) \ 26 | (if (fboundp (quote loaddefs-generate)) \ 27 | (loaddefs-generate default-directory target excludes) \ 28 | (update-file-autoloads \"$<\" t target)))" 29 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: [push, pull_request] 3 | permissions: {} 4 | 5 | jobs: 6 | build: 7 | runs-on: ubuntu-latest 8 | 9 | strategy: 10 | matrix: 11 | emacs_version: 12 | - 24.3 13 | - 24.4 14 | - 24.5 15 | - 25.1 16 | - 25.2 17 | - 25.3 18 | - 26.1 19 | - 26.2 20 | - 26.3 21 | - 27.1 22 | - 27.2 23 | - 28.1 24 | - 28.2 25 | - 29.1 26 | - 29.2 27 | - 29.3 28 | - 29.4 29 | - 30.1 30 | - 30.2 31 | - release-snapshot 32 | - snapshot 33 | 34 | steps: 35 | - uses: actions/checkout@v5 36 | with: 37 | persist-credentials: false 38 | 39 | - uses: purcell/setup-emacs@master 40 | with: 41 | version: ${{ matrix.emacs_version }} 42 | 43 | - run: make all 44 | - run: make test 45 | -------------------------------------------------------------------------------- /example/notes/org-mode-pubs.org: -------------------------------------------------------------------------------- 1 | #+startup: showall 2 | 3 | Before you start, tell Bog where things are. 4 | 5 | #+begin_src emacs-lisp :results silent 6 | (setq bog-notes-directory (expand-file-name "./") 7 | bog-bib-directory (expand-file-name "../bibs") 8 | bog-file-directory (expand-file-name "../citekey-files") 9 | bog-stage-directory) (expand-file-name "../stage") 10 | #+end_src 11 | 12 | Now start Bog with =M-x bog-mode= or 13 | 14 | #+begin_src emacs-lisp :results silent 15 | (bog-mode 1) 16 | #+end_src 17 | 18 | The rest of this file is an example of how notes can be structured. 19 | 20 | ------------------------------------------------------------------------ 21 | 22 | * Books 23 | 24 | ** dominik2010org 25 | 26 | The Org Mode 7 Reference Manual - Organize your life with GNU Emacs 27 | 28 | http://dl.acm.org/citation.cfm?id=1952135 29 | 30 | The BibTeX files are stored in =bog-bib-directory=. You can open the 31 | file for the current heading with =bog-find-citekey-bib= (=C-c " b=). 32 | 33 | * Reproducible research 34 | 35 | ** hinsen2011data 36 | 37 | A data and code model for reproducible research and executable papers 38 | 39 | doi:10.1016/j.procs.2011.04.061 40 | 41 | A new BibTeX file for this citekey has been downloaded to 42 | =bog-stage-directory=. To prepare this file (and any other BibTeX 43 | file in that directory), run =bog-clean-and-rename-staged-bibs=. 44 | 45 | The BibTeX mode settings below make the automatically generated 46 | citekey match Bog's citekey format. 47 | 48 | #+begin_src emacs-lisp :results silent 49 | (setq bibtex-autokey-year-length 4 50 | bibtex-autokey-titleword-length nil 51 | bibtex-autokey-titlewords-stretch 0 52 | bibtex-autokey-titlewords 1 53 | bibtex-autokey-year-title-separator "") 54 | #+end_src 55 | 56 | ** TODO schulte2011active 57 | 58 | Active documents with Org-mode 59 | 60 | doi:10.1109/MCSE.2011.41 61 | 62 | A file associated with this citekey has been downloaded to 63 | =bog-stage-directory=. To associate that file with this heading, run 64 | =bog-rename-staged-file-to-citekey= (=C-c " r=). 65 | 66 | That file is now stored in =bog-file-directory= and can be opened with 67 | =bog-find-citekey-file= (=C-c " f=). 68 | 69 | ** schulte2012multi 70 | 71 | A multi-language computing environment for literate programming and 72 | reproducible research 73 | 74 | http://www.jstatsoft.org/v46/i03 75 | 76 | After a title and URL (neither of which are necessary), there will 77 | usually be notes about the paper. To refer to another study, just 78 | insert the citekey name, such as dominik2010org. This is just normal 79 | text, but many Bog commands treat it as special. Put your point on 80 | dominik2010org, and run =bog-open-first-citekey-link= (=C-c " l=). 81 | 82 | Notes do not have to be limited to a single file. name1990word is a 83 | study in another notes file. Place the point on name1990word and run 84 | =bog-goto-citekey-heading-in-notes= (=C-c " H=) to jump to that 85 | heading. 86 | 87 | Look at the other commands by pressing =C-c " C-h=. 88 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+title: Bog 2 | #+options: toc:nil 3 | #+startup: showall 4 | 5 | [[https://github.com/kyleam/bog/actions/workflows/test.yml][https://github.com/kyleam/bog/actions/workflows/test.yml/badge.svg]] 6 | [[https://melpa.org/#/bog][https://melpa.org/packages/bog-badge.svg]] 7 | 8 | Bog is a system for taking research notes in [[https://orgmode.org/][Org mode]]. It adds a few 9 | research-specific features, nearly all of which are focused on managing 10 | and taking notes with Org, not on writing research articles with Org. 11 | 12 | * Installation 13 | 14 | Bog is available on [[https://melpa.org/][MELPA]]. 15 | 16 | To enable Bog in all Org buffers, add it to =org-mode-hook=. 17 | 18 | #+begin_src emacs-lisp 19 | (add-hook 'org-mode-hook #'bog-mode) 20 | #+end_src 21 | 22 | * Workflow 23 | 24 | The Bog workflow is focused around the citekey, which is the only study 25 | information that must be included in the notes. This unique identifier 26 | is used as a link to the BibTeX file and other associated files. 27 | 28 | In the example below, the citekey "name2000word" is a study heading. A 29 | study heading is defined as a heading that has a citekey as a title or 30 | as the value of =bog-citekey-property=. When a citekey occurs anywhere 31 | else (like "another1999study" below), it is taken as a reference to 32 | another study (which may or may not have a subtree in this or another 33 | Org file). 34 | 35 | #+begin_example 36 | 37 | ,* Topic heading 38 | 39 | ,** TODO name2000word :atag: 40 | 41 | 42 | 43 | Article notes ... a reference to another1999study ... 44 | #+end_example 45 | 46 | The default format for the citekey is the first author's last name, the 47 | year, and then the first non-trivial word. To have BibTeX mode 48 | automatically generate a key of this format, the =bibtex-autokey-*= 49 | settings can be modified. 50 | 51 | #+begin_src emacs-lisp 52 | (setq bibtex-autokey-year-length 4 53 | bibtex-autokey-titleword-length 'infty 54 | bibtex-autokey-titlewords-stretch 0 55 | bibtex-autokey-titlewords 1 56 | bibtex-autokey-year-title-separator "") 57 | #+end_src 58 | 59 | * Main features 60 | 61 | Many Bog functions take the citekey from the notes. If the point is on 62 | a citekey (like "another1999study" above), then that citekey will be 63 | used. If this fails, many functions will try to take the citekey from 64 | the first parent heading that is a study heading. 65 | 66 | - =bog-find-citekey-file= 67 | 68 | Open an associated file (usually a PDF) for a citekey. 69 | 70 | - =bog-find-citekey-bib= 71 | 72 | Open a BibTeX file for a citekey. 73 | 74 | BibTeX entries can be stored in one of two ways: 75 | - As a single file with many entries 76 | - As single-entry files named citekey.bib within a common directory 77 | 78 | - =bog-search-citekey-on-web= 79 | 80 | Search Google Scholar for a citekey. The default citekey format 81 | (first author's last name, year, and first non-trivial word) usually 82 | contains enough information to make this search successful. 83 | 84 | - =bog-rename-staged-file-to-citekey= 85 | 86 | Rename a new file (usually a PDF) to be associated with a citekey. 87 | 88 | - =bog-clean-and-rename-staged-bibs= 89 | 90 | Rename new BibTeX files. If a separate BibTeX file is used for each 91 | citekey, this function can be used to rename all new BibTeX files. 92 | =bibtex-clean-entry= is used to clean the entry and autogenerate the 93 | key. 94 | 95 | - =bog-create-combined-bib= 96 | 97 | Generate a combined BibTeX file for all citekeys in buffer. This is 98 | useful if single-entry BibTeX files are used. 99 | 100 | Other useful functions include 101 | 102 | - =bog-citekey-tree-to-indirect-buffer= 103 | - =bog-goto-citekey-heading-in-notes= 104 | - =bog-insert-heading-citekey= 105 | - =bog-jump-to-topic-heading= 106 | - =bog-list-duplicate-heading-citekeys= 107 | - =bog-list-orphan-citekeys= 108 | - =bog-open-citekey-link= 109 | - =bog-open-first-citekey-link= 110 | - =bog-refile= 111 | - =bog-search-notes= 112 | - =bog-search-notes-for-citekey= 113 | - =bog-sort-topic-headings-in-buffer= 114 | - =bog-sort-topic-headings-in-notes= 115 | 116 | You can try out many of the commands in 117 | [[file:example/notes/org-mode-pubs.org][example/notes/org-mode-pubs.org]]. 118 | 119 | * Variables 120 | 121 | Several variables determine where Bog looks for things. 122 | 123 | - =bog-bib-directory= or =bog-bib-file= 124 | - =bog-file-directory= 125 | - =bog-note-directory= 126 | - =bog-stage-directory= 127 | 128 | The variables below are important for specifying how Bog behaves. 129 | 130 | - =bog-citekey-format= 131 | 132 | A regular expression that defines the format used for citekeys. 133 | 134 | - =bog-find-citekey-bib-func= 135 | 136 | A function to find a citekey in a BibTeX file. This determines 137 | whether a directory of single-entry BibTeX files or a single BibTeX 138 | file is used. 139 | 140 | * Keybindings 141 | 142 | A keymap is defined for Bog under the prefix =C-c "​=. If you prefer 143 | something else (like =C-c b=), set =bog-keymap-prefix=. 144 | 145 | Many of the Bog functions are useful outside of an Org buffer. You 146 | can turn Bog minor mode on (=bog-mode=) in non-Org buffers to get 147 | access to the keymap and citekey highlighting. To make Bog commands 148 | available from any buffer, bind =bog-command-map= to a global key. 149 | 150 | * Other approaches 151 | 152 | If Bog doesn't fit your workflow, there are a good number of other 153 | approaches to explore. On the Org mode mailing list, there are some 154 | [[https://yhetil.org/orgmode/528AC19F.3000803@binghamton.edu/][nice]] [[https://yhetil.org/orgmode/2c75873c0906230106h3daf3d34y230845e15dad278e@mail.gmail.com/][descriptions]] of systems people have come up with for taking 155 | research notes in Org. For a package that focuses on both taking 156 | research notes and writing research articles, look into [[https://github.com/jkitchin/org-ref][Org-ref]]. 157 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | Bog NEWS -- history of user-visible changes -*- mode: org; -*- 2 | 3 | * v1.3.0 4 | 5 | ** New features 6 | 7 | - New option ~bog-citekey-format-allow-at~, which can be disabled to 8 | make it easier to use Bog commands on citekeys that use Pandoc's 9 | @citekey format. 10 | 11 | - New hook ~bog-clean-bib-hook~ is run for each file processed with 12 | ~bog-clean-and-rename-staged-bibs~. 13 | 14 | ** Other changes 15 | 16 | - The default value for ~bog-file-secondary-name~ has been changed 17 | from "-supplement" to ".supplement". 18 | 19 | * v1.2.0 20 | 21 | ** New features 22 | 23 | - New command ~bog-list-orphan-files~. 24 | - New command ~bog-dired-jump-to-citekey-file~. 25 | 26 | * v1.1.0 27 | 28 | ** New features 29 | 30 | - New command ~bog-list-orphan-files~ finds citekey files that don't 31 | have a corresponding citekey heading in the notes. 32 | 33 | - New command ~bog-rename-citekey-file~ updates the name of an 34 | existing citekey file. 35 | 36 | - New option ~bog-combined-bib-ignore-not-found~ controls whether 37 | ~bog-create-combined-bib~ prompts to continue when a citekey's bib 38 | file is missing. With a prefix argument to 39 | ~bog-create-combined-bib~, the meaning of this option is reversed. 40 | 41 | ** Other changes 42 | 43 | - ~bog-search-notes~ and ~bog-search-notes-for-citekey~ now ignore any 44 | agenda restriction locks. 45 | 46 | - In Dired, ~bog-create-combined-bib~ now always acts on the marked 47 | files (or, if there are none, the one at point) regardless of the 48 | prefix argument, which is no longer interpreted by 49 | ~dired-get-marked-files~. 50 | 51 | * v1.0.0 52 | 53 | ** New features 54 | 55 | - Any file type (not just PDFs) can now be associated with a citekey. 56 | Variables ~bog-pdf-directory~ and ~bog-pdf-file-name-separators~ 57 | have been replaced by new variables ~bog-file-directory~ and 58 | ~bog-citekey-file-name-separators~, respectively. 59 | Unlike ~bog-pdf-file-name-separators~, the value of 60 | ~bog-citekey-file-name-separators~ is a regular expression, not a 61 | list. 62 | 63 | - In addition to ~bog-find-citekey-file~ and ~bog-find-citekey-bib~, 64 | most functions will now prompt with set of citekeys when prefix 65 | argument is given. What this list is depends on the function. 66 | 67 | - When locating a citekey from the notes fails, functions will now 68 | prompt with a list of citekeys instead of giving an error. 69 | 70 | - All Bog commands now work outside of Org buffers. To access them, 71 | bind ~bog-command~ a global key. 72 | 73 | - When Bog mode is turned on in non-Org buffers, text matching 74 | bog-citekey-format is now highlighted, without relying on 75 | Org-specific font-lock mechanisms. 76 | 77 | - New command ~bog-citekey-tree-to-indirect-buffer~ opens the subtree 78 | for a citekey in an indirect buffer. The citekey is either taken from 79 | at point or selected from all heading citekeys. 80 | 81 | - New command ~bog-insert-heading-citekey~ prompts with all heading 82 | citekeys and inserts the selected one at point. 83 | 84 | - New commands ~bog-open-citekey-link~ and 85 | ~bog-open-first-citekey-link~ open a link (or links) for a citekey. 86 | ~bog-open-first-citekey-link~ is particularly useful if you place 87 | the main link for the study (usually a DOI link) as the first link 88 | in the citekey's subtree. The citekey is either taken from at point 89 | or selected from all heading citekeys. 90 | 91 | - New commands ~bog-next-non-heading-citekey~ and 92 | ~bog-previous-non-heading-citekey~ 93 | 94 | - New command ~bog-list-orphan-citekeys~ finds citekeys that are 95 | referred to in the notes but don't have their own heading. 96 | 97 | - ~bog-create-combined-bib~ now supports collecting citekeys from 98 | marked files in a Dired buffer. 99 | 100 | - ~bog-goto-citekey-heading-in-notes~ now works when citekeys are 101 | stored are stored as property values. 102 | 103 | - New command ~bog-list-duplicate-heading-citekeys~ finds citekeys 104 | that have more than one heading in the notes. 105 | 106 | - New command ~bog-jump-to-topic-heading~ provides quick navigation to 107 | topic headings in any note file. 108 | 109 | - New variable ~bog-subdirectory-group~ controls whether BibTeX and 110 | citekey-associated files are organized into subdirectories generated 111 | from a ~bog-citekey-format~ regexp group. 112 | 113 | - New minor mode Bog View sets the buffer to read-only and provides 114 | single-letter key for bindings for many Bog commands. 115 | 116 | ** Other changes 117 | 118 | - The command ~bog-goto-citekey-heading-in-buffer~ has been removed. 119 | Similar behavior is now available when a double C-u is used as the 120 | prefix argument to ~bog-goto-citekey-heading-in-notes~. 121 | 122 | - ~bog-goto-citekey-heading-in-notes~ now widens the buffer if the 123 | heading is outside of the narrowed region. 124 | 125 | - The format for citekeys is now restricted to letters, digits, 126 | underscores, and hyphens. 127 | 128 | - ~bog-notes-directory~ has been renamed to ~bog-note-directory~. 129 | 130 | - New variable ~bog-citekey-web-search-groups~ specifies which parts 131 | of the citekey are used for the search. 132 | 133 | * v0.6.0 134 | 135 | ** New features 136 | 137 | - Citekeys can now be stored as a property in addition to as a heading 138 | title. 139 | 140 | - Make functions compatible with a single BibTeX file. 141 | - Add new command ~bog-refile~. 142 | 143 | - Multiple PDFs can be associated with a citekey. 144 | 145 | - Add commands ~bog-goto-citekey-heading-in-buffer~ and 146 | ~bog-goto-citekey-heading-in-notes~. 147 | 148 | - Make PDF file separator customizable. 149 | 150 | - Add agenda search commands ~bog-search-notes~ and 151 | ~bog-search-notes-for-citekey~. 152 | 153 | - Add commands ~bog-sort-topic-headings-in-buffer~ and 154 | ~bog-sort-topic-headings-in-notes~. 155 | 156 | - Read a new name if renaming to PDF that exists (instead of giving an 157 | error). 158 | 159 | - Allow numbers to be in the title word of citekey. 160 | 161 | ** Bugs fixed 162 | 163 | - Fix a logic bug in citekey selection. 164 | 165 | ** Other changes 166 | 167 | - In addition to renaming PDF files, use the stage for renaming and 168 | cleaning BibTeX files. 169 | 170 | - Remove the path when presenting choices for renaming a PDF. 171 | 172 | - Define a keymap and minor mode for Bog. 173 | -------------------------------------------------------------------------------- /bog-tests.el: -------------------------------------------------------------------------------- 1 | ;;; bog-tests.el --- Tests for Bog -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2013-2016 Kyle Meyer 4 | ;; Copyright (C) 2020 Basil L. Contovounesios 5 | 6 | ;; Author: Kyle Meyer 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (require 'bog) 24 | (require 'ert) 25 | (require 'org) 26 | 27 | (with-no-warnings ;; Silence "lacks a prefix" warning. 28 | (defvar citekey)) 29 | 30 | ;; Modified from magit-tests.el. 31 | (defmacro bog-tests-with-temp-dir (&rest body) 32 | (declare (indent 0) (debug t)) 33 | (let ((dir (make-symbol "dir"))) 34 | `(let ((,dir (file-name-as-directory (make-temp-file "dir" t)))) 35 | (unwind-protect 36 | (let ((default-directory ,dir)) ,@body) 37 | (delete-directory ,dir t))))) 38 | 39 | ;; Modified from org-tests.el. 40 | (defmacro bog-tests-with-temp-text (text &rest body) 41 | "Run body in a temporary buffer with Org-mode buffer. 42 | Insert TEXT in buffer. 43 | 44 | If string \"\" appears in TEXT, replace it with the 45 | value of the variable `citekey'. 46 | 47 | If the string \"\" appears in TEXT then remove it and 48 | place the point there before running BODY, otherwise place the 49 | point at the beginning of the inserted text." 50 | (declare (indent 1) (debug t)) 51 | `(with-temp-buffer 52 | (org-mode) 53 | (insert ,text) 54 | (goto-char (point-min)) 55 | (when (and (bound-and-true-p citekey) 56 | (search-forward "" nil t)) 57 | (replace-match citekey t t)) 58 | (goto-char (point-min)) 59 | (when (search-forward "" nil t) 60 | (replace-match "" t t)) 61 | ,@body)) 62 | 63 | 64 | ;;; Citekey functions 65 | 66 | (ert-deftest bog-citekey-p () 67 | (should (bog-citekey-p "name2010word")) 68 | (should (bog-citekey-p "name1900word")) 69 | (should-not (bog-citekey-p "name201word"))) 70 | 71 | (ert-deftest bog-citekey-p/hyphen-in-name () 72 | (should (bog-citekey-p "hyphen-ok2010word"))) 73 | 74 | (ert-deftest bog-citekey/other-text () 75 | (should-not (bog-citekey-p "name2010word more text"))) 76 | 77 | (ert-deftest bog--citekey-groups-with-delim () 78 | (let ((citekey "name2010word")) 79 | (should (equal (bog--citekey-groups-with-delim citekey ",") 80 | "name,2010,word")))) 81 | 82 | (ert-deftest bog-citekey-at-point/bob () 83 | (let ((citekey "name2010word")) 84 | (with-temp-buffer 85 | (insert citekey) 86 | (goto-char (point-min)) 87 | (should (equal (bog-citekey-at-point) citekey))))) 88 | 89 | (ert-deftest bog-citekey-at-point/newline () 90 | (let ((citekey "name2010word")) 91 | (with-temp-buffer 92 | (insert "\n" citekey) 93 | (should (equal (bog-citekey-at-point) citekey))))) 94 | 95 | (ert-deftest bog-citekey-at-point/parens () 96 | (let ((citekey "name2010word")) 97 | (with-temp-buffer 98 | (insert "\n(" citekey ")") 99 | (backward-char 2) 100 | (should (equal (bog-citekey-at-point) citekey))))) 101 | 102 | (ert-deftest bog-citekey-at-point/spaces () 103 | (let ((citekey "name2010word")) 104 | (with-temp-buffer 105 | (insert "\n " citekey " ") 106 | (backward-char 2) 107 | (should (equal (bog-citekey-at-point) citekey))))) 108 | 109 | (ert-deftest bog-citekey-at-point/with-hyphen () 110 | (let ((citekey "hyphen-name2010word")) 111 | (with-temp-buffer 112 | (insert citekey) 113 | ;; At beginning 114 | (goto-char (point-min)) 115 | (should (equal (bog-citekey-at-point) citekey)) 116 | ;; On hyphen 117 | (skip-chars-forward "-") 118 | (should (equal (bog-citekey-at-point) citekey)) 119 | ;; After hyphen 120 | (forward-char) 121 | (should (equal (bog-citekey-at-point) citekey)) 122 | ;; On word 123 | (skip-chars-forward "0-9") 124 | ;; At year 125 | (skip-chars-forward "-a-z") 126 | (should (equal (bog-citekey-at-point) citekey))))) 127 | 128 | (ert-deftest bog-citekey-from-tree/heading-title-current-level () 129 | (let ((citekey "name2010word")) 130 | (bog-tests-with-temp-text 131 | " 132 | * top level 133 | ** 134 | some text 135 | " 136 | (should (equal (bog-citekey-from-tree) citekey))))) 137 | 138 | (ert-deftest bog-citekey-from-tree/heading-title-on-heading () 139 | (let ((citekey "name2010word")) 140 | (bog-tests-with-temp-text 141 | " 142 | * top level 143 | ** 144 | some text" 145 | (should (equal (bog-citekey-from-tree) citekey))))) 146 | 147 | (ert-deftest bog-citekey-from-tree/heading-title-in-parent () 148 | (let ((citekey "name2010word")) 149 | (bog-tests-with-temp-text 150 | " 151 | * top level 152 | ** 153 | *** subheading 154 | some text 155 | " 156 | (should (equal (bog-citekey-from-tree) citekey))))) 157 | 158 | (ert-deftest bog-citekey-from-tree/property-current-level () 159 | (let ((citekey "name2010word")) 160 | (bog-tests-with-temp-text 161 | " 162 | * top level 163 | ** subhead 164 | :PROPERTIES: 165 | :CUSTOM_ID: 166 | :END: 167 | 168 | some text" 169 | (should (equal (bog-citekey-from-tree) citekey))))) 170 | 171 | (ert-deftest bog-citekey-from-tree/property-in-parent () 172 | (let ((citekey "name2010word")) 173 | (bog-tests-with-temp-text 174 | " 175 | * top level 176 | :PROPERTIES: 177 | :CUSTOM_ID: 178 | :END: 179 | 180 | some text 181 | 182 | ** subhead 183 | " 184 | (should (equal (bog-citekey-from-tree) citekey))))) 185 | 186 | (ert-deftest bog-citekey-from-tree/property-on-heading () 187 | (let ((citekey "name2010word")) 188 | (bog-tests-with-temp-text 189 | " 190 | * top level 191 | ** subhead 192 | :PROPERTIES: 193 | :CUSTOM_ID: 194 | :END: 195 | some text" 196 | (should (equal (bog-citekey-from-tree) citekey))))) 197 | 198 | (ert-deftest bog-citekey-from-surroundings/on-heading () 199 | (let ((citekey "name2010word")) 200 | (bog-tests-with-temp-text 201 | " 202 | * top level 203 | ** 204 | some text" 205 | (should (equal (bog-citekey-from-surroundings) citekey))))) 206 | 207 | (ert-deftest bog-citekey-from-surroundings/before-text-citekey () 208 | (let ((citekey "name2010word")) 209 | (bog-tests-with-temp-text 210 | " 211 | * top level 212 | ** other2000key 213 | some text and " 214 | (should (equal (bog-citekey-from-surroundings) citekey))))) 215 | 216 | (ert-deftest bog-citekey-from-surroundings/after-text-citekey () 217 | (let ((citekey "name2010word")) 218 | (bog-tests-with-temp-text 219 | " 220 | * top level 221 | ** other2000key 222 | some text and " 223 | (should (equal (bog-citekey-from-surroundings) citekey))))) 224 | 225 | (ert-deftest bog-citekey-from-surroundings/on-text-citekey () 226 | (let ((citekey "name2010word")) 227 | (bog-tests-with-temp-text 228 | " 229 | * top level 230 | ** other2000key 231 | some text and " 232 | (forward-char) 233 | (should (equal (bog-citekey-from-surroundings) citekey))))) 234 | 235 | (ert-deftest bog-citekey-from-surroundings/no-citekey () 236 | (bog-tests-with-temp-text 237 | " 238 | * top level 239 | ** second" 240 | (should-not (bog-citekey-from-surroundings)))) 241 | 242 | (ert-deftest bog-citekeys-in-buffer () 243 | (should (equal '("abc1900def" "ghi1950jkl" "mno2000pqr") 244 | (bog-tests-with-temp-text 245 | " 246 | * abc1900def 247 | ghi1950jkl 248 | * mno2000pqr 249 | * mno2000pqr" 250 | (sort (bog-citekeys-in-buffer) #'string-lessp))))) 251 | 252 | (ert-deftest bog-heading-citekeys-in-buffer () 253 | (should (equal '("abc1900def" "mno2000pqr") 254 | (bog-tests-with-temp-text 255 | " 256 | * abc1900def 257 | ghi1950jkl 258 | * mno2000pqr" 259 | (bog-heading-citekeys-in-buffer))))) 260 | 261 | (ert-deftest bog-next-non-heading-citekey/default-arg () 262 | (let ((citekey "name2010word")) 263 | (bog-tests-with-temp-text 264 | " 265 | 266 | other2000key" 267 | (bog-next-non-heading-citekey) 268 | (should (equal citekey (bog-citekey-at-point)))))) 269 | 270 | (ert-deftest bog-next-non-heading-citekey/pos-arg () 271 | (let ((citekey "name2010word")) 272 | (bog-tests-with-temp-text 273 | " 274 | 275 | other2000key " 276 | (bog-next-non-heading-citekey 2) 277 | (should (equal citekey (bog-citekey-at-point)))))) 278 | 279 | (ert-deftest bog-next-non-heading-citekey/on-citekey () 280 | (let ((citekey "name2010word")) 281 | (bog-tests-with-temp-text 282 | " 283 | other2000key 284 | " 285 | (bog-next-non-heading-citekey) 286 | (should (equal citekey (bog-citekey-at-point)))))) 287 | 288 | (ert-deftest bog-next-non-heading-citekey/pos-neg-arg () 289 | (let ((citekey "name2010word")) 290 | (bog-tests-with-temp-text 291 | " " 292 | (bog-next-non-heading-citekey -1) 293 | (should (equal citekey (bog-citekey-at-point)))))) 294 | 295 | (ert-deftest bog-previous-non-heading-citekey/default-arg () 296 | (let ((citekey "name2010word")) 297 | (bog-tests-with-temp-text 298 | "other2000key " 299 | (bog-previous-non-heading-citekey) 300 | (should (equal citekey (bog-citekey-at-point)))))) 301 | 302 | (ert-deftest bog-previous-non-heading-citekey/on-citekey () 303 | (let ((citekey "name2010word")) 304 | (bog-tests-with-temp-text 305 | " 306 | 307 | other2000key" 308 | (bog-previous-non-heading-citekey) 309 | (should (equal citekey (bog-citekey-at-point)))))) 310 | 311 | (ert-deftest bog-previous-non-heading-citekey/pos-arg () 312 | (let ((citekey "name2010word")) 313 | (bog-tests-with-temp-text 314 | " other2000key " 315 | (bog-previous-non-heading-citekey 2) 316 | (should (equal citekey (bog-citekey-at-point)))))) 317 | 318 | (ert-deftest bog--find-citekey-heading-in-buffer/citekey-heading () 319 | (let ((citekey "name2010word")) 320 | (bog-tests-with-temp-text 321 | " 322 | 323 | * other heading 324 | 325 | * " 326 | (goto-char (bog--find-citekey-heading-in-buffer citekey)) 327 | (should (equal citekey (org-get-heading t t)))))) 328 | 329 | (ert-deftest bog--find-citekey-heading-in-buffer/citekey-property () 330 | (let ((citekey "name2010word")) 331 | (bog-tests-with-temp-text 332 | (format " 333 | 334 | * other heading 335 | 336 | * heading 337 | :PROPERTIES: 338 | :%s: 339 | :END" 340 | bog-citekey-property) 341 | (goto-char (bog--find-citekey-heading-in-buffer citekey)) 342 | (should (equal "heading" (org-get-heading t t)))))) 343 | 344 | 345 | ;;; File functions 346 | 347 | (ert-deftest bog-file-citekey () 348 | (should (equal (bog-file-citekey "name2000word.pdf") "name2000word")) 349 | (should (equal (bog-file-citekey "name2000word-supp.pdf") "name2000word")) 350 | (should (equal (bog-file-citekey "name2000word_0.pdf") "name2000word")) 351 | (should-not (bog-file-citekey "name2000.pdf")) 352 | (should-not (bog-file-citekey "leader_name2000word.pdf"))) 353 | 354 | (ert-deftest bog-all-file-citekeys () 355 | (bog-tests-with-temp-dir 356 | (let ((bog-file-directory (expand-file-name "citekey-files"))) 357 | (make-directory bog-file-directory) 358 | (let ((default-directory bog-file-directory)) 359 | (make-directory "key2000butdir")) 360 | (write-region "" nil (expand-file-name "nokey.pdf" bog-file-directory)) 361 | (write-region "" nil (expand-file-name "one2010key.pdf" 362 | bog-file-directory)) 363 | (write-region "" nil (expand-file-name "two1980key.txt" 364 | bog-file-directory)) 365 | (should (equal (bog-all-file-citekeys) 366 | '("one2010key" "two1980key")))))) 367 | 368 | (ert-deftest bog-rename-staged-file-to-citekey/one-file () 369 | (bog-tests-with-temp-dir 370 | (let ((bog-stage-directory (expand-file-name "stage")) 371 | (bog-file-directory (expand-file-name "citekey-files")) 372 | (citekey "name2010word")) 373 | (make-directory bog-stage-directory) 374 | (make-directory bog-file-directory) 375 | (write-region "" nil (expand-file-name "one.pdf" bog-stage-directory)) 376 | (bog-tests-with-temp-text 377 | " 378 | * top level 379 | ** 380 | some text" 381 | (bog-rename-staged-file-to-citekey)) 382 | (should (file-exists-p (expand-file-name 383 | (concat citekey ".pdf") bog-file-directory))) 384 | (should-not (file-exists-p (expand-file-name 385 | "one.pdf" bog-stage-directory)))))) 386 | 387 | (ert-deftest bog-rename-staged-file-to-citekey/one-file-subdir () 388 | (bog-tests-with-temp-dir 389 | (let ((bog-stage-directory (expand-file-name "stage")) 390 | (bog-file-directory (expand-file-name "citekey-files")) 391 | (citekey "name2010word") 392 | (bog-subdirectory-group 2)) 393 | (make-directory bog-stage-directory) 394 | (make-directory bog-file-directory) 395 | (write-region "" nil (expand-file-name "one.pdf" bog-stage-directory)) 396 | (bog-tests-with-temp-text 397 | " 398 | * top level 399 | ** 400 | some text" 401 | (bog-rename-staged-file-to-citekey)) 402 | (should (file-exists-p (expand-file-name (concat "2010/" citekey ".pdf") 403 | bog-file-directory))) 404 | (should-not (file-exists-p (expand-file-name 405 | "one.pdf" bog-stage-directory)))))) 406 | 407 | (ert-deftest bog-file-citekeys/multiple-variants () 408 | (bog-tests-with-temp-dir 409 | (let* ((bog-file-directory (expand-file-name "citekey-files")) 410 | (citekey "name2010word") 411 | (variants (list (concat citekey ".pdf") 412 | (concat citekey ".txt") 413 | (concat citekey "_0.pdf") 414 | (concat citekey "-supplement.pdf"))) 415 | files-found) 416 | (make-directory bog-file-directory) 417 | (dolist (var variants) 418 | (write-region "" nil (expand-file-name var bog-file-directory))) 419 | (setq files-found (bog-citekey-files citekey)) 420 | (should (= (length files-found) 4))))) 421 | 422 | 423 | ;;; BibTeX functions 424 | 425 | (ert-deftest bog--prepare-bib-file () 426 | (bog-tests-with-temp-dir 427 | (let ((temp-file (make-temp-file 428 | (expand-file-name "bog-testing-" default-directory) 429 | nil ".bib")) 430 | (citekey "name2010word") 431 | (bog-bib-directory default-directory)) 432 | (with-current-buffer (find-file-noselect temp-file) 433 | (insert (format "\n@article{%s,\n" citekey) 434 | "title = {A title},\n" 435 | "author = {Last, First},\n" 436 | "journal = {Some journal},\n" 437 | "year = 2009,\n" 438 | "\n}") 439 | (save-buffer)) 440 | (kill-buffer (get-file-buffer temp-file)) 441 | (bog--prepare-bib-file temp-file) 442 | (should-not (file-exists-p temp-file)) 443 | (let* ((new-file (concat citekey ".bib")) 444 | (new-buffer (get-file-buffer new-file))) 445 | (should (file-exists-p new-file)) 446 | (should-not new-buffer) 447 | (delete-file new-file))))) 448 | 449 | (ert-deftest bog--prepare-bib-file/was-open () 450 | (bog-tests-with-temp-dir 451 | (let ((temp-file (make-temp-file 452 | (expand-file-name "bog-testing-" default-directory) 453 | nil ".bib")) 454 | (citekey "name2010word") 455 | (bog-bib-directory default-directory)) 456 | (with-current-buffer (find-file-noselect temp-file) 457 | (insert (format "\n@article{%s,\n" citekey) 458 | "title = {A title},\n" 459 | "author = {Last, First},\n" 460 | "journal = {Some journal},\n" 461 | "year = 2009,\n" 462 | "\n}") 463 | (save-buffer)) 464 | (bog--prepare-bib-file temp-file) 465 | (should-not (file-exists-p temp-file)) 466 | (let* ((new-file (concat citekey ".bib")) 467 | (new-buffer (get-file-buffer new-file))) 468 | (should new-buffer) 469 | (kill-buffer new-buffer) 470 | (delete-file new-file))))) 471 | 472 | (ert-deftest bog--prepare-bib-file/subdir () 473 | (bog-tests-with-temp-dir 474 | (let ((temp-file (make-temp-file 475 | (expand-file-name "bog-testing-" default-directory) 476 | nil ".bib")) 477 | (citekey "name2010word") 478 | (bog-bib-directory default-directory) 479 | (bog-subdirectory-group 2)) 480 | (with-current-buffer (find-file-noselect temp-file) 481 | (insert (format "\n@article{%s,\n" citekey) 482 | "title = {A title},\n" 483 | "author = {Last, First},\n" 484 | "journal = {Some journal},\n" 485 | "year = 2009,\n" 486 | "\n}") 487 | (save-buffer)) 488 | (kill-buffer (get-file-buffer temp-file)) 489 | (bog--prepare-bib-file temp-file) 490 | (should-not (file-exists-p temp-file)) 491 | (let ((new-file (concat "2010/" citekey ".bib"))) 492 | (should (file-exists-p new-file)) 493 | (delete-file new-file))))) 494 | 495 | (ert-deftest bog-sort-topic-headings-in-buffer () 496 | (bog-tests-with-temp-text 497 | " 498 | * topic heading 499 | ** zoo2000key 500 | ** apple2000key 501 | 502 | * another topic heading 503 | ** orange2000key 504 | ** banana2000key 505 | ** yogurt2000key" 506 | (let ((bog-topic-heading-level 1)) 507 | (bog-sort-topic-headings-in-buffer) 508 | (outline-next-visible-heading 2) 509 | (should (equal (org-no-properties (org-get-heading t t)) 510 | "apple2000key")) 511 | (outline-next-visible-heading 3) 512 | (should (equal (org-no-properties (org-get-heading t t)) 513 | "banana2000key"))))) 514 | 515 | (ert-deftest bog-sort-topic-headings-in-buffer/ignore-citekey-heading () 516 | (bog-tests-with-temp-text 517 | " 518 | * topic heading 519 | ** zoo2000key 520 | ** apple2000key 521 | * citekey2000heading 522 | ** orange2000key 523 | ** banana2000key 524 | ** yogurt2000key" 525 | (let ((bog-topic-heading-level 1)) 526 | (bog-sort-topic-headings-in-buffer) 527 | (outline-next-visible-heading 2) 528 | (should (equal (org-no-properties (org-get-heading t t)) 529 | "apple2000key")) 530 | (outline-next-visible-heading 3) 531 | (should (equal (org-no-properties (org-get-heading t t)) 532 | "orange2000key"))))) 533 | 534 | (ert-deftest bog-sort-topic-headings-in-buffer/ignore-citekey-property () 535 | (bog-tests-with-temp-text 536 | (format " 537 | * topic heading 538 | ** zoo2000key 539 | ** apple2000key 540 | * non-topic heading 541 | :PROPERTIES: 542 | :%s: citekey2000prop 543 | :END: 544 | ** orange2000key 545 | ** banana2000key 546 | ** yogurt2000key" 547 | bog-citekey-property) 548 | (let ((bog-topic-heading-level 1)) 549 | (bog-sort-topic-headings-in-buffer) 550 | (outline-next-visible-heading 2) 551 | (should (equal (org-no-properties (org-get-heading t t)) 552 | "apple2000key")) 553 | (outline-next-visible-heading 3) 554 | (should (equal (org-no-properties (org-get-heading t t)) 555 | "orange2000key"))))) 556 | 557 | (ert-deftest bog-sort-topic-headings-in-buffer/passed-sorting-type () 558 | (bog-tests-with-temp-text 559 | " 560 | * topic heading 561 | ** zoo2000key 562 | ** apple2000key 563 | 564 | * another topic heading 565 | ** orange2000key 566 | ** banana2000key 567 | ** yogurt2000key" 568 | (let ((bog-topic-heading-level 1)) 569 | (bog-sort-topic-headings-in-buffer ?n) 570 | (outline-next-visible-heading 2) 571 | (should (equal (org-no-properties (org-get-heading t t)) 572 | "zoo2000key")) 573 | (outline-next-visible-heading 3) 574 | (should (equal (org-no-properties (org-get-heading t t)) 575 | "orange2000key"))))) 576 | 577 | 578 | ;;; Other 579 | 580 | (ert-deftest bog--find-duplicates () 581 | (should (equal nil (bog--find-duplicates nil))) 582 | (should (equal (list 1) (bog--find-duplicates (list 1 1 2)))) 583 | (should (equal (list "a" "b") 584 | (sort (bog--find-duplicates 585 | (list "a" "b" "c" "b" "a")) 586 | #'string-lessp)))) 587 | 588 | ;;; bog-tests.el ends here 589 | -------------------------------------------------------------------------------- /bog.el: -------------------------------------------------------------------------------- 1 | ;;; bog.el --- Extensions for research notes in Org mode -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2013-2016 Kyle Meyer 4 | ;; Copyright (C) 2020-2023 Basil L. Contovounesios 5 | 6 | ;; Author: Kyle Meyer 7 | ;; URL: https://github.com/kyleam/bog 8 | ;; Keywords: bib, outlines 9 | ;; Version: 1.3.3 10 | ;; Package-Requires: ((cl-lib "0.5")) 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation; either version 3, or (at your option) 15 | ;; any later version. 16 | ;; 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | ;; 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with GNU Emacs. If not, see . 24 | 25 | ;;; Commentary: 26 | ;; 27 | ;; Bog provides a few convenience functions for taking research notes in 28 | ;; Org mode. Many of these commands center around a citekey, the unique 29 | ;; identifier for a study. See the README 30 | ;; (https://github.com/kyleam/bog) for more information. 31 | 32 | ;;; Code: 33 | 34 | (require 'bibtex) 35 | (require 'cl-lib) 36 | (require 'dired) 37 | (require 'org) 38 | (require 'org-agenda) 39 | (require 'org-compat) 40 | 41 | 42 | ;;; Customization 43 | 44 | (defgroup bog nil 45 | "Extensions for research notes in Org mode" 46 | :group 'org) 47 | 48 | (defcustom bog-citekey-format 49 | (rx 50 | word-start 51 | (group 52 | (one-or-more lower) 53 | (zero-or-more (any lower "-"))) 54 | (group (= 4 digit)) 55 | (group 56 | (one-or-more lower) 57 | (zero-or-more (any lower digit))) 58 | word-end) 59 | "Regular expression used to match study citekey. 60 | 61 | By default, this matches any sequence of lower case 62 | letters (allowing hyphenation) that is followed by 4 digits and 63 | then lower case letters. 64 | 65 | The format should be restricted to word characters and anchored 66 | by word boundaries (i.e. '\\b..\\b' or '\\\\=<..\\>'). 67 | `bog-citekey-format-allow-at' controls whether '@' is considered 68 | a word character. 69 | 70 | This is case-sensitive (i.e., `case-fold-search' will be set to 71 | nil). 72 | 73 | The default format corresponds to the following BibTeX autokey 74 | settings: 75 | 76 | (setq bibtex-autokey-year-length 4 77 | bibtex-autokey-titleword-length nil 78 | bibtex-autokey-titlewords-stretch 0 79 | bibtex-autokey-titlewords 1 80 | bibtex-autokey-year-title-separator \"\")" 81 | :type 'regexp) 82 | 83 | (defcustom bog-citekey-format-allow-at t 84 | "Treat '@' as a word character, as it is in Org mode. 85 | 86 | If this value is nil, Bog functions treat '@' as a punctuation 87 | character, which allows them to work on Pandoc's @citekey format. 88 | 89 | Warning: Setting this variable after Bog is loaded does not have 90 | an effect. However, it can be changed at any time through the 91 | Customize interface." 92 | :package-version '(bog . "1.3.0") 93 | :set (lambda (var val) 94 | (set var val) 95 | (when (boundp 'bog-citekey-syntax-table) 96 | (modify-syntax-entry ?@ (if val "w" ".") 97 | bog-citekey-syntax-table))) 98 | :type 'boolean) 99 | 100 | (defcustom bog-citekey-web-search-groups '(1 2 3) 101 | "List of citekey subexpressions to use for web search. 102 | The default groups correspond to the last name of the first 103 | author, the publication year, and the first meaningful word in 104 | the title." 105 | :type '(repeat integer)) 106 | 107 | (defcustom bog-citekey-property "CUSTOM_ID" 108 | "Property name used to store citekey. 109 | The default corresponds to the default value of 110 | `org-bibtex-key-property'." 111 | :type 'string) 112 | 113 | (defcustom bog-root-directory "~/bib/" 114 | "Root directory for default values of other Bog directories." 115 | :type 'directory) 116 | 117 | (defcustom bog-note-directory 118 | (expand-file-name "notes/" bog-root-directory) 119 | "Directory with Org research notes." 120 | :type 'directory) 121 | 122 | (defcustom bog-file-directory 123 | (expand-file-name "citekey-files/" bog-root-directory) 124 | "Directory with citekey-associated files. 125 | Files are stored in subdirectories if `bog-subdirectory-group' is 126 | non-nil." 127 | :type 'directory) 128 | 129 | (defcustom bog-stage-directory 130 | (expand-file-name "stage/" bog-root-directory) 131 | "Directory to search for new files. 132 | `bog-rename-staged-file-to-citekey' and 133 | `bog-rename-staged-bib-to-citekey' searches here for files to 134 | rename." 135 | :type 'directory) 136 | 137 | (defcustom bog-find-citekey-bib-func #'bog-find-citekey-bib-file 138 | "Function used to find BibTeX entry for citekey. 139 | 140 | Default is `bog-find-citekey-bib-file', which locates single 141 | entry BibTeX files in `bog-bib-directory'. 142 | 143 | The other option is `bog-find-citekey-entry', which searches 144 | within a single BibTeX file, `bog-bib-file', for the citekey 145 | entry." 146 | :type 'function) 147 | 148 | (defcustom bog-subdirectory-group nil 149 | "Regexp group from `bog-citekey-format' to use as subdirectory name. 150 | If non-nil, use the indicated group to generate the subdirectory 151 | name for BibTeX and citekey-associated files." 152 | :type '(choice (const :tag "Don't use subdirectories" nil) 153 | (integer :tag "Regexp group number"))) 154 | 155 | (defcustom bog-bib-directory 156 | (expand-file-name "bibs/" bog-root-directory) 157 | "The name of the directory that BibTeX files are stored in. 158 | This is only meaningful if `bog-find-citekey-bib-func' set to 159 | `bog-find-citekey-bib-file'. Files are stored in subdirectories 160 | if `bog-subdirectory-group' is non-nil." 161 | :type 'directory) 162 | 163 | (defcustom bog-bib-file nil 164 | "BibTeX file name. 165 | This is only meaningful if `bog-find-citekey-bib-func' set to 166 | `bog-find-citekey-entry'." 167 | :type '(choice (const :tag "Don't use single file" nil) 168 | (file :tag "Single file"))) 169 | 170 | (defcustom bog-combined-bib-ignore-not-found nil 171 | "Whether `bog-create-combined-bib' ignores missing bib files. 172 | If non-nil, `bog-create-combined-bib' does not ask whether to 173 | continue when a citekey's bib file is not found." 174 | :package-version '(bog . "1.1.0") 175 | :type 'boolean) 176 | 177 | (defcustom bog-citekey-file-name-separators "[-_]" 178 | "Regular expression matching separators in file names. 179 | When `bog-find-citekey-file' is run on , it will find 180 | files with the format .* and *., 181 | where is matched by this regular expression.." 182 | :type 'regexp) 183 | 184 | (defcustom bog-file-renaming-func #'bog-file-ask-on-conflict 185 | "Function used to rename staged files. 186 | This function should accept a file name and a citekey as 187 | arguments and return the name of the final file. Currently the 188 | only built-in function is `bog-file-ask-on-conflict'." 189 | :type 'function) 190 | 191 | (defcustom bog-file-secondary-name ".supplement" 192 | "Modification to make to file name on renaming conflict. 193 | 194 | If . already exists, `bog-file-ask-on-conflict' 195 | prompts for another name. 196 | `bog-file-secondary-name'. is the default value for 197 | the prompt. 198 | 199 | For `bog-list-orphan-files' to work correctly, the first 200 | character should be a non-word character according to 201 | `bog-citekey-syntax-table'." 202 | :type 'string 203 | :package-version '(bog . "1.3.0")) 204 | 205 | (defcustom bog-web-search-url 206 | "https://scholar.google.com/scholar?q=%s" 207 | "URL to use for CITEKEY search. 208 | It should contain the placeholder \"%s\" for the query." 209 | :type 'string) 210 | 211 | (defcustom bog-topic-heading-level 1 212 | "Consider headings at this level to be topic headings. 213 | Topic headings for studies may be at any level, but 214 | `bog-sort-topic-headings' and `bog-jump-to-topic-heading' use 215 | this variable to determine what level to operate on." 216 | :type 'integer) 217 | 218 | (defcustom bog-refile-maxlevel bog-topic-heading-level 219 | "Consider up to this level when refiling with `bog-refile'." 220 | :type 'integer) 221 | 222 | (defcustom bog-keymap-prefix (kbd "C-c \"") 223 | "Bog keymap prefix." 224 | :type 'key-sequence) 225 | 226 | (defcustom bog-use-citekey-cache nil 227 | "List indicating which citekey lists to cache. 228 | 229 | Possible values are 230 | 231 | - headings Citekeys for all headings in the notes 232 | - all-notes All citekeys in the notes 233 | - files Citekeys with associated files 234 | - bibs Citekeys with BibTeX entries 235 | 236 | If set to nil, disable cache completely. If set to t, enable 237 | cache for all categories. 238 | 239 | Depending on the number of citekeys present for each of these 240 | categories, enabling this can make functions that prompt with a 241 | list of citekeys noticeably faster. However, no attempt is made 242 | to update the list of citekeys. To see newly added citekeys, 243 | clear the cache with `bog-clear-citekey-cache'. 244 | 245 | This cache will not persist across sessions." 246 | :type '(choice 247 | (const :tag "Disable cache" nil) 248 | (const :tag "Cache all" t) 249 | (repeat :tag "Individual categories" 250 | (choice 251 | (const :tag "Cache citekeys for headings" headings) 252 | (const :tag "Cache all citekeys in notes" all-notes) 253 | (const :tag "Cache citekeys with associated files" files) 254 | (const :tag "Cache citekeys with BibTeX entries" bibs))))) 255 | 256 | (defcustom bog-keep-indirect nil 257 | "Keep the previous buffer from `bog-citekey-tree-to-indirect-buffer'. 258 | Otherwise, each call to `bog-citekey-tree-to-indirect-buffer' 259 | kills the indirect buffer created by the previous call." 260 | :type 'boolean) 261 | 262 | (defvar bog-citekey-syntax-table 263 | (let ((st (make-syntax-table text-mode-syntax-table))) 264 | (modify-syntax-entry ?- "w" st) 265 | (modify-syntax-entry ?_ "w" st) 266 | (modify-syntax-entry ?@ (if bog-citekey-format-allow-at "w" ".") st) 267 | (modify-syntax-entry ?\" "\"" st) 268 | (modify-syntax-entry ?\\ "_" st) 269 | (modify-syntax-entry ?~ "_" st) 270 | st) 271 | "Syntax table used when working with citekeys. 272 | Like `org-mode-syntax-table', but hyphens and underscores are 273 | treated as word characters. '@' will be considered a word 274 | character if `bog-citekey-format-allow-at' is non-nil.") 275 | 276 | (defcustom bog-clean-bib-hook nil 277 | "Hook run during `bog-clean-and-rename-staged-bibs' call. 278 | After each bib file is processed, functions in this hook will be 279 | called in a buffer visiting the bib file." 280 | :package-version '(bog . "1.3.0") 281 | :type 'hook) 282 | 283 | 284 | ;;; Citekey methods 285 | 286 | (defun bog-citekey-p (text) 287 | "Return non-nil if TEXT matches `bog-citekey-format'." 288 | (with-syntax-table bog-citekey-syntax-table 289 | (let ((case-fold-search nil)) 290 | (string-match-p (format "\\`%s\\'" bog-citekey-format) text)))) 291 | 292 | (defun bog-citekey-at-point () 293 | "Return citekey at point." 294 | (save-excursion 295 | (with-syntax-table bog-citekey-syntax-table 296 | (skip-syntax-backward "w") 297 | (let ((case-fold-search nil)) 298 | (and (looking-at bog-citekey-format) 299 | (match-string-no-properties 0)))))) 300 | 301 | (defun bog-citekey-from-heading-title () 302 | "Retrieve citekey from heading title." 303 | (when (derived-mode-p 'org-mode) 304 | (unless (org-before-first-heading-p) 305 | (let ((heading (org-no-properties (org-get-heading t t)))) 306 | (and (bog-citekey-p heading) 307 | heading))))) 308 | 309 | (defun bog-citekey-from-heading () 310 | "Retrieve citekey from current heading title or property." 311 | (or (bog-citekey-from-heading-title) 312 | (bog-citekey-from-property))) 313 | 314 | (defun bog-citekey-from-tree () 315 | "Retrieve citekey from first parent heading associated with citekey." 316 | (when (derived-mode-p 'org-mode) 317 | (org-with-wide-buffer 318 | (let (maybe-citekey) 319 | (while (and (not (setq maybe-citekey (bog-citekey-from-heading))) 320 | ;; This isn't actually safe in Org mode <= 8.2.10. 321 | ;; Fixed in Org mode commit 322 | ;; 9ba9f916e87297d863c197cb87199adbb39da894. 323 | (ignore-errors (org-up-heading-safe)))) 324 | maybe-citekey)))) 325 | 326 | (defun bog-citekey-from-surroundings () 327 | "Get the citekey from the context of the Org file." 328 | (or (bog-citekey-at-point) 329 | (bog-citekey-from-tree))) 330 | 331 | (defun bog-citekey-from-property () 332 | "Retrieve citekey from `bog-citekey-property'." 333 | (when (derived-mode-p 'org-mode) 334 | (let ((ck (org-entry-get (point) bog-citekey-property))) 335 | (and ck (bog-citekey-p ck) ck)))) 336 | 337 | ;;;; Collections 338 | 339 | (defvar bog--citekey-cache nil 340 | "Alist of cached citekeys. 341 | Keys match values in `bog-use-citekey-cache'.") 342 | 343 | (defun bog--use-cache-p (key) 344 | "Return non-nil if cache should be used for KEY." 345 | (or (eq bog-use-citekey-cache t) 346 | (memq key bog-use-citekey-cache))) 347 | 348 | (defmacro bog--with-citekey-cache (key &rest body) 349 | "Execute BODY, maybe using cached citekey values for KEY. 350 | Use cached values if `bog-use-citekey-cache' is non-nil for KEY. 351 | Cached values are updated to the return values of BODY." 352 | (declare (indent 1) (debug t)) 353 | (let ((use-cache-p (make-symbol "use-cache-p"))) 354 | `(let* ((,use-cache-p (bog--use-cache-p ,key)) 355 | (citekeys (or (and ,use-cache-p 356 | (cdr (assq ,key bog--citekey-cache))) 357 | ,@body))) 358 | (when ,use-cache-p 359 | (setq bog--citekey-cache 360 | (cons (cons ,key citekeys) 361 | (assq-delete-all ,key bog--citekey-cache)))) 362 | citekeys))) 363 | 364 | (defun bog-clear-citekey-cache (category) 365 | "Clear cache of citekeys for CATEGORY. 366 | CATEGORY should be a key in `bog-use-citekey-cache' or t, which 367 | indicates to clear all categories. Interactively, clear all 368 | categories when a single \\[universal-argument] is given. 369 | Otherwise, prompt for CATEGORY." 370 | (interactive 371 | (progn 372 | (unless bog--citekey-cache 373 | (user-error "Citekey cache is empty")) 374 | (list (or (equal current-prefix-arg '(4)) 375 | (let ((choice (and bog--citekey-cache 376 | (completing-read 377 | "Category: " 378 | (cons "*all*" bog--citekey-cache))))) 379 | (if (equal choice "*all*") t (intern choice))))))) 380 | (setq bog--citekey-cache 381 | (and (not (eq category t)) 382 | (assq-delete-all category bog--citekey-cache)))) 383 | 384 | (defvar bog--no-sort nil) 385 | (defun bog--maybe-sort (values) 386 | "Sort VALUES by `string-lessp' unless `bog--no-sort' is non-nil." 387 | (or (and bog--no-sort values) 388 | (sort values #'string-lessp))) 389 | 390 | (defun bog-citekeys-in-file (file) 391 | "Return all citekeys in FILE." 392 | (with-temp-buffer 393 | (insert-file-contents file) 394 | (bog-citekeys-in-buffer))) 395 | 396 | (defun bog-all-citekeys () 397 | "Return all citekeys in notes." 398 | (bog--with-citekey-cache 'all-notes 399 | (bog--maybe-sort 400 | (let ((bog--no-sort t)) 401 | (cl-mapcan #'bog-citekeys-in-file (bog-notes)))))) 402 | 403 | (defun bog-heading-citekeys-in-buffer () 404 | "Return all heading citekeys in current buffer." 405 | (bog--maybe-sort (delq nil (org-map-entries #'bog-citekey-from-heading)))) 406 | 407 | (defun bog-heading-citekeys-in-file (file) 408 | "Return all citekeys in headings of FILE." 409 | (with-temp-buffer 410 | (let ((default-directory (file-name-directory file))) 411 | (insert-file-contents file) 412 | (org-mode) 413 | (bog-heading-citekeys-in-buffer)))) 414 | 415 | (defun bog-all-heading-citekeys () 416 | "Return citekeys that have a heading in any note file." 417 | (bog--with-citekey-cache 'headings 418 | (bog--maybe-sort 419 | (let ((bog--no-sort t)) 420 | (cl-mapcan #'bog-heading-citekeys-in-file (bog-notes)))))) 421 | 422 | (defun bog-citekeys-in-buffer () 423 | "Return all citekeys in current buffer." 424 | (save-excursion 425 | (let ((case-fold-search nil) 426 | citekeys) 427 | (goto-char (point-min)) 428 | (with-syntax-table bog-citekey-syntax-table 429 | (while (re-search-forward bog-citekey-format nil t) 430 | (push (match-string-no-properties 0) citekeys))) 431 | (bog--maybe-sort (delete-dups citekeys))))) 432 | 433 | (defun bog-heading-citekeys-in-wide-buffer () 434 | "Return all citekeys in current buffer, without any narrowing." 435 | (bog--maybe-sort 436 | (delq nil (org-map-entries #'bog-citekey-from-heading nil 'file)))) 437 | 438 | (defun bog-non-heading-citekeys-in-file (file) 439 | "Return all non-heading citekeys in FILE." 440 | (let ((case-fold-search nil) 441 | citekeys) 442 | (with-temp-buffer 443 | (let ((default-directory (file-name-directory file))) 444 | (insert-file-contents file) 445 | (org-mode) 446 | (with-syntax-table bog-citekey-syntax-table 447 | (while (re-search-forward bog-citekey-format nil t) 448 | (unless (or (org-at-heading-p) 449 | (org-at-property-p)) 450 | (push (match-string-no-properties 0) citekeys))))) 451 | (bog--maybe-sort (delete-dups citekeys))))) 452 | 453 | ;;;; Selection 454 | 455 | (defmacro bog-selection-method (name context-method collection-method) 456 | "Create citekey selection function. 457 | Create a function named bog-citekey-from-NAME with the following 458 | behavior: 459 | - Takes one argument (NO-CONTEXT). 460 | - If NO-CONTEXT is nil, calls CONTEXT-METHOD with no arguments. 461 | - If CONTEXT-METHOD returns nil or if NO-CONTEXT is non-nil, 462 | prompts with the citekeys gathered by COLLECTION-METHOD." 463 | `(defun ,(intern (concat "bog-citekey-from-" name)) (no-context) 464 | ,(format "Select citekey with `%s'. 465 | Fall back on `%s'. 466 | If NO-CONTEXT is non-nil, immediately fall back." 467 | context-method 468 | collection-method) 469 | (or (and no-context (bog-select-citekey (,collection-method))) 470 | (,context-method) 471 | (bog-select-citekey (,collection-method))))) 472 | 473 | (bog-selection-method "surroundings-or-files" 474 | bog-citekey-from-surroundings 475 | bog-all-file-citekeys) 476 | 477 | (bog-selection-method "surroundings-or-bibs" 478 | bog-citekey-from-surroundings 479 | bog-bib-citekeys) 480 | 481 | (bog-selection-method "surroundings-or-all" 482 | bog-citekey-from-surroundings 483 | bog-all-citekeys) 484 | 485 | (bog-selection-method "point-or-buffer-headings" 486 | bog-citekey-at-point 487 | bog-heading-citekeys-in-wide-buffer) 488 | 489 | (bog-selection-method "point-or-all-headings" 490 | bog-citekey-at-point 491 | bog-all-heading-citekeys) 492 | 493 | (defvar bog-citekey-history nil) 494 | 495 | (defun bog-select-citekey (citekeys) 496 | "Prompt for citekey from CITEKEYS." 497 | (completing-read "Select citekey: " citekeys 498 | nil t nil 'bog-citekey-history)) 499 | 500 | ;;;; Other 501 | 502 | ;; `show-all' is obsolete as of Emacs 25.1. 503 | (defalias 'bog--outline-show-all 504 | (if (fboundp 'outline-show-all) 505 | #'outline-show-all 506 | 'show-all)) 507 | 508 | (defun bog--set-difference (list1 list2) 509 | (let ((sdiff (cl-set-difference list1 list2 :test #'string=))) 510 | ;; As of Emacs 25.1, `cl-set-difference' keeps the order of LIST1 511 | ;; rather than leaving it reversed. 512 | (if (string-lessp (nth 0 sdiff) (nth 1 sdiff)) 513 | sdiff 514 | (nreverse sdiff)))) 515 | 516 | (defun bog-list-orphan-citekeys (&optional file) 517 | "List citekeys that appear in notes but don't have a heading. 518 | With prefix argument FILE, include only orphan citekeys from that 519 | file." 520 | (interactive (and current-prefix-arg 521 | (list (bog-read-note-file-name)))) 522 | (let ((files (if file (list file) (bog-notes))) 523 | (heading-cks (bog-all-heading-citekeys))) 524 | (with-current-buffer (get-buffer-create "*Bog orphan citekeys*") 525 | (erase-buffer) 526 | (dolist (file files) 527 | (let* ((text-cks (bog-non-heading-citekeys-in-file file)) 528 | (nohead-cks (bog--set-difference text-cks heading-cks))) 529 | (when nohead-cks 530 | (insert (format "* %s\n\n%s\n\n" 531 | (file-name-nondirectory file) 532 | (mapconcat #'identity nohead-cks "\n")))))) 533 | (if (> (buffer-size) 0) 534 | (progn 535 | (org-mode) 536 | (bog-mode) 537 | (bog--outline-show-all) 538 | (goto-char (point-min)) 539 | (pop-to-buffer (current-buffer))) 540 | (kill-buffer) 541 | (message "No orphans found"))))) 542 | 543 | (defun bog-list-duplicate-heading-citekeys (&optional clear-cache) 544 | "List citekeys that have more than one heading. 545 | With prefix CLEAR-CACHE, reset cache of citekey headings (which 546 | is only active if `bog-use-citekey-cache' is non-nil)." 547 | (interactive "P") 548 | (when clear-cache 549 | (bog-clear-citekey-cache 'headings)) 550 | (let ((bufname "*Bog duplicate heading citekeys*") 551 | (dup-cks (bog--find-duplicates (bog-all-heading-citekeys)))) 552 | (if (not dup-cks) 553 | (progn (message "No duplicate citekeys found") 554 | (and (get-buffer bufname) 555 | (kill-buffer bufname))) 556 | (with-current-buffer (get-buffer-create bufname) 557 | (erase-buffer) 558 | (insert (mapconcat #'identity dup-cks "\n") ?\n) 559 | (org-mode) 560 | (bog-mode 1) 561 | (goto-char (point-min))) 562 | (pop-to-buffer bufname)))) 563 | 564 | (defun bog--find-duplicates (list) 565 | (let (dups uniqs) 566 | (dolist (it list) 567 | (cond 568 | ((member it dups)) 569 | ((member it uniqs) 570 | (push it dups)) 571 | (t 572 | (push it uniqs)))) 573 | (nreverse dups))) 574 | 575 | 576 | ;;; Citekey-associated files 577 | 578 | ;;;###autoload 579 | (defun bog-find-citekey-file (&optional no-context) 580 | "Open citekey-associated file. 581 | 582 | The citekey is taken from the text under point if it matches 583 | `bog-citekey-format' or from the current tree. 584 | 585 | With prefix argument NO-CONTEXT, prompt with citekeys that have 586 | an associated file in `bog-file-directory'. Do the same if 587 | locating a citekey from context fails. 588 | 589 | If the citekey prompt is slow to appear, consider enabling the 590 | `files' category in `bog-use-citekey-cache'." 591 | (interactive "P") 592 | (org-open-file 593 | (bog--get-citekey-file 594 | (bog-citekey-from-surroundings-or-files no-context)))) 595 | 596 | ;;;###autoload 597 | (defun bog-dired-jump-to-citekey-file (&optional no-context) 598 | "Jump to citekey file in Dired. 599 | 600 | The citekey is taken from the text under point if it matches 601 | `bog-citekey-format' or from the current tree. 602 | 603 | With prefix argument NO-CONTEXT, prompt with citekeys that have 604 | an associated file in `bog-file-directory'. Do the same if 605 | locating a citekey from context fails. 606 | 607 | If the citekey prompt is slow to appear, consider enabling the 608 | `files' category in `bog-use-citekey-cache'." 609 | (interactive "P") 610 | (dired-jump 611 | 'other-window 612 | (bog--get-citekey-file 613 | (bog-citekey-from-surroundings-or-files no-context)))) 614 | 615 | (defun bog--get-citekey-file (citekey) 616 | (let* ((citekey-files (bog-citekey-files citekey)) 617 | (num-choices (length citekey-files))) 618 | (cl-case num-choices 619 | (0 (user-error "No file found for %s" citekey)) 620 | (1 (car citekey-files)) 621 | (t 622 | (let* ((fname-paths 623 | (mapcar (lambda (path) 624 | (cons (file-name-nondirectory path) path)) 625 | citekey-files)) 626 | (fname (completing-read "Select file: " fname-paths))) 627 | (cdr (assoc-string fname fname-paths))))))) 628 | 629 | (defun bog-citekey-files (citekey) 630 | "Return files in `bog-file-directory' associated with CITEKEY. 631 | These should be named [/]CITEKEY[*]., where 632 | is a character in `bog-citekey-file-name-separators' and is 633 | determined by `bog-subdirectory-group'." 634 | (let* ((subdir (bog--get-subdir citekey)) 635 | (dir (file-name-as-directory 636 | (or (and subdir (expand-file-name subdir bog-file-directory)) 637 | bog-file-directory)))) 638 | (directory-files dir t 639 | (format "\\`%s\\(%s.*\\)?\\." 640 | (regexp-quote citekey) 641 | bog-citekey-file-name-separators)))) 642 | 643 | (defun bog--get-subdir (citekey) 644 | "Return subdirectory for citekey file. 645 | Subdirectory is determined by `bog-subdirectory-group'." 646 | (with-syntax-table bog-citekey-syntax-table 647 | (let ((case-fold-search nil)) 648 | (and bog-subdirectory-group 649 | (string-match bog-citekey-format citekey) 650 | (match-string-no-properties bog-subdirectory-group 651 | citekey))))) 652 | 653 | ;;;###autoload 654 | (defun bog-rename-staged-file-to-citekey (&optional no-context) 655 | "Rename citekey file in `bog-stage-directory' with `bog-file-renaming-func'. 656 | 657 | The citekey is taken from the text under point if it matches 658 | `bog-citekey-format' or from the current tree. 659 | 660 | With prefix argument NO-CONTEXT, prompt with citekeys present in 661 | any note file. Do the same if locating a citekey from context 662 | fails. 663 | 664 | If the citekey prompt is slow to appear, consider enabling the 665 | `files' category in `bog-use-citekey-cache'." 666 | (interactive "P") 667 | (bog--rename-staged-file-to-citekey 668 | (bog-citekey-from-surroundings-or-all no-context))) 669 | 670 | (defun bog--rename-staged-file-to-citekey (citekey) 671 | (let* ((staged-files (bog-staged-files)) 672 | (staged-file-names (mapcar #'file-name-nondirectory staged-files)) 673 | (num-choices (length staged-file-names)) 674 | staged-file) 675 | (cl-case num-choices 676 | (0 (setq staged-file (read-file-name "Select file to rename: "))) 677 | (1 (setq staged-file (car staged-files))) 678 | (t (setq staged-file (expand-file-name 679 | (completing-read "Select file to rename: " 680 | staged-file-names) 681 | bog-stage-directory)))) 682 | (bog--rename-file-to-citekey staged-file citekey))) 683 | 684 | ;;;###autoload 685 | (defun bog-rename-citekey-file (&optional no-context) 686 | "Associate a citekey file with a new citekey. 687 | 688 | This allows you to update a file's name if you change the 689 | citekey. 690 | 691 | The new citekey is taken from the text under point if it matches 692 | `bog-citekey-format' or from the current tree. 693 | 694 | With prefix argument NO-CONTEXT, prompt with citekeys present in 695 | any note file. Do the same if locating a citekey from context 696 | fails." 697 | (interactive "P") 698 | (let ((file-paths (mapcar (lambda (path) 699 | (cons (file-name-nondirectory path) path)) 700 | (bog-all-citekey-files)))) 701 | (bog--rename-file-to-citekey 702 | (cdr (assoc-string (completing-read "Rename file: " file-paths) 703 | file-paths)) 704 | (bog-citekey-from-surroundings-or-all no-context)))) 705 | 706 | (defun bog--rename-file-to-citekey (file citekey) 707 | (message "Renamed %s to %s" file 708 | (funcall bog-file-renaming-func file citekey))) 709 | 710 | (defun bog-file-ask-on-conflict (staged-file citekey) 711 | "Rename citekey file, prompting for a new name if it already exists. 712 | STAGED-FILE is renamed to . within 713 | `bog-file-directory' (and, optionally, within a subdirectory, 714 | depending on `bog-subdirectory-group'). If this file already 715 | exists, prompt for another name. `bog-file-secondary-name' 716 | controls the default string for the prompt." 717 | (let* ((ext (file-name-extension staged-file)) 718 | (citekey-file (bog-citekey-as-file citekey ext)) 719 | (dir (file-name-directory citekey-file))) 720 | (unless (file-exists-p dir) 721 | (make-directory dir)) 722 | (condition-case nil 723 | (rename-file staged-file citekey-file) 724 | (file-already-exists 725 | (let ((dir (file-name-directory citekey-file)) 726 | (new-file-name 727 | (file-name-nondirectory 728 | (bog-citekey-as-file (concat citekey bog-file-secondary-name) 729 | ext)))) 730 | (setq new-file-name 731 | (read-string 732 | (format "File %s already exists. Name to use instead: " 733 | (file-name-base citekey-file)) 734 | new-file-name)) 735 | (setq citekey-file (expand-file-name new-file-name dir)) 736 | (rename-file staged-file citekey-file)))) 737 | citekey-file)) 738 | 739 | (defun bog-citekey-as-file (citekey ext) 740 | "Return name of associated file for CITEKEY. 741 | Generate a file name with the form 742 | `bog-file-directory'/[/]CITEKEY.EXT, where the optional 743 | is determined by `bog-subdirectory-group'." 744 | (let* ((subdir (bog--get-subdir citekey)) 745 | (dir (file-name-as-directory 746 | (or (and subdir (expand-file-name subdir bog-file-directory)) 747 | bog-file-directory)))) 748 | (expand-file-name (concat citekey "." ext) dir))) 749 | 750 | (defun bog-all-file-citekeys () 751 | "Return a list of citekeys for files in `bog-file-directory'." 752 | (bog--with-citekey-cache 'files 753 | (bog--maybe-sort 754 | (delete-dups (delq nil (mapcar #'bog-file-citekey 755 | (bog-all-citekey-files))))))) 756 | 757 | (defun bog-file-citekey (file) 758 | "Return leading citekey part from base name of FILE." 759 | (let ((fname (file-name-base file)) 760 | (case-fold-search nil)) 761 | ;; Use `org-mode-syntax-table' instead of 762 | ;; `bog-citekey-syntax-table' so the hyphens and underscores are 763 | ;; treated as word boundaries. 764 | (with-syntax-table org-mode-syntax-table 765 | (and (string-match (concat "\\`" bog-citekey-format) fname) 766 | (match-string 0 fname))))) 767 | 768 | (defun bog-all-citekey-files () 769 | "Return list of all files in `bog-file-directory'." 770 | (let (dirs) 771 | (if bog-subdirectory-group 772 | (dolist (df (directory-files bog-file-directory t 773 | directory-files-no-dot-files-regexp t)) 774 | (when (and (file-readable-p df) (file-directory-p df)) 775 | (push df dirs))) 776 | (push bog-file-directory dirs)) 777 | (cl-mapcan 778 | (lambda (dir) 779 | (cl-remove-if #'file-directory-p 780 | (directory-files 781 | dir t directory-files-no-dot-files-regexp t))) 782 | dirs))) 783 | 784 | (defun bog-staged-files () 785 | "Return files in `bog-stage-directory'." 786 | (cl-remove-if (lambda (f) (or (file-directory-p f) 787 | (backup-file-name-p f))) 788 | (directory-files bog-stage-directory 789 | t directory-files-no-dot-files-regexp))) 790 | 791 | ;;;###autoload 792 | (defun bog-list-orphan-files () 793 | "Find files in `bog-file-directory' without a citekey heading." 794 | (interactive) 795 | (let ((head-cks (bog-all-heading-citekeys))) 796 | (with-current-buffer (get-buffer-create "*Bog orphan files*") 797 | (erase-buffer) 798 | (setq default-directory bog-root-directory) 799 | (with-syntax-table bog-citekey-syntax-table 800 | (dolist (ck-file (bog-all-citekey-files)) 801 | (let ((base-name (file-name-nondirectory ck-file)) 802 | (case-fold-search nil)) 803 | (unless (and (string-match (concat "\\`" bog-citekey-format) 804 | base-name) 805 | (member (match-string-no-properties 0 base-name) 806 | head-cks)) 807 | (insert (format "- [[file:%s]]\n" 808 | (file-relative-name ck-file))))))) 809 | (goto-char (point-min)) 810 | (org-mode) 811 | (if (> (buffer-size) 0) 812 | (pop-to-buffer (current-buffer)) 813 | (message "No orphans found") 814 | (kill-buffer))))) 815 | 816 | 817 | ;;; BibTeX-related 818 | 819 | ;;;###autoload 820 | (defun bog-find-citekey-bib (&optional no-context) 821 | "Open BibTeX file for a citekey. 822 | 823 | The citekey is taken from the text under point if it matches 824 | `bog-citekey-format' or from the current tree. 825 | 826 | The variable `bog-find-citekey-bib-func' determines how the 827 | citekey is found. 828 | 829 | With prefix argument NO-CONTEXT, prompt with citekeys that have a 830 | BibTeX entry. Do the same if locating a citekey from context 831 | fails. 832 | 833 | If the citekey prompt is slow to appear, consider enabling the 834 | `bib' category in `bog-use-citekey-cache'." 835 | (interactive "P") 836 | (funcall bog-find-citekey-bib-func 837 | (bog-citekey-from-surroundings-or-bibs no-context))) 838 | 839 | (defun bog-find-citekey-bib-file (citekey) 840 | "Open BibTeX file of CITEKEY contained in `bog-bib-directory'." 841 | (let ((bib-file (bog-citekey-as-bib citekey))) 842 | (unless (file-exists-p bib-file) 843 | (user-error "%s does not exist" bib-file)) 844 | (find-file-other-window bib-file))) 845 | 846 | (defun bog-find-citekey-entry (citekey) 847 | "Search for CITEKEY in `bog-bib-file'." 848 | (find-file-other-window bog-bib-file) 849 | (bibtex-search-entry citekey)) 850 | 851 | ;;;###autoload 852 | (defun bog-clean-and-rename-staged-bibs () 853 | "Clean and rename BibTeX files in `bog-stage-directory'. 854 | 855 | Search for new BibTeX files in `bog-stage-directory', and run 856 | `bibtex-clean-entry' on each file before it is moved to 857 | `bog-bib-directory'/[/].bib, where the optional 858 | is determined by `bog-subdirectory-group'. 859 | 860 | This function is only useful if you use the non-standard setup of 861 | one entry per BibTeX file." 862 | (interactive) 863 | (let ((staged (directory-files bog-stage-directory t "\\.bib\\'"))) 864 | (dolist (file staged) 865 | (bog--prepare-bib-file file t)))) 866 | 867 | (defun bog--prepare-bib-file (file &optional new-key) 868 | (let (bib-file) 869 | (with-temp-buffer 870 | (bibtex-mode) 871 | (insert-file-contents file) 872 | ;; Make sure `bibtex-entry-head' is set since we're not visiting 873 | ;; a file. 874 | (unless bibtex-entry-head (bibtex-set-dialect nil 'local)) 875 | (bibtex-skip-to-valid-entry) 876 | (bibtex-clean-entry new-key) 877 | (if (looking-at bibtex-entry-head) 878 | (setq bib-file (bog-citekey-as-bib (bibtex-key-in-head))) 879 | (error "BibTeX header line looks wrong")) 880 | (let ((dir (file-name-directory bib-file))) 881 | (unless (file-exists-p dir) 882 | (make-directory dir))) 883 | (write-file bib-file) 884 | (run-hooks 'bog-clean-bib-hook)) 885 | ;; If a buffer was visiting the original bib file, point it to the 886 | ;; new file. 887 | (let ((file-buf (find-buffer-visiting file))) 888 | (when file-buf 889 | (with-current-buffer file-buf 890 | (when (get-buffer bib-file) 891 | (user-error "Buffer for %s already exists" bib-file)) 892 | (rename-buffer bib-file) 893 | (set-visited-file-name bib-file nil t)))) 894 | (delete-file file))) 895 | 896 | ;;;###autoload 897 | (defun bog-create-combined-bib (&optional arg) 898 | "Create a buffer that has entries for a collection of citekeys. 899 | If in Dired, collect citekeys from marked files. Otherwise, 900 | collect citekeys from the current buffer. With prefix argument 901 | ARG, reverse the meaning of `bog-combined-bib-ignore-not-found'." 902 | (interactive (list (if current-prefix-arg 903 | (not bog-combined-bib-ignore-not-found) 904 | bog-combined-bib-ignore-not-found))) 905 | (let ((bib-buffer-name "*Bog combined bib*") 906 | citekeys 907 | citekey-bibs) 908 | (let ((bog--no-sort t)) 909 | (if (derived-mode-p 'dired-mode) 910 | (setq citekeys 911 | (delete-dups (cl-mapcan #'bog-citekeys-in-file 912 | (dired-get-marked-files)))) 913 | (setq citekeys (bog-citekeys-in-buffer)))) 914 | (setq citekeys (sort citekeys #'string-lessp)) 915 | (setq citekey-bibs 916 | (mapcar (lambda (ck) (cons ck (bog-citekey-as-bib ck))) 917 | citekeys)) 918 | (with-current-buffer (get-buffer-create bib-buffer-name) 919 | (erase-buffer) 920 | (dolist (citekey-bib citekey-bibs) 921 | (cond 922 | ((file-exists-p (cdr citekey-bib)) 923 | (insert "\n") 924 | (insert-file-contents (cdr citekey-bib)) 925 | (goto-char (point-max))) 926 | ((or arg 927 | (y-or-n-p (format "No BibTeX entry found for %s. Skip it? " 928 | (car citekey-bib))))) 929 | (t 930 | (kill-buffer bib-buffer-name) 931 | (user-error "Aborting")))) 932 | (bibtex-mode) 933 | (goto-char (point-min))) 934 | (pop-to-buffer bib-buffer-name))) 935 | 936 | (defun bog-citekey-as-bib (citekey) 937 | "Return file name `bog-bib-directory'/CITEKEY.bib." 938 | (let* ((subdir (bog--get-subdir citekey)) 939 | (dir (file-name-as-directory 940 | (or (and subdir (expand-file-name subdir bog-bib-directory)) 941 | bog-bib-directory)))) 942 | (expand-file-name (concat citekey ".bib") dir))) 943 | 944 | (defun bog-bib-citekeys () 945 | "Return a list citekeys for all BibTeX entries. 946 | If `bog-bib-file' is non-nil, it returns citekeys from this file 947 | instead of citekeys from file names in `bog-bib-directory'." 948 | (bog--with-citekey-cache 'bibs 949 | (if bog-bib-file 950 | (with-temp-buffer 951 | (bibtex-mode) 952 | (insert-file-contents bog-bib-file) 953 | (mapcar #'car (bibtex-parse-keys))) 954 | (let (dirs) 955 | (if bog-subdirectory-group 956 | (dolist (df (directory-files 957 | bog-bib-directory t 958 | directory-files-no-dot-files-regexp t)) 959 | (when (and (file-readable-p df) (file-directory-p df)) 960 | (push df dirs))) 961 | (push bog-bib-directory dirs)) 962 | (bog--maybe-sort 963 | (mapcar #'file-name-sans-extension 964 | (cl-mapcan 965 | (lambda (dir) (directory-files dir nil "\\.bib\\'" t)) 966 | dirs))))))) 967 | 968 | ;;;###autoload 969 | (defun bog-list-orphan-bibs () 970 | "Find bib citekeys that don't have a citekey heading." 971 | (interactive) 972 | (let ((orphans (bog--set-difference (bog-bib-citekeys) 973 | (bog-all-heading-citekeys))) 974 | (orphan-bufname "*Bog orphan bibs*")) 975 | (if orphans 976 | (with-current-buffer (get-buffer-create orphan-bufname) 977 | (erase-buffer) 978 | (setq default-directory bog-root-directory) 979 | (insert (mapconcat #'identity orphans "\n") ?\n) 980 | (goto-char (point-min)) 981 | (org-mode) 982 | (pop-to-buffer (current-buffer))) 983 | (let ((old-buf (get-buffer orphan-bufname))) 984 | (when old-buf 985 | (kill-buffer old-buf))) 986 | (message "No orphans found")))) 987 | 988 | ;;; Web 989 | 990 | ;;;###autoload 991 | (defun bog-search-citekey-on-web (&optional no-context) 992 | "Open browser and perform query based for a citekey. 993 | 994 | Take the URL from `bog-web-search-url'. 995 | 996 | The citekey is split by groups in `bog-citekey-format' and joined by 997 | \"+\" to form the query string. 998 | 999 | The citekey is taken from the text under point if it matches 1000 | `bog-citekey-format' or from the current tree. 1001 | 1002 | With prefix argument NO-CONTEXT, prompt with citekeys present in 1003 | any note file. Do the same if locating a citekey from context 1004 | fails. 1005 | 1006 | If the citekey file prompt is slow to appear, consider enabling 1007 | `bog-use-citekey-cache'. 1008 | 1009 | If the citekey prompt is slow to appear, consider enabling the 1010 | `all-notes' category in `bog-use-citekey-cache'." 1011 | (interactive "P") 1012 | (bog--search-citekey-on-web 1013 | (bog-citekey-from-surroundings-or-all no-context))) 1014 | 1015 | (defun bog--search-citekey-on-web (citekey) 1016 | (browse-url (bog-citekey-as-search-url citekey))) 1017 | 1018 | (defun bog-citekey-as-search-url (citekey) 1019 | "Return URL to use for CITEKEY search." 1020 | (format bog-web-search-url 1021 | (bog--citekey-groups-with-delim citekey "+"))) 1022 | 1023 | (defun bog--citekey-groups-with-delim (citekey delim) 1024 | "Return expression groups CITEKEY, separated by DELIM. 1025 | Groups are specified by `bog-citekey-web-search-groups'." 1026 | (with-syntax-table bog-citekey-syntax-table 1027 | (let ((case-fold-search nil)) 1028 | (string-match bog-citekey-format citekey) 1029 | (mapconcat (lambda (g) (match-string-no-properties g citekey)) 1030 | bog-citekey-web-search-groups delim)))) 1031 | 1032 | 1033 | ;;; Notes-related 1034 | 1035 | ;; `org-show-context' is obsolete as of Org 9.6. 1036 | (defalias 'bog--fold-show-context 1037 | (if (fboundp 'org-fold-show-context) 1038 | #'org-fold-show-context 1039 | 'org-show-context)) 1040 | 1041 | ;;;###autoload 1042 | (defun bog-goto-citekey-heading-in-notes (&optional no-context) 1043 | "Find citekey heading in notes. 1044 | 1045 | The citekey is taken from the text under point if it matches 1046 | `bog-citekey-format'. 1047 | 1048 | When the prefix argument NO-CONTEXT is given by a single 1049 | \\[universal-argument], prompt with citekeys that have a heading 1050 | in any note file. Do the same if locating a citekey from context 1051 | fails. With a double \\[universal-argument], restrict the prompt 1052 | to citekeys that have a heading in the current buffer. 1053 | 1054 | If the citekey prompt is slow to appear, consider enabling the 1055 | `heading' category in `bog-use-citekey-cache'. 1056 | 1057 | If the heading is found outside any current narrowing of the 1058 | buffer, the narrowing is removed." 1059 | (interactive "P") 1060 | (let* ((citekey (if (equal no-context '(16)) 1061 | (bog-citekey-from-point-or-buffer-headings no-context) 1062 | (bog-citekey-from-point-or-all-headings no-context))) 1063 | (marker (bog--find-citekey-heading-in-notes citekey))) 1064 | (if (not marker) 1065 | (message "Heading for %s not found in notes" citekey) 1066 | (pop-to-buffer (marker-buffer marker)) 1067 | (when (or (< marker (point-min)) 1068 | (> marker (point-max))) 1069 | (widen)) 1070 | (goto-char marker) 1071 | (bog--fold-show-context)))) 1072 | 1073 | (defun bog--find-citekey-heading-in-buffer (citekey &optional pos-only) 1074 | "Return the marker of heading for CITEKEY. 1075 | CITEKEY can either be the heading title or the property value of 1076 | the key `bog-citekey-property'. If POS-ONLY is non-nil, return 1077 | the position instead of a marker." 1078 | (or (org-find-exact-headline-in-buffer citekey nil pos-only) 1079 | (bog--find-citekey-property-in-buffer citekey nil pos-only))) 1080 | 1081 | (defun bog--find-citekey-property-in-buffer (citekey &optional buffer pos-only) 1082 | "Return marker in BUFFER for heading with CITEKEY as a property value. 1083 | The property key must match `bog-citekey-property'. If POS-ONLY 1084 | is non-nil, return the position instead of a marker." 1085 | (with-current-buffer (or buffer (current-buffer)) 1086 | (save-excursion 1087 | (save-restriction 1088 | (widen) 1089 | (goto-char (point-min)) 1090 | (catch 'found 1091 | (while (re-search-forward (concat "\\b" citekey "\\b") nil t) 1092 | (save-excursion 1093 | (beginning-of-line) 1094 | (when (and (looking-at org-property-re) 1095 | (equal (downcase (match-string 2)) 1096 | (downcase bog-citekey-property))) 1097 | (org-back-to-heading t) 1098 | (throw 'found 1099 | (if pos-only 1100 | (point) 1101 | (move-marker (make-marker) (point)))))))))))) 1102 | 1103 | (defun bog--find-citekey-heading-in-notes (citekey) 1104 | "Return the marker of heading for CITEKEY in notes. 1105 | CITEKEY can either be the heading title or the property value of 1106 | the key `bog-citekey-property'. When in a note file, search for 1107 | headings there first." 1108 | (or (and (member (buffer-file-name (buffer-base-buffer)) 1109 | (bog-notes)) 1110 | (bog--find-citekey-heading-in-buffer citekey)) 1111 | (org-find-exact-heading-in-directory citekey bog-note-directory) 1112 | (bog--find-citekey-property-in-notes citekey))) 1113 | 1114 | (defun bog--find-citekey-property-in-notes (citekey) 1115 | "Return marker within notes for heading with CITEKEY as a property value. 1116 | If the current buffer is a note file, try to find the heading 1117 | there first." 1118 | ;; Modified from `org-find-exact-heading-in-directory'. 1119 | (let ((files (bog-notes)) 1120 | file visiting m buffer) 1121 | (catch 'found 1122 | (while (setq file (pop files)) 1123 | (message "Searching properties in %s" file) 1124 | (setq visiting (org-find-base-buffer-visiting file)) 1125 | (setq buffer (or visiting (find-file-noselect file))) 1126 | (setq m (bog--find-citekey-property-in-buffer citekey buffer)) 1127 | (when (and (not m) (not visiting)) (kill-buffer buffer)) 1128 | (and m (throw 'found m)))))) 1129 | 1130 | (defvar bog--last-indirect-buffer nil) 1131 | 1132 | ;;;###autoload 1133 | (defun bog-citekey-tree-to-indirect-buffer (&optional no-context) 1134 | "Open subtree for citekey in an indirect buffer. 1135 | 1136 | Unless `bog-keep-indirect' is non-nil, replace the indirect 1137 | buffer from the previous call. 1138 | 1139 | The citekey is taken from the text under point if it matches 1140 | `bog-citekey-format'. 1141 | 1142 | With prefix argument NO-CONTEXT, prompt with citekeys that have a 1143 | heading in any note file. Do the same if locating a citekey from 1144 | context fails. 1145 | 1146 | If the citekey prompt is slow to appear, consider enabling the 1147 | `heading' category in `bog-use-citekey-cache'." 1148 | (interactive "P") 1149 | (let* ((orig-buf (current-buffer)) 1150 | (citekey (bog-citekey-from-point-or-all-headings no-context)) 1151 | (marker (with-current-buffer (or (buffer-base-buffer) 1152 | (current-buffer)) 1153 | (bog--find-citekey-heading-in-notes citekey)))) 1154 | (if marker 1155 | (with-current-buffer (marker-buffer marker) 1156 | (org-with-wide-buffer 1157 | (goto-char marker) 1158 | (let ((org-indirect-buffer-display 1159 | (if (and (not bog-keep-indirect) 1160 | (eq bog--last-indirect-buffer orig-buf)) 1161 | 'current-window 1162 | 'other-window))) 1163 | (org-tree-to-indirect-buffer 1164 | (or bog-keep-indirect 1165 | (not (buffer-live-p bog--last-indirect-buffer)))) 1166 | (setq bog--last-indirect-buffer org-last-indirect-buffer)))) 1167 | (message "Heading for %s not found in notes" citekey)))) 1168 | 1169 | ;;;###autoload 1170 | (defun bog-refile () 1171 | "Refile heading within notes. 1172 | All headings from Org files in `bog-note-directory' at or above 1173 | level `bog-refile-maxlevel' are considered." 1174 | (interactive) 1175 | (let ((org-refile-targets `((bog-notes 1176 | :maxlevel . ,bog-refile-maxlevel)))) 1177 | (org-refile))) 1178 | 1179 | (defun bog-notes () 1180 | "Return Org files in `bog-note-directory'." 1181 | (directory-files bog-note-directory t 1182 | "\\`[^.].*\\.org\\'")) 1183 | 1184 | (defun bog-read-note-file-name () 1185 | "Read name of Org file in `bog-note-directory'." 1186 | (let ((note-paths (mapcar (lambda (path) 1187 | (cons (file-name-nondirectory path) path)) 1188 | (bog-notes)))) 1189 | (cdr (assoc-string (completing-read "File: " note-paths) 1190 | note-paths)))) 1191 | 1192 | (defvar bog--agenda-map 1193 | (let ((map (make-sparse-keymap))) 1194 | (set-keymap-parent map org-agenda-mode-map) 1195 | (define-key map "r" 'bog-agenda-redo) 1196 | (define-key map "g" 'bog-agenda-redo) 1197 | map) 1198 | "Local keymap for Bog-related agendas.") 1199 | 1200 | (defmacro bog--with-search-lprops (&rest body) 1201 | "Execute BODY with Bog-related agenda values. 1202 | Restore the `org-lprops' property value for 1203 | `org-agenda-redo-command' after executing BODY." 1204 | (declare (indent 0) (debug t)) 1205 | (let ((bog-lprops '((org-agenda-buffer-name "*Bog search*") 1206 | (org-agenda-files (bog-notes)) 1207 | (org-agenda-text-search-extra-files ()) 1208 | (org-agenda-sticky nil)))) 1209 | `(cl-letf (((get 'org-agenda-redo-command 'org-lprops) ',bog-lprops) 1210 | ,@bog-lprops) 1211 | (put 'org-agenda-files 'org-restrict nil) 1212 | ,@body 1213 | (use-local-map bog--agenda-map)))) 1214 | 1215 | ;;;###autoload 1216 | (defun bog-search-notes (&optional todo-only string) 1217 | "Search notes using `org-search-view'. 1218 | With prefix argument TODO-ONLY, search only TODO entries. If 1219 | STRING is non-nil, use it as the search term (instead of 1220 | prompting for one)." 1221 | (interactive "P") 1222 | (bog--with-search-lprops 1223 | (org-search-view todo-only string))) 1224 | 1225 | ;;;###autoload 1226 | (defun bog-search-notes-for-citekey (&optional todo-only) 1227 | "Search notes for citekey using `org-search-view'. 1228 | 1229 | With prefix argument TODO-ONLY, search only TODO entries. 1230 | 1231 | The citekey is taken from the text under point if it matches 1232 | `bog-citekey-format' or from the current tree. If a citekey is 1233 | not found, prompt with citekeys present in any note file. 1234 | 1235 | If the citekey prompt is slow to appear, consider enabling the 1236 | `all-notes' category in `bog-use-citekey-cache'." 1237 | (interactive "P") 1238 | (bog-search-notes todo-only 1239 | (bog-citekey-from-surroundings-or-all nil))) 1240 | 1241 | (defun bog-agenda-redo (&optional all) 1242 | (interactive "P") 1243 | (bog--with-search-lprops 1244 | (org-agenda-redo all))) 1245 | 1246 | (defun bog-sort-topic-headings-in-buffer (&optional sorting-type) 1247 | "Sort topic headings in this buffer. 1248 | SORTING-TYPE is a character passed to `org-sort-entries'. If 1249 | nil, use ?a. The level to sort is determined by 1250 | `bog-topic-heading-level'." 1251 | (interactive) 1252 | (org-map-entries (lambda () (bog-sort-if-topic-header sorting-type)))) 1253 | 1254 | (defun bog-sort-topic-headings-in-notes (&optional sorting-type) 1255 | "Sort topic headings in notes. 1256 | Unlike `bog-sort-topic-headings-in-buffer', sort topic headings 1257 | in all note files." 1258 | (interactive) 1259 | (org-map-entries (lambda () (bog-sort-if-topic-header sorting-type)) 1260 | nil (bog-notes))) 1261 | 1262 | (defun bog-sort-if-topic-header (sorting-type) 1263 | "Sort heading with `org-sort-entries' according to SORTING-TYPE. 1264 | Sorting is only done if the heading's level matches 1265 | `bog-topic-heading-level' and it isn't a citekey heading." 1266 | (let ((sorting-type (or sorting-type ?a))) 1267 | (when (and (= (org-current-level) bog-topic-heading-level) 1268 | (not (bog-citekey-from-heading))) 1269 | (org-sort-entries nil sorting-type)))) 1270 | 1271 | ;;;###autoload 1272 | (defun bog-insert-heading-citekey (&optional current-buffer) 1273 | "Select a citekey to insert at point. 1274 | By default, offer heading citekeys from all files. With prefix 1275 | argument CURRENT-BUFFER, limit to heading citekeys from the 1276 | current buffer." 1277 | (interactive "P") 1278 | (let ((citekey-func (if current-buffer 1279 | #'bog-heading-citekeys-in-wide-buffer 1280 | #'bog-all-heading-citekeys))) 1281 | (insert (bog-select-citekey (funcall citekey-func))))) 1282 | 1283 | ;;;###autoload 1284 | (defun bog-open-citekey-link (&optional no-context first) 1285 | "Open a link for a citekey heading. 1286 | 1287 | If FIRST is non-nil, open the first link under the heading. 1288 | Otherwise, if there is more than one link under the heading, 1289 | prompt with a list of links using the `org-open-at-point' 1290 | interface. 1291 | 1292 | The citekey is taken from the text under point if it matches 1293 | `bog-citekey-format' or from the current tree. 1294 | 1295 | With prefix argument NO-CONTEXT, prompt with citekeys that have a 1296 | heading in any note file. Do the same if locating a citekey from 1297 | context fails. 1298 | 1299 | If the citekey prompt is slow to appear, consider enabling the 1300 | `heading' category in `bog-use-citekey-cache'." 1301 | (interactive "P") 1302 | (let* ((citekey (bog-citekey-from-point-or-all-headings no-context)) 1303 | (marker (bog--find-citekey-heading-in-notes citekey))) 1304 | (if marker 1305 | (with-current-buffer (marker-buffer marker) 1306 | (org-with-wide-buffer 1307 | (goto-char marker) 1308 | (org-narrow-to-subtree) 1309 | (when first (org-next-link)) 1310 | (org-open-at-point))) 1311 | (message "Heading for %s not found in notes" citekey)))) 1312 | 1313 | ;;;###autoload 1314 | (defun bog-open-first-citekey-link (&optional no-context) 1315 | "Open first link for a citekey heading. 1316 | 1317 | The citekey is taken from the text under point if it matches 1318 | `bog-citekey-format' or from the current tree. 1319 | 1320 | With prefix argument NO-CONTEXT, prompt with citekeys that have a 1321 | heading in any note file. Do the same if locating a citekey from 1322 | context fails." 1323 | (interactive "P") 1324 | (bog-open-citekey-link no-context t)) 1325 | 1326 | ;;;###autoload 1327 | (defun bog-next-non-heading-citekey (&optional arg) 1328 | "Move forward to next non-heading citekey. 1329 | With argument ARG, do it ARG times." 1330 | (interactive "p") 1331 | (setq arg (or arg 1)) 1332 | (if (< arg 0) 1333 | (bog-previous-non-heading-citekey (- arg)) 1334 | (with-syntax-table bog-citekey-syntax-table 1335 | (skip-syntax-forward "w") 1336 | (let ((case-fold-search nil)) 1337 | (while (and (> arg 0) 1338 | (re-search-forward bog-citekey-format nil t)) 1339 | (unless (org-at-heading-p) 1340 | (setq arg (1- arg)))))) 1341 | (bog--fold-show-context))) 1342 | 1343 | ;;;###autoload 1344 | (defun bog-previous-non-heading-citekey (&optional arg) 1345 | "Move backward to previous non-heading citekey. 1346 | With argument ARG, do it ARG times." 1347 | (interactive "p") 1348 | (setq arg (or arg 1)) 1349 | (with-syntax-table bog-citekey-syntax-table 1350 | (let ((case-fold-search nil)) 1351 | (while (and (> arg 0) 1352 | (re-search-backward bog-citekey-format nil t)) 1353 | (unless (org-at-heading-p) 1354 | (setq arg (1- arg))))) 1355 | (skip-syntax-backward "w")) 1356 | (bog--fold-show-context)) 1357 | 1358 | ;;;###autoload 1359 | (defun bog-jump-to-topic-heading () 1360 | "Jump to topic heading. 1361 | Topic headings are determined by `bog-topic-heading-level'." 1362 | (interactive) 1363 | (let ((org-refile-targets 1364 | `((bog-notes :level . ,bog-topic-heading-level)))) 1365 | (org-refile '(4)))) 1366 | 1367 | 1368 | ;;; Font-lock 1369 | 1370 | (defface bog-citekey-face 1371 | '((t :inherit org-link :underline nil)) 1372 | "Face used to highlight text that matches `bog-citekey-format'.") 1373 | 1374 | (defun bog-fontify-non-heading-citekeys (limit) 1375 | "Highlight non-heading citekeys." 1376 | (let ((org-buffer-p (derived-mode-p 'org-mode))) 1377 | (with-syntax-table bog-citekey-syntax-table 1378 | (let ((case-fold-search nil)) 1379 | (while (re-search-forward bog-citekey-format limit t) 1380 | (unless (and org-buffer-p 1381 | (save-match-data (org-at-heading-p))) 1382 | (add-text-properties (match-beginning 0) (match-end 0) 1383 | '(face bog-citekey-face)))))))) 1384 | 1385 | (defvar bog-citekey-font-lock-keywords 1386 | '((bog-fontify-non-heading-citekeys . bog-citekey-face))) 1387 | 1388 | (defalias 'bog--font-lock-function 1389 | (if (fboundp 'font-lock-flush) 1390 | #'font-lock-flush 1391 | #'font-lock-fontify-buffer)) 1392 | 1393 | 1394 | ;;; Minor mode 1395 | 1396 | ;;;###autoload 1397 | (defvar bog-command-map 1398 | (let ((map (make-sparse-keymap))) 1399 | (define-key map "b" 'bog-find-citekey-bib) 1400 | (define-key map "c" 'bog-search-notes-for-citekey) 1401 | (define-key map "f" 'bog-find-citekey-file) 1402 | (define-key map "F" 'bog-dired-jump-to-citekey-file) 1403 | (define-key map "g" 'bog-search-citekey-on-web) 1404 | (define-key map "h" 'bog-goto-citekey-heading-in-notes) 1405 | (define-key map "i" 'bog-citekey-tree-to-indirect-buffer) 1406 | (define-key map "j" 'bog-jump-to-topic-heading) 1407 | (define-key map "l" 'bog-open-citekey-link) 1408 | (define-key map "L" 'bog-open-first-citekey-link) 1409 | (define-key map "n" 'bog-next-non-heading-citekey) 1410 | (define-key map "p" 'bog-previous-non-heading-citekey) 1411 | (define-key map "r" 'bog-rename-staged-file-to-citekey) 1412 | (define-key map "s" 'bog-search-notes) 1413 | (define-key map "w" 'bog-refile) 1414 | (define-key map "v" 'bog-view-mode) 1415 | (define-key map "y" 'bog-insert-heading-citekey) 1416 | map) 1417 | "Keymap for Bog commands. 1418 | In Bog mode, these are under `bog-keymap-prefix'. 1419 | `bog-command-map' can also be bound to a key outside of Bog 1420 | mode.") 1421 | 1422 | ;;;###autoload 1423 | (fset 'bog-command-map bog-command-map) 1424 | 1425 | (defvar bog-mode-map 1426 | (let ((map (make-sparse-keymap))) 1427 | (define-key map bog-keymap-prefix 'bog-command-map) 1428 | map) 1429 | "Keymap for Bog mode.") 1430 | 1431 | ;;;###autoload 1432 | (define-minor-mode bog-mode 1433 | "Toggle Bog in this buffer. 1434 | With a prefix argument ARG, enable `bog-mode' if ARG is positive, 1435 | and disable it otherwise. If called from Lisp, enable the mode 1436 | if ARG is omitted or nil. 1437 | 1438 | \\{bog-mode-map}" 1439 | :lighter " Bog" 1440 | (cond 1441 | (bog-mode 1442 | (if (derived-mode-p 'org-mode) 1443 | (add-hook 'org-font-lock-hook #'bog-fontify-non-heading-citekeys nil t) 1444 | (font-lock-add-keywords nil bog-citekey-font-lock-keywords))) 1445 | (t 1446 | (if (derived-mode-p 'org-mode) 1447 | (remove-hook 'org-font-lock-hook #'bog-fontify-non-heading-citekeys t) 1448 | (font-lock-remove-keywords nil bog-citekey-font-lock-keywords)) 1449 | (when (bound-and-true-p bog-view-mode) 1450 | (bog-view-mode -1)))) 1451 | (when font-lock-mode 1452 | (bog--font-lock-function))) 1453 | 1454 | 1455 | ;;; View minor mode 1456 | 1457 | (defvar bog-view-mode-map 1458 | (let ((map (make-sparse-keymap))) 1459 | (define-key map "b" 'bog-find-citekey-bib) 1460 | (define-key map "c" 'bog-search-notes-for-citekey) 1461 | (define-key map "f" 'bog-find-citekey-file) 1462 | (define-key map "F" 'bog-dired-jump-to-citekey-file) 1463 | (define-key map "g" 'bog-search-citekey-on-web) 1464 | (define-key map "h" 'bog-goto-citekey-heading-in-notes) 1465 | (define-key map "i" 'bog-citekey-tree-to-indirect-buffer) 1466 | (define-key map "j" 'bog-jump-to-topic-heading) 1467 | (define-key map "l" 'bog-open-citekey-link) 1468 | (define-key map "L" 'bog-open-first-citekey-link) 1469 | (define-key map "n" 'bog-next-non-heading-citekey) 1470 | (define-key map "p" 'bog-previous-non-heading-citekey) 1471 | (define-key map "q" 'bog-view-quit) 1472 | (define-key map "r" 'bog-rename-staged-file-to-citekey) 1473 | (define-key map "s" 'bog-search-notes) 1474 | map) 1475 | "Keymap for Bog View mode.") 1476 | 1477 | (defvar bog-view--old-buffer-read-only nil) 1478 | (defvar bog-view--old-bog-mode nil) 1479 | 1480 | ;;;###autoload 1481 | (define-minor-mode bog-view-mode 1482 | "Toggle Bog View mode in this buffer. 1483 | 1484 | With a prefix argument ARG, enable `bog-view-mode' if ARG is 1485 | positive, and disable it otherwise. If called from Lisp, enable 1486 | the mode if ARG is omitted or nil. 1487 | 1488 | Turning on Bog View mode sets the buffer to read-only and gives 1489 | many of the Bog commands a single-letter key binding. 1490 | 1491 | \\\ 1492 | To exit Bog View mode, type \\[bog-view-quit]. 1493 | 1494 | \\{bog-view-mode-map}" 1495 | :lighter " Bog-view" 1496 | (cond 1497 | (bog-view-mode 1498 | (setq bog-view--old-buffer-read-only buffer-read-only 1499 | buffer-read-only t) 1500 | (setq bog-view--old-bog-mode bog-mode) 1501 | (bog-mode)) 1502 | (t 1503 | (setq buffer-read-only bog-view--old-buffer-read-only) 1504 | (unless bog-view--old-bog-mode 1505 | (bog-mode -1))))) 1506 | 1507 | (defun bog-view-quit () 1508 | "Leave Bog View mode." 1509 | (interactive) 1510 | (bog-view-mode -1)) 1511 | 1512 | (provide 'bog) 1513 | 1514 | ;;; bog.el ends here 1515 | --------------------------------------------------------------------------------