;;; 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 level))
                 (hs-life-goes-on
                  (hs-hide-level-recursive 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 level)
               (hs-hide-level-recursive 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, folded 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 ()
                      (when (or (bound-and-true-p outline-minor-mode)
                                (derived-mode-p 'outline-mode))
                        (cl-destructuring-bind
                            (count fn bound-fn)
                            (if (> count 0)
                                (list count
                                      #'outline-next-visible-heading #'eobp)
                              (list (- count)
                                    #'outline-previous-visible-heading #'bobp))
                          (dotimes (_ count)
                            (funcall fn 1)
                            (outline-end-of-heading)
                            (while (and (not (funcall bound-fn))
                                        (not (outline-invisible-p)))
                              (funcall fn 1)
                              (outline-end-of-heading))))
                        (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)))