From: Matthias Meulien <orontee@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 51809@debbugs.gnu.org, juri@linkov.net
Subject: bug#51809: 29.0.50; [PATCH] Support for outline default state in Diff buffers
Date: Sun, 26 Dec 2021 20:19:13 +0100 [thread overview]
Message-ID: <87fsqfmaxa.fsf@gmail.com> (raw)
In-Reply-To: <83fsqfnxpl.fsf@gnu.org> (Eli Zaretskii's message of "Sun, 26 Dec 2021 18:21:42 +0200")
[-- Attachment #1: Type: text/plain, Size: 150 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
> (...) a few comments to the documentation parts:
Here is an updated patch taking your remarks into account:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Extend-Outline-mode-with-default-visibility-state.patch --]
[-- Type: text/x-diff, Size: 10749 bytes --]
From ecf57d0fb33ba3d569ca8fb2933993e139bbf94e Mon Sep 17 00:00:00 2001
From: Matthias Meulien <orontee@gmail.com>
Date: Wed, 8 Dec 2021 22:35:42 +0100
Subject: [PATCH] Extend Outline mode with default visibility state
* etc/NEWS: Announce support for default visibility state.
* lisp/outline.el (outline-mode, outline-minor-mode): Ensure default
visibility state is applied.
(outline-hide-sublevels): Add optional argument for function to call
on each heading.
(outline-default-state): Define the default visibility state.
(outline-apply-default-state): Apply default visibility state.
---
etc/NEWS | 10 +++
lisp/outline.el | 190 +++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 197 insertions(+), 3 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index cfea513cca..9a49ff8379 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -215,6 +215,16 @@ These will take you (respectively) to the next and previous "page".
---
*** 'describe-char' now also outputs the name of emoji combinations.
+** Outline Mode
+
+*** Support for a default visibility state.
+Customize the option 'outline-default-state' to define what headings
+are visible when the mode is set. When equal to a number, the option
+'outline-default-state-subtree-visibility' determines the visibility
+of the subtree starting at the corresponding level. Values are
+provided to show a heading subtree unless the heading match a regexp,
+or its subtree has long lines or is long.
+
** Outline Minor Mode
+++
diff --git a/lisp/outline.el b/lisp/outline.el
index 5e3d4e0e00..ad45e38946 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -354,7 +354,9 @@ outline-mode
'(outline-font-lock-keywords t nil nil backward-paragraph))
(setq-local imenu-generic-expression
(list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
- (add-hook 'change-major-mode-hook #'outline-show-all nil t))
+ (add-hook 'change-major-mode-hook #'outline-show-all nil t)
+ (add-hook 'hack-local-variables-hook
+ #'outline-apply-default-state))
(defvar outline-minor-mode-map)
@@ -437,7 +439,9 @@ outline-minor-mode
nil t)
(setq-local line-move-ignore-invisible t)
;; Cause use of ellipses for invisible text.
- (add-to-invisibility-spec '(outline . t)))
+ (add-to-invisibility-spec '(outline . t))
+ (add-hook 'hack-local-variables-hook
+ #'outline-apply-default-state))
(when (or outline-minor-mode-cycle outline-minor-mode-highlight)
(if font-lock-fontified
(font-lock-remove-keywords nil outline-font-lock-keywords))
@@ -1094,7 +1098,7 @@ outline-hide-sublevels
(outline-map-region
(lambda ()
(if (<= (funcall outline-level) levels)
- (outline-show-heading)))
+ (outline-show-heading)))
beg end)
;; Finally unhide any trailing newline.
(goto-char (point-max))
@@ -1308,6 +1312,186 @@ outline-headers-as-kill
(insert "\n\n"))))))
(kill-new (buffer-string)))))))
+(defcustom outline-default-state nil
+ "If non-nil, some headings are initially outlined.
+
+Note that the default state is applied when the major mode is set
+or when the command `outline-apply-default-state' is called
+interactively.
+
+When nil, headings visibility is left unchanged.
+
+If equal to `outline-show-all', all text of buffer is shown.
+
+If equal to `outline-show-only-headings', only headings are shown.
+
+If equal to a number, show only headings up to and including the
+corresponding level. See
+`outline-default-state-subtree-visibility' to customize
+visibility of the subtree at the choosen level.
+
+If equal to a lambda function or function name, this function is
+expected to toggle headings visibility, and will be called after
+the mode is enabled."
+ :version "29.1"
+ :type '(choice (const :tag "Disabled" nil)
+ (const :tag "Show all" outline-show-all)
+ (const :tag "Only headings" outline-show-only-headings)
+ (natnum :tag "Show headings up to level" :value 1)
+ (function :tag "Custom function")))
+
+(defcustom outline-default-state-subtree-visibility nil
+ "Determines visibility of subtree starting at `outline-default-state' level.
+
+When nil, the subtree is hidden unconditionally.
+
+When equal to a list, each element should be one of the following:
+
+- A cons cell with CAR `match-regexp' and CDR a regexp, the
+ subtree will be hidden when the outline heading match the
+ regexp.
+
+- `subtree-has-long-lines' to only show the heading branches when
+ long lines are detected in its subtree (see
+ `outline-long-line-threshold' for the definition of long
+ lines).
+
+- `subtree-is-long' to only show the heading branches when its
+ subtree contains more than `outline-line-count-threshold'
+ lines.
+
+- A lambda function or function name which will be evaluated with
+ point at the beginning of the heading and the match data set
+ appropriately, the function being expected to toggle the
+ heading visibility."
+ :version "29.1"
+ :type '(choice (const :tag "Hide subtree" nil)
+ (set :tag "Show subtree unless"
+ (cons :tag "Heading match regexp"
+ (const match-regexp) string)
+ (const :tag "Subtree has long lines"
+ subtree-has-long-lines)
+ (const :tag "Subtree is long"
+ subtree-is-long)
+ (cons :tag "Custom function"
+ (const custom-function) function))))
+
+(defcustom outline-long-line-threshold 1000
+ "Minimal number of characters in a line for a heading to be outlined."
+ :version "29.1"
+ :type '(natnum :tag "Number of lines"))
+
+(defcustom outline-line-count-threshold 50
+ "Minimal number of lines for a heading to be outlined."
+ :version "29.1"
+ :type '(natnum :tag "Number of lines"))
+
+(defun outline-apply-default-state ()
+ "Apply the outline state defined by `outline-default-state'."
+ (interactive)
+ (cond
+ ((integerp outline-default-state)
+ (outline--show-headings-up-to-level outline-default-state))
+ ((when (functionp outline-default-state)
+ (funcall outline-default-state)))))
+
+(defun outline-show-only-headings ()
+ "Show only headings."
+ (interactive)
+ (outline-show-all)
+ (outline-hide-region-body (point-min) (point-max)))
+
+(eval-when-compile (require 'so-long))
+(autoload 'so-long-detected-long-line-p "so-long")
+(defvar so-long-skip-leading-comments)
+(defvar so-long-threshold)
+(defvar so-long-max-lines)
+
+(defun outline--show-headings-up-to-level (level)
+ "Show only headings up to a LEVEL level and call FUN on the leaves.
+
+Like `outline-hide-sublevels' but but call
+`outline-default-state-subtree-visibility' for each heading at
+level equal to LEVEL."
+ (if (not outline-default-state-subtree-visibility)
+ (outline-hide-sublevels level)
+ (if (< level 1)
+ (error "Must keep at least one level of headers"))
+ (save-excursion
+ (let* (outline-view-change-hook
+ (beg (progn
+ (goto-char (point-min))
+ ;; Skip the prelude, if any.
+ (unless (outline-on-heading-p t) (outline-next-heading))
+ (point)))
+ (end (progn
+ (goto-char (point-max))
+ ;; Keep empty last line, if available.
+ (if (bolp) (1- (point)) (point))))
+ (heading-regexp
+ (cdr-safe
+ (assoc 'match-regexp
+ outline-default-state-subtree-visibility)))
+ (check-line-count
+ (memq 'subtree-is-long
+ outline-default-state-subtree-visibility))
+ (check-long-lines
+ (memq 'subtree-has-long-lines
+ outline-default-state-subtree-visibility))
+ (custom-function
+ (cdr-safe
+ (assoc 'custom-function
+ outline-default-state-subtree-visibility))))
+ (if (< end beg)
+ (setq beg (prog1 end (setq end beg))))
+ ;; First hide everything.
+ (outline-hide-sublevels level)
+ ;; Then unhide the top level headers.
+ (outline-map-region
+ (lambda ()
+ (let ((current-level (outline-level)))
+ (when (< current-level level)
+ (outline-show-heading)
+ (outline-show-entry))
+ (when (= current-level level)
+ (cond
+ ((and heading-regexp
+ (let ((beg (point))
+ (end (progn (outline-end-of-heading) (point))))
+ (string-match-p heading-regexp (buffer-substring beg end))))
+ ;; hide entry when heading match regexp
+ (outline-hide-entry))
+ ((and check-line-count
+ (save-excursion
+ (let* ((beg (point))
+ (end (progn (outline-end-of-subtree) (point)))
+ (line-count (count-lines beg end)))
+ (< outline-line-count-threshold line-count))))
+ ;; show only branches when line count of subtree >
+ ;; threshold
+ (outline-show-branches))
+ ((and check-long-lines
+ (save-excursion
+ (let ((beg (point))
+ (end (progn (outline-end-of-subtree) (point))))
+ (save-restriction
+ (narrow-to-region beg end)
+ (let ((so-long-skip-leading-comments nil)
+ (so-long-threshold outline-long-line-threshold)
+ (so-long-max-lines nil))
+ (so-long-detected-long-line-p))))))
+ ;; show only branches when long lines are detected
+ ;; in subtree
+ (outline-show-branches))
+ (custom-function
+ ;; call custom function if defined
+ (funcall custom-function))
+ (t
+ ;; if no previous clause succeeds, show subtree
+ (outline-show-subtree))))))
+ beg end)))
+ (run-hooks 'outline-view-change-hook)))
+
(defun outline--cycle-state ()
"Return the cycle state of current heading.
Return either 'hide-all, 'headings-only, or 'show-all."
--
2.30.2
[-- Attachment #3: Type: text/plain, Size: 15 bytes --]
--
Matthias
next prev parent reply other threads:[~2021-12-26 19:19 UTC|newest]
Thread overview: 45+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-11-13 13:04 bug#51809: 29.0.50; [PATCH] Support for outline default state in Diff buffers Matthias Meulien
2021-11-13 17:45 ` Juri Linkov
2021-11-13 18:08 ` Matthias Meulien
2021-11-13 18:27 ` Juri Linkov
2021-11-13 18:41 ` Matthias Meulien
2021-11-13 19:29 ` Juri Linkov
2021-11-13 21:27 ` Matthias Meulien
2021-11-13 23:29 ` Matthias Meulien
2021-11-29 17:06 ` Juri Linkov
2021-11-30 19:33 ` Matthias Meulien
2021-12-11 18:18 ` Matthias Meulien
2021-12-12 8:43 ` Juri Linkov
2021-12-13 7:55 ` Matthias Meulien
2021-12-13 8:58 ` Juri Linkov
2021-12-26 16:05 ` Matthias Meulien
2021-12-26 16:21 ` Eli Zaretskii
2021-12-26 19:19 ` Matthias Meulien [this message]
2021-12-26 20:32 ` Matthias Meulien
2021-12-26 20:55 ` Matthias Meulien
2021-12-27 19:52 ` Juri Linkov
2021-12-28 18:37 ` Juri Linkov
2021-12-28 21:46 ` Matthias Meulien
2021-12-28 22:28 ` Matthias Meulien
2022-01-11 17:46 ` Juri Linkov
2022-01-14 16:41 ` Matthias Meulien
2022-01-16 18:14 ` Juri Linkov
2022-01-17 21:10 ` Matthias Meulien
2022-01-29 19:12 ` Juri Linkov
2022-02-05 18:45 ` Juri Linkov
2022-02-05 22:00 ` Lars Ingebrigtsen
2022-02-12 17:09 ` Juri Linkov
2022-02-12 17:26 ` Matthias Meulien
2022-02-14 21:07 ` Matthias Meulien
2022-02-14 21:13 ` Matthias Meulien
2022-02-14 21:33 ` Matthias Meulien
2022-02-14 21:39 ` Matthias Meulien
2022-02-16 19:20 ` Juri Linkov
2021-12-28 18:32 ` Juri Linkov
2021-12-28 21:45 ` Matthias Meulien
2021-11-14 18:25 ` Juri Linkov
2021-11-14 19:35 ` Matthias Meulien
2021-11-14 19:46 ` Juri Linkov
2021-11-14 19:54 ` Matthias Meulien
2021-11-14 20:31 ` Juri Linkov
2021-12-28 8:09 ` Matthias Meulien
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87fsqfmaxa.fsf@gmail.com \
--to=orontee@gmail.com \
--cc=51809@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=juri@linkov.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).