;;; jao-org-focus.el --- focusing on org subtrees  -*- lexical-binding: t; -*-

;; Copyright (C) 2025, 2026  Jose Antonio Ortega Ruiz

;; Author: Jose Antonio Ortega Ruiz <mail@jao.io>
;; Keywords: docs

;; 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 <https://www.gnu.org/licenses/>.

(require 'org)
(require 'cl-lib)

(defvar-local jao-org-focus--parent nil)
(defvar-local jao-org-focus--section nil)

(defvar jao-org-focus-siblings '("escaleta.org" . "novela.org"))

(defun jao-org-focus--header-title ()
  (when-let* ((elem (org-element-at-point))
              (header (if (eq 'headline (org-element-type elem))
                         elem
                       (org-previous-visible-heading 1)
                       (org-element-at-point))))
    (org-element-property :title header)))

(defun jao-org-focus--is-outline ()
  (string= (car jao-org-focus-siblings)
           (file-name-nondirectory (or (buffer-file-name) ""))))

(defun jao-org-focus--jump-to-title (file title)
  (let* ((file (if (bufferp file) (buffer-file-name file) file))
         (link (format "[[%s::*%s]]" file title)))
    (org-link-open-from-string link)))

(defun jao-org-focus-jump-to-sibling ()
  (interactive)
  (when-let* ((title (save-excursion (jao-org-focus--header-title)))
              (file (if (jao-org-focus--is-outline)
                        (cdr jao-org-focus-siblings)
                      (car jao-org-focus-siblings)))
              (link (format "[[./%s::*%s]]" file title)))
    (jao-org-focus--jump-to-title (format "./%s" file) title)))

;;; focus on subtree
(defun jao-org-focus ()
  "Pop creatingly to an indirect buffer focused on the encloing subtree.

When invoked on an indirect buffer, pops back to its base."
  (interactive)
  (when (jao-org-focus--is-outline)
    (jao-org-focus-jump-to-sibling))
  (if-let* ((b (get-buffer (or jao-org-focus--parent ""))))
      (let ((title (save-excursion
                     (goto-char (point-min))
                     (jao-org-focus--header-title))))
        (jao-org-focus--jump-to-title b title))
    (when-let* ((title (jao-org-focus--header-title))
                (parent (buffer-name))
                (bname (format "%s [%s]" title parent)))
      (if-let* ((b (get-buffer bname)))
          (pop-to-buffer b)
        (clone-indirect-buffer bname t)
        (org-focus-mode -1)
        (org-focus-child-mode)
        (setq jao-org-focus--parent parent
              jao-org-focus--section title)
        (org-narrow-to-subtree)
        (show-subtree)
        (count-words (point-min) (point-max))))))

(defun jao-org-focus-redisplay ()
  "Redisplay a focused buffer.

Useful when its parent has been reorganised and the narrowing is out of
sync."
  (interactive)
  (when-let* ((title jao-org-focus--section))
    (widen)
    (goto-char (point-min))
    (when (re-search-forward (format "\\*+ %s" title) nil t)
      (org-narrow-to-subtree)
      (goto-char (point-min)))))

(defun jao-org-focus-redisplay-children ()
  "Find focused children and redisplay them."
  (interactive)
  (dolist (b (jao-org-focus-list))
    (with-current-buffer b
      (save-excursion (jao-org-focus-redisplay)))))

(defun jao-org-focus-list (&optional any-parent exclude)
  "List of buffers that are focusing on a subtree of this one or its parent."
  (let ((n (or jao-org-focus--parent (buffer-name))))
    (seq-filter (lambda (b)
                  (let ((p (buffer-local-value 'jao-org-focus--parent b)))
                    (and p
                         (or any-parent (string= n p))
                         (or (not exclude)
                             (not (string= (buffer-name b) exclude))))))
                (buffer-list))))

(defvar jao-org-focus--focused-history nil)

(defun jao-org-focus-switch (arg)
  "Read with completion a focused child and pop to it.

With arg, offer to switch to all children, regardless of their parent."
  (interactive "P")
  (let ((fl (mapcar 'buffer-name (jao-org-focus-list arg (buffer-name)))))
    (unless fl (error "No focused children"))
    (pop-to-buffer
     (completing-read "Focused child: " fl
                      nil t nil 'jao-org-focus--focused-history))))

(define-minor-mode org-focus-mode
  "A mode where keeping track of focused children is on by default."
  :lighter " ◎"
  :keymap '(("\C-ce" . jao-org-focus-jump-to-sibling)
            ("\C-cl" . jao-org-focus-switch)
            ("\C-cR" . jao-org-focus-redisplay)
            ("\C-co" . jao-org-focus)
            ("\C-cw" . count-words))
  (if org-focus-mode
      (add-hook 'after-save-hook #'jao-org-focus-redisplay-children nil t)
    (remove-hook 'after-save-hook #'jao-org-focus-redisplay-children t)))

(define-minor-mode org-focus-child-mode
  "A mode for the children of a focused org buffer."
  :lighter " ◉"
  :keymap org-focus-mode-map
  (when (and org-focus-child-mode (require 'symbol-overlay nil t))
    (face-remap-reset-base 'symbol-overlay-default-face)
    (face-remap-add-relative 'symbol-overlay-default-face 'warning 'underline)
    (symbol-overlay-mode 1)))

(with-eval-after-load 'symbol-overlay
  (keymap-set org-focus-mode-map "M-n" 'symbol-overlay-jump-next)
  (keymap-set org-focus-mode-map "M-p" 'symbol-overlay-jump-prev))


(provide 'jao-org-focus)
;;; jao-org-focus.el ends here