+++ /dev/null
-;;; bicycle-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
-;; Generated by the `loaddefs-generate' function.
-
-;; This file is part of GNU Emacs.
-
-;;; Code:
-
-(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
-
-
-\f
-;;; Generated autoloads from bicycle.el
-
-(autoload 'bicycle-cycle "bicycle" "\
-Cycle local or global visibility.
-
-With a prefix argument call `bicycle-cycle-global'.
-Without a prefix argument call `bicycle-cycle-local'.
-
-(fn &optional GLOBAL)" t)
-(autoload 'bicycle-cycle-global "bicycle" "\
-Cycle visibility of all sections.
-
-1. OVERVIEW: Show only top-level headings.
-
-(2. There is no equivalent of `bicycle-cycle-local's
- CHILDREN state.)
-
-3. TOC: Recursively show all headings,
- without treating code blocks as sections.
-
-4. TREES: Recursively show all headings,
- treating code blocks as sections
- (i.e., their first line is treated as a heading).
-
-5. ALL: Show everything, including code blocks,
- empty lines and comments.
- However, do not expand code blocks that were
- previously collapsed individually.
-
-In situations when cycling to a state makes no difference compared
-to the previous state, then immediately continue to the next state." t)
-(register-definition-prefixes "bicycle" '("bicycle-" "outline-code-level"))
-\f
-;;; End of scraped data
-
-(provide 'bicycle-autoloads)
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; no-native-compile: t
-;; coding: utf-8-emacs-unix
-;; End:
-
-;;; bicycle-autoloads.el ends here
+++ /dev/null
-;; -*- no-byte-compile: t; lexical-binding: nil -*-
-(define-package "bicycle" "20251212.2319"
- "Cycle outline and code visibility."
- '((emacs "28.1")
- (compat "30.1"))
- :url "https://github.com/tarsius/bicycle"
- :commit "80643a60f8066cba20a51f419be0c168af7fcbd7"
- :revdesc "80643a60f806"
- :keywords '("outlines")
- :authors '(("Jonas Bernoulli" . "emacs.bicycleNOSPAMjonas.bernoulli.dev"))
- :maintainers '(("Jonas Bernoulli" . "emacs.bicycleNOSPAMjonas.bernoulli.dev")))
+++ /dev/null
-;;; bicycle.el --- Cycle outline and code visibility -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2025 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.bicycleNOSPAMjonas.bernoulli.dev>
-;; Homepage: https://github.com/tarsius/bicycle
-;; Keywords: outlines
-
-;; Package-Version: 20251212.2319
-;; Package-Revision: 80643a60f806
-;; Package-Requires: (
-;; (emacs "28.1")
-;; (compat "30.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:
-
-;; This package provides commands for cycling the visibility of
-;; outline sections and code blocks. These commands are intended to
-;; be bound in `outline-minor-mode-map' and do most of the work using
-;; functions provided by the `outline' package.
-
-;; This package is named `bicycle' because it can additionally make
-;; use of the `hideshow' package.
-
-;; If `hs-minor-mode' is enabled and point is at the start of a code
-;; block, then `hs-toggle-hiding' is used instead of some `outline'
-;; function. When you later cycle the visibility of a section that
-;; contains code blocks (which is done using `outline' functions),
-;; then code block that have been hidden using `hs-toggle-hiding',
-;; are *not* extended.
-
-;; A reasonable configuration could be:
-;;
-;; (use-package bicycle
-;; :after outline
-;; :bind (:map outline-minor-mode-map
-;; ([C-tab] . bicycle-cycle)
-;; ([S-tab] . bicycle-cycle-global)))
-;;
-;; (use-package prog-mode
-;; :config
-;; (add-hook 'prog-mode-hook #'outline-minor-mode)
-;; (add-hook 'prog-mode-hook #'hs-minor-mode))
-
-;;; Code:
-
-(require 'compat)
-
-(require 'hideshow)
-(require 'outline)
-
-(defvar-local outline-code-level 1000)
-
-;;; Options
-
-(defgroup bicycle nil
- "Cycle outline and code visibility."
- :group 'hideshow
- :group 'outlines)
-
-(defcustom bicycle-echo-state t
- "Whether to echo the name of the new state while cycling."
- :package-version '(bicycle . "0.1.0")
- :group 'bicycle
- :type 'boolean)
-
-;;; Commands
-
-;;;###autoload
-(defun bicycle-cycle (&optional global)
- "Cycle local or global visibility.
-
-With a prefix argument call `bicycle-cycle-global'.
-Without a prefix argument call `bicycle-cycle-local'."
- (interactive "P")
- (if global
- (bicycle-cycle-global)
- (bicycle-cycle-local)))
-
-;;;###autoload
-(defun bicycle-cycle-global ()
- "Cycle visibility of all sections.
-
-1. OVERVIEW: Show only top-level headings.
-
-\(2. There is no equivalent of `bicycle-cycle-local's
- CHILDREN state.)
-
-3. TOC: Recursively show all headings,
- without treating code blocks as sections.
-
-4. TREES: Recursively show all headings,
- treating code blocks as sections
- (i.e., their first line is treated as a heading).
-
-5. ALL: Show everything, including code blocks,
- empty lines and comments.
- However, do not expand code blocks that were
- previously collapsed individually.
-
-In situations when cycling to a state makes no difference compared
-to the previous state, then immediately continue to the next state."
- (interactive)
- (setq deactivate-mark t)
- (save-excursion
- (goto-char (point-min))
- (unless (re-search-forward outline-regexp nil t)
- (user-error "Found no heading"))
- (cond
- ((bicycle--maybe-cycle 'outline-cycle-overview 'outline-cycle-toc
- (lambda () (and (bicycle--top-level-p) (bicycle--non-code-children-p)))
- (lambda ()
- (bicycle--show-children
- (- outline-code-level (bicycle--top-level) 1)
- t)))
- (bicycle--message "TOC"))
- ((bicycle--maybe-cycle 'outline-cycle-toc 'outline-cycle-trees
- (lambda () (cdr (bicycle--child-types)))
- #'outline-show-branches)
- (bicycle--message "TREES"))
- ((eq last-command 'outline-cycle-trees)
- (outline-show-all)
- (bicycle--message "ALL"))
- (t
- (outline-hide-sublevels (bicycle--level))
- (bicycle--message "OVERVIEW")
- (setq this-command 'outline-cycle-overview)))))
-
-(defun bicycle-cycle-local ()
- "Cycle visibility of the current section.
-
-If point is within a code block, then toggle its visibility,
-provided `hs-minor-mode' is enabled. Otherwise move to the
-previous outline heading.
-
-If point is in between code blocks, then move to the previous
-outline heading.
-
-If point is within an outline heading line, then rotate the
-visibility of that subtree through these four states:
-
-1. FOLDED: Show only the current heading.
-
-2. CHILDREN: Show headings of children,
- treating top-level code block as sections
- (i.e., their first line is treated as a heading).
-
-3. HEADINGS: Recursively show headings of all subsections,
- without treating top-level code blocks as sections.
-
-3. BRANCHES: Recursively show headings of all subsections,
- treating top-level code block as sections
- (i.e., their first line is treated as a heading).
-
-5. SUBTREE: Show the entire subtree, including code blocks,
- empty lines and comments.
- However, do not expand code blocks that were
- previously collapsed individually.
-
-If the section has no children then toggle between HIDE and SHOW.
-This also works for code blocks. This is one way to collapsed a
-code block \"individually\", with has the side-effect mentioned
-above.
-
-If the section has no body (not even empty lines), then there is
-only one state, EMPTY, and cycling does nothing."
- (let ((eol (save-excursion (end-of-visible-line) (point)))
- (eoh (save-excursion (outline-end-of-heading) (point)))
- (eos (save-excursion (outline-end-of-subtree) (point))))
- (setq deactivate-mark t)
- (skip-chars-forward "\s\t")
- (cond
- ((and hs-minor-mode
- (bicycle--code-level-p)
- (static-if (fboundp 'hs-find-block-beg-fn--default)
- (hs-find-block-beg-fn--default)
- (or (hs-looking-at-block-start-p)
- (hs-find-block-beginning))))
- (cond
- ((outline-invisible-p eoh)
- (outline-show-entry)
- (hs-life-goes-on
- (when (hs-already-hidden-p)
- (save-excursion (hs-show-block)))))
- (t
- (hs-life-goes-on
- (if (hs-already-hidden-p)
- (progn
- (save-excursion (hs-show-block))
- (outline-show-entry))
- (save-excursion (hs-hide-block))
- (outline-hide-entry))))))
- ((save-excursion
- (beginning-of-line 1)
- (not (outline-on-heading-p t)))
- (outline-back-to-heading)
- (when (bicycle--code-level-p)
- (outline-up-heading 1)))
- (t
- (outline-back-to-heading)
- (cond
- ((bicycle--code-level-p)
- (outline-toggle-children)
- (bicycle--message "CODE"))
- ((or (= eos eoh)
- (= (1+ eoh) (point-max)))
- (outline-show-entry)
- (bicycle--message "EMPTY"))
- ((null (bicycle--child-types))
- (cond ((outline-invisible-p eoh)
- (outline-show-entry)
- (bicycle--message "SHOW"))
- (t
- (outline-hide-entry)
- (bicycle--message "HIDE"))))
- ((and (>= eol eos)
- (not (eq last-command 'outline-cycle-children)))
- (bicycle--show-children)
- (bicycle--message "CHILDREN")
- (setq this-command 'outline-cycle-children))
- ((and (not (derived-mode-p 'outline-mode))
- (bicycle--maybe-cycle
- 'outline-cycle-children 'outline-cycle-headings
- #'bicycle--non-code-children-p
- #'outline-show-children
- eoh eos))
- (bicycle--message "HEADINGS"))
- ((and (not (derived-mode-p 'outline-mode))
- (bicycle--maybe-cycle
- 'outline-cycle-headings 'outline-cycle-branches
- (lambda () (not (bicycle--code-level-p)))
- #'outline-show-branches
- eoh eos))
- (bicycle--message "BRANCHES"))
- ((eq last-command 'outline-cycle-branches)
- (outline-show-subtree)
- (bicycle--message "SUBTREE"))
- (t
- (outline-hide-subtree)
- (bicycle--message "FOLDED")))))))
-
-;;; Utilities
-
-(defun bicycle--maybe-cycle (last-cmd this-cmd pred cycle &optional beg end)
- (declare (indent defun))
- (and (eq last-command last-cmd)
- (let ((noop t))
- (outline-map-region (lambda ()
- (when (funcall pred)
- (funcall cycle)
- (setq noop nil)))
- (or beg (point-min))
- (or end (point-max)))
- (if noop
- (setq last-command this-cmd)
- (setq this-command this-cmd))
- (not noop))))
-
-(defun bicycle--show-children (&optional level nocode)
- "Show all direct subheadings of this heading.
-Prefix arg LEVEL is how many levels below the current level
-should be shown. Default is enough to cause the following
-heading to appear. Unlike for `outline-show-children' code
-is not considered to be a sublevel."
- (interactive "P")
- (if (or level
- (derived-mode-p 'outline-mode)
- (not (bicycle--non-code-children-p)))
- (outline-show-children level)
- (let ((start-level (funcall outline-level))
- (eos (save-excursion (outline-end-of-subtree) (point)))
- (eoc nil))
- (save-excursion
- (outline-back-to-heading)
- (while (and (not level) (outline-next-heading))
- (cond
- ((eobp)
- (setq level 1))
- ((bicycle--code-level-p)
- (unless level
- (setq eoc (1+ (point)))))
- ((not (> (point) eos))
- (setq level (max 1 (- (funcall outline-level) start-level)))))))
- (outline-show-children
- (or level (max 1 (- outline-code-level start-level))))
- (when (and eoc (not nocode))
- (save-excursion
- (outline-back-to-heading)
- (outline-end-of-heading)
- (outline-map-region #'outline-show-heading (point) eoc))))))
-
-(defun bicycle--level ()
- "Return the depth to which a statement is nested in the outline.
-Point must be on a header line (but unlike for `outline-level',
-not necessarily at its beginning)."
- (and (outline-on-heading-p t)
- (save-excursion
- (beginning-of-line)
- (funcall outline-level))))
-
-(defvar-local bicycle--top-level nil)
-
-(defun bicycle--top-level ()
- "Return the number identifying the top-level in this buffer.
-Ideally this would always be 1, then we would not have to
-guess and risk that the guess was wrong, but sadly this
-number depends on the regexp used to identify headings."
- (or bicycle--top-level
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((min (or (bicycle--level) outline-code-level)))
- (while (outline-next-heading)
- (setq min (min min (bicycle--level))))
- (setq bicycle--top-level min))))))
-
-(defun bicycle--top-level-p ()
- "Return t if inside the heading of a top-level section."
- (let ((lvl (bicycle--level))
- (top (bicycle--top-level)))
- (when (< lvl top)
- (setq bicycle--top-level nil)
- (setq top (bicycle--top-level)))
- (= lvl top)))
-
-(defun bicycle--code-level-p ()
- "Return t if inside a code block.
-On outline headings and in between code blocks,
-return nil."
- (= (funcall outline-level) outline-code-level))
-
-(defun bicycle--non-code-children-p ()
- "Return t if the current section has subsections."
- (catch 'non-code
- (save-excursion
- (outline-back-to-heading)
- (outline-end-of-heading)
- (outline-map-region
- (lambda ()
- (and (not (bicycle--code-level-p))
- (throw 'non-code t)))
- (point)
- (progn (outline-end-of-subtree)
- (if (eobp) (point-max) (1+ (point))))))
- nil))
-
-(defun bicycle--child-types ()
- "Indicate what types of children the current section has.
-If the current section has no children, then return nil.
-Otherwise return (HEADINGS . CODE), where HEADINGS and
-CODE are booleans indicating whether the section contains
-headings and/or code blocks."
- (let (headings code)
- (catch 'both
- (save-excursion
- (outline-back-to-heading)
- (outline-end-of-heading)
- (outline-map-region
- (lambda ()
- (if (bicycle--code-level-p)
- (setq code t)
- (setq headings t))
- (when (and headings code)
- (throw 'both nil)))
- (point)
- (progn (outline-end-of-subtree)
- (if (eobp) (point-max) (1+ (point)))))))
- (and (or headings code)
- (cons headings code))))
-
-(defun bicycle--message (format-string &rest args)
- "Like `message' but if `bicycle-echo-state' is nil then do nothing."
- (when bicycle-echo-state
- (apply #'message format-string args)))
-
-;;; _
-(provide 'bicycle)
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
-;;; bicycle.el ends here
--- /dev/null
+This package provides commands for cycling the visibility of
+outline sections and code blocks. These commands are intended to
+be bound in `outline-minor-mode-map' and do most of the work using
+functions provided by the `outline' package.
+
+This package is named `bicycle' because it can additionally make
+use of the `hideshow' package.
+
+If `hs-minor-mode' is enabled and point is at the start of a code
+block, then `hs-toggle-hiding' is used instead of some `outline'
+function. When you later cycle the visibility of a section that
+contains code blocks (which is done using `outline' functions),
+then code block that have been hidden using `hs-toggle-hiding',
+are *not* extended.
+
+A reasonable configuration could be:
+
+ (use-package bicycle
+ :after outline
+ :bind (:map outline-minor-mode-map
+ ([C-tab] . bicycle-cycle)
+ ([S-tab] . bicycle-cycle-global)))
+
+ (use-package prog-mode
+ :config
+ (add-hook 'prog-mode-hook #'outline-minor-mode)
+ (add-hook 'prog-mode-hook #'hs-minor-mode))
--- /dev/null
+;;; bicycle-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from bicycle.el
+
+(autoload 'bicycle-cycle "bicycle"
+"Cycle local or global visibility.
+
+With a prefix argument call `bicycle-cycle-global'.
+Without a prefix argument call `bicycle-cycle-local'.
+
+(fn &optional GLOBAL)" t)
+(autoload 'bicycle-cycle-global "bicycle"
+"Cycle visibility of all sections.
+
+1. OVERVIEW: Show only top-level headings.
+
+(2. There is no equivalent of `bicycle-cycle-local's
+ CHILDREN state.)
+
+3. TOC: Recursively show all headings,
+ without treating code blocks as sections.
+
+4. TREES: Recursively show all headings,
+ treating code blocks as sections
+ (i.e., their first line is treated as a heading).
+
+5. ALL: Show everything, including code blocks,
+ empty lines and comments.
+ However, do not expand code blocks that were
+ previously collapsed individually.
+
+In situations when cycling to a state makes no difference compared
+to the previous state, then immediately continue to the next state." t)
+(register-definition-prefixes "bicycle" '("bicycle-" "outline-code-level"))
+\f
+;;; End of scraped data
+
+(provide 'bicycle-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; bicycle-autoloads.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "bicycle" "20260101.1825"
+ "Cycle outline and code visibility."
+ '((emacs "28.1")
+ (compat "30.1"))
+ :url "https://github.com/tarsius/bicycle"
+ :commit "9da65dcb0e8ea6a9fe2b02d3be3cd4f2f4e29977"
+ :revdesc "9da65dcb0e8e"
+ :keywords '("outlines")
+ :authors '(("Jonas Bernoulli" . "emacs.bicycleNOSPAMjonas.bernoulli.dev"))
+ :maintainers '(("Jonas Bernoulli" . "emacs.bicycleNOSPAMjonas.bernoulli.dev")))
--- /dev/null
+;;; bicycle.el --- Cycle outline and code visibility -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2026 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.bicycleNOSPAMjonas.bernoulli.dev>
+;; Homepage: https://github.com/tarsius/bicycle
+;; Keywords: outlines
+
+;; Package-Version: 20260101.1825
+;; Package-Revision: 9da65dcb0e8e
+;; Package-Requires: (
+;; (emacs "28.1")
+;; (compat "30.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:
+
+;; This package provides commands for cycling the visibility of
+;; outline sections and code blocks. These commands are intended to
+;; be bound in `outline-minor-mode-map' and do most of the work using
+;; functions provided by the `outline' package.
+
+;; This package is named `bicycle' because it can additionally make
+;; use of the `hideshow' package.
+
+;; If `hs-minor-mode' is enabled and point is at the start of a code
+;; block, then `hs-toggle-hiding' is used instead of some `outline'
+;; function. When you later cycle the visibility of a section that
+;; contains code blocks (which is done using `outline' functions),
+;; then code block that have been hidden using `hs-toggle-hiding',
+;; are *not* extended.
+
+;; A reasonable configuration could be:
+;;
+;; (use-package bicycle
+;; :after outline
+;; :bind (:map outline-minor-mode-map
+;; ([C-tab] . bicycle-cycle)
+;; ([S-tab] . bicycle-cycle-global)))
+;;
+;; (use-package prog-mode
+;; :config
+;; (add-hook 'prog-mode-hook #'outline-minor-mode)
+;; (add-hook 'prog-mode-hook #'hs-minor-mode))
+
+;;; Code:
+
+(require 'compat)
+
+(require 'hideshow)
+(require 'outline)
+
+(defvar-local outline-code-level 1000)
+
+;;; Options
+
+(defgroup bicycle nil
+ "Cycle outline and code visibility."
+ :group 'hideshow
+ :group 'outlines)
+
+(defcustom bicycle-echo-state t
+ "Whether to echo the name of the new state while cycling."
+ :package-version '(bicycle . "0.1.0")
+ :group 'bicycle
+ :type 'boolean)
+
+;;; Commands
+
+;;;###autoload
+(defun bicycle-cycle (&optional global)
+ "Cycle local or global visibility.
+
+With a prefix argument call `bicycle-cycle-global'.
+Without a prefix argument call `bicycle-cycle-local'."
+ (interactive "P")
+ (if global
+ (bicycle-cycle-global)
+ (bicycle-cycle-local)))
+
+;;;###autoload
+(defun bicycle-cycle-global ()
+ "Cycle visibility of all sections.
+
+1. OVERVIEW: Show only top-level headings.
+
+\(2. There is no equivalent of `bicycle-cycle-local's
+ CHILDREN state.)
+
+3. TOC: Recursively show all headings,
+ without treating code blocks as sections.
+
+4. TREES: Recursively show all headings,
+ treating code blocks as sections
+ (i.e., their first line is treated as a heading).
+
+5. ALL: Show everything, including code blocks,
+ empty lines and comments.
+ However, do not expand code blocks that were
+ previously collapsed individually.
+
+In situations when cycling to a state makes no difference compared
+to the previous state, then immediately continue to the next state."
+ (interactive)
+ (setq deactivate-mark t)
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward outline-regexp nil t)
+ (user-error "Found no heading"))
+ (cond
+ ((bicycle--maybe-cycle 'outline-cycle-overview 'outline-cycle-toc
+ (lambda () (and (bicycle--top-level-p) (bicycle--non-code-children-p)))
+ (lambda ()
+ (bicycle--show-children
+ (- outline-code-level (bicycle--top-level) 1)
+ t)))
+ (bicycle--message "TOC"))
+ ((bicycle--maybe-cycle 'outline-cycle-toc 'outline-cycle-trees
+ (lambda () (cdr (bicycle--child-types)))
+ #'outline-show-branches)
+ (bicycle--message "TREES"))
+ ((eq last-command 'outline-cycle-trees)
+ (outline-show-all)
+ (bicycle--message "ALL"))
+ (t
+ (outline-hide-sublevels (bicycle--level))
+ (bicycle--message "OVERVIEW")
+ (setq this-command 'outline-cycle-overview)))))
+
+(defun bicycle-cycle-local ()
+ "Cycle visibility of the current section.
+
+If point is within a code block, then toggle its visibility,
+provided `hs-minor-mode' is enabled. Otherwise move to the
+previous outline heading.
+
+If point is in between code blocks, then move to the previous
+outline heading.
+
+If point is within an outline heading line, then rotate the
+visibility of that subtree through these four states:
+
+1. FOLDED: Show only the current heading.
+
+2. CHILDREN: Show headings of children,
+ treating top-level code block as sections
+ (i.e., their first line is treated as a heading).
+
+3. HEADINGS: Recursively show headings of all subsections,
+ without treating top-level code blocks as sections.
+
+3. BRANCHES: Recursively show headings of all subsections,
+ treating top-level code block as sections
+ (i.e., their first line is treated as a heading).
+
+5. SUBTREE: Show the entire subtree, including code blocks,
+ empty lines and comments.
+ However, do not expand code blocks that were
+ previously collapsed individually.
+
+If the section has no children then toggle between HIDE and SHOW.
+This also works for code blocks. This is one way to collapsed a
+code block \"individually\", with has the side-effect mentioned
+above.
+
+If the section has no body (not even empty lines), then there is
+only one state, EMPTY, and cycling does nothing."
+ (let ((eol (save-excursion (end-of-visible-line) (point)))
+ (eoh (save-excursion (outline-end-of-heading) (point)))
+ (eos (save-excursion (outline-end-of-subtree) (point))))
+ (setq deactivate-mark t)
+ (skip-chars-forward "\s\t")
+ (cond
+ ((and hs-minor-mode
+ (bicycle--code-level-p)
+ (static-if (fboundp 'hs-find-block-beg-fn--default)
+ (hs-find-block-beg-fn--default)
+ (or (hs-looking-at-block-start-p)
+ (hs-find-block-beginning))))
+ (cond
+ ((outline-invisible-p eoh)
+ (outline-show-entry)
+ (hs-life-goes-on
+ (when (hs-already-hidden-p)
+ (save-excursion (hs-show-block)))))
+ (t
+ (hs-life-goes-on
+ (if (hs-already-hidden-p)
+ (progn
+ (save-excursion (hs-show-block))
+ (outline-show-entry))
+ (save-excursion (hs-hide-block))
+ (outline-hide-entry))))))
+ ((save-excursion
+ (beginning-of-line 1)
+ (not (outline-on-heading-p t)))
+ (outline-back-to-heading)
+ (when (bicycle--code-level-p)
+ (outline-up-heading 1)))
+ (t
+ (outline-back-to-heading)
+ (cond
+ ((bicycle--code-level-p)
+ (outline-toggle-children)
+ (bicycle--message "CODE"))
+ ((or (= eos eoh)
+ (= (1+ eoh) (point-max)))
+ (outline-show-entry)
+ (bicycle--message "EMPTY"))
+ ((null (bicycle--child-types))
+ (cond ((outline-invisible-p eoh)
+ (outline-show-entry)
+ (bicycle--message "SHOW"))
+ (t
+ (outline-hide-entry)
+ (bicycle--message "HIDE"))))
+ ((and (>= eol eos)
+ (not (eq last-command 'outline-cycle-children)))
+ (bicycle--show-children)
+ (bicycle--message "CHILDREN")
+ (setq this-command 'outline-cycle-children))
+ ((and (not (derived-mode-p 'outline-mode))
+ (bicycle--maybe-cycle
+ 'outline-cycle-children 'outline-cycle-headings
+ #'bicycle--non-code-children-p
+ #'outline-show-children
+ eoh eos))
+ (bicycle--message "HEADINGS"))
+ ((and (not (derived-mode-p 'outline-mode))
+ (bicycle--maybe-cycle
+ 'outline-cycle-headings 'outline-cycle-branches
+ (lambda () (not (bicycle--code-level-p)))
+ #'outline-show-branches
+ eoh eos))
+ (bicycle--message "BRANCHES"))
+ ((eq last-command 'outline-cycle-branches)
+ (outline-show-subtree)
+ (bicycle--message "SUBTREE"))
+ (t
+ (outline-hide-subtree)
+ (bicycle--message "FOLDED")))))))
+
+;;; Utilities
+
+(defun bicycle--maybe-cycle (last-cmd this-cmd pred cycle &optional beg end)
+ (declare (indent defun))
+ (and (eq last-command last-cmd)
+ (let ((noop t))
+ (outline-map-region (lambda ()
+ (when (funcall pred)
+ (funcall cycle)
+ (setq noop nil)))
+ (or beg (point-min))
+ (or end (point-max)))
+ (if noop
+ (setq last-command this-cmd)
+ (setq this-command this-cmd))
+ (not noop))))
+
+(defun bicycle--show-children (&optional level nocode)
+ "Show all direct subheadings of this heading.
+Prefix arg LEVEL is how many levels below the current level
+should be shown. Default is enough to cause the following
+heading to appear. Unlike for `outline-show-children' code
+is not considered to be a sublevel."
+ (interactive "P")
+ (if (or level
+ (derived-mode-p 'outline-mode)
+ (not (bicycle--non-code-children-p)))
+ (outline-show-children level)
+ (let ((start-level (funcall outline-level))
+ (eos (save-excursion (outline-end-of-subtree) (point)))
+ (eoc nil))
+ (save-excursion
+ (outline-back-to-heading)
+ (while (and (not level) (outline-next-heading))
+ (cond
+ ((eobp)
+ (setq level 1))
+ ((bicycle--code-level-p)
+ (unless level
+ (setq eoc (1+ (point)))))
+ ((not (> (point) eos))
+ (setq level (max 1 (- (funcall outline-level) start-level)))))))
+ (outline-show-children
+ (or level (max 1 (- outline-code-level start-level))))
+ (when (and eoc (not nocode))
+ (save-excursion
+ (outline-back-to-heading)
+ (outline-end-of-heading)
+ (outline-map-region #'outline-show-heading (point) eoc))))))
+
+(defun bicycle--level ()
+ "Return the depth to which a statement is nested in the outline.
+Point must be on a header line (but unlike for `outline-level',
+not necessarily at its beginning)."
+ (and (outline-on-heading-p t)
+ (save-excursion
+ (beginning-of-line)
+ (funcall outline-level))))
+
+(defvar-local bicycle--top-level nil)
+
+(defun bicycle--top-level ()
+ "Return the number identifying the top-level in this buffer.
+Ideally this would always be 1, then we would not have to
+guess and risk that the guess was wrong, but sadly this
+number depends on the regexp used to identify headings."
+ (or bicycle--top-level
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((min (or (bicycle--level) outline-code-level)))
+ (while (outline-next-heading)
+ (setq min (min min (bicycle--level))))
+ (setq bicycle--top-level min))))))
+
+(defun bicycle--top-level-p ()
+ "Return t if inside the heading of a top-level section."
+ (let ((lvl (bicycle--level))
+ (top (bicycle--top-level)))
+ (when (< lvl top)
+ (setq bicycle--top-level nil)
+ (setq top (bicycle--top-level)))
+ (= lvl top)))
+
+(defun bicycle--code-level-p ()
+ "Return t if inside a code block.
+On outline headings and in between code blocks,
+return nil."
+ (= (funcall outline-level) outline-code-level))
+
+(defun bicycle--non-code-children-p ()
+ "Return t if the current section has subsections."
+ (catch 'non-code
+ (save-excursion
+ (outline-back-to-heading)
+ (outline-end-of-heading)
+ (outline-map-region
+ (lambda ()
+ (and (not (bicycle--code-level-p))
+ (throw 'non-code t)))
+ (point)
+ (progn (outline-end-of-subtree)
+ (if (eobp) (point-max) (1+ (point))))))
+ nil))
+
+(defun bicycle--child-types ()
+ "Indicate what types of children the current section has.
+If the current section has no children, then return nil.
+Otherwise return (HEADINGS . CODE), where HEADINGS and
+CODE are booleans indicating whether the section contains
+headings and/or code blocks."
+ (let (headings code)
+ (catch 'both
+ (save-excursion
+ (outline-back-to-heading)
+ (outline-end-of-heading)
+ (outline-map-region
+ (lambda ()
+ (if (bicycle--code-level-p)
+ (setq code t)
+ (setq headings t))
+ (when (and headings code)
+ (throw 'both nil)))
+ (point)
+ (progn (outline-end-of-subtree)
+ (if (eobp) (point-max) (1+ (point)))))))
+ (and (or headings code)
+ (cons headings code))))
+
+(defun bicycle--message (format-string &rest args)
+ "Like `message' but if `bicycle-echo-state' is nil then do nothing."
+ (when bicycle-echo-state
+ (apply #'message format-string args)))
+
+;;; _
+(provide 'bicycle)
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; lisp-indent-local-overrides: ((cond . 0) (interactive . 0))
+;; End:
+;;; bicycle.el ends here
projects / emacsconfig.git / commitdiff