unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Matthias Meulien <orontee@gmail.com>
To: Juri Linkov <juri@linkov.net>
Cc: 51809@debbugs.gnu.org
Subject: bug#51809: 29.0.50; [PATCH] Support for outline default state in Diff buffers
Date: Sun, 26 Dec 2021 17:05:25 +0100	[thread overview]
Message-ID: <87r19zs662.fsf@gmail.com> (raw)
In-Reply-To: <871r2hc51a.fsf@gmail.com> (Matthias Meulien's message of "Mon, 13 Dec 2021 08:55:45 +0100")

[-- Attachment #1: Type: text/plain, Size: 294 bytes --]

Matthias Meulien <orontee@gmail.com> writes:

> (...) Thanks for reading the patch! I'll send another one, hopefully
> taking your remarks into account, when support of local variables is
> fixed.

Here is an updated patch implementing a default state for Outline mode
and Outline minor mode:


[-- 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: 9692 bytes --]

From db0cf942950c7e997d2701742ce16c8385f452e0 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

* 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
---
 lisp/outline.el | 183 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 180 insertions(+), 3 deletions(-)

diff --git a/lisp/outline.el b/lisp/outline.el
index 2ede4e23ea..c52b9cd4e7 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -353,7 +353,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)
 
@@ -436,7 +438,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))
@@ -1093,7 +1097,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))
@@ -1307,6 +1311,179 @@ outline-headers-as-kill
                     (insert "\n\n"))))))
           (kill-new (buffer-string)))))))
 
+(defcustom outline-default-state nil
+  "If non-nil, some headings are initially outlined.
+
+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 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
+  "Defines visibility of subtree starting at level defined by `outline-default-state'.
+
+When nil, the subtree is hidden unconditionally.
+
+When equal to a list, each element is expected to equal one of:
+
+- 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 beginningg 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 "Body has long lines"
+                             subtree-has-long-lines)
+                      (const :tag "Body 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: 44 bytes --]


Here is a file used to test this feature:


[-- Attachment #4: test.outline --]
[-- Type: text/plain, Size: 2596 bytes --]

# -*- mode: outline; -*-

Help to test implementation of outline default state.

* Heading 1

Preambule

** Heading with long lines 1.1

With looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong line

** Heading 1.2

Some text

** Heading 1.3

A first paragraph followed by a second paragraph but with less
interesting text.

To be discussed.

** Heading with not so long line 1.4

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa	

* Heading 2

Preamble to a heading with many lines.

** Heading with many lines 2.1

Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines
Many lines

** Heading 2.2
Many lines
* Heading 3

Preamble

** Heading matching regex 3.1 TOHIDE

Hidden body

*** Heading 3.1.1

Body of hidden parent

**** Heading 3.1.1.1

*** Heading 3.1.2

Still in a hidden parent

* Heading 4

Last body
and nothing
else but those three lines

# Local Variables:
# outline-default-state: 2
# outline-default-state-subtree-visibility: ((match-regexp . "TOHIDE") subtree-has-long-lines subtree-is-long)
# outline-long-line-threshold: 200
# outline-line-count-threshold: 100
# End:

[-- Attachment #5: Type: text/plain, Size: 174 bytes --]


There's a bug when used with diff-mode (where `outline-level' returns
unexpected values), the starting point of that thread! I'll try to study
this in the forthcoming days.

  parent reply	other threads:[~2021-12-26 16:05 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 [this message]
2021-12-26 16:21                     ` Eli Zaretskii
2021-12-26 19:19                       ` Matthias Meulien
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=87r19zs662.fsf@gmail.com \
    --to=orontee@gmail.com \
    --cc=51809@debbugs.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).