summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2018-01-13 12:35:10 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2018-01-13 14:15:53 +0100
commit000b943ebd2086b069dde715194358aeaf4175e3 (patch)
treee912e1d2e015b9bc8ef98998fbcf7b3201ae964d
parenta8ee20d23d3c2250477bf7590e225da48f327dd3 (diff)
downloadorg-mode-000b943ebd2086b069dde715194358aeaf4175e3.tar.gz
Re-order visibility functions in "org.el"
* lisp/org-macs.el (org-outline-overlay-data): (org-set-outline-overlay-data): Moved from "org.el". * lisp/org.el (org-remove-empty-overlays-at): (org-show-empty-lines-in-parent): (org-files-list): (org-entry-beginning-position): (org-entry-end-position): (org-subtree-end-visible-p): (org-first-headline-recenter): (org-flag-region): (org-show-entry): (org-show-children): (org-show-subtree): (org-hide-block-toggle-maybe): (org-hide-block-toggle): (org-hide-block-toggle-all): (org-hide-block-all): (org-cycle-hide-drawers): (org-flag-drawer): (org-previous-block): (org-next-block): Move functions.
-rw-r--r--lisp/ob-core.el1
-rw-r--r--lisp/org-macs.el29
-rw-r--r--lisp/org.el742
3 files changed, 391 insertions, 381 deletions
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 465814d..d839ae6 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -75,7 +75,6 @@
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-next-block "org" (arg &optional backward block-regexp))
(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
-(declare-function org-outline-overlay-data "org" (&optional use-markers))
(declare-function org-previous-block "org" (arg &optional block-regexp))
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-reverse-string "org" (string))
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index dce6f91..24c4442 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -736,6 +736,35 @@ Optional argument REGEXP selects variables to clone."
(or (null regexp) (string-match-p regexp (symbol-name name))))
(ignore-errors (set (make-local-variable name) value)))))))
+
+;;; Visibility
+
+(defun org-outline-overlay-data (&optional use-markers)
+ "Return a list of the locations of all outline overlays.
+These are overlays with the `invisible' property value `outline'.
+The return value is a list of cons cells, with start and stop
+positions for each overlay.
+If USE-MARKERS is set, return the positions as markers."
+ (let (beg end)
+ (org-with-wide-buffer
+ (delq nil
+ (mapcar (lambda (o)
+ (when (eq (overlay-get o 'invisible) 'outline)
+ (setq beg (overlay-start o)
+ end (overlay-end o))
+ (and beg end (> end beg)
+ (if use-markers
+ (cons (copy-marker beg)
+ (copy-marker end t))
+ (cons beg end)))))
+ (overlays-in (point-min) (point-max)))))))
+
+(defun org-set-outline-overlay-data (data)
+ "Create visibility overlays for all positions in DATA.
+DATA should have been made by `org-outline-overlay-data'."
+ (org-with-wide-buffer
+ (org-show-all)
+ (dolist (c data) (org-flag-region (car c) (cdr c) t 'outline))))
;;; Miscellaneous
diff --git a/lisp/org.el b/lisp/org.el
index 8c75d2d..afebb20 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -6582,9 +6582,238 @@ and subscripts."
(list 'invisible t))))
t)))
-;;;; Visibility cycling, including org-goto and indirect buffer
+(defun org-remove-empty-overlays-at (pos)
+ "Remove outline overlays that do not contain non-white stuff."
+ (dolist (o (overlays-at pos))
+ (and (eq 'outline (overlay-get o 'invisible))
+ (not (string-match "\\S-" (buffer-substring (overlay-start o)
+ (overlay-end o))))
+ (delete-overlay o))))
+
+(defun org-show-empty-lines-in-parent ()
+ "Move to the parent and re-show empty lines before visible headlines."
+ (save-excursion
+ (let ((context (if (org-up-heading-safe) 'children 'overview)))
+ (org-cycle-show-empty-lines context))))
+
+(defun org-files-list ()
+ "Return `org-agenda-files' list, plus all open Org files.
+This is useful for operations that need to scan all of a user's
+open and agenda-wise Org files."
+ (let ((files (mapcar #'expand-file-name (org-agenda-files))))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (and (derived-mode-p 'org-mode) (buffer-file-name))
+ (cl-pushnew (expand-file-name (buffer-file-name)) files
+ :test #'equal))))
+ files))
+
+(defsubst org-entry-beginning-position ()
+ "Return the beginning position of the current entry."
+ (save-excursion (org-back-to-heading t) (point)))
+
+(defsubst org-entry-end-position ()
+ "Return the end position of the current entry."
+ (save-excursion (outline-next-heading) (point)))
+
+(defun org-subtree-end-visible-p ()
+ "Is the end of the current subtree visible?"
+ (pos-visible-in-window-p
+ (save-excursion (org-end-of-subtree t) (point))))
+
+(defun org-first-headline-recenter ()
+ "Move cursor to the first headline and recenter the headline."
+ (let ((window (get-buffer-window)))
+ (when window
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
+ (set-window-start window (line-beginning-position))))))
+
+
+;;; Visibility (headlines, blocks, drawers)
+
+(defun org-flag-region (from to flag spec)
+ "Hide or show lines from FROM to TO, according to FLAG.
+SPEC is the invisibility spec, as a symbol."
+ (remove-overlays from to 'invisible spec)
+ ;; Use `front-advance' since text right before to the beginning of
+ ;; the overlay belongs to the visible line than to the contents.
+ (when flag
+ (let ((o (make-overlay from to nil 'front-advance)))
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'invisible spec)
+ (overlay-put o 'isearch-open-invisible #'delete-overlay))))
+
+;;;; Headlines visibility
+
+(defun org-show-entry ()
+ "Show the body directly following this heading.
+Show the heading too, if it is currently invisible."
+ (interactive)
+ (save-excursion
+ (ignore-errors
+ (org-back-to-heading t)
+ (org-flag-region
+ (line-end-position 0)
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
+ (match-beginning 1)
+ (point-max)))
+ nil
+ 'outline))))
+
+(defun org-show-children (&optional level)
+ "Show all direct subheadings of this heading.
+Prefix arg LEVEL is how many levels below the current level
+should be shown. Default is enough to cause the following
+heading to appear."
+ (interactive "p")
+ (save-excursion
+ (org-back-to-heading t)
+ (let* ((current-level (funcall outline-level))
+ (max-level (org-get-valid-level
+ current-level
+ (if level (prefix-numeric-value level) 1)))
+ (end (save-excursion (org-end-of-subtree t t)))
+ (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
+ (past-first-child nil)
+ ;; Make sure to skip inlinetasks.
+ (re (format regexp-fmt
+ current-level
+ (cond
+ ((not (featurep 'org-inlinetask)) "")
+ (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
+ 3))
+ (t (1- org-inlinetask-min-level))))))
+ ;; Display parent heading.
+ (org-flag-heading nil)
+ (forward-line)
+ ;; Display children. First child may be deeper than expected
+ ;; MAX-LEVEL. Since we want to display it anyway, adjust
+ ;; MAX-LEVEL accordingly.
+ (while (re-search-forward re end t)
+ (unless past-first-child
+ (setq re (format regexp-fmt
+ current-level
+ (max (funcall outline-level) max-level)))
+ (setq past-first-child t))
+ (org-flag-heading nil)))))
+
+(defun org-show-subtree ()
+ "Show everything after this heading at deeper levels."
+ (interactive)
+ (org-flag-region
+ (point) (save-excursion (org-end-of-subtree t t)) nil 'outline))
+
+;;;; Blocks visibility
+
+(defun org-hide-block-toggle-maybe ()
+ "Toggle visibility of block at point.
+Unlike to `org-hide-block-toggle', this function does not throw
+an error. Return a non-nil value when toggling is successful."
+ (interactive)
+ (ignore-errors (org-hide-block-toggle)))
+
+(defun org-hide-block-toggle (&optional force)
+ "Toggle the visibility of the current block.
+When optional argument FORCE is `off', make block visible. If it
+is non-nil, hide it unconditionally. Throw an error when not at
+a block. Return a non-nil value when toggling is successful."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (memq (org-element-type element)
+ '(center-block comment-block dynamic-block example-block
+ export-block quote-block special-block
+ src-block verse-block))
+ (user-error "Not at a block"))
+ (let* ((post (org-element-property :post-affiliated element))
+ (start (save-excursion
+ (goto-char post)
+ (line-end-position)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \t\n")
+ (line-end-position))))
+ ;; Do nothing when not before or at the block opening line or at
+ ;; the block closing line.
+ (unless (let ((eol (line-end-position))) (and (> eol start) (/= eol end)))
+ (cond ((eq force 'off)
+ (org-flag-region start end nil 'org-hide-block))
+ (force
+ (org-flag-region start end t 'org-hide-block))
+ ((eq (get-char-property start 'invisible) 'org-hide-block)
+ (org-flag-region start end nil 'org-hide-block))
+ (t
+ (org-flag-region start end t 'org-hide-block)))
+ ;; When the block is hidden away, make sure point is left in
+ ;; a visible part of the buffer.
+ (when (invisible-p (max (1- (point)) (point-min)))
+ (goto-char post))
+ ;; Signal success.
+ t))))
+
+(defun org-hide-block-toggle-all ()
+ "Toggle the visibility of all blocks in the current buffer."
+ (org-block-map 'org-hide-block-toggle))
+
+(defun org-hide-block-all ()
+ "Fold all blocks in the current buffer."
+ (interactive)
+ (org-show-all '(blocks))
+ (org-block-map 'org-hide-block-toggle-maybe))
+
+;;;; Drawers visibility
+
+(defun org-cycle-hide-drawers (state &optional exceptions)
+ "Re-hide all drawers after a visibility state change.
+STATE should be one of the symbols listed in the docstring of
+`org-cycle-hook'. When non-nil, optional argument EXCEPTIONS is
+a list of strings specifying which drawers should not be hidden."
+ (when (and (derived-mode-p 'org-mode)
+ (not (memq state '(overview folded contents))))
+ (save-excursion
+ (let* ((globalp (eq state 'all))
+ (beg (if globalp (point-min) (point)))
+ (end (if globalp (point-max)
+ (if (eq state 'children)
+ (save-excursion (outline-next-heading) (point))
+ (org-end-of-subtree t)))))
+ (goto-char beg)
+ (while (re-search-forward org-drawer-regexp (max end (point)) t)
+ (unless (member-ignore-case (match-string 1) exceptions)
+ (let ((drawer (org-element-at-point)))
+ (when (memq (org-element-type drawer) '(drawer property-drawer))
+ (org-flag-drawer t drawer)
+ ;; Make sure to skip drawer entirely or we might flag
+ ;; it another time when matching its ending line with
+ ;; `org-drawer-regexp'.
+ (goto-char (org-element-property :end drawer))))))))))
+
+(defun org-flag-drawer (flag &optional element)
+ "When FLAG is non-nil, hide the drawer we are at.
+Otherwise make it visible. When optional argument ELEMENT is
+a parsed drawer, as returned by `org-element-at-point', hide or
+show that drawer instead."
+ (let ((drawer (or element
+ (and (save-excursion
+ (beginning-of-line)
+ (looking-at-p org-drawer-regexp))
+ (org-element-at-point)))))
+ (when (memq (org-element-type drawer) '(drawer property-drawer))
+ (let ((post (org-element-property :post-affiliated drawer)))
+ (org-flag-region
+ (save-excursion (goto-char post) (line-end-position))
+ (save-excursion (goto-char (org-element-property :end drawer))
+ (skip-chars-backward " \t\n")
+ (line-end-position))
+ flag 'org-hide-drawer)
+ ;; When the drawer is hidden away, make sure point lies in
+ ;; a visible part of the buffer.
+ (when (invisible-p (max (1- (point)) (point-min)))
+ (goto-char post))))))
-;;; Cycling
+;;;; Visibility cycling
(defvar-local org-cycle-global-status nil)
(put 'org-cycle-global-status 'org-state t)
@@ -7021,14 +7250,6 @@ This function is the default value of the hook `org-cycle-hook'."
((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
-(defun org-remove-empty-overlays-at (pos)
- "Remove outline overlays that do not contain non-white stuff."
- (dolist (o (overlays-at pos))
- (and (eq 'outline (overlay-get o 'invisible))
- (not (string-match "\\S-" (buffer-substring (overlay-start o)
- (overlay-end o))))
- (delete-overlay o))))
-
(defun org-clean-visibility-after-subtree-move ()
"Fix visibility issues after moving a subtree."
;; First, find a reasonable region to look at:
@@ -7103,209 +7324,78 @@ are at least `org-cycle-separator-lines' empty lines before the headline."
(= (match-end 0) (point-max)))
(org-flag-region (point) (match-end 0) nil 'outline))))
-(defun org-show-empty-lines-in-parent ()
- "Move to the parent and re-show empty lines before visible headlines."
- (save-excursion
- (let ((context (if (org-up-heading-safe) 'children 'overview)))
- (org-cycle-show-empty-lines context))))
-
-(defun org-files-list ()
- "Return `org-agenda-files' list, plus all open Org files.
-This is useful for operations that need to scan all of a user's
-open and agenda-wise Org files."
- (let ((files (mapcar #'expand-file-name (org-agenda-files))))
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (and (derived-mode-p 'org-mode) (buffer-file-name))
- (cl-pushnew (expand-file-name (buffer-file-name)) files
- :test #'equal))))
- files))
-
-(defsubst org-entry-beginning-position ()
- "Return the beginning position of the current entry."
- (save-excursion (org-back-to-heading t) (point)))
-
-(defsubst org-entry-end-position ()
- "Return the end position of the current entry."
- (save-excursion (outline-next-heading) (point)))
-
-(defun org-cycle-hide-drawers (state &optional exceptions)
- "Re-hide all drawers after a visibility state change.
-STATE should be one of the symbols listed in the docstring of
-`org-cycle-hook'. When non-nil, optional argument EXCEPTIONS is
-a list of strings specifying which drawers should not be hidden."
- (when (and (derived-mode-p 'org-mode)
- (not (memq state '(overview folded contents))))
- (save-excursion
- (let* ((globalp (eq state 'all))
- (beg (if globalp (point-min) (point)))
- (end (if globalp (point-max)
- (if (eq state 'children)
- (save-excursion (outline-next-heading) (point))
- (org-end-of-subtree t)))))
- (goto-char beg)
- (while (re-search-forward org-drawer-regexp (max end (point)) t)
- (unless (member-ignore-case (match-string 1) exceptions)
- (let ((drawer (org-element-at-point)))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (org-flag-drawer t drawer)
- ;; Make sure to skip drawer entirely or we might flag
- ;; it another time when matching its ending line with
- ;; `org-drawer-regexp'.
- (goto-char (org-element-property :end drawer))))))))))
-
-(defun org-flag-drawer (flag &optional element)
- "When FLAG is non-nil, hide the drawer we are at.
-Otherwise make it visible. When optional argument ELEMENT is
-a parsed drawer, as returned by `org-element-at-point', hide or
-show that drawer instead."
- (let ((drawer (or element
- (and (save-excursion
- (beginning-of-line)
- (looking-at-p org-drawer-regexp))
- (org-element-at-point)))))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (let ((post (org-element-property :post-affiliated drawer)))
- (org-flag-region
- (save-excursion (goto-char post) (line-end-position))
- (save-excursion (goto-char (org-element-property :end drawer))
- (skip-chars-backward " \t\n")
- (line-end-position))
- flag 'org-hide-drawer)
- ;; When the drawer is hidden away, make sure point lies in
- ;; a visible part of the buffer.
- (when (invisible-p (max (1- (point)) (point-min)))
- (goto-char post))))))
-
-(defun org-subtree-end-visible-p ()
- "Is the end of the current subtree visible?"
- (pos-visible-in-window-p
- (save-excursion (org-end-of-subtree t) (point))))
-
-(defun org-first-headline-recenter ()
- "Move cursor to the first headline and recenter the headline."
- (let ((window (get-buffer-window)))
- (when window
- (goto-char (point-min))
- (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
- (set-window-start window (line-beginning-position))))))
-
-;;; Saving and restoring visibility
-
-(defun org-outline-overlay-data (&optional use-markers)
- "Return a list of the locations of all outline overlays.
-These are overlays with the `invisible' property value `outline'.
-The return value is a list of cons cells, with start and stop
-positions for each overlay.
-If USE-MARKERS is set, return the positions as markers."
- (let (beg end)
- (org-with-wide-buffer
- (delq nil
- (mapcar (lambda (o)
- (when (eq (overlay-get o 'invisible) 'outline)
- (setq beg (overlay-start o)
- end (overlay-end o))
- (and beg end (> end beg)
- (if use-markers
- (cons (copy-marker beg)
- (copy-marker end t))
- (cons beg end)))))
- (overlays-in (point-min) (point-max)))))))
-
-(defun org-set-outline-overlay-data (data)
- "Create visibility overlays for all positions in DATA.
-DATA should have been made by `org-outline-overlay-data'."
- (org-with-wide-buffer
- (org-show-all)
- (dolist (c data) (org-flag-region (car c) (cdr c) t 'outline))))
+;;;; Reveal point location
-;;; Folding of blocks
-
-(defun org-flag-region (from to flag spec)
- "Hide or show lines from FROM to TO, according to FLAG.
-SPEC is the invisibility spec, as a symbol."
- (remove-overlays from to 'invisible spec)
- ;; Use `front-advance' since text right before to the beginning of
- ;; the overlay belongs to the visible line than to the contents.
- (when flag
- (let ((o (make-overlay from to nil 'front-advance)))
- (overlay-put o 'evaporate t)
- (overlay-put o 'invisible spec)
- (overlay-put o 'isearch-open-invisible #'delete-overlay))))
+(defun org-show-context (&optional key)
+ "Make sure point and context are visible.
+Optional argument KEY, when non-nil, is a symbol. See
+`org-show-context-detail' for allowed values and how much is to
+be shown."
+ (org-show-set-visibility
+ (cond ((symbolp org-show-context-detail) org-show-context-detail)
+ ((cdr (assq key org-show-context-detail)))
+ (t (cdr (assq 'default org-show-context-detail))))))
-(defun org-block-map (function &optional start end)
- "Call FUNCTION at the head of all source blocks in the current buffer.
-Optional arguments START and END can be used to limit the range."
- (let ((start (or start (point-min)))
- (end (or end (point-max))))
+(defun org-show-set-visibility (detail)
+ "Set visibility around point according to DETAIL.
+DETAIL is either nil, `minimal', `local', `ancestors', `lineage',
+`tree', `canonical' or t. See `org-show-context-detail' for more
+information."
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-flag-heading nil)
+ (org-show-entry)
+ ;; If point is hidden within a drawer or a block, make sure to
+ ;; expose it.
+ (dolist (o (overlays-at (point)))
+ (when (memq (overlay-get o 'invisible)
+ '(org-hide-block org-hide-drawer outline))
+ (delete-overlay o)))
+ (unless (org-before-first-heading-p)
+ (org-with-limited-levels
+ (cl-case detail
+ ((tree canonical t) (org-show-children))
+ ((nil minimal ancestors))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-flag-heading nil)))))))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors lineage tree canonical t))
(save-excursion
- (goto-char start)
- (while (and (< (point) end) (re-search-forward org-block-regexp end t))
- (save-excursion
- (save-match-data
- (goto-char (match-beginning 0))
- (funcall function)))))))
+ (while (org-up-heading-safe)
+ (org-flag-heading nil)
+ (when (memq detail '(canonical t)) (org-show-entry))
+ (when (memq detail '(tree canonical t)) (org-show-children))))))
-(defun org-hide-block-toggle-all ()
- "Toggle the visibility of all blocks in the current buffer."
- (org-block-map 'org-hide-block-toggle))
+(defvar org-reveal-start-hook nil
+ "Hook run before revealing a location.")
-(defun org-hide-block-all ()
- "Fold all blocks in the current buffer."
- (interactive)
- (org-show-all '(blocks))
- (org-block-map 'org-hide-block-toggle-maybe))
+(defun org-reveal (&optional siblings)
+ "Show current entry, hierarchy above it, and the following headline.
-(defun org-hide-block-toggle-maybe ()
- "Toggle visibility of block at point.
-Unlike to `org-hide-block-toggle', this function does not throw
-an error. Return a non-nil value when toggling is successful."
- (interactive)
- (ignore-errors (org-hide-block-toggle)))
+This can be used to show a consistent set of context around
+locations exposed with `org-show-context'.
-(defun org-hide-block-toggle (&optional force)
- "Toggle the visibility of the current block.
-When optional argument FORCE is `off', make block visible. If it
-is non-nil, hide it unconditionally. Throw an error when not at
-a block. Return a non-nil value when toggling is successful."
- (interactive)
- (let ((element (org-element-at-point)))
- (unless (memq (org-element-type element)
- '(center-block comment-block dynamic-block example-block
- export-block quote-block special-block
- src-block verse-block))
- (user-error "Not at a block"))
- (let* ((post (org-element-property :post-affiliated element))
- (start (save-excursion
- (goto-char post)
- (line-end-position)))
- (end (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \t\n")
- (line-end-position))))
- ;; Do nothing when not before or at the block opening line or at
- ;; the block closing line.
- (unless (let ((eol (line-end-position))) (and (> eol start) (/= eol end)))
- (cond ((eq force 'off)
- (org-flag-region start end nil 'org-hide-block))
- (force
- (org-flag-region start end t 'org-hide-block))
- ((eq (get-char-property start 'invisible) 'org-hide-block)
- (org-flag-region start end nil 'org-hide-block))
- (t
- (org-flag-region start end t 'org-hide-block)))
- ;; When the block is hidden away, make sure point is left in
- ;; a visible part of the buffer.
- (when (invisible-p (max (1- (point)) (point-min)))
- (goto-char post))
- ;; Signal success.
- t))))
+With optional argument SIBLINGS, on each level of the hierarchy all
+siblings are shown. This repairs the tree structure to what it would
+look like when opened with hierarchical calls to `org-cycle'.
-;; Remove overlays when changing major mode
-(add-hook 'org-mode-hook
- (lambda () (add-hook 'change-major-mode-hook
- 'org-show-all 'append 'local)))
+With a \\[universal-argument] \\[universal-argument] prefix, \
+go to the parent and show the entire tree."
+ (interactive "P")
+ (run-hooks 'org-reveal-start-hook)
+ (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
+ ((equal siblings '(16))
+ (save-excursion
+ (when (org-up-heading-safe)
+ (org-show-subtree)
+ (run-hook-with-args 'org-cycle-hook 'subtree))))
+ (t (org-show-set-visibility 'lineage))))
+
;;; Indirect buffer display of subtrees
(defvar org-indirect-dedicated-frame nil
@@ -13262,75 +13352,6 @@ match is found."
(goto-char p1)
(user-error "No more matches"))))
-(defun org-show-context (&optional key)
- "Make sure point and context are visible.
-Optional argument KEY, when non-nil, is a symbol. See
-`org-show-context-detail' for allowed values and how much is to
-be shown."
- (org-show-set-visibility
- (cond ((symbolp org-show-context-detail) org-show-context-detail)
- ((cdr (assq key org-show-context-detail)))
- (t (cdr (assq 'default org-show-context-detail))))))
-
-(defun org-show-set-visibility (detail)
- "Set visibility around point according to DETAIL.
-DETAIL is either nil, `minimal', `local', `ancestors', `lineage',
-`tree', `canonical' or t. See `org-show-context-detail' for more
-information."
- ;; Show current heading and possibly its entry, following headline
- ;; or all children.
- (if (and (org-at-heading-p) (not (eq detail 'local)))
- (org-flag-heading nil)
- (org-show-entry)
- ;; If point is hidden within a drawer or a block, make sure to
- ;; expose it.
- (dolist (o (overlays-at (point)))
- (when (memq (overlay-get o 'invisible)
- '(org-hide-block org-hide-drawer outline))
- (delete-overlay o)))
- (unless (org-before-first-heading-p)
- (org-with-limited-levels
- (cl-case detail
- ((tree canonical t) (org-show-children))
- ((nil minimal ancestors))
- (t (save-excursion
- (outline-next-heading)
- (org-flag-heading nil)))))))
- ;; Show all siblings.
- (when (eq detail 'lineage) (org-show-siblings))
- ;; Show ancestors, possibly with their children.
- (when (memq detail '(ancestors lineage tree canonical t))
- (save-excursion
- (while (org-up-heading-safe)
- (org-flag-heading nil)
- (when (memq detail '(canonical t)) (org-show-entry))
- (when (memq detail '(tree canonical t)) (org-show-children))))))
-
-(defvar org-reveal-start-hook nil
- "Hook run before revealing a location.")
-
-(defun org-reveal (&optional siblings)
- "Show current entry, hierarchy above it, and the following headline.
-
-This can be used to show a consistent set of context around
-locations exposed with `org-show-context'.
-
-With optional argument SIBLINGS, on each level of the hierarchy all
-siblings are shown. This repairs the tree structure to what it would
-look like when opened with hierarchical calls to `org-cycle'.
-
-With a \\[universal-argument] \\[universal-argument] prefix, \
-go to the parent and show the entire tree."
- (interactive "P")
- (run-hooks 'org-reveal-start-hook)
- (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
- ((equal siblings '(16))
- (save-excursion
- (when (org-up-heading-safe)
- (org-show-subtree)
- (run-hook-with-args 'org-cycle-hook 'subtree))))
- (t (org-show-set-visibility 'lineage))))
-
(defun org-highlight-new-match (beg end)
"Highlight from BEG to END and mark the highlight is an occur headline."
(let ((ov (make-overlay beg end)))
@@ -22365,7 +22386,69 @@ region only contains such lines."
(forward-line)))))))
(set-marker end nil))))
+
+;;; Blocks
+
+(defun org-block-map (function &optional start end)
+ "Call FUNCTION at the head of all source blocks in the current buffer.
+Optional arguments START and END can be used to limit the range."
+ (let ((start (or start (point-min)))
+ (end (or end (point-max))))
+ (save-excursion
+ (goto-char start)
+ (while (and (< (point) end) (re-search-forward org-block-regexp end t))
+ (save-excursion
+ (save-match-data
+ (goto-char (match-beginning 0))
+ (funcall function)))))))
+
+(defun org-next-block (arg &optional backward block-regexp)
+ "Jump to the next block.
+
+With a prefix argument ARG, jump forward ARG many blocks.
+
+When BACKWARD is non-nil, jump to the previous block.
+
+When BLOCK-REGEXP is non-nil, use this regexp to find blocks.
+Match data is set according to this regexp when the function
+returns.
+
+Return point at beginning of the opening line of found block.
+Throw an error if no block is found."
+ (interactive "p")
+ (let ((re (or block-regexp "^[ \t]*#\\+BEGIN"))
+ (case-fold-search t)
+ (search-fn (if backward #'re-search-backward #'re-search-forward))
+ (count (or arg 1))
+ (origin (point))
+ last-element)
+ (if backward (beginning-of-line) (end-of-line))
+ (while (and (> count 0) (funcall search-fn re nil t))
+ (let ((element (save-excursion
+ (goto-char (match-beginning 0))
+ (save-match-data (org-element-at-point)))))
+ (when (and (memq (org-element-type element)
+ '(center-block comment-block dynamic-block
+ example-block export-block quote-block
+ special-block src-block verse-block))
+ (<= (match-beginning 0)
+ (org-element-property :post-affiliated element)))
+ (setq last-element element)
+ (cl-decf count))))
+ (if (= count 0)
+ (prog1 (goto-char (org-element-property :post-affiliated last-element))
+ (save-match-data (org-show-context)))
+ (goto-char origin)
+ (user-error "No %s code blocks" (if backward "previous" "further")))))
+
+(defun org-previous-block (arg &optional block-regexp)
+ "Jump to the previous block.
+With a prefix argument ARG, jump backward ARG many source blocks.
+When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
+ (interactive "p")
+ (org-next-block arg t block-regexp))
+
;;; Comments
;; Org comments syntax is quite complex. It requires the entire line
@@ -23253,52 +23336,6 @@ respect customization of `org-odd-levels-only'."
(org-with-limited-levels
(outline-previous-visible-heading arg)))
-(defun org-next-block (arg &optional backward block-regexp)
- "Jump to the next block.
-
-With a prefix argument ARG, jump forward ARG many blocks.
-
-When BACKWARD is non-nil, jump to the previous block.
-
-When BLOCK-REGEXP is non-nil, use this regexp to find blocks.
-Match data is set according to this regexp when the function
-returns.
-
-Return point at beginning of the opening line of found block.
-Throw an error if no block is found."
- (interactive "p")
- (let ((re (or block-regexp "^[ \t]*#\\+BEGIN"))
- (case-fold-search t)
- (search-fn (if backward #'re-search-backward #'re-search-forward))
- (count (or arg 1))
- (origin (point))
- last-element)
- (if backward (beginning-of-line) (end-of-line))
- (while (and (> count 0) (funcall search-fn re nil t))
- (let ((element (save-excursion
- (goto-char (match-beginning 0))
- (save-match-data (org-element-at-point)))))
- (when (and (memq (org-element-type element)
- '(center-block comment-block dynamic-block
- example-block export-block quote-block
- special-block src-block verse-block))
- (<= (match-beginning 0)
- (org-element-property :post-affiliated element)))
- (setq last-element element)
- (cl-decf count))))
- (if (= count 0)
- (prog1 (goto-char (org-element-property :post-affiliated last-element))
- (save-match-data (org-show-context)))
- (goto-char origin)
- (user-error "No %s code blocks" (if backward "previous" "further")))))
-
-(defun org-previous-block (arg &optional block-regexp)
- "Jump to the previous block.
-With a prefix argument ARG, jump backward ARG many source blocks.
-When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
- (interactive "p")
- (org-next-block arg t block-regexp))
-
(defun org-forward-paragraph ()
"Move forward to beginning of next paragraph or equivalent.
@@ -23684,66 +23721,6 @@ modified."
(org-do-remove-indentation))))))))
(funcall unindent-tree (org-element-contents parse-tree))))
-(defun org-show-children (&optional level)
- "Show all direct subheadings of this heading.
-Prefix arg LEVEL is how many levels below the current level
-should be shown. Default is enough to cause the following
-heading to appear."
- (interactive "p")
- (save-excursion
- (org-back-to-heading t)
- (let* ((current-level (funcall outline-level))
- (max-level (org-get-valid-level
- current-level
- (if level (prefix-numeric-value level) 1)))
- (end (save-excursion (org-end-of-subtree t t)))
- (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
- (past-first-child nil)
- ;; Make sure to skip inlinetasks.
- (re (format regexp-fmt
- current-level
- (cond
- ((not (featurep 'org-inlinetask)) "")
- (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
- 3))
- (t (1- org-inlinetask-min-level))))))
- ;; Display parent heading.
- (org-flag-heading nil)
- (forward-line)
- ;; Display children. First child may be deeper than expected
- ;; MAX-LEVEL. Since we want to display it anyway, adjust
- ;; MAX-LEVEL accordingly.
- (while (re-search-forward re end t)
- (unless past-first-child
- (setq re (format regexp-fmt
- current-level
- (max (funcall outline-level) max-level)))
- (setq past-first-child t))
- (org-flag-heading nil)))))
-
-(defun org-show-subtree ()
- "Show everything after this heading at deeper levels."
- (interactive)
- (org-flag-region
- (point) (save-excursion (org-end-of-subtree t t)) nil 'outline))
-
-(defun org-show-entry ()
- "Show the body directly following this heading.
-Show the heading too, if it is currently invisible."
- (interactive)
- (save-excursion
- (ignore-errors
- (org-back-to-heading t)
- (org-flag-region
- (line-end-position 0)
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
- (match-beginning 1)
- (point-max)))
- nil
- 'outline))))
-
(defun org-make-options-regexp (kwds &optional extra)
"Make a regular expression for keyword lines.
KWDS is a list of keywords, as strings. Optional argument EXTRA,
@@ -23753,7 +23730,12 @@ when non-nil, is a regexp matching keywords names."
(and extra (concat (and kwds "\\|") extra))
"\\):[ \t]*\\(.*\\)"))
-;;;; Finish up
+
+;;; Finish up
+
+(add-hook 'org-mode-hook ;remove overlays when changing major mode
+ (lambda () (add-hook 'change-major-mode-hook
+ 'org-show-all 'append 'local)))
(provide 'org)