| 1 | ;; from http://bewatermyfriend.org/p/2011/00a/ |
| 2 | ;; https://www.0x50.de/fterbeck/emacs/blob/master/private/gnus-article-treat-patch.el |
| 3 | ;; https://github.com/orgcandman/emacs-plugins/blob/master/gnus-article-treat-patch.el |
| 4 | |
| 5 | ;; Gnus addon to beautify patch-like emails. This uses a "ft/" prefix for |
| 6 | ;; everything to avoid clashing with anything upstream. That prefix can be |
| 7 | ;; savely s,ft/,,'d - if this is to be submitted to the gnus developers. |
| 8 | |
| 9 | (require 'diff-mode) |
| 10 | |
| 11 | (add-hook 'gnus-part-display-hook 'ft/gnus-article-treat-patch) |
| 12 | |
| 13 | ;; Colour handling and faces |
| 14 | (defun ft/gnus-colour-line (use-face) |
| 15 | "Set text overlay to `use-face' for the current line." |
| 16 | (overlay-put (make-overlay (point-at-bol) (point-at-eol)) 'face use-face)) |
| 17 | |
| 18 | (make-face 'ft/gnus-three-dashes) |
| 19 | (set-face-attribute 'ft/gnus-three-dashes nil :foreground "brightblue") |
| 20 | (make-face 'ft/gnus-scissors) |
| 21 | (set-face-attribute 'ft/gnus-scissors nil :foreground "brown") |
| 22 | (make-face 'ft/gnus-diff-index) |
| 23 | (set-face-attribute 'ft/gnus-diff-index nil :foreground "brightmagenta") |
| 24 | (make-face 'ft/gnus-diff-hunk) |
| 25 | (set-face-attribute 'ft/gnus-diff-hunk nil :foreground "brightblue") |
| 26 | (make-face 'ft/gnus-diff-equals) |
| 27 | (set-face-attribute 'ft/gnus-diff-equals nil :foreground "brightmagenta") |
| 28 | (make-face 'ft/gnus-commit-message) |
| 29 | (set-face-attribute 'ft/gnus-commit-message nil :foreground "white") |
| 30 | (make-face 'ft/gnus-diff-stat-file) |
| 31 | (set-face-attribute 'ft/gnus-diff-stat-file nil :foreground "yellow") |
| 32 | (make-face 'ft/gnus-diff-stat-bar) |
| 33 | (set-face-attribute 'ft/gnus-diff-stat-bar nil :foreground "magenta") |
| 34 | (make-face 'ft/gnus-diff-stat-num) |
| 35 | (set-face-attribute 'ft/gnus-diff-stat-num nil :foreground "white") |
| 36 | (make-face 'ft/gnus-diff-misc) |
| 37 | (set-face-attribute 'ft/gnus-diff-misc nil :foreground "magenta") |
| 38 | (make-face 'ft/gnus-commit-comment) |
| 39 | (set-face-attribute 'ft/gnus-commit-comment nil :inherit 'default) |
| 40 | (make-face 'ft/gnus-diff-header) |
| 41 | (set-face-attribute 'ft/gnus-diff-header nil :inherit 'diff-header) |
| 42 | (make-face 'ft/gnus-diff-add) |
| 43 | (set-face-attribute 'ft/gnus-diff-add nil :inherit 'diff-added) |
| 44 | (make-face 'ft/gnus-diff-remove) |
| 45 | (set-face-attribute 'ft/gnus-diff-remove nil :inherit 'diff-removed) |
| 46 | |
| 47 | ;; Pseudo-headers |
| 48 | (defvar ft/gnus-article-patch-pseudo-headers |
| 49 | '(("^Acked-by: " 'gnus-header-name 'gnus-header-from) |
| 50 | ("^C\\(c\\|C\\): " 'gnus-header-name 'gnus-header-from) |
| 51 | ("^From: " 'gnus-header-name 'gnus-header-from) |
| 52 | ("^Link: " 'gnus-header-name 'gnus-header-from) |
| 53 | ("^Reported-by: " 'gnus-header-name 'gnus-header-from) |
| 54 | ("^Reviewed-by: " 'gnus-header-name 'gnus-header-from) |
| 55 | ("^Signed-off-by: " 'gnus-header-name 'gnus-header-from) |
| 56 | ("^Subject: " 'gnus-header-name 'gnus-header-from) |
| 57 | ("^Suggested-by: " 'gnus-header-name 'gnus-header-from)) |
| 58 | "List of lists of regular expressions (with two face names) |
| 59 | which are used to determine the highlighting of pseudo headers in |
| 60 | the commit message (such as \"Signed-off-by:\"). |
| 61 | |
| 62 | The first face if used to highlight the header's name; the second |
| 63 | highlights the header's value.") |
| 64 | |
| 65 | (defun ft/gnus-pseudo-header-get (line) |
| 66 | "Check if `line' is a pseudo header, and if so return its enty in |
| 67 | `ft/gnus-article-patch-pseudo-headers'." |
| 68 | (catch 'done |
| 69 | (dolist (entry ft/gnus-article-patch-pseudo-headers) |
| 70 | (let ((regex (car entry))) |
| 71 | (if (string-match regex line) |
| 72 | (throw 'done entry)))) |
| 73 | (throw 'done '()))) |
| 74 | |
| 75 | (defun ft/gnus-pseudo-header-p (line) |
| 76 | "Returns `t' if `line' looks like a pseudo-header; `nil' otherwise. |
| 77 | |
| 78 | `ft/gnus-article-patch-pseudo-headers' is used to determine what a pseudo-header |
| 79 | is." |
| 80 | (if (eq (ft/gnus-pseudo-header-get line) '()) nil t)) |
| 81 | |
| 82 | (defun ft/gnus-pseudo-header-colour (line) |
| 83 | "Colourise a pseudo-header line." |
| 84 | (let ((data (ft/gnus-pseudo-header-get line))) |
| 85 | (if (eq data '()) |
| 86 | nil |
| 87 | (let* ((s (point-at-bol)) |
| 88 | (e (point-at-eol)) |
| 89 | (colon (re-search-forward ":")) |
| 90 | (value (+ colon 1))) |
| 91 | (overlay-put (make-overlay s colon) 'face (nth 1 data)) |
| 92 | (overlay-put (make-overlay value e) 'face (nth 2 data)))))) |
| 93 | |
| 94 | ;; diff-stat |
| 95 | (defun ft/gnus-diff-stat-colour (line) |
| 96 | "Colourise a diff-stat line." |
| 97 | (let ((s (point-at-bol)) |
| 98 | (e (point-at-eol)) |
| 99 | (bar (- (re-search-forward "|") 1)) |
| 100 | (num (- (re-search-forward "[0-9]") 1)) |
| 101 | (pm (- (re-search-forward "\\([+-]\\|$\\)") 1))) |
| 102 | |
| 103 | (overlay-put (make-overlay s (- bar 1)) 'face 'ft/gnus-diff-stat-file) |
| 104 | (overlay-put (make-overlay bar (+ bar 1)) 'face 'ft/gnus-diff-stat-bar) |
| 105 | (overlay-put (make-overlay num pm) 'face 'ft/gnus-diff-stat-num) |
| 106 | |
| 107 | (goto-char pm) |
| 108 | (let* ((plus (looking-at "\\+")) |
| 109 | (regex (if plus "-+" "\\++")) |
| 110 | (brk (if plus |
| 111 | (re-search-forward "-" e t) |
| 112 | (re-search-forward "\\+" e t))) |
| 113 | (first-face (if plus 'ft/gnus-diff-add 'ft/gnus-diff-remove)) |
| 114 | (second-face (if plus 'ft/gnus-diff-remove 'ft/gnus-diff-add))) |
| 115 | |
| 116 | (if (eq brk nil) |
| 117 | (overlay-put (make-overlay pm e) 'face first-face) |
| 118 | (progn |
| 119 | (setq brk (- brk 1)) |
| 120 | (overlay-put (make-overlay pm brk) 'face first-face) |
| 121 | (overlay-put (make-overlay brk e) 'face second-face)))))) |
| 122 | |
| 123 | (defun ft/gnus-diff-stat-summary-colour (line) |
| 124 | "Colourise a diff-stat summary-line." |
| 125 | (let* ((e (point-at-eol)) |
| 126 | (plus (- (re-search-forward "(\\+)" e t) 2)) |
| 127 | (minus (- (re-search-forward "(-)" e t) 2))) |
| 128 | (overlay-put (make-overlay plus (+ plus 1)) 'face 'ft/gnus-diff-add) |
| 129 | (overlay-put (make-overlay minus (+ minus 1)) 'face 'ft/gnus-diff-remove))) |
| 130 | |
| 131 | (defun ft/gnus-diff-stat-line-p (line) |
| 132 | "Return `t' if `line' is a diff-stat line; `nil' otherwise." |
| 133 | (string-match "^ *[^ ]+[^|]+| +[0-9]+\\( *\\| +[+-]+\\)$" line)) |
| 134 | |
| 135 | (defun ft/gnus-diff-stat-summary-p (line) |
| 136 | "Return `t' if `line' is a diff-stat summary-line; `nil' otherwise." |
| 137 | (string-match "^ *[0-9]+ file\\(s\\|\\) changed,.*insertion.*deletion" line)) |
| 138 | |
| 139 | ;; unified-diffs |
| 140 | (defun ft/gnus-diff-header-p (line) |
| 141 | "Returns `t' if `line' looks like a diff-header; `nil' otherwise." |
| 142 | (cond |
| 143 | ((string-match "^\\(\\+\\+\\+\\|---\\) " line) t) |
| 144 | ((string-match "^diff -" line) t) |
| 145 | (t nil))) |
| 146 | |
| 147 | (defun ft/gnus-index-line-p (line) |
| 148 | "Returns `t' if `line' looks like an index-line; `nil' otherwise." |
| 149 | (cond |
| 150 | ((string-match "^Index: " line) t) |
| 151 | ((string-match "^index [0-9a-f]+\\.\\.[0-9a-f]+" line) t) |
| 152 | (t nil))) |
| 153 | |
| 154 | (defun ft/gnus-hunk-line-p (line) |
| 155 | "Returns `t' if `line' looks like a hunk-line; `nil' otherwise." |
| 156 | (string-match "^@@ -[0-9]+,[0-9]+ \\+[0-9]+,[0-9]+ @@" line)) |
| 157 | |
| 158 | (defun ft/gnus-atp-misc-diff-p (line) |
| 159 | "Return `t' if `line' is a \"misc line\" with respect to patch |
| 160 | treatment; `nil' otherwise." |
| 161 | (let ((patterns '("^new file" |
| 162 | "^RCS file:" |
| 163 | "^retrieving revision "))) |
| 164 | (catch 'done |
| 165 | (dolist (regex patterns) |
| 166 | (if (string-match regex line) |
| 167 | (throw 'done t))) |
| 168 | (throw 'done nil)))) |
| 169 | |
| 170 | (defun ft/gnus-atp-looks-like-diff (line) |
| 171 | "Return `t' if `line' looks remotely like a line from a unified |
| 172 | diff; `nil' otherwise." |
| 173 | (or (ft/gnus-index-line-p line) |
| 174 | (ft/gnus-diff-header-p line) |
| 175 | (ft/gnus-hunk-line-p line))) |
| 176 | |
| 177 | ;; miscellaneous line handlers |
| 178 | (defun ft/gnus-scissors-line-p (line) |
| 179 | "Returns `t' if `line' looks like a scissors-line; `nil' otherwise." |
| 180 | (cond |
| 181 | ((string-match "^\\( *--* *\\(8<\\|>8\\)\\)+ *-* *$" line) t) |
| 182 | (t nil))) |
| 183 | |
| 184 | ;; Patch mail detection |
| 185 | (defvar ft/gnus-article-patch-conditions nil |
| 186 | "List of conditions that will enable patch treatment. String |
| 187 | values will be matched as regular expressions within the currently |
| 188 | processed part. Non-string value are supposed to be code fragments, |
| 189 | which determine whether or not to do treatment: The code needs to |
| 190 | return `t' if treatment is wanted.") |
| 191 | |
| 192 | (defun ft/gnus-part-want-patch-treatment () |
| 193 | "Run through `ft/gnus-article-patch-conditions' to determine whether |
| 194 | patch treatment is wanted or not. Return `t' or `nil' accordingly." |
| 195 | (catch 'done |
| 196 | (dolist (entry ft/gnus-article-patch-conditions) |
| 197 | (cond |
| 198 | ((stringp entry) |
| 199 | (if (re-search-forward entry nil t) |
| 200 | (throw 'done t))) |
| 201 | (t |
| 202 | (if (eval entry) |
| 203 | (throw 'done t))))) |
| 204 | (throw 'done nil))) |
| 205 | |
| 206 | |
| 207 | ;; The actual article treatment code |
| 208 | (defun ft/gnus-article-treat-patch-state-machine () |
| 209 | "Implement the state machine which colourises a part of an article |
| 210 | if it looks patch-like. |
| 211 | |
| 212 | The state machine works like this: |
| 213 | |
| 214 | 0a. The machinery starts at the first line of the article's body. Not |
| 215 | the header lines. We don't care about header lines at all. |
| 216 | |
| 217 | 0b. The whole thing works line by line. It doesn't do any forward or |
| 218 | backward looks. |
| 219 | |
| 220 | 1. Initially, we assume, that what we'll see first is part of the |
| 221 | patch's commit-message. Hence this first initial state is |
| 222 | \"commit-message\". There are several ways out of this state: |
| 223 | |
| 224 | a) a scissors line is found (see 2.) |
| 225 | b) a pseudo-header line is found (see 3.) |
| 226 | c) a three-dashes line is found (see 4.) |
| 227 | d) something that looks like the start of a unified diff is |
| 228 | found (see 7.) |
| 229 | |
| 230 | 2. A scissors line is something that looks like a pair of scissors running |
| 231 | through a piece of paper. Like this: |
| 232 | |
| 233 | ------ 8< ----- 8< ------ |
| 234 | |
| 235 | or this: |
| 236 | |
| 237 | ------------>8----------- |
| 238 | |
| 239 | The function `ft/gnus-scissors-line-p' decides whether a line is a |
| 240 | scissors line or not. After a scissors line was treated, the machine |
| 241 | will switch back to the \"commit-mesage\" state. |
| 242 | |
| 243 | 3. This is very similar to a scissors line. It'll just return to the old |
| 244 | state after its being done. The `ft/gnus-pseudo-header-p' function |
| 245 | decides if a line is a pseudo header. The line will be appropriately |
| 246 | coloured. |
| 247 | |
| 248 | 4. A three-dashes line is a line that looks like this: \"---\". It's the |
| 249 | definite end of the \"commit-message\" state. The three dashes line is |
| 250 | coloured and the state switches to \"commit-comment\". (See 5.) |
| 251 | |
| 252 | 5. Nothing in \"commit-comment\" will appear in the generated commit (this |
| 253 | is git-am specific semantics, but it's useful, so...). It may contain |
| 254 | things like random comments or - promimently - a diff stat. (See 6.) |
| 255 | |
| 256 | 6. A diff stat provides statistics about how much changed in a given commit |
| 257 | by files and by whole commit (in a summary line). Two functions |
| 258 | `ft/gnus-diff-stat-line-p' and `ft/gnus-diff-stat-summary-p' decide if a |
| 259 | line belongs to a diff stat. It's coloured appropriately and the state |
| 260 | switches back to \"commit-comment\". |
| 261 | |
| 262 | 7. There is a function `ft/gnus-unified-diff-line-p' which will cause the |
| 263 | state to switch to \"unified-diff\" state from either \"commit-message\" |
| 264 | or \"commit-comment\". In this mode there can be a set of lines types: |
| 265 | |
| 266 | a) diff-header lines (`ft/gnus-diff-header-p') |
| 267 | b) index lines (`ft/gnus-index-line-p') |
| 268 | c) hunk lines (`ft/gnus-hunk-line-p') |
| 269 | d) equals line (\"^==*$\") |
| 270 | e) context lines (\"^ \") |
| 271 | f) add lines (\"^\\+\") |
| 272 | g) remove lines (\"^-\") |
| 273 | h) empty lines (\"^$\") |
| 274 | |
| 275 | This state runs until the end of the part." |
| 276 | (catch 'ft/gnus-atp-done |
| 277 | (let ((state 'commit-message) |
| 278 | line do-not-move) |
| 279 | |
| 280 | (while t |
| 281 | ;; Put the current line into an easy-to-handle string variable. |
| 282 | (setq line |
| 283 | (buffer-substring-no-properties (point-at-bol) (point-at-eol))) |
| 284 | (setq do-not-move nil) |
| 285 | |
| 286 | ;; Switched state machine. The "real" states are `commit-message', |
| 287 | ;; `commit-comment' and `unified-diff'. The other "states" are only |
| 288 | ;; single-line colourisations that return to their respective parent- |
| 289 | ;; state. Each state may (throw 'ft/gnus-atp-done) to leave the state- |
| 290 | ;; machine immediately. |
| 291 | (setq state |
| 292 | (cond |
| 293 | |
| 294 | ((eq state 'commit-message) |
| 295 | (cond |
| 296 | ((ft/gnus-scissors-line-p line) |
| 297 | (ft/gnus-colour-line 'ft/gnus-scissors) |
| 298 | 'commit-message) |
| 299 | ((ft/gnus-pseudo-header-p line) |
| 300 | (ft/gnus-pseudo-header-colour line) |
| 301 | 'commit-message) |
| 302 | ((string= line "---") |
| 303 | (ft/gnus-colour-line 'ft/gnus-three-dashes) |
| 304 | 'commit-comment) |
| 305 | ((ft/gnus-atp-looks-like-diff line) |
| 306 | (setq do-not-move t) |
| 307 | 'unified-diff) |
| 308 | (t |
| 309 | (ft/gnus-colour-line 'ft/gnus-commit-message) |
| 310 | 'commit-message))) |
| 311 | |
| 312 | ((eq state 'commit-comment) |
| 313 | (cond |
| 314 | ((ft/gnus-diff-stat-line-p line) |
| 315 | (ft/gnus-diff-stat-colour line) |
| 316 | 'commit-comment) |
| 317 | ((ft/gnus-diff-stat-summary-p line) |
| 318 | (ft/gnus-diff-stat-summary-colour line) |
| 319 | 'commit-comment) |
| 320 | ((ft/gnus-atp-looks-like-diff line) |
| 321 | (setq do-not-move t) |
| 322 | 'unified-diff) |
| 323 | (t |
| 324 | (ft/gnus-colour-line 'ft/gnus-commit-comment) |
| 325 | 'commit-comment))) |
| 326 | |
| 327 | ((eq state 'unified-diff) |
| 328 | (cond |
| 329 | ((ft/gnus-diff-header-p line) |
| 330 | (ft/gnus-colour-line 'ft/gnus-diff-header) |
| 331 | 'unified-diff) |
| 332 | ((ft/gnus-index-line-p line) |
| 333 | (ft/gnus-colour-line 'ft/gnus-diff-index) |
| 334 | 'unified-diff) |
| 335 | ((ft/gnus-hunk-line-p line) |
| 336 | (ft/gnus-colour-line 'ft/gnus-diff-hunk) |
| 337 | 'unified-diff) |
| 338 | ((string-match "^==*$" line) |
| 339 | (ft/gnus-colour-line 'ft/gnus-diff-equals) |
| 340 | 'unified-diff) |
| 341 | ((string-match "^$" line) |
| 342 | 'unified-diff) |
| 343 | ((string-match "^ " line) |
| 344 | (ft/gnus-colour-line 'ft/gnus-diff-context) |
| 345 | 'unified-diff) |
| 346 | ((ft/gnus-atp-misc-diff-p line) |
| 347 | (ft/gnus-colour-line 'ft/gnus-diff-misc) |
| 348 | 'unified-diff) |
| 349 | ((string-match "^\\+" line) |
| 350 | (ft/gnus-colour-line 'ft/gnus-diff-add) |
| 351 | 'unified-diff) |
| 352 | ((string-match "^-" line) |
| 353 | (ft/gnus-colour-line 'ft/gnus-diff-remove) |
| 354 | 'unified-diff) |
| 355 | (t 'unified-diff))))) |
| 356 | |
| 357 | (if (not do-not-move) |
| 358 | (if (> (forward-line) 0) |
| 359 | (throw 'ft/gnus-atp-done t))))))) |
| 360 | |
| 361 | (defun ft/gnus-article-treat-patch () |
| 362 | "Highlight mail parts, that look like patches (well, usually |
| 363 | they *are* patches - or possibly, when you take git's format-patch output, |
| 364 | entire commit exports - including comments). This treatment assumes the |
| 365 | use of unified diffs. Here is how it works: |
| 366 | |
| 367 | The most fancy type of patch mails look like this: |
| 368 | |
| 369 | From: ... |
| 370 | Subject: ... |
| 371 | Other-Headers: ... |
| 372 | |
| 373 | Body text, which can be reflecting the commit message but may |
| 374 | optionally be followed by a so called scissors line, which |
| 375 | looks like this (in case of a scissors line, the text above is |
| 376 | not part of the commit message): |
| 377 | |
| 378 | -------8<---------- |
| 379 | |
| 380 | If there really was a scissors line, then it's usually |
| 381 | followed by repeated mail-headers. Which do not *have* to |
| 382 | be the same as the one from the sender. |
| 383 | |
| 384 | From: ... |
| 385 | Subject: ... |
| 386 | |
| 387 | More text. Usually part of the commit message. Likely |
| 388 | multiline. What follows may be an optional diffstat. If |
| 389 | there is one, it's usually preceded by a line that contains |
| 390 | only three dashes and nothing more. Before the diffstat, |
| 391 | however, there may be a set of pseudo headers again, like |
| 392 | these: |
| 393 | |
| 394 | Acked-by: Mike Dev <md@other.tld> |
| 395 | Signed-off-by: Joe D. User <jdu@example.com> |
| 396 | |
| 397 | --- |
| 398 | ChangeLog | 5 ++++- |
| 399 | 1 file changed, 4 insertions(+), 1 deletions(-) |
| 400 | |
| 401 | Now, there is again room for optional text, which is not |
| 402 | part of the actual commit message. May be multiline. Actually, |
| 403 | anything between the three-dashes line and the diff content |
| 404 | is ignored as far as the commit message goes. |
| 405 | |
| 406 | Now for the actual diff part. I want this to work for as |
| 407 | many unified diff formats as possible. What comes to mind |
| 408 | is the format used by git and the format used by cvs and |
| 409 | quilt. |
| 410 | |
| 411 | CVS style looks like this: |
| 412 | |
| 413 | Index: foo/bar.c |
| 414 | ============================================================ |
| 415 | --- boo.orig/foo/bar.c 2010-02-24 .... |
| 416 | +++ boo/foo/bar.c 2010-02-28 .... |
| 417 | @@ -1823,7 +1823,7 @@ |
| 418 | <hunk> |
| 419 | |
| 420 | There may be multiple hunks. Each file gets an \"Index:\" and |
| 421 | equals line. Now the git format looks like this: |
| 422 | |
| 423 | diff --git a/ChangeLog b/ChangeLog |
| 424 | index 6ffbc8c..36e5c17 100644 |
| 425 | --- a/ChangeLog |
| 426 | +++ b/ChangeLog |
| 427 | @@ -3,6 +3,9 @@ |
| 428 | <hunk> |
| 429 | |
| 430 | Again, there may be multiple hunks. |
| 431 | |
| 432 | When all hunks and all files are done, there may be additional |
| 433 | text below the actual text. |
| 434 | |
| 435 | And that's it. |
| 436 | |
| 437 | You may define the look of several things: pseudo headers, scissor |
| 438 | lines, three-dashes-line, equals lines, diffstat lines, diffstat |
| 439 | summary. Then there is added lines, removed lines, context lines, |
| 440 | diff-header lines and diff-file-header lines, for which we are |
| 441 | borrowing the highlighting faces for from `diff-mode'." |
| 442 | (if (ft/gnus-part-want-patch-treatment) |
| 443 | (save-excursion |
| 444 | (progn |
| 445 | (let ((inhibit-read-only t)) |
| 446 | (goto-char (point-min)) |
| 447 | (ft/gnus-article-treat-patch-state-machine)))))) |
| 448 | |
| 449 | (provide 'gnus-article-treat-patch) |