summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKyle Meyer <kyle@kyleam.com>2014-05-01 22:58:31 -0400
committerKyle Meyer <kyle@kyleam.com>2014-05-01 22:58:31 -0400
commit68ae8262b2ac3a5ae7ba7bf2a90da1ad9db5c51f (patch)
tree8ac63a405c587877c87d68022d6c150ca258e65b
parent3ad4c4332d82e0bf05d747067c9b2c7b9679d449 (diff)
parent3c49474c93d93cd5d0caf7f6a4cfaaf5b93bf86e (diff)
downloadbog-68ae8262b2ac3a5ae7ba7bf2a90da1ad9db5c51f.tar.gz
Merge branch 'citekey-selection-fallback'
-rw-r--r--NEWS7
-rw-r--r--bog-tests.el2
-rw-r--r--bog.el180
3 files changed, 146 insertions, 43 deletions
diff --git a/NEWS b/NEWS
index db86a10..c38895c 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,13 @@
- Any file type (not just PDFs) can now be associated with a citekey.
+- In addition to =bog-find-citekey-file= and =bog-find-citekey-bib=,
+ most functions will now prompt with set of citekeys when prefix
+ argument is given. What this list is depends on the function.
+
+- When locating a citekey from the notes fails, functions will now
+ prompt with a list of citekeys instead of giving an error.
+
* v0.6.0
** New features
diff --git a/bog-tests.el b/bog-tests.el
index 42fab5c..0ce46ad 100644
--- a/bog-tests.el
+++ b/bog-tests.el
@@ -145,7 +145,7 @@
(insert "\n* top level\n\n** second\n\n")
(org-mode)
(show-all)
- (should-error (bog-citekey-from-notes))))
+ (should-not (bog-citekey-from-notes))))
;;; File functions
diff --git a/bog.el b/bog.el
index b8ed18c..c648bd2 100644
--- a/bog.el
+++ b/bog.el
@@ -198,7 +198,33 @@ will still be available through `bog-search-notes' and
(string :tag "Key for agenda dispatch")))
-;;; General utilities
+;;; Citekey methods
+
+(defmacro bog-selection-method (name context-method collection-method)
+ `(defun ,(intern (concat "bog-citekey-from-" name)) (no-context)
+ (or (and no-context (bog-select-citekey (,collection-method)))
+ (,context-method)
+ (bog-select-citekey (,collection-method)))))
+
+(bog-selection-method "notes-or-files"
+ bog-citekey-from-notes
+ bog-all-file-citekeys)
+
+(bog-selection-method "notes-or-bibs"
+ bog-citekey-from-notes
+ bog-bib-citekeys)
+
+(bog-selection-method "notes-or-all"
+ bog-citekey-from-notes
+ bog-all-citekeys)
+
+(bog-selection-method "point-or-buffer-headings"
+ bog-citekey-at-point
+ bog-heading-citekeys-in-buffer)
+
+(bog-selection-method "point-or-all-headings"
+ bog-citekey-at-point
+ bog-all-heading-citekeys)
(defun bog-select-citekey (citekeys)
"Prompt for citekey from CITEKEYS."
@@ -239,9 +265,8 @@ year, and the first meaningful word in the title)."
(while (and (not (bog-citekey-only-p heading))
(org-up-heading-safe))
(setq heading (org-no-properties (org-get-heading t t))))
- (when (not (bog-citekey-only-p heading))
- (error "Citekey not found"))
- heading))))
+ (when (bog-citekey-only-p heading)
+ heading)))))
(defun bog-citekey-from-property ()
"Retrieve citekey from first parent heading that has the
@@ -253,8 +278,6 @@ year, and the first meaningful word in the title)."
(while (and (not citekey)
(org-up-heading-safe))
(setq citekey (org-entry-get (point) bog-citekey-property)))
- (when (not citekey)
- (error "Citekey not found"))
citekey))))
(defun bog-citekey-heading-p ()
@@ -273,19 +296,66 @@ year, and the first meaningful word in the title)."
(when (equal (length text) (match-end 0))
t))
+(defun bog-all-citekeys ()
+ (apply 'append
+ (-map 'bog-citekeys-in-file
+ (bog-notes-files))))
+
+(defun bog-all-heading-citekeys ()
+ (-mapcat 'bog-heading-citekeys-in-file
+ (bog-notes-files)))
+
+(defun bog-citekeys-in-file (file)
+ (let ((was-open (org-find-base-buffer-visiting file))
+ (buffer (find-file-noselect file))
+ refs)
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward bog-citekey-format nil t)
+ (add-to-list 'refs (match-string-no-properties 0))))))
+ (unless was-open
+ (kill-buffer buffer))
+ refs))
+
+(defun bog-heading-citekeys-in-file (file)
+ (let ((was-open (org-find-base-buffer-visiting file))
+ (buffer (find-file-noselect file))
+ citekeys)
+ (with-current-buffer buffer
+ (save-excursion
+ (setq citekeys (bog-heading-citekeys-in-buffer))))
+ (unless was-open
+ (kill-buffer buffer))
+ citekeys))
+
+(defun bog-heading-citekeys-in-buffer ()
+ (--keep it
+ (org-map-entries 'bog-get-heading-if-citekey nil 'file)))
+
+(defun bog-get-heading-if-citekey ()
+ (let ((heading (org-no-properties (org-get-heading t t))))
+ (when (bog-citekey-only-p heading)
+ heading)))
+
;;; Citekey-associated files
;;;###autoload
-(defun bog-find-citekey-file (arg)
+(defun bog-find-citekey-file (&optional no-context)
"Open citekey-associated file.
-If a prefix argument is given, a prompt will open to select from
-available citekeys. Otherwise, the citekey will be taken from the
-text under point if it matches `bog-citekey-format' or using
-`bog-citekey-func'."
+
+The citekey will be taken from the text under point if it matches
+`bog-citekey-format' or from the current subtree using
+`bog-citekey-func'.
+
+With prefix argument NO-CONTEXT, a prompt will open to select
+from citekeys for all associated files. This same prompt will be
+opened if locating a citekey from context fails."
(interactive "P")
- (let ((citekey (or (and arg (bog-select-citekey (bog-all-file-citekeys)))
- (bog-citekey-from-notes))))
+ (let ((citekey (bog-citekey-from-notes-or-files no-context)))
(bog-open-citekey-file citekey)))
(defun bog-open-citekey-file (citekey)
@@ -314,12 +384,18 @@ text under point if it matches `bog-citekey-format' or using
patterns)))
;;;###autoload
-(defun bog-rename-staged-file-to-citekey ()
+(defun bog-rename-staged-file-to-citekey (&optional no-context)
"Rename citekey file in `bog-stage-directory' with `bog-file-renaming-func'.
+
The citekey will be taken from the text under point if it matches
-`bog-citekey-format' or using `bog-citekey-func'."
- (interactive)
- (let ((citekey (bog-citekey-from-notes)))
+`bog-citekey-format' or from the current subtree using
+`bog-citekey-func'.
+
+With prefix argument NO-CONTEXT, a prompt will open to select
+from citekeys for all associated files. This same prompt will be
+opened if locating a citekey from context fails."
+ (interactive "P")
+ (let ((citekey (bog-citekey-from-notes-or-all no-context)))
(bog-rename-staged-file citekey)))
(defun bog-rename-staged-file (citekey)
@@ -391,15 +467,18 @@ used to control the default string used in the prompt."
;;; BibTeX-related
;;;###autoload
-(defun bog-find-citekey-bib (arg)
+(defun bog-find-citekey-bib (&optional no-context)
"Open BibTeX file for a citekey.
-If a prefix argument is given, a prompt will open to select from
-available citekeys. Otherwise, the citekey will be taken from the
-text under point if it matches `bog-citekey-format' or using
-`bog-citekey-func'."
+
+The citekey will be taken from the text under point if it matches
+`bog-citekey-format' or from the current subtree using
+`bog-citekey-func'.
+
+With prefix argument NO-CONTEXT, a prompt will open to select
+from citekeys for all BibTeX files. This same prompt will be
+opened if locating a citekey from context fails."
(interactive "P")
- (let ((citekey (or (and arg (bog-select-citekey (bog-bib-citekeys)))
- (bog-citekey-from-notes))))
+ (let ((citekey (bog-citekey-from-notes-or-bibs no-context)))
(funcall bog-find-citekey-bib-func citekey)))
(defun bog-find-citekey-bib-file (citekey)
@@ -498,15 +577,23 @@ instead of citekeys from file names in `bog-bib-directory'."
;;; Web
;;;###autoload
-(defun bog-search-citekey-on-web ()
+(defun bog-search-citekey-on-web (&optional no-context)
"Open browser and perform query based for a citekey.
The URL will be taken from `bog-web-search-url'.
The citekey is split by groups in `bog-citekey-format' and joined by
-\"+\" to form the query string."
- (interactive)
- (let ((citekey (bog-citekey-from-notes)))
+\"+\" to form the query string.
+
+The citekey will be taken from the text under point if it matches
+`bog-citekey-format' or from the current subtree using
+`bog-citekey-func'.
+
+With prefix argument NO-CONTEXT, a prompt will open to select
+from all citekeys present in notes. This same prompt will be
+opened if locating a citekey from context fails."
+ (interactive "P")
+ (let ((citekey (bog-citekey-from-notes-or-all no-context)))
(bog-open-citekey-on-web citekey)))
(defun bog-open-citekey-on-web (citekey)
@@ -521,13 +608,17 @@ The citekey is split by groups in `bog-citekey-format' and joined by
;;; Notes-related
-(defun bog-goto-citekey-heading-in-buffer ()
+(defun bog-goto-citekey-heading-in-buffer (&optional no-context)
"Find citekey heading in this buffer.
+
The citekey will be taken from the text under point if it matches
-`bog-citekey-format'."
- (interactive)
- (let* ((citekey (or (bog-citekey-at-point)
- (read-string "Enter citekey: ")))
+`bog-citekey-format'.
+
+With prefix argument NO-CONTEXT, a prompt will open to select
+from all citekeys for headings in the current buffer. This same
+prompt will be opened if locating a citekey from context fails."
+ (interactive "P")
+ (let* ((citekey (bog-citekey-from-point-or-buffer-headings no-context))
(pos (org-find-exact-headline-in-buffer citekey nil t)))
(if pos
(progn
@@ -536,16 +627,21 @@ The citekey will be taken from the text under point if it matches
(org-show-context))
(message "Heading for %s not found in buffer" citekey))))
-(defun bog-goto-citekey-heading-in-notes ()
+(defun bog-goto-citekey-heading-in-notes (&optional no-context)
"Find citekey heading in notes.
-All org files in `bog-notes-directory' will be searched. The
-citekey will be taken from the text under point if it matches
-`bog-citekey-format'."
- (interactive)
- (let* ((citekey (or (bog-citekey-at-point)
- (read-string "Enter citekey: ")))
- (marker
- (org-find-exact-heading-in-directory citekey bog-notes-directory)))
+
+All org files in `bog-notes-directory' will be searched.
+
+The citekey will be taken from the text under point if it matches
+`bog-citekey-format'.
+
+With prefix argument NO-CONTEXT, a prompt will open to select
+from all citekeys for headings in notes. This same prompt will be
+opened if locating a citekey from context fails."
+ (interactive "P")
+ (let* ((citekey (bog-citekey-from-point-or-all-headings no-context))
+ (marker
+ (org-find-exact-heading-in-directory citekey bog-notes-directory)))
(if marker
(progn
(switch-to-buffer (marker-buffer marker))