Browse Source

org-fold-core: New API to fold/restore buffer folding state

* lisp/org-fold-core.el (org-fold-core-get-regions): New function to
retrieve the list of folded regions in buffer.
(org-fold-core-regions): New function to set folding state in buffer
according to the list returned by `org-fold-core-get-regions'.
(org-fold-core-save-visibility): New macro, equivalent to
`org-fold-save-outline-visibility'.
Ihor Radchenko 2 years ago
parent
commit
15658b8665
1 changed files with 86 additions and 0 deletions
  1. 86 0
      lisp/org-fold-core.el

+ 86 - 0
lisp/org-fold-core.el

@@ -932,6 +932,55 @@ Move point right after the end of the region, to LIMIT, or
             (set-match-data (list (set-marker (make-marker) (car region) (current-buffer))
 				  (set-marker (make-marker) (cdr region) (current-buffer))))))))))
 
+(cl-defun org-fold-core-get-regions (&key specs from to with-markers relative)
+  "Find all the folded regions in current buffer.
+
+Each element of the returned list represent folded region boundaries
+and the folding spec: (BEG END SPEC).
+
+Search folds intersecting with (FROM TO) buffer region if FROM and TO
+are provided.
+
+If FROM is non-nil and TO is nil, search the folded regions at FROM.
+
+When SPECS is non-nil it should be a list of folding specs or a symbol.
+Only return the matching fold types.
+
+When WITH-MARKERS is non-nil, use markers to represent region
+boundaries.
+
+When RELATIVE is a buffer position, regions boundaries are given
+relative to that position.
+When RELATIVE is t, use FROM as the position.
+WITH-MARKERS must be nil when RELATIVE is non-nil."
+  (when (and relative with-markers)
+    (error "Cannot use markers in non-absolute region boundaries"))
+  (when (eq relative t) (setq relative from))
+  (unless (listp specs) (setq specs (list specs)))
+  (let (regions region mk-region)
+    (org-with-wide-buffer
+     (when (and from (not to)) (setq to (point-max)))
+     (when (and from (< from (point-min))) (setq from (point-min)))
+     (when (and to (> to (point-max))) (setq to (point-max)))
+     (unless from (setq from (point-min)))
+     (dolist (spec (or specs (org-fold-core-folding-spec-list)) regions)
+       (goto-char from)
+       (catch :exit
+         (while (or (not to) (< (point) to))
+           (when (org-fold-core-get-folding-spec spec)
+             (setq region (org-fold-core-get-region-at-point spec))
+             (when relative
+               (cl-decf (car region) relative)
+               (cl-decf (cdr region) relative))
+             (if (not with-markers)
+                 (setq mk-region `(,(car region) ,(cdr region) ,spec))
+               (setq mk-region `(,(make-marker) ,(make-marker) ,spec))
+               (move-marker (nth 0 mk-region) (car region))
+               (move-marker (nth 1 mk-region) (cdr region)))
+             (push mk-region regions))
+           (unless to (throw :exit nil))
+           (goto-char (org-fold-core-next-folding-state-change spec nil to))))))))
+
 ;;;; Changing visibility
 
 ;;;;; Region visibility
@@ -999,6 +1048,43 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region."
                    (jit-lock-refontify from to)
                  (save-match-data (font-lock-fontify-region from to)))))))))))
 
+(cl-defmacro org-fold-core-regions (regions &key override clean-markers relative)
+  "Fold every region in REGIONS list in current buffer.
+
+Each region in the list is a list (BEG END SPEC-OR-ALIAS) describing
+region and folding spec to be applied.
+
+When optional argument OVERRIDE is non-nil, clear folding state in the
+buffer first.
+
+When optional argument CLEAN-MARKERS is non-nil, clear markers used to
+mark region boundaries in REGIONS.
+
+When optional argument RELATIVE is non-nil, it must be a buffer
+position.  REGION boundaries are then treated as relative distances
+from that position."
+  `(org-with-wide-buffer
+    (when ,override (org-fold-core-region (point-min) (point-max) nil))
+    (pcase-dolist (`(,beg ,end ,spec) (delq nil ,regions))
+      (if ,relative
+          (org-fold-core-region (+ ,relative beg) (+ ,relative end) t spec)
+        (org-fold-core-region beg end t spec))
+      (when ,clean-markers
+        (when (markerp beg) (set-marker beg nil))
+        (when (markerp end) (set-marker end nil))))))
+
+(defmacro org-fold-core-save-visibility (use-markers &rest body)
+  "Save and restore folding state around BODY.
+If USE-MARKERS is non-nil, use markers for the positions.  This
+means that the buffer may change while running BODY, but it also
+means that the buffer should stay alive during the operation,
+because otherwise all these markers will point to nowhere."
+  (declare (debug (form body)) (indent 1))
+  (org-with-gensyms (regions)
+    `(let* ((,regions ,(org-fold-core-get-regions :with-markers use-markers)))
+       (unwind-protect (progn ,@body)
+         (org-fold-core-regions ,regions :override t :clean-markers t)))))
+
 ;;; Make isearch search in some text hidden via text propertoes
 
 (defvar org-fold-core--isearch-overlays nil