diff options
| -rw-r--r-- | lisp/init-org.el | 115 |
1 files changed, 101 insertions, 14 deletions
diff --git a/lisp/init-org.el b/lisp/init-org.el index be79d25..8f81b78 100644 --- a/lisp/init-org.el +++ b/lisp/init-org.el @@ -169,25 +169,112 @@ heading." (org-update-checkbox-count-maybe) (message "Deleted %s item(s)" deleted-count))))) +(defmacro km/org--save-pos-on-sort (&rest body) + "Try to return to the orginal position after sorting. + +Sorting doesn't play well with `save-restriction' or markers, so +just put the point where it was relative to the original heading. +This may not actually be the same tree if there are redundant +headings. + +This relies on point being placed at the heading that was sorted, +as `org-sort-entries' does." + `(let ((starting-pos (point))) + (org-back-to-heading t) + (let ((heading-line (buffer-substring-no-properties + (point-at-bol) (point-at-eol))) + (chars-after-heading (- starting-pos (point)))) + ,@body + (search-forward heading-line) + (beginning-of-line) + (goto-char (+ (point) chars-after-heading))))) + (defun km/org-sort-parent (arg) "Sort on parent heading ARG levels up. After sorting, return point to its previous location under the current heading." (interactive "p") - (let ((starting-pos (point))) - (org-back-to-heading t) - (let ((heading-line (buffer-substring-no-properties - (point-at-bol) (point-at-eol))) - (chars-after-heading (- starting-pos (point)))) - (outline-up-heading arg) - (call-interactively #'org-sort) - ;; Sorting doesn't play well with `save-restriction' or markers, - ;; so just put the point where it was relative to the original - ;; heading. This may not actually be the same tree if there are - ;; redundant headings. - (re-search-forward heading-line) - (beginning-of-line) - (goto-char (+ (point) chars-after-heading))))) + (km/org--save-pos-on-sort + (outline-up-heading arg) + (call-interactively #'org-sort))) + +(defun km/org--prop-sort-args () + "Return `org-sort-entries' arguments based on \"SORT\" property." + (when (save-excursion (org-goto-first-child)) + (let ((prop (org-entry-get nil "sort" 'inherit))) + (when prop + (let* ((current-level (org-current-level)) + (sort-prop (s-split " by " prop)) + (levels (mapcar #'string-to-number (s-split nil (car sort-prop)))) + (sorting-type (cadr sort-prop)) + sorting-func) + (if sorting-type + (progn + (setq sorting-type (read sorting-type)) + (cond + ((characterp sorting-type)) + ((fboundp sorting-type) + (setq sorting-func sorting-type + sorting-type ?f)) + (t + (user-error "Invalid sorting type: %s" sorting-type)))) + (setq sorting-type ?a)) + (when (or (equal levels (list 0)) + (memq current-level levels)) + (list nil sorting-type sorting-func))))))) + +(defun km/org-maybe-sort () + "Sort current heading based on \"SORT\" property. + +Property value should have the format \"LEVELS by TYPE\", where +LEVELS specifies the level of heading to sort and TYPE is the +sorting type. + +If LEVELS is a space-seperated list of positive integers, only +sort heading if it is at one of these levels. If LEVELS is zero +or a non-numeric string, sort heading regardless of its level. +If LEVELS is a negative number, do not sort. (Notice that there +is only support for sorting subheadings in a tree, not top-level +headings.) + +If TYPE is a character, pass it as the SORTING-TYPE argument to +`org-sort-entries'. If TYPE is the name of a bound function, +pass it as the GETKEY-FUNC argument to `org-sort-entries' (with +?f as the SORTING-TYPE value). If \"by TYPE\" is omitted from +the property value, sort alphabetically. + +For example + + 2 by ?a Sort alphabetically if level 2 heading. + 2 Same as above. + + t Sort heading alphabetically. + all Same as above. + + 1 by func Sort heading using function if level 1 heading. + + -1 Don't sort. Useful for overriding parent value." + (let ((sort-args (km/org--prop-sort-args))) + (when sort-args + (apply #'org-sort-entries sort-args)))) + +(defun km/org-maybe-sort-buffer-headings () + "Call `km/org-maybe-sort' on buffer headings." + (interactive) + (org-map-entries #'km/org-maybe-sort)) + +(defun km/org-maybe-sort-parent () + "Sort parent heading based on \"SORT\" property. +See `km/org-maybe-sort' for details of property value format." + (let (heading-pos sort-args) + (save-excursion + (and (org-up-heading-safe) + (setq heading-pos (point) + sort-args (km/org--prop-sort-args)))) + (when sort-args + (km/org--save-pos-on-sort + (goto-char heading-pos) + (apply #'org-sort-entries sort-args))))) (defun km/org-sort-heading-ignoring-articles () "Sort alphabetically, but ignore any leading articles." |