56e998c577
With four folding systems in play, there are numerous ways to create nested folds (eg. hideshow folds inside folded outline headings with `+fold/close-all`). So `+fold/open-rec' needs to be able to open all kinds of folds within the newly unfolded region. It can't stop at unfolding the type of fold it was called on.
265 lines
10 KiB
EmacsLisp
265 lines
10 KiB
EmacsLisp
;;; editor/fold/autoload/fold.el -*- lexical-binding: t; -*-
|
|
|
|
;; `hideshow' is a decent code folding implementation, but it won't let you
|
|
;; create custom folds. `vimish-fold' offers custom folds, but essentially
|
|
;; ignores any other type of folding (indent or custom markers, which hideshow
|
|
;; and `outline-mode' give you). This is my effort to combine them.
|
|
|
|
;;
|
|
;;; Helpers
|
|
|
|
(defun +fold--ensure-hideshow-mode ()
|
|
(unless (bound-and-true-p hs-minor-mode)
|
|
(hs-minor-mode +1)))
|
|
|
|
(defun +fold--vimish-fold-p ()
|
|
(and (featurep 'vimish-fold)
|
|
(cl-some #'vimish-fold--vimish-overlay-p
|
|
(overlays-at (point)))))
|
|
|
|
(defun +fold--outline-fold-p ()
|
|
(and (or (bound-and-true-p outline-minor-mode)
|
|
(derived-mode-p 'outline-mode))
|
|
(outline-on-heading-p)))
|
|
|
|
(defun +fold--hideshow-fold-p ()
|
|
(+fold--ensure-hideshow-mode)
|
|
(save-excursion
|
|
(ignore-errors
|
|
(or (hs-looking-at-block-start-p)
|
|
(hs-find-block-beginning)
|
|
(unless (eolp)
|
|
(end-of-line)
|
|
(+fold--hideshow-fold-p))))))
|
|
|
|
;; NOTE: does this need more?
|
|
(defun +fold--ts-fold-p ()
|
|
(and (bound-and-true-p tree-sitter-mode)
|
|
(featurep 'ts-fold)))
|
|
|
|
(defun +fold--invisible-points (count)
|
|
(let (points)
|
|
(save-excursion
|
|
(catch 'abort
|
|
(if (< count 0) (beginning-of-line))
|
|
(while (re-search-forward hs-block-start-regexp nil t
|
|
(if (> count 0) 1 -1))
|
|
(unless (invisible-p (point))
|
|
(end-of-line)
|
|
(when (hs-already-hidden-p)
|
|
(push (point) points)
|
|
(when (>= (length points) count)
|
|
(throw 'abort nil))))
|
|
(forward-line (if (> count 0) 1 -1)))))
|
|
points))
|
|
|
|
(defmacro +fold-from-eol (&rest body)
|
|
"Perform action after moving to the end of the line."
|
|
`(save-excursion
|
|
(end-of-line)
|
|
,@body))
|
|
|
|
(defun +fold--union ()
|
|
"Get the combined region covered by all folds at point."
|
|
;; We are supporting four folding systems that weren't really designed to work
|
|
;; together. No doubt users will find novel, unanticipated ways to nest
|
|
;; different types of folds (especially easy to do with `outline-minor-mode').
|
|
;; So, we need code that can deal with any arbitrary overlap.
|
|
(cl-reduce
|
|
(lambda (&optional acc cur)
|
|
(when (and acc cur)
|
|
(cons (min (car acc) (car cur))
|
|
(max (cdr acc) (cdr cur)))))
|
|
(nconc
|
|
(when (+fold--vimish-fold-p)
|
|
(mapcar (lambda (ov)
|
|
(cons (overlay-start ov) (overlay-end ov)))
|
|
(seq-filter #'vimish-fold--vimish-overlay-p
|
|
(or (overlays-at (point)) '()))))
|
|
(when (+fold--outline-fold-p)
|
|
(save-excursion
|
|
(let ((beg (progn (outline-back-to-heading) (point)))
|
|
(end (progn (outline-end-of-subtree) (point))))
|
|
(list (cons beg end)))))
|
|
(when-let ((start (+fold--hideshow-fold-p)))
|
|
;; `start' could be start of the block, or 't' if that wasn't found.
|
|
;; In either case, we know the fold is on the same line.
|
|
(let* ((start (or (and (numberp start) start)
|
|
(line-beginning-position)))
|
|
(end (line-end-position))
|
|
(ov (hs-overlay-at start)))
|
|
(while (and (not ov) (< start end))
|
|
(setq start (next-overlay-change start)
|
|
ov (hs-overlay-at start)))
|
|
(when ov
|
|
(list (cons (overlay-start ov) (overlay-end ov))))))
|
|
(when (+fold--ts-fold-p)
|
|
(when-let* ((node (ts-fold--foldable-node-at-pos))
|
|
(beg (tsc-node-start-position node))
|
|
(end (tsc-node-end-position node)))
|
|
(list (cons beg end)))))))
|
|
|
|
(defun +fold--open-rec-between (beg end)
|
|
"Recursively open all folds betwen BEG and END."
|
|
(when (featurep 'vimish-fold)
|
|
;; from `vimish-fold-unfold-all'
|
|
(mapc #'vimish-fold--unfold
|
|
(vimish-fold--folds-in
|
|
(point-min)
|
|
(point-max))))
|
|
(and (+fold--outline-fold-p)
|
|
(outline-show-subtree))
|
|
(hs-life-goes-on
|
|
;; from `hs-show-all'
|
|
(let ((hs-allow-nesting nil))
|
|
(hs-discard-overlays beg end))
|
|
(run-hooks 'hs-show-hook))
|
|
(when (bound-and-true-p ts-fold-mode)
|
|
;; from `ts-fold-open-all'
|
|
(ts-fold--ensure-ts
|
|
(thread-last (overlays-in (point-min) (point-max))
|
|
(seq-filter
|
|
(lambda (ov)
|
|
(eq (overlay-get ov 'invisible) 'ts-fold)))
|
|
(mapc #'delete-overlay)))))
|
|
|
|
;;
|
|
;;; Commands
|
|
|
|
;;;###autoload
|
|
(defun +fold/toggle ()
|
|
"Toggle the fold at point.
|
|
|
|
Targets `vimmish-fold', `hideshow', `ts-fold' and `outline' folds."
|
|
(interactive)
|
|
(save-excursion
|
|
(cond ((+fold--vimish-fold-p) (vimish-fold-toggle))
|
|
((+fold--outline-fold-p)
|
|
(cl-letf (((symbol-function #'outline-hide-subtree)
|
|
(symbol-function #'outline-hide-entry)))
|
|
(outline-toggle-children)))
|
|
((+fold--hideshow-fold-p) (+fold-from-eol (hs-toggle-hiding)))
|
|
((+fold--ts-fold-p) (ts-fold-toggle)))))
|
|
|
|
;;;###autoload
|
|
(defun +fold/open-rec ()
|
|
"Recursively open the folded region at point.
|
|
|
|
Targets `vimmish-fold', `hideshow', `ts-fold' and `outline' folds."
|
|
(interactive)
|
|
(cl-destructuring-bind (beg . end) (+fold--union)
|
|
(+fold--open-rec-between beg end)))
|
|
|
|
;;;###autoload
|
|
(defun +fold/open ()
|
|
"Open the folded region at point.
|
|
|
|
Targets `vimmish-fold', `hideshow', `ts-fold' and `outline' folds."
|
|
(interactive)
|
|
(save-excursion
|
|
(cond ((+fold--vimish-fold-p) (vimish-fold-unfold))
|
|
((+fold--outline-fold-p)
|
|
(outline-show-branches)
|
|
(outline-show-entry))
|
|
((+fold--hideshow-fold-p) (+fold-from-eol (hs-show-block)))
|
|
((+fold--ts-fold-p) (ts-fold-open)))))
|
|
|
|
;;;###autoload
|
|
(defun +fold/close ()
|
|
"Close the folded region at point.
|
|
|
|
Targets `vimmish-fold', `hideshow', `ts-fold' and `outline' folds."
|
|
(interactive)
|
|
(save-excursion
|
|
(cond ((+fold--vimish-fold-p) (vimish-fold-refold))
|
|
((+fold--outline-fold-p) (outline-hide-subtree))
|
|
((+fold--hideshow-fold-p) (+fold-from-eol (hs-hide-block)))
|
|
((+fold--ts-fold-p) (ts-fold-close)))))
|
|
|
|
;;;###autoload
|
|
(defun +fold/open-all (&optional level)
|
|
"Open folds at LEVEL (or all folds if LEVEL is nil)."
|
|
(interactive
|
|
(list (if current-prefix-arg (prefix-numeric-value current-prefix-arg))))
|
|
(cond ((+fold--ts-fold-p)
|
|
(ts-fold-open-all))
|
|
((and (featurep 'vimish-fold) (+fold--vimish-fold-p))
|
|
(vimish-fold-unfold-all))
|
|
((save-excursion
|
|
(+fold--ensure-hideshow-mode)
|
|
(if (integerp level)
|
|
(progn
|
|
(outline-hide-sublevels (max 1 (1- level)))
|
|
(hs-life-goes-on
|
|
(hs-hide-level-recursive (1- level) (point-min) (point-max))))
|
|
(hs-show-all)
|
|
(when (fboundp 'outline-show-all)
|
|
(outline-show-all)))))))
|
|
|
|
;;;###autoload
|
|
(defun +fold/close-all (&optional level)
|
|
"Close folds at LEVEL (or all folds if LEVEL is nil)."
|
|
(interactive
|
|
(list (if current-prefix-arg (prefix-numeric-value current-prefix-arg))))
|
|
(save-excursion
|
|
(if (+fold--ts-fold-p)
|
|
(ts-fold-close-all)
|
|
(progn
|
|
(when (featurep 'vimish-fold)
|
|
(vimish-fold-refold-all))
|
|
(+fold--ensure-hideshow-mode)
|
|
(hs-life-goes-on
|
|
(if (integerp level)
|
|
(progn
|
|
(outline--show-headings-up-to-level (1+ level))
|
|
(hs-hide-level-recursive (1- level) (point-min) (point-max)))
|
|
(hs-hide-all)
|
|
(when (fboundp 'outline-hide-sublevels)
|
|
(outline-show-only-headings))))))))
|
|
|
|
;;;###autoload
|
|
(defun +fold/next (count)
|
|
"Jump to the next vimish fold, outline heading or folded region."
|
|
(interactive "p")
|
|
(cl-loop with orig-pt = (point)
|
|
for fn
|
|
in (list (lambda ()
|
|
(when (bound-and-true-p hs-block-start-regexp)
|
|
(car (+fold--invisible-points count))))
|
|
(lambda ()
|
|
(when (featurep 'vimish-fold)
|
|
(if (> count 0)
|
|
(dotimes (_ count) (vimish-fold-next-fold))
|
|
(dotimes (_ count)
|
|
(vimish-fold-previous-fold (- count)))))
|
|
(if (/= (point) orig-pt) (point)))
|
|
(lambda ()
|
|
;; ts-fold does not define movement functions so we need to do it ourselves
|
|
(when (+fold--ts-fold-p)
|
|
(let* ((arg-list (if (> count 0) ;; depending on direction we need to change the ranges
|
|
(list (point) (point-max))
|
|
(list (point-min) (point))))
|
|
(comp-fun (if (> count 0) ;; also depending on direction we need to change how we sort the list
|
|
#'<
|
|
#'>))
|
|
(ovs (cl-remove-if-not
|
|
(lambda (ov)
|
|
(eq (overlay-get ov 'creator) 'ts-fold))
|
|
;; `overlays-in' does not provide a list that is sorted
|
|
;; (in the way we need it atleast) so we need to sort it based on direction
|
|
(cl-sort (apply #'overlays-in arg-list) comp-fun :key #'overlay-start))))
|
|
(if (and ovs (<= (abs count) (length ovs)))
|
|
(goto-char (overlay-start (nth (- (abs count) 1) ovs))))))))
|
|
if (save-excursion (funcall fn))
|
|
collect it into points
|
|
finally do
|
|
(if-let* ((pt (car (sort points (if (> count 0) #'< #'>)))))
|
|
(goto-char pt)
|
|
(message "No more folds %s point" (if (> count 0) "after" "before"))
|
|
(goto-char orig-pt))))
|
|
|
|
;;;###autoload
|
|
(defun +fold/previous (count)
|
|
"Jump to the previous vimish fold, outline heading or folded region."
|
|
(interactive "p")
|
|
(+fold/next (- count)))
|