From e32756fcfa26f1e0bc215fecdb1e5b1f6b8604b6 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Tue, 17 Feb 2015 01:55:30 -0500 Subject: Add option to store citekey files in subdirectories --- NEWS | 4 ++ bog-tests.el | 50 +++++++++++++++++++++- bog.el | 137 ++++++++++++++++++++++++++++++++++++++++++----------------- 3 files changed, 150 insertions(+), 41 deletions(-) diff --git a/NEWS b/NEWS index 0a744ce..8deec7b 100644 --- a/NEWS +++ b/NEWS @@ -51,6 +51,10 @@ - New command =bog-jump-to-topic-heading= provides quick navigation to topic headings in any note file. +- New variable =bog-subdirectory-group= controls whether BibTeX and + citekey-associated files are organized into subdirectories generated + from a =bog-citekey-format= regexp group. + ** Other changes - =bog-goto-citekey-heading-in-buffer= and diff --git a/bog-tests.el b/bog-tests.el index 3fefc0b..0bab888 100644 --- a/bog-tests.el +++ b/bog-tests.el @@ -397,6 +397,26 @@ some text" (should-not (file-exists-p (expand-file-name (concat "one.pdf") bog-stage-directory)))))) +(ert-deftest bog-rename-staged-file-to-citekey-one-file-subdir () + (bog-tests--with-temp-dir + (let ((bog-stage-directory (expand-file-name "stage")) + (bog-file-directory (expand-file-name "citekey-files")) + (citekey "name2010word") + (bog-subdirectory-group 2)) + (make-directory bog-stage-directory) + (make-directory bog-file-directory) + (write-region "" nil (expand-file-name "one.pdf" bog-stage-directory)) + (bog-tests--with-temp-text + " +* top level +** +some text" + (bog-rename-staged-file-to-citekey)) + (should (file-exists-p (expand-file-name + (concat "2010/" citekey ".pdf") bog-file-directory))) + (should-not (file-exists-p (expand-file-name + (concat "one.pdf") bog-stage-directory)))))) + (ert-deftest bog-file-citekeys-multiple-variants () (bog-tests--with-temp-dir (let* ((bog-file-directory (expand-file-name "citekey-files")) @@ -422,7 +442,8 @@ some text" (let ((temp-file (make-temp-file (expand-file-name "bog-testing-" default-directory) nil ".bib")) - (citekey "name2010word")) + (citekey "name2010word") + (bog-bib-directory default-directory)) (with-current-buffer (find-file-noselect temp-file) (insert (format "\n@article{%s,\n" citekey) "title = {A title},\n" @@ -436,6 +457,7 @@ some text" (should-not (file-exists-p temp-file)) (let* ((new-file (concat citekey ".bib")) (new-buffer (get-file-buffer new-file))) + (should (file-exists-p new-file)) (should-not new-buffer) (delete-file new-file))))) @@ -444,7 +466,8 @@ some text" (let ((temp-file (make-temp-file (expand-file-name "bog-testing-" default-directory) nil ".bib")) - (citekey "name2010word")) + (citekey "name2010word") + (bog-bib-directory default-directory)) (with-current-buffer (find-file-noselect temp-file) (insert (format "\n@article{%s,\n" citekey) "title = {A title},\n" @@ -461,6 +484,29 @@ some text" (kill-buffer new-buffer) (delete-file new-file))))) +(ert-deftest bog--prepare-bib-file-subdir () + (bog-tests--with-temp-dir + (let ((temp-file (make-temp-file + (expand-file-name "bog-testing-" default-directory) + nil ".bib")) + (citekey "name2010word") + (bog-bib-directory default-directory) + (bog-subdirectory-group 2)) + (with-current-buffer (find-file-noselect temp-file) + (insert (format "\n@article{%s,\n" citekey) + "title = {A title},\n" + "author = {Last, First},\n" + "journal = {Some journal},\n" + "year = 2009,\n" + "\n}") + (save-buffer)) + (kill-buffer (get-file-buffer temp-file)) + (bog--prepare-bib-file temp-file) + (should-not (file-exists-p temp-file)) + (let ((new-file (concat "2010/" citekey ".bib"))) + (should (file-exists-p new-file)) + (delete-file new-file))))) + ;; `bog-sort-topic-headings-in-buffer' (ert-deftest bog-sort-topic-headings-in-buffer () diff --git a/bog.el b/bog.el index 3ee30c1..4f81278 100644 --- a/bog.el +++ b/bog.el @@ -99,7 +99,9 @@ The default corresponds to the default value of (defcustom bog-file-directory (expand-file-name "citekey-files/" bog-root-directory) - "Directory with citekey-associated files." + "Directory with citekey-associated files. +Files are stored in subdirectories if `bog-subdirectory-group' is +non-nil." :group 'bog :type 'directory) @@ -124,11 +126,20 @@ entry." :group 'bog :type 'function) +(defcustom bog-subdirectory-group nil + "Regexp group from `bog-citekey-format' to use as subdirectory name. +If non-nil, use the indicated group to generate the subdirectory +name for BibTeX and citekey-associated files." + :group 'bog + :type '(choice (const :tag "Don't use subdirectories" nil) + (integer :tag "Regexp group number"))) + (defcustom bog-bib-directory (expand-file-name "bibs/" bog-root-directory) "The name of the directory that BibTeX files are stored in. This is only meaningful if `bog-find-citekey-bib-func' set to -`bog-find-citekey-bib-file'." +`bog-find-citekey-bib-file'. Files are stored in subdirectories +if `bog-subdirectory-group' is non-nil." :group 'bog :type 'directory) @@ -454,29 +465,40 @@ locating a citekey from context fails." (bog-citekey-from-surroundings-or-files no-context))) (defun bog--find-citekey-file (citekey) - (let* (citekey-file - (citekey-files (bog-citekey-files citekey)) - (citekey-file-names (-map 'file-name-nondirectory citekey-files)) - (num-choices (length citekey-file-names))) + (let* ((citekey-files (bog-citekey-files citekey)) + (num-choices (length citekey-files)) + citekey-file) (case num-choices (0 (user-error "No file found for %s" citekey)) (1 (setq citekey-file (car citekey-files))) - (t (setq citekey-file (expand-file-name - (org-icompleting-read "Select file: " - citekey-file-names) - bog-file-directory)))) + (t + (let* ((fname-paths (-annotate #'file-name-nondirectory citekey-files)) + (fname (org-icompleting-read "Select file: " + (-map #'car fname-paths)))) + (setq citekey-file (cdr (assoc fname fname-paths)))))) (org-open-file citekey-file))) (defun bog-citekey-files (citekey) "Return files in `bog-file-directory' associated with CITEKEY. -These should be named CITEKEY*., where is a -character in `bog-citekey-file-name-separators'." - (let* ((patterns (--map (concat it "*") bog-citekey-file-name-separators)) +These should be named [/]CITEKEY*., where +is a character in `bog-citekey-file-name-separators' and is +determined by `bog-subdirectory-group'." + (let* ((subdir (bog--get-subdir citekey)) + (dir (file-name-as-directory + (or (and subdir (expand-file-name subdir bog-file-directory)) + bog-file-directory))) + (patterns (--map (concat it "*") bog-citekey-file-name-separators)) (patterns (cons ".*" patterns))) - (--mapcat (file-expand-wildcards - (concat (file-name-as-directory bog-file-directory) - citekey it)) - patterns))) + (--mapcat (file-expand-wildcards (concat dir citekey it)) patterns))) + +(defun bog--get-subdir (citekey) + "Return subdirectory for citekey file. +Subdirectory is determined by `bog-subdirectory-group'." + (let (case-fold-search) + (and bog-subdirectory-group + (string-match bog-citekey-format citekey) + (match-string-no-properties bog-subdirectory-group + citekey)))) ;;;###autoload (defun bog-rename-staged-file-to-citekey (&optional no-context) @@ -513,15 +535,20 @@ If the citekey file prompt is slow to appear, consider enabling (defun bog-file-ask-on-conflict (staged-file citekey) "Rename citekey file, prompting for a new name if it already exists. STAGED-FILE is renamed to . within -`bog-file-directory'. If this file already exists, prompt for -another name. `bog-file-secondary-name' controls the default -string for the prompt." +`bog-file-directory' (and, optionally, within a subdirectory, +depending on `bog-subdirectory-group'). If this file already +exists, prompt for another name. `bog-file-secondary-name' +controls the default string for the prompt." (let* ((ext (file-name-extension staged-file)) - (citekey-file (bog-citekey-as-file citekey ext))) + (citekey-file (bog-citekey-as-file citekey ext)) + (dir (file-name-directory citekey-file))) + (unless (file-exists-p dir) + (make-directory dir)) (condition-case nil (rename-file staged-file citekey-file) (file-error - (let ((new-file-name + (let ((dir (file-name-directory citekey-file)) + (new-file-name (file-name-nondirectory (bog-citekey-as-file (concat citekey bog-file-secondary-name) ext)))) @@ -530,13 +557,20 @@ string for the prompt." (format "File %s already exists. Name to use instead: " citekey-file) new-file-name nil nil '(new-file-name))) - (setq citekey-file (expand-file-name new-file-name bog-file-directory)) + (setq citekey-file (expand-file-name new-file-name dir)) (rename-file staged-file citekey-file)))) citekey-file)) (defun bog-citekey-as-file (citekey ext) - "Return file name `bog-file-directory'/CITEKEY.." - (expand-file-name (concat citekey "." ext) bog-file-directory)) + "Return name of associated file for CITEKEY. +Generate a file name with the form +`bog-file-directory'/[/]CITEKEY.EXT, where the optional + is determined by `bog-subdirectory-group'." + (let* ((subdir (bog--get-subdir citekey)) + (dir (file-name-as-directory + (or (and subdir (expand-file-name subdir bog-file-directory)) + bog-file-directory)))) + (expand-file-name (concat citekey "." ext) dir))) (defun bog-all-file-citekeys () "Return a list of citekeys for files in `bog-file-directory'." @@ -551,9 +585,18 @@ string for the prompt." (defun bog-all-citekey-files () "Return list of all files in `bog-file-directory'." - (-remove 'file-directory-p - (directory-files bog-file-directory - t directory-files-no-dot-files-regexp))) + (let (dirs) + (if bog-subdirectory-group + (dolist (df (directory-files bog-file-directory t + directory-files-no-dot-files-regexp)) + (when (and (file-readable-p df) (file-directory-p df)) + (push df dirs))) + (push bog-file-directory dirs)) + (-remove #'file-directory-p + (-mapcat (lambda (d) + (directory-files + d t directory-files-no-dot-files-regexp)) + dirs)))) (defun bog-staged-files () "Return files in `bog-stage-directory'." @@ -599,7 +642,8 @@ fails." Search for new BibTeX files in `bog-stage-directory', and run `bibtex-clean-entry' on each file before it is moved to -`bog-bib-directory'/.bib. +`bog-bib-directory'/[/].bib, where the optional + is determined by `bog-subdirectory-group'. This function is only useful if you use the non-standard setup of one entry per BibTeX file." @@ -608,9 +652,9 @@ one entry per BibTeX file." (file-expand-wildcards (concat (file-name-as-directory bog-stage-directory) "*.bib")))) (--each staged - (bog--prepare-bib-file it t bog-bib-directory)))) + (bog--prepare-bib-file it t)))) -(defun bog--prepare-bib-file (file &optional new-key new-directory) +(defun bog--prepare-bib-file (file &optional new-key) (let (bib-file) (with-temp-buffer (bibtex-mode) @@ -618,9 +662,11 @@ one entry per BibTeX file." (bibtex-skip-to-valid-entry) (bibtex-clean-entry new-key) (if (looking-at bibtex-entry-head) - (setq bib-file (expand-file-name (concat (bibtex-key-in-head) ".bib") - new-directory)) + (setq bib-file (bog-citekey-as-bib (bibtex-key-in-head))) (error "BibTeX header line looks wrong")) + (let ((dir (file-name-directory bib-file))) + (unless (file-exists-p dir) + (make-directory dir))) (write-file bib-file)) ;; If a buffer was visiting the original bib file, point it to the ;; new file. @@ -665,7 +711,11 @@ one entry per BibTeX file." (defun bog-citekey-as-bib (citekey) "Return file name `bog-bib-directory'/CITEKEY.bib." - (expand-file-name (concat citekey ".bib") bog-bib-directory)) + (let* ((subdir (bog--get-subdir citekey)) + (dir (file-name-as-directory + (or (and subdir (expand-file-name subdir bog-bib-directory)) + bog-bib-directory)))) + (expand-file-name (concat citekey ".bib") dir))) (defun bog-bib-citekeys () "Return a list citekeys for all BibTeX entries. @@ -675,11 +725,20 @@ instead of citekeys from file names in `bog-bib-directory'." (with-temp-buffer (bibtex-mode) (insert-file-contents bog-bib-file) - (-map 'car (bibtex-parse-keys))) - (-map 'file-name-base - (file-expand-wildcards (concat - (file-name-as-directory bog-bib-directory) - "*.bib"))))) + (-map #'car (bibtex-parse-keys))) + (let (dirs) + (if bog-subdirectory-group + (dolist (df (directory-files + bog-bib-directory t directory-files-no-dot-files-regexp)) + (when (and (file-readable-p df) (file-directory-p df)) + (push df dirs))) + (push bog-bib-directory dirs)) + (-map #'file-name-base + (-mapcat + (lambda (dir) + (file-expand-wildcards + (concat (file-name-as-directory dir) "*.bib"))) + dirs))))) ;;; Web -- cgit v1.2.3