diff options
| -rw-r--r-- | README.md | 2 | ||||
| -rw-r--r-- | bog-readme.org | 2 | ||||
| -rw-r--r-- | bog-tests.el | 89 | ||||
| -rw-r--r-- | bog.el | 40 |
4 files changed, 132 insertions, 1 deletions
@@ -85,6 +85,8 @@ Other useful functions include - `bog-refile` - `bog-search-notes` - `bog-search-notes-for-citekey` +- `bog-sort-topic-headings-in-buffer` +- `bog-sort-topic-headings-in-notes` # Variables diff --git a/bog-readme.org b/bog-readme.org index e7fb20d..5a1b7f7 100644 --- a/bog-readme.org +++ b/bog-readme.org @@ -92,6 +92,8 @@ Other useful functions include - =bog-refile= - =bog-search-notes= - =bog-search-notes-for-citekey= +- =bog-sort-topic-headings-in-buffer= +- =bog-sort-topic-headings-in-notes= * Variables diff --git a/bog-tests.el b/bog-tests.el index f83c3af..0c737c4 100644 --- a/bog-tests.el +++ b/bog-tests.el @@ -239,3 +239,92 @@ (insert "abc1900word\nhij2000word\nefg1800word\n") (should (equal (bog-collect-references t) '("efg1800word" "hij2000word" "abc1900word"))))) + +;; `bog-sort-topic-headings-in-buffer' + +(ert-deftest bog-sort-topic-headings-in-buffer () + (with-temp-buffer + (let ((bog-topic-heading-level 1)) + (insert "\n* topic heading\n\n" + "** zoo2000key\n\nsome text\n\n" + "** apple2000key\n\nsome text\n" + "* another topic heading\n\n" + "** orange2000key\n\nsome text\n\n" + "** banana2000key\n\nsome text\n" + "** yogurt2000key\n\nsome text\n") + (org-mode) + (show-all) + (bog-sort-topic-headings-in-buffer) + (goto-char 0) + (outline-next-visible-heading 2) + (should (equal (org-no-properties (org-get-heading t t)) + "apple2000key")) + (outline-next-visible-heading 3) + (should (equal (org-no-properties (org-get-heading t t)) + "banana2000key"))))) + +(ert-deftest bog-sort-topic-headings-in-buffer-ignore-citekey-heading () + (with-temp-buffer + (let ((bog-topic-heading-level 1)) + (insert "\n* topic heading\n\n" + "** zoo2000key\n\nsome text\n\n" + "** apple2000key\n\nsome text\n" + "* citekey2000heading\n\n" + "** orange2000key\n\nsome text\n\n" + "** banana2000key\n\nsome text\n" + "** yogurt2000key\n\nsome text\n") + (org-mode) + (show-all) + (bog-sort-topic-headings-in-buffer) + (goto-char 0) + (outline-next-visible-heading 2) + (should (equal (org-no-properties (org-get-heading t t)) + "apple2000key")) + (outline-next-visible-heading 3) + (should (equal (org-no-properties (org-get-heading t t)) + "orange2000key"))))) + +(ert-deftest bog-sort-topic-headings-in-buffer-ignore-citekey-property () + (with-temp-buffer + (let ((bog-topic-heading-level 1)) + (insert "\n* topic heading\n\n" + "** zoo2000key\n\nsome text\n\n" + "** apple2000key\n\nsome text\n" + "* non-topic heading\n" + " :PROPERTIES:\n" + (format " :%s: citekey2000prop\n" bog-citekey-property) + " :END:\n" + "** orange2000key\n\nsome text\n\n" + "** banana2000key\n\nsome text\n" + "** yogurt2000key\n\nsome text\n") + (org-mode) + (show-all) + (bog-sort-topic-headings-in-buffer) + (goto-char 0) + (outline-next-visible-heading 2) + (should (equal (org-no-properties (org-get-heading t t)) + "apple2000key")) + (outline-next-visible-heading 3) + (should (equal (org-no-properties (org-get-heading t t)) + "orange2000key"))))) + +(ert-deftest bog-sort-topic-headings-in-buffer-passed-sorting-type () + (with-temp-buffer + (let ((bog-topic-heading-level 1)) + (insert "\n* topic heading\n\n" + "** zoo2000key\n\nsome text\n\n" + "** apple2000key\n\nsome text\n" + "* another topic heading\n\n" + "** orange2000key\n\nsome text\n\n" + "** banana2000key\n\nsome text\n" + "** yogurt2000key\n\nsome text\n") + (org-mode) + (show-all) + (bog-sort-topic-headings-in-buffer ?n) + (goto-char 0) + (outline-next-visible-heading 2) + (should (equal (org-no-properties (org-get-heading t t)) + "zoo2000key")) + (outline-next-visible-heading 3) + (should (equal (org-no-properties (org-get-heading t t)) + "orange2000key"))))) @@ -171,7 +171,15 @@ It should contain the placeholder \"%s\" for the query." :group 'bog :type 'string) -(defcustom bog-refile-maxlevel 1 +(defcustom bog-topic-heading-level 1 + "Consider headings at this level to be topic headings. +Topic headings for studies may be at any level, but +`bog-sort-topic-headings' uses this variable to determine what +level to operate on." + :group 'bog + :type 'integer) + +(defcustom bog-refile-maxlevel bog-topic-heading-level "Consider up to this level when refiling with `bog-refile'." :group 'bog :type 'integer) @@ -252,6 +260,11 @@ year, and the first meaningful word in the title)." (error "Citekey not found")) citekey)))) +(defun bog-citekey-heading-p () + (let ((heading (org-no-properties (org-get-heading t t)))) + (or (bog-citekey-only-p heading) + (org-entry-get (point) bog-citekey-property)))) + (defun bog-citekey-p (text) "Indicate if TEXT matches `bog-citekey-format'." (when (string-match bog-citekey-format text) @@ -561,6 +574,31 @@ With prefix argument TODO-ONLY, only TODO entries are searched." (put 'org-agenda-redo-command 'org-lprops lprops) (org-let lprops '(org-search-view todo-only citekey)))) +(defun bog-sort-topic-headings-in-buffer (&optional sorting-type) + "Sort topic headings in this buffer. +SORTING-TYPE is a character passed to `org-sort-entries'. If nil, +?a is used. The level to sort is determined by +`bog-topic-heading-level'." + (interactive) + (org-map-entries '(lambda () (bog-sort-if-topic-header sorting-type)))) + +(defun bog-sort-topic-headings-in-notes (&optional sorting-type) + "Sort topic headings in notes. +Unlike `bog-sort-topic-headings-in-buffer', sort topic headings +in all Bog notes." + (interactive) + (org-map-entries '(lambda () (bog-sort-if-topic-header sorting-type)) + nil (bog-notes-files))) + +(defun bog-sort-if-topic-header (sorting-type) + "Sort heading with `org-sort-entries' according to SORTING-TYPE. +Sorting is only done if the heading's level matches +`bog-topic-heading-level' and it isn't a citekey heading." + (let ((sorting-type (or sorting-type ?a))) + (when (and (= (org-current-level) bog-topic-heading-level) + (not (bog-citekey-heading-p))) + (org-sort-entries nil sorting-type)))) + ;;; Font-lock |