+++ /dev/null
-;;; gnus-article-treat-patch.el --- Highlight inline patches in articles
-;;
-;; Copyright © 2011-2019 Frank Terbeck <ft@bewatermyfriend.org>
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; This file is free software; you can redistribute it and/or modify it under
-;; the terms of the GNU General Public License as published by the Free Soft-
-;; ware Foundation; either version 3, or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful, but WITHOUT ANY
-;; WARRANTY without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-;; A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this file. If not, see <http://www.gnu.org/licenses/>.
-;;
-;;
-;;; Commentary:
-;;
-;; Gnus addon to beautify patch-like emails. This uses a "ft/" prefix for
-;; everything to avoid clashing with anything upstream. That prefix can be
-;; savely s,ft/,,'d - if this is to be submitted to the gnus developers.
-
-(require 'diff-mode)
-
-(add-hook 'gnus-part-display-hook 'ft/gnus-article-treat-patch)
-
-;; Colour handling and faces
-(defun ft/gnus-colour-line (use-face)
- "Set text overlay to `use-face' for the current line."
- (overlay-put (make-overlay (point-at-bol) (point-at-eol)) 'face use-face))
-
-(make-face 'ft/gnus-three-dashes)
-(set-face-attribute 'ft/gnus-three-dashes nil :foreground "brightblue")
-(make-face 'ft/gnus-scissors)
-(set-face-attribute 'ft/gnus-scissors nil :foreground "brown")
-(make-face 'ft/gnus-diff-index)
-(set-face-attribute 'ft/gnus-diff-index nil :foreground "brightmagenta")
-(make-face 'ft/gnus-diff-hunk)
-(set-face-attribute 'ft/gnus-diff-hunk nil :foreground "brightblue")
-(make-face 'ft/gnus-diff-equals)
-(set-face-attribute 'ft/gnus-diff-equals nil :foreground "brightmagenta")
-(make-face 'ft/gnus-commit-message)
-(set-face-attribute 'ft/gnus-commit-message nil :foreground "white")
-(make-face 'ft/gnus-diff-stat-file)
-(set-face-attribute 'ft/gnus-diff-stat-file nil :foreground "yellow")
-(make-face 'ft/gnus-diff-stat-bar)
-(set-face-attribute 'ft/gnus-diff-stat-bar nil :foreground "magenta")
-(make-face 'ft/gnus-diff-stat-num)
-(set-face-attribute 'ft/gnus-diff-stat-num nil :foreground "white")
-(make-face 'ft/gnus-diff-misc)
-(set-face-attribute 'ft/gnus-diff-misc nil :foreground "magenta")
-(make-face 'ft/gnus-commit-comment)
-(set-face-attribute 'ft/gnus-commit-comment nil :inherit 'default)
-(make-face 'ft/gnus-diff-header)
-(set-face-attribute 'ft/gnus-diff-header nil :inherit 'diff-header)
-(make-face 'ft/gnus-diff-add)
-(set-face-attribute 'ft/gnus-diff-add nil :inherit 'diff-added)
-(make-face 'ft/gnus-diff-remove)
-(set-face-attribute 'ft/gnus-diff-remove nil :inherit 'diff-removed)
-
-;; Pseudo-headers
-(defvar ft/gnus-article-patch-pseudo-headers
- '(("^Acked-by: " 'gnus-header-name 'gnus-header-from)
- ("^C\\(c\\|C\\): " 'gnus-header-name 'gnus-header-from)
- ("^From: " 'gnus-header-name 'gnus-header-from)
- ("^Link: " 'gnus-header-name 'gnus-header-from)
- ("^Reported-by: " 'gnus-header-name 'gnus-header-from)
- ("^Reviewed-by: " 'gnus-header-name 'gnus-header-from)
- ("^Signed-off-by: " 'gnus-header-name 'gnus-header-from)
- ("^Subject: " 'gnus-header-name 'gnus-header-from)
- ("^Suggested-by: " 'gnus-header-name 'gnus-header-from))
- "List of lists of regular expressions (with two face names)
-which are used to determine the highlighting of pseudo headers in
-the commit message (such as \"Signed-off-by:\").
-
-The first face if used to highlight the header's name; the second
-highlights the header's value.")
-
-(defun ft/gnus-pseudo-header-get (line)
- "Check if `line' is a pseudo header, and if so return its enty in
-`ft/gnus-article-patch-pseudo-headers'."
- (catch 'done
- (dolist (entry ft/gnus-article-patch-pseudo-headers)
- (let ((regex (car entry)))
- (if (string-match regex line)
- (throw 'done entry))))
- (throw 'done '())))
-
-(defun ft/gnus-pseudo-header-p (line)
- "Returns `t' if `line' looks like a pseudo-header; `nil' otherwise.
-
-`ft/gnus-article-patch-pseudo-headers' is used to determine what a pseudo-header
-is."
- (if (eq (ft/gnus-pseudo-header-get line) '()) nil t))
-
-(defun ft/gnus-pseudo-header-colour (line)
- "Colourise a pseudo-header line."
- (let ((data (ft/gnus-pseudo-header-get line)))
- (if (eq data '())
- nil
- (let* ((s (point-at-bol))
- (e (point-at-eol))
- (colon (re-search-forward ":"))
- (value (+ colon 1)))
- (overlay-put (make-overlay s colon) 'face (nth 1 data))
- (overlay-put (make-overlay value e) 'face (nth 2 data))))))
-
-;; diff-stat
-(defun ft/gnus-diff-stat-colour (line)
- "Colourise a diff-stat line."
- (let ((s (point-at-bol))
- (e (point-at-eol))
- (bar (- (re-search-forward "|") 1))
- (num (- (re-search-forward "[0-9]") 1))
- (pm (- (re-search-forward "\\([+-]\\|$\\)") 1)))
-
- (overlay-put (make-overlay s (- bar 1)) 'face 'ft/gnus-diff-stat-file)
- (overlay-put (make-overlay bar (+ bar 1)) 'face 'ft/gnus-diff-stat-bar)
- (overlay-put (make-overlay num pm) 'face 'ft/gnus-diff-stat-num)
-
- (goto-char pm)
- (let* ((plus (looking-at "\\+"))
- (regex (if plus "-+" "\\++"))
- (brk (if plus
- (re-search-forward "-" e t)
- (re-search-forward "\\+" e t)))
- (first-face (if plus 'ft/gnus-diff-add 'ft/gnus-diff-remove))
- (second-face (if plus 'ft/gnus-diff-remove 'ft/gnus-diff-add)))
-
- (if (eq brk nil)
- (overlay-put (make-overlay pm e) 'face first-face)
- (progn
- (setq brk (- brk 1))
- (overlay-put (make-overlay pm brk) 'face first-face)
- (overlay-put (make-overlay brk e) 'face second-face))))))
-
-(defun ft/gnus-diff-stat-summary-colour (line)
- "Colourise a diff-stat summary-line."
- (let* ((e (point-at-eol))
- (plus (- (re-search-forward "(\\+)" e t) 2))
- (minus (- (re-search-forward "(-)" e t) 2)))
- (overlay-put (make-overlay plus (+ plus 1)) 'face 'ft/gnus-diff-add)
- (overlay-put (make-overlay minus (+ minus 1)) 'face 'ft/gnus-diff-remove)))
-
-(defun ft/gnus-diff-stat-line-p (line)
- "Return `t' if `line' is a diff-stat line; `nil' otherwise."
- (string-match "^ *[^ ]+[^|]+| +[0-9]+\\( *\\| +[+-]+\\)$" line))
-
-(defun ft/gnus-diff-stat-summary-p (line)
- "Return `t' if `line' is a diff-stat summary-line; `nil' otherwise."
- (string-match "^ *[0-9]+ file\\(s\\|\\) changed,.*insertion.*deletion" line))
-
-;; unified-diffs
-(defun ft/gnus-diff-header-p (line)
- "Returns `t' if `line' looks like a diff-header; `nil' otherwise."
- (cond
- ((string-match "^\\(\\+\\+\\+\\|---\\) " line) t)
- ((string-match "^diff -" line) t)
- (t nil)))
-
-(defun ft/gnus-index-line-p (line)
- "Returns `t' if `line' looks like an index-line; `nil' otherwise."
- (cond
- ((string-match "^Index: " line) t)
- ((string-match "^index [0-9a-f]+\\.\\.[0-9a-f]+" line) t)
- (t nil)))
-
-(defun ft/gnus-hunk-line-p (line)
- "Returns `t' if `line' looks like a hunk-line; `nil' otherwise."
- (string-match "^@@ -[0-9]+,[0-9]+ \\+[0-9]+,[0-9]+ @@" line))
-
-(defun ft/gnus-atp-misc-diff-p (line)
- "Return `t' if `line' is a \"misc line\" with respect to patch
-treatment; `nil' otherwise."
- (let ((patterns '("^new file"
- "^RCS file:"
- "^retrieving revision ")))
- (catch 'done
- (dolist (regex patterns)
- (if (string-match regex line)
- (throw 'done t)))
- (throw 'done nil))))
-
-(defun ft/gnus-atp-looks-like-diff (line)
- "Return `t' if `line' looks remotely like a line from a unified
-diff; `nil' otherwise."
- (or (ft/gnus-index-line-p line)
- (ft/gnus-diff-header-p line)
- (ft/gnus-hunk-line-p line)))
-
-;; miscellaneous line handlers
-(defun ft/gnus-scissors-line-p (line)
- "Returns `t' if `line' looks like a scissors-line; `nil' otherwise."
- (cond
- ((string-match "^\\( *--* *\\(8<\\|>8\\)\\)+ *-* *$" line) t)
- (t nil)))
-
-;; Patch mail detection
-(defvar ft/gnus-article-patch-conditions nil
- "List of conditions that will enable patch treatment. String
-values will be matched as regular expressions within the currently
-processed part. Non-string value are supposed to be code fragments,
-which determine whether or not to do treatment: The code needs to
-return `t' if treatment is wanted.")
-
-(defun ft/gnus-part-want-patch-treatment ()
- "Run through `ft/gnus-article-patch-conditions' to determine whether
-patch treatment is wanted or not. Return `t' or `nil' accordingly."
- (catch 'done
- (dolist (entry ft/gnus-article-patch-conditions)
- (cond
- ((stringp entry)
- (if (re-search-forward entry nil t)
- (throw 'done t)))
- (t
- (if (eval entry)
- (throw 'done t)))))
- (throw 'done nil)))
-
-
-;; The actual article treatment code
-(defun ft/gnus-article-treat-patch-state-machine ()
- "Implement the state machine which colourises a part of an article
-if it looks patch-like.
-
-The state machine works like this:
-
- 0a. The machinery starts at the first line of the article's body. Not
- the header lines. We don't care about header lines at all.
-
- 0b. The whole thing works line by line. It doesn't do any forward or
- backward looks.
-
- 1. Initially, we assume, that what we'll see first is part of the
- patch's commit-message. Hence this first initial state is
- \"commit-message\". There are several ways out of this state:
-
- a) a scissors line is found (see 2.)
- b) a pseudo-header line is found (see 3.)
- c) a three-dashes line is found (see 4.)
- d) something that looks like the start of a unified diff is
- found (see 7.)
-
- 2. A scissors line is something that looks like a pair of scissors running
- through a piece of paper. Like this:
-
- ------ 8< ----- 8< ------
-
- or this:
-
- ------------>8-----------
-
- The function `ft/gnus-scissors-line-p' decides whether a line is a
- scissors line or not. After a scissors line was treated, the machine
- will switch back to the \"commit-mesage\" state.
-
- 3. This is very similar to a scissors line. It'll just return to the old
- state after its being done. The `ft/gnus-pseudo-header-p' function
- decides if a line is a pseudo header. The line will be appropriately
- coloured.
-
- 4. A three-dashes line is a line that looks like this: \"---\". It's the
- definite end of the \"commit-message\" state. The three dashes line is
- coloured and the state switches to \"commit-comment\". (See 5.)
-
- 5. Nothing in \"commit-comment\" will appear in the generated commit (this
- is git-am specific semantics, but it's useful, so...). It may contain
- things like random comments or - promimently - a diff stat. (See 6.)
-
- 6. A diff stat provides statistics about how much changed in a given commit
- by files and by whole commit (in a summary line). Two functions
- `ft/gnus-diff-stat-line-p' and `ft/gnus-diff-stat-summary-p' decide if a
- line belongs to a diff stat. It's coloured appropriately and the state
- switches back to \"commit-comment\".
-
- 7. There is a function `ft/gnus-unified-diff-line-p' which will cause the
- state to switch to \"unified-diff\" state from either \"commit-message\"
- or \"commit-comment\". In this mode there can be a set of lines types:
-
- a) diff-header lines (`ft/gnus-diff-header-p')
- b) index lines (`ft/gnus-index-line-p')
- c) hunk lines (`ft/gnus-hunk-line-p')
- d) equals line (\"^==*$\")
- e) context lines (\"^ \")
- f) add lines (\"^\\+\")
- g) remove lines (\"^-\")
- h) empty lines (\"^$\")
-
- This state runs until the end of the part."
- (catch 'ft/gnus-atp-done
- (let ((state 'commit-message)
- line do-not-move)
-
- (while t
- ;; Put the current line into an easy-to-handle string variable.
- (setq line
- (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
- (setq do-not-move nil)
-
- ;; Switched state machine. The "real" states are `commit-message',
- ;; `commit-comment' and `unified-diff'. The other "states" are only
- ;; single-line colourisations that return to their respective parent-
- ;; state. Each state may (throw 'ft/gnus-atp-done) to leave the state-
- ;; machine immediately.
- (setq state
- (cond
-
- ((eq state 'commit-message)
- (cond
- ((ft/gnus-scissors-line-p line)
- (ft/gnus-colour-line 'ft/gnus-scissors)
- 'commit-message)
- ((ft/gnus-pseudo-header-p line)
- (ft/gnus-pseudo-header-colour line)
- 'commit-message)
- ((string= line "---")
- (ft/gnus-colour-line 'ft/gnus-three-dashes)
- 'commit-comment)
- ((ft/gnus-atp-looks-like-diff line)
- (setq do-not-move t)
- 'unified-diff)
- (t
- (ft/gnus-colour-line 'ft/gnus-commit-message)
- 'commit-message)))
-
- ((eq state 'commit-comment)
- (cond
- ((ft/gnus-diff-stat-line-p line)
- (ft/gnus-diff-stat-colour line)
- 'commit-comment)
- ((ft/gnus-diff-stat-summary-p line)
- (ft/gnus-diff-stat-summary-colour line)
- 'commit-comment)
- ((ft/gnus-atp-looks-like-diff line)
- (setq do-not-move t)
- 'unified-diff)
- (t
- (ft/gnus-colour-line 'ft/gnus-commit-comment)
- 'commit-comment)))
-
- ((eq state 'unified-diff)
- (cond
- ((ft/gnus-diff-header-p line)
- (ft/gnus-colour-line 'ft/gnus-diff-header)
- 'unified-diff)
- ((ft/gnus-index-line-p line)
- (ft/gnus-colour-line 'ft/gnus-diff-index)
- 'unified-diff)
- ((ft/gnus-hunk-line-p line)
- (ft/gnus-colour-line 'ft/gnus-diff-hunk)
- 'unified-diff)
- ((string-match "^==*$" line)
- (ft/gnus-colour-line 'ft/gnus-diff-equals)
- 'unified-diff)
- ((string-match "^$" line)
- 'unified-diff)
- ((string-match "^ " line)
- (ft/gnus-colour-line 'ft/gnus-diff-context)
- 'unified-diff)
- ((ft/gnus-atp-misc-diff-p line)
- (ft/gnus-colour-line 'ft/gnus-diff-misc)
- 'unified-diff)
- ((string-match "^\\+" line)
- (ft/gnus-colour-line 'ft/gnus-diff-add)
- 'unified-diff)
- ((string-match "^-" line)
- (ft/gnus-colour-line 'ft/gnus-diff-remove)
- 'unified-diff)
- (t 'unified-diff)))))
-
- (if (not do-not-move)
- (if (> (forward-line) 0)
- (throw 'ft/gnus-atp-done t)))))))
-
-(defun ft/gnus-article-treat-patch ()
- "Highlight mail parts, that look like patches (well, usually
-they *are* patches - or possibly, when you take git's format-patch output,
-entire commit exports - including comments). This treatment assumes the
-use of unified diffs. Here is how it works:
-
-The most fancy type of patch mails look like this:
-
- From: ...
- Subject: ...
- Other-Headers: ...
-
- Body text, which can be reflecting the commit message but may
- optionally be followed by a so called scissors line, which
- looks like this (in case of a scissors line, the text above is
- not part of the commit message):
-
- -------8<----------
-
- If there really was a scissors line, then it's usually
- followed by repeated mail-headers. Which do not *have* to
- be the same as the one from the sender.
-
- From: ...
- Subject: ...
-
- More text. Usually part of the commit message. Likely
- multiline. What follows may be an optional diffstat. If
- there is one, it's usually preceded by a line that contains
- only three dashes and nothing more. Before the diffstat,
- however, there may be a set of pseudo headers again, like
- these:
-
- Acked-by: Mike Dev <md@other.tld>
- Signed-off-by: Joe D. User <jdu@example.com>
-
- ---
- ChangeLog | 5 ++++-
- 1 file changed, 4 insertions(+), 1 deletions(-)
-
- Now, there is again room for optional text, which is not
- part of the actual commit message. May be multiline. Actually,
- anything between the three-dashes line and the diff content
- is ignored as far as the commit message goes.
-
- Now for the actual diff part. I want this to work for as
- many unified diff formats as possible. What comes to mind
- is the format used by git and the format used by cvs and
- quilt.
-
- CVS style looks like this:
-
- Index: foo/bar.c
- ============================================================
- --- boo.orig/foo/bar.c 2010-02-24 ....
- +++ boo/foo/bar.c 2010-02-28 ....
- @@ -1823,7 +1823,7 @@
- <hunk>
-
- There may be multiple hunks. Each file gets an \"Index:\" and
- equals line. Now the git format looks like this:
-
- diff --git a/ChangeLog b/ChangeLog
- index 6ffbc8c..36e5c17 100644
- --- a/ChangeLog
- +++ b/ChangeLog
- @@ -3,6 +3,9 @@
- <hunk>
-
- Again, there may be multiple hunks.
-
- When all hunks and all files are done, there may be additional
- text below the actual text.
-
-And that's it.
-
-You may define the look of several things: pseudo headers, scissor
-lines, three-dashes-line, equals lines, diffstat lines, diffstat
-summary. Then there is added lines, removed lines, context lines,
-diff-header lines and diff-file-header lines, for which we are
-borrowing the highlighting faces for from `diff-mode'."
- (if (ft/gnus-part-want-patch-treatment)
- (save-excursion
- (progn
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (ft/gnus-article-treat-patch-state-machine))))))
-
-(provide 'gnus-article-treat-patch)
projects / ~bandali / configs / commitdiff