Last active
March 11, 2020 00:51
-
-
Save clsn/09ac4b098b6ad7366bb5e0bc88882d5f to your computer and use it in GitHub Desktop.
PoC of org-pop-mode, which allows (effectively) "popping" back up to a higher org-mode level without a new heading.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; org-pop.el --- Allow popping back up from a sublevel without a heading -*- lexical-binding: t -*- | |
;; Author: Mark Shoulson <mark@shoulson.com> | |
;; Url: XXXXXX | |
;; Package-Version: XXXX | |
;; Version: 0.01 | |
;; Package-Requires: ((emacs "24.4") (org "8.3.5")) | |
;; Keywords: hypermedia, outlines, Org | |
;;; Commentary: | |
;; This package makes it possible for subheadings in org-mode to become | |
;; "digressions", in that you can return back from them to a higher level | |
;; without needing to start a new heading at that level (sort of.) | |
;; This is something you can do with plain lists just by adjusting the | |
;; indentation, and it can be handy: | |
;; + Headline | |
;; - A plain list item, containing several paragraphs | |
;; | |
;; Here is another paragraph | |
;; | |
;; + At this point, a digression into another topic | |
;; | |
;; Which may last another paragraph | |
;; | |
;; And now we return to our previous topic. | |
;; But you can't do it with headings, and indeed it kind of breaks the | |
;; whole underlying outline-mode structure. org-pop-mode lets you do | |
;; something that *looks* mostly like you're doing this, by using special | |
;; "continuation" headings to pop back up, and hiding them and unfolding | |
;; and folding them under appropriate circumstances. | |
;; These special headings are distinguished by having a special tag, by | |
;; default "contd". This can be customized via the | |
;; `org-pop-continuation-tag' option. The rest of the heading can be | |
;; anything you want, etc. It might be convenient, for when you export | |
;; into HTML or something, to make the rest of the headline something like | |
;; "--------------", but exporting to HTML still won't be really great. | |
;; To accomplish the above example with headings, you could do: | |
;; ============================== | |
;; * org-pop example | |
;; ** Headline | |
;; Plain lists don't mirror headlines perfectly; body text is not a header. | |
;; | |
;; Here is another paragraph | |
;; | |
;; *** Digression | |
;; At this point, a digression into another topic | |
;; | |
;; Which may last another paragraph | |
;; | |
;; ** -------- :contd: | |
;; And now we return to our previous topic. | |
;; | |
;; ** Bonus header | |
;; A sibling of the original [[*Headline]]. | |
;; ============================== | |
;; Continuation headers have the following special characteristics: | |
;; 1. They fold and unfold together with their "base" (i.e. the nearest | |
;; previous non-continuation same-level sibling). So when the | |
;; "Headline" heading is folded and hit <TAB> on it, this is what you | |
;; see: | |
;; ============================== | |
;; ** Headline | |
;; Plain lists don't mirror headlines perfectly; body text is not a header. | |
;; | |
;; Here is another paragraph | |
;; | |
;; *** Digression... | |
;; | |
;; ** -------- :contd: | |
;; And now we return to our previous topic. | |
;; ============================== | |
;; The "Headline" *and* the continuation heading both unfold and show | |
;; their children, and they both fold when the "Headline" folds also. | |
;; 2. By default, the header itself, along with its subtree, is completely | |
;; hidden when folded, including the newline before it, so it doesn't | |
;; even leave a space. So in the example above, when everything is | |
;; folded and all that shows is just "* org-pop example...", and we hit | |
;; <TAB> on that headline so it shows its children, what you see is: | |
;; ============================== | |
;; * org-pop header | |
;; | |
;; ** Headline | |
;; ** Bonus Header | |
;; ============================== | |
;; | |
;; This can be changed by setting the value of | |
;; org-pop-continuation-headers-display. You should use the | |
;; org-pop-set-continuation-display command to do that. The | |
;; possibilities are: | |
;; a. nil: Always display them, treat them just like ordinary headers | |
;; of their level when it comes to display, except for folding and | |
;; unfolding as above. | |
;; b. 'never: Never display the headers, even when their subtrees are | |
;; unfolded etc. This can be very confusing: you wouldn't be able to | |
;; see where the digression ends and the continuation begins, unless | |
;; you are running org-indent-mode or have the lines indented with | |
;; spaces. | |
;; c. 'nofolded: This is the default. The heading lines are hidden when | |
;; they are folded, but not otherwise. So when looking at the | |
;; children of their parent heading, they will not appear among their | |
;; siblings, but when you unfold their "base", they will become | |
;; visible as their own contents and children are displayed. | |
;; 3. The (C-c @) and (C-x n s) keys (org-mark-subtree and | |
;; org-narrow-to-subtree, respectively) will treat as a single subtree a | |
;; base together with all its continuations. | |
;;; Installation: | |
;; Install from MELPA and run `org-pop-mode'. | |
;; To install manually, put this file in your `load-path', require | |
;; `org-pop' in your init file, and run the same command. | |
;; You might want to add `org-pop' to your `org-mode-hook'. | |
;;; License: | |
;; This program is free software; you can redistribute it and/or modify | |
;; it under the terms of the GNU General Public License as published by | |
;; the Free Software Foundation, either version 3 of the License, or | |
;; (at your option) any later version. | |
;; This program is distributed in the hope that it will be useful, | |
;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
;; GNU General Public License for more details. | |
;; You should have received a copy of the GNU General Public License | |
;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
;;; Code: | |
;;;; Requirements | |
(require 'org) | |
;;;; Variables | |
(defcustom org-pop-continuation-tag "contd" | |
"Tag which distinguishes a continuation header." | |
:group 'org-pop | |
:type '(string | |
:validate | |
(lambda (w) | |
(let ((str (widget-value w))) | |
(unless | |
(string-match-p "^[A-Za-z0-9_@]+$" str) | |
(widget-put | |
w :error | |
"Tag must consist of ASCII letters, numbers, _ and @ alone.") | |
w)))) | |
;; safe-after tag-inheritance-related things? | |
:safe t) | |
(defun org-pop-continuation-re () | |
(format "^\\*+ .*:%s:[[:alpha:][:digit:]_@]*$" org-pop-continuation-tag)) | |
;; Can't be a custom-option, because affects the buffer-invisibility-spec, | |
;; which is buffer-local! Make a "default" option instead. | |
(defvar-local org-pop-continuation-headers-display 'nofolded | |
"How to display continuation headings: | |
nil : normal headline display (default) | |
'nofolded : suppress continuations when main header is folded | |
'never : suppress continuations always. May be confusing outside of | |
org-indent-mode! | |
Only change this value through through | |
`org-pop-set-continuation-display'") | |
(defcustom org-pop-default-continuation-headers-display 'nofolded | |
"Initial setting of how to display continuation headings: | |
nil : normal headline display | |
'nofolded : suppress continuations when main header is folded | |
'never : suppress continuations always. May be confusing outside of | |
org-indent-mode!" | |
:group 'org-pop | |
:type '(choice (const :tag "Normal display" nil) | |
(const :tag "Suppress when folded" nofolded) | |
(const :tag "Always suppress" never))) | |
;; In case you want them to look different. An underlined face will give | |
;; you a big horizontal line, which might be useful. | |
(defface org-pop-continuation-header-face | |
'(nil) ; empty face | |
"face for continuation headers, when shown." | |
:group 'org-pop) | |
;; Override the usual keys with org-pop-aware versions. | |
;; Probably the wrong way to do this. | |
(setq org-pop-keymap (make-sparse-keymap)) | |
(define-key org-pop-keymap [remap org-mark-subtree] ; (kbd "C-c @") | |
(lambda () (interactive) | |
(org-pop-with-continuations | |
(org-back-to-heading) | |
(call-interactively #'org-mark-subtree)))) | |
(define-key org-pop-keymap [remap org-narrow-to-subtree] ; (kbd "C-x n s") | |
(lambda () (interactive) | |
(org-pop-with-continuations | |
(call-interactively #'org-narrow-to-subtree)))) | |
;;;; Functions | |
;; Really, not so critical to set via this anymore: font-lock takes care of | |
;; refreshing everything. | |
(defun org-pop-set-continuation-display (val) | |
"update invisibility etc for continuation-headers display. Remove all the | |
'org-pop-heading: 'org-pop-heading overlays first. If val is nil, do | |
nothing else. Otherwise, add overlays to all continuation-headings in the | |
buffer." | |
(remove-overlays (point-min) (point-max) 'org-pop-heading 'org-pop-heading) | |
(setq org-pop-continuation-headers-display val) | |
(if (not val) | |
(setq buffer-invisibility-spec (delq 'org-pop-heading | |
buffer-invisibility-spec)) | |
(save-excursion | |
(save-restriction | |
(widen) | |
(goto-char (point-min)) | |
(while (re-search-forward | |
(org-pop-continuation-re) nil t) | |
(let ((o (make-overlay | |
(1- (match-beginning 0)) ; !!! maybe dangerous? | |
(match-end 0)))) | |
;; I can't really set the overlay correctly without the | |
;; state, etc, so just set conservatively. Things may look | |
;; goofy until the next visibility cycling. | |
(org-pop-set-header-overlay o 'subtree 0 0))))) | |
(if (memq val '(nofolded never)) | |
(add-to-list 'buffer-invisibility-spec 'org-pop-heading)))) | |
;; TODO: use read-answer (or map-y-or-n-p?) to make a good interactive | |
;; interface to the above. | |
;; TODO: do it *well* | |
(defun org-pop-set-display () | |
(interactive) | |
(let* ((read-answer-short t) | |
(ans | |
(read-answer | |
"When to display continuation headers " | |
'(("never" ?n "Never display them") | |
("always" ?a "Always display them") | |
("nofolded" ?f "Display unless folded") | |
("quit" ?q "Quit")))) | |
(res (cond ((string= ans "never") 'never) | |
((string= ans "always") nil) | |
((string= ans "nofolded") 'nofolded) | |
(t 'quit)))) | |
(when (not (eq res 'quit)) | |
(org-pop-set-continuation-display res)))) | |
(defun org-pop-set-header-overlay (o state lvl thislvl) | |
"Do the Right Thing for overlay o as regards visibility or face for | |
state state, at thislvl, assuming called from level lvl." | |
(overlay-put o 'evaporate t) | |
(overlay-put o 'org-pop-heading 'org-pop-heading) ; to identify later | |
(overlay-put o 'face 'org-pop-continuation-header-face) | |
(unless | |
(or | |
(null org-pop-continuation-headers-display) | |
(and (eq org-pop-continuation-headers-display | |
'nofolded) | |
(or | |
(and | |
(= thislvl lvl) | |
(not (eq state 'folded))) | |
(eq state 'all) | |
(eq state 'subtree)))) | |
(overlay-put o 'invisible 'org-pop-heading))) | |
(defun org-pop-continuation-p () | |
"Is point at the start of a \"continuation\" headline?" | |
;; Faster and more reliable than actually parsing the tags; I don't need | |
;; inheritance or anything. | |
(looking-at | |
(org-pop-continuation-re))) | |
;; Other possibilities: A property? Probably a bit more complicated. | |
(defun org-pop-cycle-continuations (state &optional start end) | |
"When a header is folded or unfolded, fold or unfold its continuation | |
headers (siblings), if any." | |
(save-excursion | |
(cond ((memq state '(folded children subtree)) ;local cycle | |
(setq start (or start (progn (org-pop-back-to-heading) (point)))) | |
(setq end (or end (progn (org-pop-end-of-subtree) (point))))) | |
((memq state '(overview contents all)) ;global cycle | |
(setq start (or start (progn | |
(goto-char (point-min)) | |
(outline-next-heading) | |
(point)))) | |
(setq end (or end (point-max))) | |
(cond ((eq state 'overview) | |
(setq state 'children))) ;?? | |
)) | |
(save-restriction | |
(org-with-limited-levels | |
(narrow-to-region start end) | |
(goto-char (point-min)) | |
(let ((done nil)) | |
(while (and (not done) (org-get-next-sibling)) | |
(cond ((org-pop-continuation-p) | |
(cond ((eq state 'children) | |
(outline-hide-subtree) | |
(org-show-entry) | |
(org-show-children)) | |
((eq state 'folded) | |
(outline-hide-subtree)) | |
((eq state 'subtree) | |
(org-show-subtree) | |
(org-cycle-hide-archived-subtrees state) | |
(org-cycle-hide-drawers state)))) | |
(t (setq done t))))))))) | |
;; This part is rather hairier. | |
(defun org-pop-hide-continuation-headers (state &optional start end) | |
"When (AFTER) a header is folded or unfolded, wrap its continuation trees, | |
(siblings) if any, in overlays with 'org-pop and a higher priority, to | |
suppress the org-ellipsis." | |
(save-excursion | |
(org-with-limited-levels | |
(setq start (or start | |
(and (memq state '(contents overview all)) | |
(point-min)) | |
(progn (org-pop-back-to-heading) (point)))) | |
(setq end (or end | |
(and (memq state '(contents overview all)) | |
(point-min)) | |
(progn (org-pop-end-of-subtree) (point)))) | |
(save-restriction | |
(narrow-to-region start end) | |
(remove-overlays start end 'invisible 'org-pop) | |
(remove-overlays start end 'org-pop-heading 'org-pop-heading) | |
(goto-char start) | |
(let ((done nil) | |
(globalp (memq state '(contents overview all))) | |
(overlays) | |
(lvl (funcall outline-level)) | |
(thislvl) | |
(ov) | |
(ov2) | |
(overlay) | |
(stat (if (memq state '(contents overview)) 'folded state)) | |
(boh (point))) | |
;; Process ALL headings within the affected region. | |
(while (outline-next-heading) | |
(setq thislvl (funcall outline-level)) | |
(cond ((org-pop-continuation-p) | |
(cond (t ;; (memq state '(folded 'subtree)) ; always? | |
;; Overlay the header | |
(setq boh (point)) | |
(outline-end-of-heading) | |
;; Lose the newline too | |
(setq ov2 (make-overlay (1- boh) (point))) | |
(org-pop-set-header-overlay | |
ov2 stat lvl thislvl) | |
(setq overlays (overlays-at (point))) | |
(when (and (eq stat 'folded) | |
(= thislvl lvl)) | |
(while overlays | |
(setq overlay (car overlays)) | |
(when (eq (overlay-get overlay 'invisible) | |
'outline) | |
(setq ov (copy-overlay overlay)) | |
(overlay-put ov 'invisible 'org-pop) | |
;; priority to override and hide ellipses. | |
(overlay-put ov 'priority 1)) | |
(setq overlays (cdr overlays)))))))))))))) | |
;; hack org-back-to-heading and org-end-of-subtree to be wise to | |
;; continuation headers, and skip them going back or forward as the case | |
;; may be. I'd want to do this only when needed, though; replacing the | |
;; functions everywhere could break who knows what. So making my own | |
;; functions. | |
(defun org-pop-back-to-heading (&optional invisible-ok) | |
"Hacked org-back-to-heading to skip continuations" | |
(condition-case nil | |
(let ((lvl)) | |
(outline-back-to-heading invisible-ok) | |
(when (org-pop-continuation-p) | |
(setq lvl (funcall outline-level)) | |
(while (or | |
(> (funcall outline-level) lvl) | |
(org-pop-continuation-p)) | |
(beginning-of-line 0) | |
(outline-back-to-heading invisible-ok)))) | |
(error (user-error "Before first headline at position %d in buffer %s" | |
(point) (current-buffer))))) | |
(defun org-pop-end-of-subtree (&optional invisible-ok to-heading) | |
"Goto to the end of a subtree." | |
;; HACKING to allow for continuations! | |
;; | |
(org-pop-back-to-heading invisible-ok) | |
(let ((first t) | |
(level (funcall outline-level))) | |
(if (and (derived-mode-p 'org-mode) (< level 1000)) | |
;; A true heading (not a plain list item), in Org | |
;; This means we can easily find the end by looking | |
;; only for the right number of stars. Using a regexp to do | |
;; this is so much faster than using a Lisp loop. | |
(let ((re (concat "^\\*\\{1," (int-to-string level) "\\} "))) | |
(forward-char 1) | |
(while (and | |
(re-search-forward re nil 'move) | |
(progn (beginning-of-line) (org-pop-continuation-p)) | |
(= level (funcall outline-level))) | |
(beginning-of-line 2)) | |
(beginning-of-line 1)) | |
;; something else, do it the slow way | |
;; this part isn't hacked; I assume continuation-lines are a | |
;; feature only of boring, well-behaved org things. | |
(while (and (not (eobp)) | |
(or first (> (funcall outline-level) level))) | |
(setq first nil) | |
(outline-next-heading))) | |
(unless to-heading ; any changes needed here for org-pop? | |
(when (memq (preceding-char) '(?\n ?\^M)) | |
;; Go to end of line before heading | |
(forward-char -1) | |
(when (memq (preceding-char) '(?\n ?\^M)) | |
;; leave blank line before heading | |
(forward-char -1))))) | |
(point)) | |
;; Probably not really worth wrapping a lot of things with this. The two | |
;; or three we're using suffice for most cases. | |
(defmacro org-pop-with-continuations (&rest body) | |
`(let | |
((ORIG-back (symbol-function #'org-back-to-heading)) | |
(ORIG-end (symbol-function #'org-end-of-subtree))) | |
(unwind-protect | |
(progn | |
(fset 'org-back-to-heading (symbol-function | |
#'org-pop-back-to-heading)) | |
(fset 'org-end-of-subtree (symbol-function | |
#'org-pop-end-of-subtree)) | |
,@body | |
) | |
(fset 'org-back-to-heading ORIG-back) | |
(fset 'org-end-of-subtree ORIG-end)))) | |
;; Never used, and probably shouldn't be, but experimental. | |
(defun org-pop-element-headline-parser (limit &optional raw-secondary-p) | |
;; I wonder if this is even a good idea, even if it works. Probably not. | |
;; What I'm essentially thinking about is wrapping | |
;; org-element-headline-parser, and seeing if the contents of this | |
;; headline end just before a continuation headline (of the same level), | |
;; and if so, extending the :contents-end to after that. This ignores | |
;; all the other stuff that would ordinarily be gotten from that | |
;; headline, and also leaves us with an "element" that contains two | |
;; headlines of the same level (which I guess is the point of this whole | |
;; exercise). Well, let's see. | |
;; Make it org-element-headline-parser or just org-element-at-point perhaps. | |
;; Either way it doesn't suffice to make org-mark-subtree work in the ordinary | |
;; cl-flet. Not even with both. | |
(save-excursion | |
(let* ((elmnt (org-element-headline-parser limit raw-secondary-p)) | |
(props (cadr elmnt)) | |
(contents-begin (org-element-property :contents-begin elmnt)) | |
(contents-end (org-element-property :contents-end elmnt)) | |
(begin (org-element-property :begin elmnt)) | |
(end (org-element-property :end elmnt)) | |
(level (org-element-property :level elmnt)) | |
(nextelt)) | |
(goto-char contents-end) | |
(skip-chars-forward "\n\r") | |
(while (and t ; (<= (point) limit) | |
(org-pop-continuation-p) | |
(= level (funcall outline-level)) | |
(eq 'headline (car elmnt))) | |
(setq nextelt (org-element-headline-parser limit raw-secondary-p)) | |
(plist-put props :contents-end | |
(org-element-property :contents-end nextelt)) | |
(plist-put props :end | |
(org-element-property :end nextelt)) | |
(goto-char (org-element-property :contents-end elmnt)) | |
(skip-chars-forward "\n\r")) | |
elmnt))) | |
(defun org-pop-element-at-point () | |
(let ((elmnt (org-element-at-point))) | |
(if (eq 'headline (car-safe elmnt)) | |
(org-pop-element-headline-parser (point-max) t) | |
elmnt))) | |
;;;; Minor mode | |
;;;###autoload | |
(define-minor-mode org-pop-mode | |
"Pop back up without a headline" nil "_" org-pop-keymap | |
(if org-pop-mode | |
(progn | |
(add-to-invisibility-spec 'org-pop) | |
(org-pop-set-continuation-display | |
org-pop-default-continuation-headers-display) | |
;; order matters, apparently? | |
(add-hook 'org-cycle-hook #'org-pop-hide-continuation-headers) | |
(add-hook 'org-cycle-hook #'org-pop-cycle-continuations)) | |
(remove-from-invisibility-spec 'org-pop) | |
(remove-from-invisibility-spec 'org-pop-heading) | |
(remove-overlays (point-min) (point-max) 'org-pop-heading 'org-pop-heading) | |
(remove-overlays (point-min) (point-max) 'invisible 'org-pop) | |
(remove-hook 'org-cycle-hook #'org-pop-hide-continuation-headers) | |
(remove-hook 'org-cycle-hook #'org-pop-cycle-continuations))) | |
;; BUGS: | |
;; - does Weird Things(tm) if the very last headline in the file is | |
;; a continuation headline -- not noticed so much anymore; maybe fixed? | |
;; - Cycle-hook does not handle global cycling, which causes wonkiness | |
;; with continuations at level 1 (is that the only reason for it?), | |
;; and probably would do wrong things with the continuation face in | |
;; global cycling too. -- also looking better. | |
;; - Potentially surprising results on things like show-branches. | |
;; - Ditto exports and tables of contents | |
(provide 'org-pop) | |
;;; org-pop.el ends here. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment