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, 14 Nov 2021 00:29:13 +0100 [thread overview]
Message-ID: <878rxrmy7q.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: 54 bytes --]
Updated patch that takes Juri comments into account.
[-- 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: 9068 bytes --]
From 4a9f53e73dcbcd77df339bca012ee72aec343f18 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/outline.el (outline-map-sublevel-overlay):
* lisp/vc/diff-mode.el (diff-outline-default-state): Variable that
defines an outline state.
(diff-outline-apply-default-state)
(diff--outline-set-file-heading-visibility): Apply outline state
defined in `diff-outline-default-state'.
---
lisp/outline.el | 40 ++++++++++++++
lisp/vc/diff-mode.el | 128 ++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 166 insertions(+), 2 deletions(-)
diff --git a/lisp/outline.el b/lisp/outline.el
index cefb811703..77de31f785 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -1100,6 +1100,46 @@ outline-hide-sublevels
(define-obsolete-function-alias 'hide-sublevels #'outline-hide-sublevels "25.1")
+(defun outline-map-sublevel-overlay (level fun)
+ "Hide everything and call FUN on the LEVEL sublevels of headers .
+
+When FUN is called, point is at the beginning of the heading, the
+match data is set appropriately, and FUN receives one argument,
+the outline overlay for the heading entry.
+
+This also unhides the top heading-less body, if any."
+ (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)))))
+ (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 ()
+ (when (= (funcall outline-level) level)
+ (goto-char (match-end 0))
+ (let ((overlays (overlays-at (point))))
+ (while overlays
+ (let ((overlay (car overlays)))
+ (when (eq (overlay-get overlay 'invisible) 'outline)
+ (goto-char (match-beginning 0))
+ (funcall fun overlay))
+ (setq overlays (cdr overlays)))))))
+ beg end)))
+ (run-hooks 'outline-view-change-hook))
+
(defun outline-hide-other ()
"Hide everything except current body and parent and top-level headings.
This also unhides the top heading-less body, if any."
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index e68aa2257d..9617e6ceee 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -50,6 +50,7 @@
;;
;; - in diff-apply-hunk, strip context in replace-match to better
;; preserve markers and spacing.
+;;
;; - Handle `diff -b' output in context->unified.
;;; Code:
@@ -62,6 +63,18 @@
(defvar vc-find-revision-no-save)
(defvar add-log-buffer-file-name-function)
+(eval-when-compile (require 'outline))
+(defvar outline-minor-mode)
+(declare-function outline-minor-mode "outline" (&optional args))
+(declare-function outline-hide-entry "outline")
+(declare-function outline-show-branches "outline")
+(declare-function outline-show-subtree "outline" (&optional event))
+
+(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,60 @@ 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."
+ (interactive)
+ (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)
+ (outline-map-sublevel-overlay
+ 1 #'diff--outline-set-file-heading-visibility))
+ ((when (functionp diff-outline-default-state)
+ (funcall diff-outline-default-state))))))
+
+(defun diff--outline-set-file-heading-visibility (overlay)
+ (cond
+ ;; hide entry when file heading match
+ ;; `diff-outline-file-heading-regexp'
+ ((and
+ (memq 'file-heading-regexp
+ diff-outline-default-state)
+ (string-match-p
+ diff-outline-file-heading-regexp
+ (match-string 0)))
+ (outline-hide-entry))
+ ;; show only branches when line count > threshold
+ ((and
+ (memq 'line-count-threshold
+ diff-outline-default-state)
+ (let ((line-count (count-lines
+ (overlay-end overlay)
+ (overlay-start overlay))))
+ (< diff-outline-line-count-threshold line-count)))
+ (outline-show-branches))
+ ;; show only branches when a long line is detected
+ ((and
+ (memq 'long-line-threshold
+ diff-outline-default-state)
+ (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))
+ ;; otherwise show subtree
+ (t (outline-show-subtree))))
+
;;; Fine change highlighting.
(defface diff-refine-changed
--
2.30.2
[-- Attachment #3: Type: text/plain, Size: 14 bytes --]
--
Matthias
next prev parent reply other threads:[~2021-11-13 23:29 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 [this message]
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=878rxrmy7q.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).