clsn/org-pop.el

## org-pop.el
;;; 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.
	;;; 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.