bug#51809: 29.0.50; [PATCH] Support for outline default state in Diff buffers

[Matthias Meulien <orontee@gmail.com>]

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


Hi,

Attached is a patch that adds support for an outline default state in
Diff buffers.

One state makes only files and hunks headings visibles. Another one
outlines files with long hunks. A third value is proposed for users who
want to implement their own state.

My point is that, when I first review a changeset, I am trying to get an
overview of the changes; And files cumulating long hunks often don't
help for that matter.

Tell me if it's worth including in Emacs 29.


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

From f698c22bffd8cd5dd5c98a86f0e143c4e184b4dc 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 | 92 +++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 90 insertions(+), 2 deletions(-)

diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index e68aa2257d..01ea1c3994 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))
@@ -147,6 +151,27 @@ 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 `hide-body', only file and hunk headings are visible.
+
+If `size-threshold', files whose hunks cover more than
+`diff-file-outline-threshold' lines are outlined."
+  :version "29.1"
+  :type '(choice (const :tag "Don't outline " nil)
+                 (const :tag "Outline hunks" hide-body)
+                 (const :tag "Outline files with long hunks" size-threshold)
+                 (function :tag "Custom function")))
+
+(defcustom diff-file-outline-threshold 50
+  "Number of lines of hunks for a file to be outlined.
+
+Used by `diff-outline-file-according-to-size'."
+  :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 +1603,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 +1615,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 +2170,67 @@ 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 'size-threshold)
+      (diff-outline-file-according-to-size))
+     ((eq diff-outline-default-state 'hide-body)
+      (outline-hide-body))
+     ((when (functionp diff-outline-default-state)
+        (funcall diff-outline-default-state))))))
+
+(defun diff-outline-file-according-to-size ()
+  "Outline file with long hunks.
+
+A file is outlined when its hunks cover more than
+`diff-file-outline-threshold' lines. Does nothing when Outline
+minor mode is not enabled or `diff-file-outline-threshold'.
+
+Inspired by `outline-hide-sublevels'."
+  (interactive)
+  (when (and outline-minor-mode diff-file-outline-threshold)
+    (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)
+                       (let ((size (count-lines
+                                    (overlay-end overlay)
+                                    (overlay-start overlay))))
+                         (goto-char (match-beginning 0))
+			 (if (< size diff-file-outline-threshold)
+			     (outline-show-subtree)
+                           (outline-show-branches))))
+                     (setq overlays (cdr overlays))))))))
+	 beg end)))))
+
 ;;; Fine change highlighting.
 
 (defface diff-refine-changed
-- 
2.30.2


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




In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.24, cairo version 1.16.0)
 of 2021-11-13 built on carbon
Repository revision: f698c22bffd8cd5dd5c98a86f0e143c4e184b4dc
Repository branch: dev/mm
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Debian GNU/Linux 11 (bullseye)

Configured using:
 'configure --with-native-compilation'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBXML2 M17N_FLT MODULES NATIVE_COMP NOTIFY
INOTIFY PDUMPER PNG RSVG SECCOMP SOUND THREADS TIFF TOOLKIT_SCROLL_BARS
X11 XDBE XIM XPM GTK3 ZLIB

Important settings:
  value of $LANG: fr_FR.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: VC dir

Minor modes in effect:
  highlight-changes-visible-mode: t
  shell-dirtrack-mode: t
  minions-mode: t
  desktop-save-mode: t
  save-place-mode: t
  electric-pair-mode: t
  icomplete-mode: t
  global-so-long-mode: t
  global-auto-revert-mode: t
  auto-insert-mode: t
  text-scale-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  show-paren-mode: t
  electric-layout-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tab-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  window-divider-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  buffer-read-only: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t

Load-path shadows:
/home/matthias/.config/emacs/elpa/transient-20211029.1405/transient hides /usr/local/share/emacs/29.0.50/lisp/transient
/home/matthias/.config/emacs/elpa/dictionary-20201001.1727/dictionary hides /usr/local/share/emacs/29.0.50/lisp/net/dictionary

Features:
(shadow flow-fill nndoc gnus-dup url-cache crm debbugs-gnu debbugs
soap-client url-http url-auth url-gw rng-xsd xsd-regexp misearch
multi-isearch emacsbug sendmail mm-archive qp gnus-fun sort smiley
gnus-cite mail-extr gnus-async gnus-bcklg follow gnus-ml disp-table
novice gnus-topic nndraft nnmh nnfolder utf-7 reftex-dcr reftex
reftex-loaddefs reftex-vars tex-mode tramp-archive tramp-gvfs
tramp-cache zeroconf tramp tramp-loaddefs trampver tramp-integration
files-x tramp-compat ls-lisp epa-file gnutls network-stream nsm
gnus-agent gnus-srvr gnus-score score-mode nnvirtual gnus-msg gnus-cache
hl-line add-log smerge-mode diff flyspell ox-odt rng-loc rng-uri
rng-parse rng-match rng-dt rng-util rng-pttrn nxml-parse nxml-ns
nxml-enc xmltok nxml-util ox-latex ox-icalendar org-agenda ox-html table
ox-ascii ox-publish ox goto-addr org-element avl-tree generator ol-eww
eww xdg url-queue mm-url ol-rmail ol-mhe ol-irc ol-info ol-gnus nnselect
gnus-search eieio-opt speedbar ezimage dframe gnus-art mm-uu mml2015
mm-view mml-smime smime dig gnus-sum shr kinsoku svg dom ol-docview
doc-view image-mode exif ol-bibtex ol-bbdb ol-w3m ol-doi org-link-doi
mule-util jka-compr dired-aux bug-reference display-line-numbers
hilit-chg vc-dir whitespace vc-mtn vc-hg vc-bzr vc-src vc-sccs vc-svn
vc-cvs vc-rcs vc bash-completion shell eglot array jsonrpc ert ewoc
debug backtrace xref flymake-proc flymake compile pcase project imenu
avoid minions carbon-custom cus-edit cus-load gnus-demon nntp gnus-group
gnus-undo gnus-start gnus-dbus dbus xml gnus-cloud nnimap nnmail
mail-source utf7 netrc parse-time gnus-spec gnus-win nnoo gnus-int
gnus-range message yank-media rmc puny rfc822 mml mml-sec epa derived
epg rfc6068 epg-config mm-decode mm-bodies mm-encode mail-parse rfc2231
mailabbrev gmm-utils mailheader gnus nnheader gnus-util rmail
rmail-loaddefs rfc2047 rfc2045 ietf-drums mail-utils mm-util mail-prsvr
wid-edit gnus-dired dired-x dired dired-loaddefs org-capture org-refile
org ob ob-tangle ob-ref ob-lob ob-table ob-exp org-macro org-footnote
org-src ob-comint org-pcomplete pcomplete comint ansi-color ring
org-list org-faces org-entities org-version ob-emacs-lisp ob-core
ob-eval org-table oc-basic bibtex iso8601 time-date ol org-keys oc
org-compat org-macs org-loaddefs format-spec find-func cal-menu calendar
cal-loaddefs dictionary link connection advice markdown-mode
edit-indirect color thingatpt noutline outline skeleton find-file vc-git
diff-mode easy-mmode vc-dispatcher ispell desktop frameset server
bookmark text-property-search pp saveplace elec-pair icomplete so-long
autorevert filenotify autoinsert cc-mode cc-fonts cc-guess cc-menus
cc-cmds cc-styles cc-align cc-engine cc-vars cc-defs generic-x
face-remap proof-site proof-autoloads info package browse-url url
url-proxy url-privacy url-expand url-methods url-history url-cookie
url-domsuf url-util mailcap url-handlers url-parse auth-source eieio
eieio-core eieio-loaddefs password-cache json map url-vars comp
comp-cstr warnings rx cl-seq cl-macs cl-extra help-mode seq gv subr-x
byte-opt bytecomp byte-compile cconv cl-loaddefs cl-lib iso-transl
tooltip eldoc paren electric uniquify ediff-hook vc-hooks
lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd
tool-bar dnd fontset image regexp-opt fringe tabulated-list replace
newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar
rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock
font-lock syntax font-core term/tty-colors frame minibuffer cl-generic
cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao
korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech
european ethiopic indian cyrillic chinese composite emoji-zwj charscript
charprop case-table epa-hook jka-cmpr-hook help simple abbrev obarray
cl-preloaded nadvice button loaddefs faces cus-face macroexp files
window text-properties overlay sha1 md5 base64 format env code-pages
mule custom widget hashtable-print-readable backquote threads dbusbind
inotify lcms2 dynamic-setting system-font-setting font-render-setting
cairo move-toolbar gtk x-toolkit x multi-tty make-network-process
native-compile emacs)

Memory information:
((conses 16 1000739 201421)
 (symbols 48 39721 27)
 (strings 32 228421 52284)
 (string-bytes 1 7452737)
 (vectors 16 85442)
 (vector-slots 8 1542974 101097)
 (floats 8 3167 1088)
 (intervals 56 22491 1885)
 (buffers 992 61))

-- 
Matthias