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: Sat, 13 Nov 2021 22:27:52 +0100	[thread overview]
Message-ID: <87wnlbwxt3.fsf@gmail.com> (raw)
In-Reply-To: <86k0hbam7r.fsf@mail.linkov.net> (Juri Linkov's message of "Sat,  13 Nov 2021 21:29:12 +0200")

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

Juri Linkov <juri@linkov.net> writes:

Thanks for your comments!

>> +(autoload 'outline-minor-mode "outline")
>
> Actually, outline-minor-mode is already autoloaded, so no special
> handling is needed for it.

Ok, I'll improve this.

> But the problem is that too many outline functions are used in
> diff-mode.el in your patch.  This is a clear indication that
> some part should be moved to outline.el.

You're right. 

> Note that the following function has no diff-specific code, so it could
> be refactored and some generalized function added to outline.el.  Such
> function could be like `outline-map-region' to accept arguments `beg', `end'
> and a predicate function that defines whether to hide or show the
> body.

Ok. I'll make a try.

In the meantime, here is a new version that implements both:

- Outline based on presence of long lines (using `so-long-detected-long-line-p'
predicate)

- Outline based on file names matching a regexp (well, truly file
  heading matching a regexp).


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Support-for-outline-default-state-in-Diff-buffers.patch --]
[-- Type: text/x-diff, Size: 8868 bytes --]

From a571efeb5f90e42d1c86e0bef8fe0ebba819914c Mon Sep 17 00:00:00 2001
From: Matthias Meulien <orontee@gmail.com>
Date: Sat, 13 Nov 2021 12:08:58 +0100
Subject: [PATCH] Support for outline default state in Diff buffers

* lisp/vc/diff-mode.el (diff-outline-default-state): Add custom
variable that defines an outline state and apply that state in Diff
buffers.
---
 lisp/vc/diff-mode.el | 166 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 164 insertions(+), 2 deletions(-)

diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index e68aa2257d..578e80b4e2 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -50,7 +50,11 @@
 ;;
 ;; - in diff-apply-hunk, strip context in replace-match to better
 ;;   preserve markers and spacing.
+;;
 ;; - Handle `diff -b' output in context->unified.
+;;
+;; - Support outlining files by name (eg to skip automatically
+;;   generated files like package-lock.json in Javascript projects).
 
 ;;; Code:
 (eval-when-compile (require 'cl-lib))
@@ -62,6 +66,15 @@
 (defvar vc-find-revision-no-save)
 (defvar add-log-buffer-file-name-function)
 
+(eval-when-compile (require 'outline))
+(autoload 'outline-minor-mode "outline")
+(defvar outline-minor-mode)
+
+(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)
 
 (defgroup diff-mode ()
   "Major mode for viewing/editing diffs."
@@ -147,6 +160,61 @@ diff-font-lock-syntax
                  (const :tag "Highlight syntax" t)
                  (const :tag "Allow hunk-based fallback" hunk-also)))
 
+(defcustom diff-outline-default-state nil
+  "If non-nil, some files or hunk are outlined.
+Outlining is performed by Outline minor mode.
+
+If equal to `outline-hunks', only file and hunk headings are
+visibles.
+
+If equal to a lambda function or function name, this function is
+expected to toggle file or hunks visibility, and will be called
+after the mode is enabled.
+
+If equal to a list of symbols, hunk headings will be outlined
+depending on the conditions defined for each symbol:
+
+- If `line-count-threshold', when hunks under a given file
+  heading cover more than `diff-outline-line-count-threshold'
+  lines, they are outlined;
+
+- If `file-heading-regexp', file headings which match the regexp
+  `diff-outline-file-heading-regexp' are outlined;
+
+- If `long-line-threshold', when a hunk under a given file
+  heading have a line with more than
+  `diff-outline-long-line-threshold' characters, all hunks for
+  that file heading are outlined."
+  :version "29.1"
+  :type '(choice (const :tag "Don't outline " nil)
+                 (const :tag "Outline hunks" outline-hunks)
+                 (set :tag "Outline some files"
+                      (const
+                       :tag "Outline files with long hunks"
+                       line-count-threshold)
+                      (const
+                       :tag "Outline files by name"
+                       file-heading-regexp)
+                      (const
+                       :tag "Outline files whose hunks involve long lines"
+                       long-line-threshold))
+                 (function :tag "Custom function")))
+
+(defcustom diff-outline-line-count-threshold 50
+  "Minimal number of lines of hunks for a file to be outlined."
+  :version "29.1"
+  :type '(natnum :tag "Number of lines"))
+
+(defcustom diff-outline-file-heading-regexp "ChangeLog\\|package-lock\\.json"
+  "Regexp to match file headings to be outlined."
+  :version "29.1"
+  :type '(regexp :tag "Files to outline"))
+
+(defcustom diff-outline-long-line-threshold 1000
+  "Minimal number of characters in a line for a file to be outlined."
+  :version "29.1"
+  :type '(natnum :tag "Number of lines"))
+
 (defvar diff-vc-backend nil
   "The VC backend that created the current Diff buffer, if any.")
 
@@ -1578,7 +1646,8 @@ diff-setup-whitespace
 
 (defun diff-setup-buffer-type ()
   "Try to guess the `diff-buffer-type' from content of current Diff mode buffer.
-`outline-regexp' is updated accordingly."
+`outline-regexp' is updated accordingly and outline default state
+applied."
   (save-excursion
     (goto-char (point-min))
     (setq-local diff-buffer-type
@@ -1589,7 +1658,8 @@ diff-setup-buffer-type
     (setq diff-outline-regexp
           (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)"))
     (setq-local outline-level #'diff--outline-level))
-  (setq-local outline-regexp diff-outline-regexp))
+  (setq-local outline-regexp diff-outline-regexp)
+  (diff-outline-apply-default-state))
 
 (defun diff-delete-if-empty ()
   ;; An empty diff file means there's no more diffs to integrate, so we
@@ -2143,6 +2213,98 @@ diff-refresh-hunk
       (delete-file file1)
       (delete-file file2))))
 
+(defun diff-outline-apply-default-state ()
+  "Apply the outline state defined by `diff-outline-default-state'.
+
+When `diff-outline-default-state' is non-nil, Outline minor mode
+is enabled."
+  (when diff-outline-default-state
+    (when (not outline-minor-mode)
+      (outline-minor-mode))
+    (cond
+     ((eq diff-outline-default-state 'outline-hunks)
+      (outline-hide-body))
+     ((listp diff-outline-default-state)
+      (diff--outline-apply-default-state))
+     ((when (functionp diff-outline-default-state)
+        (funcall diff-outline-default-state))))))
+
+(defun diff--outline-apply-default-state ()
+  "Outline file or hunks according to `diff-outline-default-state'.
+
+See `diff-outline-default-state' for details.
+
+Inspired by `outline-hide-sublevels'."
+  (interactive)
+  (when outline-minor-mode
+    (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)))))
+	(if (< end beg)
+            (setq beg (prog1 end (setq end beg))))
+	;; First hide sublevels
+	(outline-hide-sublevels 1)
+	;; Then unhide short subtrees
+	(outline-map-region
+	 (lambda ()
+           (when (= (funcall outline-level) 1)
+             (goto-char (match-end 0))
+             (let ((overlays (overlays-at (point))))
+               (while overlays
+		 (let ((overlay (car overlays)))
+		   (progn
+                     (when (eq (overlay-get overlay 'invisible) 'outline)
+                       (goto-char (match-beginning 0))
+                       (cond
+                        ((and
+                          (memq 'file-heading-regexp
+                                diff-outline-default-state)
+                          ;; hide entry when file heading match
+                          ;; `diff-outline-file-heading-regexp'
+                          (message (concat "trying regexp on " (match-string 0)))
+                          (string-match-p
+                           diff-outline-file-heading-regexp
+                           (match-string 0)))
+                         (outline-hide-entry))
+
+                        ((and
+                          (memq 'line-count-threshold
+                                diff-outline-default-state)
+                          ;; show only branches when line count >
+                          ;; threshold
+                          (let ((line-count (count-lines
+                                             (overlay-end overlay)
+                                             (overlay-start overlay))))
+			    (< diff-outline-line-count-threshold line-count)))
+                         (outline-show-branches))
+
+                        ((and
+                          (memq 'long-line-threshold
+                                diff-outline-default-state)
+                          ;; show only branches when a long line is
+                          ;; detected
+                          (save-restriction
+                            (narrow-to-region (overlay-start overlay)
+                                              (overlay-end overlay))
+                            (let ((so-long-skip-leading-comments nil)
+                                  (so-long-threshold
+                                   diff-outline-long-line-threshold)
+                                  (so-long-max-lines nil))
+                              (so-long-detected-long-line-p))))
+                         (outline-show-branches))
+
+                        (t (outline-show-subtree))))
+                     (setq overlays (cdr overlays))))))))
+	 beg end)))))
+
 ;;; Fine change highlighting.
 
 (defface diff-refine-changed
-- 
2.30.2


[-- Attachment #3: Type: text/plain, Size: 14 bytes --]


-- 
Matthias

  reply	other threads:[~2021-11-13 21:27 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 [this message]
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
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=87wnlbwxt3.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).