Fold and Focus — Focused navigation of Org and Emacs Lisp files (Emacs package)

(use-package fold-and-focus
  :demand t
  :after  (:and org outshine)
  :bind   (:map org-mode-map
           ("M-["  . fold-and-focus-previous)                  ; In Org I use these more.
           ("M-]"  . fold-and-focus-next)                      ;
           ("s-["  . fold-and-focus-previous-fancy)
           ("s-]"  . fold-and-focus-next-fancy)
           :map outshine-mode-map
           ("M-["  . fold-and-focus-previous)                  ; In Elisp, these...
           ("M-]"  . fold-and-focus-next)                      ;
           ("s-["  . fold-and-focus-previous-fancy)
           ("s-]"  . fold-and-focus-next-fancy)
           ("s-;"  . fold-and-focus-read-previous-defun-fancy) ; ...and these
           ("s-'"  . fold-and-focus-read-next-defun-fancy)     ;
           ("s-:"  . fold-and-focus-read-previous-defun)
           ("s-\"" . fold-and-focus-read-next-defun)))

("[" fold-and-focus-previous)
("]" fold-and-focus-next)
(";" fold-and-focus-previous-fancy)
("'" fold-and-focus-next-fancy)

(use-package outshine
  :demand t
  :after  (:or outline org-mode)
  :hook   ((emacs-lisp-mode lisp-mode) . outshine-mode))

("[" . fold-and-focus-previous)                   ; I use these more...
("]" . fold-and-focus-next)                       ;
("{" . fold-and-focus-previous-fancy)
("}" . fold-and-focus-next-fancy)
(";" . fold-and-focus-read-previous-defun-fancy)  ; ...and these
("'" . fold-and-focus-read-next-defun-fancy)      ;

(require 'fold-and-focus)

(defun fold-and-focus-save-buffer-detecting-fancy-narrow (orig-fun &optional args)
  "Detects if you’re fancy-narrowed before saving."
  (interactive)
  (if (not (and (fboundp 'fancy-narrow-active-p)
                (fancy-narrow-active-p)))
      (apply orig-fun args)
    (save-excursion
      (save-restriction
        (let ((b fancy-narrow--beginning)
              (e fancy-narrow--end))
          (prog2
              (fancy-widen)
              (apply orig-fun args)
            (fancy-narrow-to-region b e)))))))

(advice-add 'save-buffer :around
            #'fold-and-focus-save-buffer-detecting-fancy-narrow)

;;; fold-and-focus.el --- Focused navigation of Org and Emacs Lisp files -*- lexical-binding: t -*-
;;; Commentary:
;;;; For all the details, please do see the README
;;; Acknowledgments:
;;; Code:
;;;; Libraries
;;;; Obsolete symbols
;;;; Symbols from other packages
;;;; Package metadata
;;;; Customizable variables
;;;; Functions
;;;;; Borrowed
;;;;; Auxiliary
;;;;; Core
;;;;;; Specific to Emacs Lisp
;;;;;; For both modes
;;;;; The ones to keybind
;;;;;; Navigation by subtree
;;;;;; Navigation by defuns
;;;;; See README
;;;;; See News
;;;; Wrapping up
;;; fold-and-focus.el ends here

;;; fold-and-focus.el --- Focused navigation of Org and Emacs Lisp files -*- lexical-binding: t -*-

;; SPDX-FileCopyrightText: © flandrew <https://flandrew.srht.site/listful>

;;---------------------------------------------------------------------------
;; Author:    flandrew
;; Created:   2021-06-11
;; Updated:   2025-05-03
;; Keywords:  outlines, convenience
;; Homepage:  <https://flandrew.srht.site/listful/software.html>
;;---------------------------------------------------------------------------
;; Package-Version:  1.0.3.1
;; Package-Requires: ((emacs "25.1"))
;;---------------------------------------------------------------------------

;; SPDX-License-Identifier: GPL-3.0-or-later

;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Fold and Focus helps you navigate Org files and Emacs Lisp files with
;; focused attention: one thing at a time. You can navigate by heading or
;; by defun, optionally narrowing to it as you go.
;;
;; As you navigate, the heading you move to will be recentered, so you'll
;; always have it at a fixed position. Its contents will be shown.
;;
;; The heading you came from will be folded and won't distract you.
;;
;;;; For all the details, please do see the README
;;
;; Open it easily with:
;;   (find-file-read-only "README.org")   <--- C-x C-e here¹
;;
;; or from any buffer:
;;   M-x fold-and-focus-see-readme
;;
;; or read it online:
;;   <https://flandrew.srht.site/listful/sw-emacs-fold-and-focus.html>
;;
;; ¹ or the key that ‘eval-last-sexp’ is bound to, if not C-x C-e.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Acknowledgments:
;;
;; Function ‘fold-and-focus-fancy-narrow-to-subtree’ was copied from
;; Outshine's ‘outshine-narrow-to-subtree’, and adapted with an added
;; "fancy-" prefix.
;;
;; outshine
;;   SPDX-FileCopyrightText:  © Thorsten Jolitz and contributors
;;   SPDX-License-Identifier: GPL-2.0-or-later
;;   Author:                  Thorsten Jolitz
;;   Homepage:                <https://github.com/alphapapa/outshine>
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;; Code:
;;;; Libraries

(require 'outline)
(require 'lisp-mnt)  ; ‘lm-summary’, ‘lm-homepage’, ‘lm-version’, ‘lm-header’


;;;; Obsolete symbols

(let ((new 'fold-and-focus)
      (old 'fnf)
      (ver "1.0.0"))

  (mapc (lambda (sym) (define-obsolete-variable-alias
                        (intern (format "%s-%s" old sym))
                        (intern (format "%s-%s" new sym)) ver))
        '(recenter-position))

  (mapc (lambda (sym) (define-obsolete-function-alias
                        (intern (format "%s-%s" old sym))
                        (intern (format "%s-%s" new sym)) ver))
        '(check-my-mode
          fold-and-show-children         reg-widen-maybe
          fold-and-read-next-entry       fancy-widen-maybe
          fold-and-read-previous-entry   fancy-narrow-to-subtree
          next                next-fancy                next-reg
          previous            previous-fancy            previous-reg
          read-next-defun     read-next-defun-fancy     read-next-defun-reg
          read-previous-defun read-previous-defun-fancy read-previous-defun-reg
          read-defun  read-entry)))


;;;; Symbols from other packages

;; Silence "not known to be defined" compiler warnings
(declare-function fancy-narrow-to-region     "ext:fancy-narrow" (start end))
(declare-function fancy-widen                "ext:fancy-narrow" ())
(declare-function outshine-narrow-to-subtree "ext:outshine"     ())
(declare-function outshine-speed-move-safe   "ext:outshine"     (cmd))


;;;; Package metadata

(defvar fold-and-focus--name "Fold and Focus")

(defvar fold-and-focus--dot-el
  (format "%s.el" (file-name-sans-extension (eval-and-compile
                                              (or load-file-name
                                                  buffer-file-name)))))
(defvar fold-and-focus--readme-org
  (expand-file-name "README.org" (file-name-directory fold-and-focus--dot-el)))

(defvar fold-and-focus--summary  (lm-summary   fold-and-focus--dot-el))
(defvar fold-and-focus--homepage (lm-homepage  fold-and-focus--dot-el))
(defvar fold-and-focus--version  (lm-with-file fold-and-focus--dot-el
                                   (or (lm-header "package-version")
                                       (lm-version))))


;;;; Customizable variables

(defgroup fold-and-focus nil
  (format "%s." fold-and-focus--summary)
  :group 'convenience
  :link  '(emacs-library-link :tag "Lisp file" "fold-and-focus.el")
  :link  `(file-link :tag "README.org" ,fold-and-focus--readme-org)
  :link  `(url-link  :tag "Homepage"   ,fold-and-focus--homepage))

(defcustom fold-and-focus-recenter-position 2
  "Number of lines from the top of the window where focused headings will be.
It uses ‘recenter-top-bottom’, so a negative number will be interpreted as
number of lines from the bottom of the window."
  :package-version '(fold-and-focus "1.0.0")
  :type 'integer)


;;;; Functions
;;;;; Borrowed

;; From ‘outshine-narrow-to-subtree’, with added "fancy-" prefix.
(defun fold-and-focus-fancy-narrow-to-subtree ()
  "Fancy-narrow buffer to subtree at point."
  (interactive)
  (if (outline-on-heading-p)
      (progn (outline-mark-subtree)
             (and (use-region-p)
                  (fancy-narrow-to-region (region-beginning) (region-end)))
             (deactivate-mark))
    (message "Not at headline, cannot narrow to subtree")))


;;;;; Auxiliary

(defun fold-and-focus-fancy-widen-maybe ()
  "Decide whether to ‘fancy-widen’."
  (and (fboundp 'fancy-narrow-active-p)
       (fancy-narrow-active-p)
       (fancy-widen)))

(defun fold-and-focus-reg-widen-maybe ()
  "Decide whether to widen."
  (when (buffer-narrowed-p)
    (if (fboundp 'recursive-widen)
        (recursive-widen)
      (widen))))

(defun fold-and-focus-check-my-mode (&optional function-name)
  "Check whether you are in a mode where fold-and-focus will work.
Optionally, give a FUNCTION-NAME in the error message."
  (or (eq major-mode 'org-mode)
      (and (memq 'outshine-mode minor-mode-list)
           (symbolp 'outshine-mode)
           (symbol-value 'outshine-mode))
      (user-error (concat "To use %s, you need to be in either "
                          "(1) elisp-mode with outshine-mode or (2) org-mode")
                  (or function-name "this command"))))


;;;;; Core
;;;;;; Specific to Emacs Lisp

(defun fold-and-focus-read-defun (&optional narrow-option)
  "In Emacs Lisp mode, focus on defun to read it.
If NARROW-OPTION is :reg or :fancy, narrow accordingly."
  (recenter-top-bottom fold-and-focus-recenter-position)
  (pcase narrow-option
    (:reg   (if (fboundp 'recursive-narrow-to-defun)
                (recursive-narrow-to-defun)
              (narrow-to-defun)))
    (:fancy (when (fboundp 'fancy-narrow-to-defun)
              (fancy-narrow-to-defun)))))

(defun fold-and-focus-read--goto-defun (e b &optional narrow-option)
  "Go to defun ending in E and beginning in B.
If NARROW-OPTION is :reg or :fancy, narrow accordingly."
  (fold-and-focus-fancy-widen-maybe)
  (pcase narrow-option
    (:reg   (fold-and-focus-reg-widen-maybe))
    (:fancy (fold-and-focus-fancy-widen-maybe)))
  (end-of-defun e)
  (beginning-of-defun b)
  (when (outline-invisible-p)
    (outline-show-entry)
    (end-of-defun e)
    (beginning-of-defun b))
  (fold-and-focus-read-defun narrow-option))

;;;;;; For both modes

(defun fold-and-focus-fold-and-show-children (&optional narrow-option)
  "Fold and show children.
If NARROW-OPTION is :reg or :fancy, narrow accordingly."
  (fold-and-focus-fancy-widen-maybe)
  (pcase narrow-option
    (:reg  (fold-and-focus-reg-widen-maybe)))
  (next-logical-line)
  (pcase major-mode
    ('emacs-lisp-mode (outshine-speed-move-safe
                       'outline-previous-visible-heading))
    ('org-mode        (outline-previous-visible-heading 1)))
  (outline-hide-subtree)
  (outline-show-children))

(defun fold-and-focus-read-entry (&optional narrow-option)
  "Focus on entry to read it.
If NARROW-OPTION is :reg or :fancy, narrow accordingly."
  (outline-hide-subtree)
  (outline-show-children)
  (outline-show-entry)
  (recenter-top-bottom fold-and-focus-recenter-position)
  (pcase major-mode
    ;; Note: Ideally, it should detect whether the next thing is a defun or
    ;; on a ;;;+ commented-heading and treat the former as a subheading of the
    ;; latter. Coding this is a bit more complicated, so we’ll leave it as
    ;; just headings for now.
    ('emacs-lisp-mode (pcase narrow-option
                        (:reg   (when (fboundp 'outshine-narrow-to-subtree)
                                  (outshine-narrow-to-subtree)))
                        (:fancy (when (fboundp 'fancy-narrow-to-region)
                                  (fold-and-focus-fancy-narrow-to-subtree)))))
    ('org-mode        (pcase narrow-option
                        (:reg   (if (fboundp 'recursive-narrow-or-widen-dwim)
                                    (recursive-narrow-or-widen-dwim)
                                  (when (fboundp 'org-narrow-to-subtree)
                                    (org-narrow-to-subtree))))
                        (:fancy (when (fboundp 'org-fancy-narrow-to-subtree)
                                  (org-fancy-narrow-to-subtree)
                                  (with-no-warnings
                                    (setq fancy-narrow--help-string nil)))))
                      (unless (bound-and-true-p org-sticky-header-mode)
                        (when (fboundp 'org-display-outline-path)
                          (org-display-outline-path))))))

(defun fold-and-focus-fold-and-read-previous-entry (&optional narrow-option)
  "Fold and read previous entry.
If NARROW-OPTION is :reg or :fancy, narrow accordingly."
  (fold-and-focus-fold-and-show-children narrow-option)
  (pcase major-mode
    ('emacs-lisp-mode (outshine-speed-move-safe
                       'outline-previous-visible-heading))
    ('org-mode        (outline-previous-visible-heading 1)))
  (fold-and-focus-read-entry narrow-option))

(defun fold-and-focus-fold-and-read-next-entry (&optional narrow-option)
  "Fold and read next entry.
If NARROW-OPTION is :reg or :fancy, narrow accordingly."
  (fold-and-focus-fold-and-show-children narrow-option)
  (pcase major-mode
    ('emacs-lisp-mode (outshine-speed-move-safe
                       'outline-next-visible-heading))
    ('org-mode        (outline-next-visible-heading 1)))
  (fold-and-focus-read-entry narrow-option))


;;;;; The ones to keybind

;;;;;; Navigation by subtree
;;;###autoload
(defun fold-and-focus-previous ()
  "When in ‘org-mode’ or ‘outshine-mode’: fold all, read previous entry.
No further narrowing."
  (interactive)
  (fold-and-focus-check-my-mode this-command)
  (fold-and-focus-fold-and-read-previous-entry))

;;;###autoload
(defun fold-and-focus-next ()
  "When in ‘org-mode’ or ‘outshine-mode’: fold all, read next entry.
No further narrowing."
  (interactive)
  (fold-and-focus-check-my-mode this-command)
  (fold-and-focus-fold-and-read-next-entry))

;;;###autoload
(defun fold-and-focus-previous-fancy ()
  "When in ‘org-mode’ or ‘outshine-mode’: fold all, read previous entry.
Fancy-narrow to it."
  (interactive)
  (fold-and-focus-check-my-mode this-command)
  (fold-and-focus-fold-and-read-previous-entry :fancy))

;;;###autoload
(defun fold-and-focus-next-fancy ()
  "When in ‘org-mode’ or ‘outshine-mode’: fold all, read next entry.
Fancy-narrow to it."
  (interactive)
  (fold-and-focus-check-my-mode this-command)
  (fold-and-focus-fold-and-read-next-entry :fancy))

;;;###autoload
(defun fold-and-focus-previous-reg ()
  "When in ‘org-mode’ or ‘outshine-mode’: fold all, read previous entry.
Regular-narrow to it (recursive-narrow is used, if you have it)."
  (interactive)
  (fold-and-focus-check-my-mode this-command)
  (fold-and-focus-fold-and-read-previous-entry :reg))

;;;###autoload
(defun fold-and-focus-next-reg ()
  "When in ‘org-mode’ or ‘outshine-mode’: fold all, read next entry.
Regular-narrow to it (recursive-narrow is used, if you have it)."
  (interactive)
  (fold-and-focus-check-my-mode this-command)
  (fold-and-focus-fold-and-read-next-entry :reg))


;;;;;; Navigation by defuns

;;;###autoload
(defun fold-and-focus-read-previous-defun (&optional narrow-option)
  "In Emacs Lisp mode, move to the beginning of the previous defun.
If NARROW-OPTION is :reg or :fancy, narrow accordingly."
  (interactive)
  (fold-and-focus-read--goto-defun 1 2 narrow-option))

;;;###autoload
(defun fold-and-focus-read-next-defun (&optional narrow-option)
  "In Emacs Lisp mode, move to the beginning of the next defun.
If NARROW-OPTION is :reg or :fancy, narrow accordingly."
  (interactive)
  (fold-and-focus-read--goto-defun 2 1 narrow-option))

;;;###autoload
(defun fold-and-focus-read-previous-defun-fancy ()
  "In Emacs Lisp mode, fancy-narrow to the beginning of the previous defun."
  (interactive)
  (fold-and-focus-read--goto-defun 1 2 :fancy))

;;;###autoload
(defun fold-and-focus-read-next-defun-fancy ()
  "In Emacs Lisp mode, fancy-narrow to the beginning of the next defun."
  (interactive)
  (fold-and-focus-read--goto-defun 2 1 :fancy))

;;;###autoload
(defun fold-and-focus-read-previous-defun-reg ()
  "In Emacs Lisp mode, narrow to the beginning of the previous defun."
  (interactive)
  (fold-and-focus-read--goto-defun 1 2 :reg))

;;;###autoload
(defun fold-and-focus-read-next-defun-reg ()
  "In Emacs Lisp mode, narrow to the beginning of the next defun."
  (interactive)
  (fold-and-focus-read--goto-defun 2 1 :reg))


;;;;; See README

;;;###autoload
(defun fold-and-focus-see-readme (&optional heading narrow)
  "Open fold-and-focus's README.org file.
Search for the file in fold-and-focus.el's directory.

If found, open it read-only.

If optional argument HEADING is passed, try to navigate to the
heading after opening it. HEADING should be a string.

If optional argument NARROW is non-nil, narrow to that heading.
This argument has no effect if HEADING is nil or not found."
  (interactive)
  (let ((readme fold-and-focus--readme-org))
    (if (file-exists-p readme)
        (let ((pr (make-progress-reporter
                   (format "Opening %s ... "
                           (abbreviate-file-name readme)))))
          (find-file-read-only readme)
          (when heading
            (fold-and-focus--goto-org-heading heading narrow))
          (progress-reporter-done pr))
      (message "Couldn't find %s's README.org" fold-and-focus--name))))

(defun fold-and-focus--goto-org-heading (heading &optional narrow)
  "Navigate to org HEADING and optionally NARROW to it."
  (let* ((hrx (format "^[*]+ %s" heading))
         (pos (save-match-data
                (save-excursion
                  (save-restriction
                    (widen)
                    (goto-char (point-max))
                    (re-search-backward hrx nil t 1))))))
    (when pos
      (widen)
      (goto-char pos)
      (if (and narrow (fboundp 'org-narrow-to-subtree))
          (org-narrow-to-subtree)
        (recenter-top-bottom 1))
      (when (fboundp 'outline-show-subtree)
        (outline-show-subtree))
      (when (fboundp 'org-flag-drawer)
        (save-excursion
          (forward-line 1)
          (org-flag-drawer t))))))


;;;;; See News

;;;###autoload
(defun fold-and-focus-see-news ()
  "See the News in fold-and-focus's README.org file."
  (interactive)
  (fold-and-focus-see-readme "News" 'narrow)
  (fold-and-focus--display-org-subtree))

(defun fold-and-focus--display-org-subtree ()
  "Selectively display org subtree."
  (let ((cmds '(outline-hide-subtree
                outline-show-children
                outline-next-heading
                outline-show-branches)))
    (and (fboundp (nth 0 cmds))
         (fboundp (nth 1 cmds))
         (fboundp (nth 2 cmds))
         (fboundp (nth 3 cmds))
         (mapc #'funcall cmds))))


;;;; Wrapping up

(provide 'fold-and-focus)

;; Local Variables:
;; coding:                     utf-8
;; indent-tabs-mode:           nil
;; sentence-end-double-space:  nil
;; outline-regexp:             ";;;;* "
;; End:

;;; fold-and-focus.el ends here