Function: diff--font-lock-prettify

diff--font-lock-prettify is a byte-compiled function defined in diff-mode.el.gz.

Signature

(diff--font-lock-prettify LIMIT)

Source Code

;; Defined in /usr/src/emacs/lisp/vc/diff-mode.el.gz
(defun diff--font-lock-prettify (limit)
  (when diff-font-lock-prettify
    ;; FIXME: `window-fringes` uselessly allocates 4 cons cells,
    ;; but the previous use of `frame-parameter' ended up internally
    ;; calling `frame-parameters' making it even worse!
    (when (> (car (window-fringes)) 0)
      (save-excursion
        ;; FIXME: Include the first space for context-style hunks!
        (while (re-search-forward "^[-+! ]" limit t)
          (unless (eq (get-text-property (match-beginning 0) 'face)
                      'diff-header)
            (put-text-property
             (match-beginning 0) (match-end 0)
             'display
             (alist-get
              (char-before)
              '((?+ . (left-fringe diff-fringe-add diff-indicator-added))
                (?- . (left-fringe diff-fringe-del diff-indicator-removed))
                (?! . (left-fringe diff-fringe-rep diff-indicator-changed))
                (?\s . (left-fringe diff-fringe-nul fringe)))))))))
    ;; Mimics the output of Magit's diff.
    ;; FIXME: This has been tested only with Git's diff output.
    ;; FIXME: Add support for Git's "rename from/to"?
    (while (re-search-forward "^diff " limit t)
      ;; We split the regexp match into a search plus a looking-at because
      ;; we want to use LIMIT for the search but we still want to match
      ;; all the header's lines even if LIMIT falls in the middle of it.
      (when (save-excursion
              (forward-line 0)
              (looking-at
               (eval-when-compile
                 (let* ((index "\\(?:index.*\n\\)?")
                        (file4 (concat
                                "\\(?:" null-device "\\|[ab]/\\(?4:.*\\)\\)"))
                        (file5 (concat
                                "\\(?:" null-device "\\|[ab]/\\(?5:.*\\)\\)"))
                        (header (concat "--- " file4 "\n"
                                        "\\+\\+\\+ " file5 "\n"))
                        (binary (concat
                                 "Binary files " file4
                                 " and " file5 " \\(?7:differ\\)\n"))
                        (horb (concat "\\(?:" header "\\|" binary "\\)?")))
                   (concat "diff.*?\\(?: a/\\(.*?\\) b/\\(.*\\)\\)?\n"
                           "\\(?:"
                           ;; For new/deleted files, there might be no
                           ;; header (and no hunk) if the file is/was empty.
                           "\\(?3:new\\(?6:\\)\\|deleted\\) file mode \\(?10:[0-7]\\{6\\}\\)\n"
                           index horb
                           ;; Normal case. There might be no header
                           ;; (and no hunk) if only the file mode
                           ;; changed.
                           "\\|"
                           "\\(?:old mode \\(?8:[0-7]\\{6\\}\\)\n\\)?"
                           "\\(?:new mode \\(?9:[0-7]\\{6\\}\\)\n\\)?"
                           index horb "\\)")))))
        ;; The file names can be extracted either from the `diff' line
        ;; or from the two header lines.  Prefer the header line info if
        ;; available since the `diff' line is ambiguous in case the
        ;; file names include " b/" or " a/".
        ;; FIXME: This prettification throws away all the information
        ;; about the index hashes.
        (let ((oldfile (or (match-string 4) (match-string 1)))
              (newfile (or (match-string 5) (match-string 2)))
              (kind (if (match-beginning 7) " BINARY"
                      (unless (or (match-beginning 4)
                                  (match-beginning 5)
                                  (not (match-beginning 3)))
                        " empty")))
              (filemode
               (cond
                ((match-beginning 10)
                 (concat " file with mode " (match-string 10) "  "))
                ((and (match-beginning 8) (match-beginning 9))
                 (concat " file (mode changed from "
                         (match-string 8) " to " (match-string 9) ")  "))
                (t " file  "))))
          (add-text-properties
           (match-beginning 0) (1- (match-end 0))
           (list 'display
                 (propertize
                  (cond
                   ((match-beginning 3)
                    (concat (capitalize (match-string 3)) kind filemode
                            (if (match-beginning 6) newfile oldfile)))
                   ((and (null (match-string 4)) (match-string 5))
                    (concat "New " kind filemode newfile))
                   ((null (match-string 2))
                    ;; We used to use
                    ;;     (concat "Deleted" kind filemode oldfile)
                    ;; here but that misfires for `diff-buffers'
                    ;; (see 24 Jun 2022 message in bug#54034).
                    ;; AFAIK if (match-string 2) is nil then so is
                    ;; (match-string 1), so "Deleted" doesn't sound right,
                    ;; so better just let the header in plain sight for now.
                    ;; FIXME: `diff-buffers' should maybe try to better
                    ;; mimic Git's format with "a/" and "b/" so prettification
                    ;; can "just work!"
                    nil)
                   (t
                    (concat "Modified" kind filemode oldfile)))
                  'face '(diff-file-header diff-header))
                 'font-lock-multiline t))))))
  nil)