emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 75d4bdc 08/42: Remove CR characters


From: Dmitry Gutov
Subject: [elpa] master 75d4bdc 08/42: Remove CR characters
Date: Wed, 09 Sep 2015 19:03:28 +0000

branch: master
commit 75d4bdc4537239e29c7b673e240f75cf62448db3
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Remove CR characters
---
 diff-hl.el | 1050 ++++++++++++++++++++++++++++++------------------------------
 1 files changed, 525 insertions(+), 525 deletions(-)

diff --git a/diff-hl.el b/diff-hl.el
index 64f2d75..d412a70 100644
--- a/diff-hl.el
+++ b/diff-hl.el
@@ -1,525 +1,525 @@
-;;; diff-hl.el --- Highlight uncommitted changes -*- lexical-binding: t -*-
-
-;; Copyright (C) 2012-2014  Free Software Foundation, Inc.
-
-;; Author:   Dmitry Gutov <address@hidden>
-;; URL:      https://github.com/dgutov/diff-hl
-;; Keywords: vc, diff
-;; Version:  1.7.0
-;; Package-Requires: ((cl-lib "0.2"))
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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 Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; `diff-hl-mode' highlights uncommitted changes on the left side of
-;; the window (using the fringe, by default), allows you to jump
-;; between the hunks and revert them selectively.
-
-;; Provided commands:
-;;
-;; `diff-hl-diff-goto-hunk'  C-x v =
-;; `diff-hl-revert-hunk'     C-x v n
-;; `diff-hl-previous-hunk'   C-x v [
-;; `diff-hl-next-hunk'       C-x v ]
-;;
-;; The mode takes advantage of `smartrep' if it is installed.
-
-;; Add either of the following to your init file.
-;;
-;; To use it in all buffers:
-;;
-;; (global-diff-hl-mode)
-;;
-;; Only in `prog-mode' buffers, with `vc-dir' integration:
-;;
-;; (add-hook 'prog-mode-hook 'turn-on-diff-hl-mode)
-;; (add-hook 'vc-dir-mode-hook 'turn-on-diff-hl-mode)
-
-;;; Code:
-
-(require 'fringe)
-(require 'diff-mode)
-(require 'vc)
-(require 'vc-dir)
-(eval-when-compile
-  (require 'cl-lib)
-  (require 'vc-git)
-  (require 'vc-hg)
-  (require 'face-remap)
-  (declare-function smartrep-define-key 'smartrep))
-
-(defgroup diff-hl nil
-  "VC diff highlighting on the side of a window"
-  :group 'vc)
-
-(defface diff-hl-insert
-  '((default :inherit diff-added)
-    (((class color)) :foreground "green4"))
-  "Face used to highlight inserted lines."
-  :group 'diff-hl)
-
-(defface diff-hl-delete
-  '((default :inherit diff-removed)
-    (((class color)) :foreground "red3"))
-  "Face used to highlight deleted lines."
-  :group 'diff-hl)
-
-(defface diff-hl-change
-  '((default :foreground "blue3")
-    (((class color) (min-colors 88) (background light))
-     :background "#ddddff")
-    (((class color) (min-colors 88) (background dark))
-     :background "#333355"))
-  "Face used to highlight changed lines."
-  :group 'diff-hl)
-
-(defcustom diff-hl-command-prefix (kbd "C-x v")
-  "The prefix for all `diff-hl' commands."
-  :group 'diff-hl
-  :type 'string)
-
-(defcustom diff-hl-draw-borders t
-  "Non-nil to draw borders around fringe indicators."
-  :group 'diff-hl
-  :type 'boolean)
-
-(defcustom diff-hl-highlight-function 'diff-hl-highlight-on-fringe
-  "Function to highlight the current line. Its arguments are
-  overlay, change type and position within a hunk."
-  :group 'diff-hl
-  :type 'function)
-
-(defcustom diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-pos
-  "Function to choose the fringe bitmap for a given change type
-  and position within a hunk.  Should accept two arguments."
-  :group 'diff-hl
-  :type '(choice (const diff-hl-fringe-bmp-from-pos)
-                 (const diff-hl-fringe-bmp-from-type)
-                 function))
-
-(defcustom diff-hl-fringe-face-function 'diff-hl-fringe-face-from-type
-  "Function to choose the fringe face for a given change type
-  and position within a hunk.  Should accept two arguments."
-  :group 'diff-hl
-  :type 'function)
-
-(defvar diff-hl-reference-revision nil
-  "Revision to diff against.  nil means the most recent one.")
-
-(defun diff-hl-define-bitmaps ()
-  (let* ((scale (if (and (boundp 'text-scale-mode-amount)
-                         (numberp text-scale-mode-amount))
-                    (expt text-scale-mode-step text-scale-mode-amount)
-                  1))
-         (spacing (or (and (display-graphic-p) (default-value 'line-spacing)) 
0))
-         (h (+ (ceiling (* (frame-char-height) scale))
-               (if (floatp spacing)
-                   (truncate (* (frame-char-height) spacing))
-                 spacing)))
-         (w (frame-parameter nil 'left-fringe))
-         (middle (make-vector h (expt 2 (1- w))))
-         (ones (1- (expt 2 w)))
-         (top (copy-sequence middle))
-         (bottom (copy-sequence middle))
-         (single (copy-sequence middle)))
-    (aset top 0 ones)
-    (aset bottom (1- h) ones)
-    (aset single 0 ones)
-    (aset single (1- h) ones)
-    (define-fringe-bitmap 'diff-hl-bmp-top top h w 'top)
-    (define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center)
-    (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom)
-    (define-fringe-bitmap 'diff-hl-bmp-single single h w 'top)
-    (define-fringe-bitmap 'diff-hl-bmp-i [3 3 0 3 3 3 3 3 3 3] nil 2 'center)
-    (let* ((w2 (* (/ w 2) 2))
-           ;; When fringes are disabled, it's easier to fix up the width,
-           ;; instead of doing nothing (#20).
-           (w2 (if (zerop w2) 2 w2))
-           (delete-row (- (expt 2 (1- w2)) 2))
-           (middle-pos (1- (/ w2 2)))
-           (middle-bit (expt 2 middle-pos))
-           (insert-bmp (make-vector w2 (* 3 middle-bit))))
-      (define-fringe-bitmap 'diff-hl-bmp-delete (make-vector 2 delete-row) w2 
w2)
-      (aset insert-bmp 0 0)
-      (aset insert-bmp middle-pos delete-row)
-      (aset insert-bmp (1+ middle-pos) delete-row)
-      (aset insert-bmp (1- w2) 0)
-      (define-fringe-bitmap 'diff-hl-bmp-insert insert-bmp w2 w2)
-      )))
-
-(defun diff-hl-maybe-define-bitmaps ()
-  (when (window-system) ;; No fringes in the console.
-    (unless (fringe-bitmap-p 'diff-hl-bmp-empty)
-      (diff-hl-define-bitmaps)
-      (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center))))
-
-(defvar diff-hl-spec-cache (make-hash-table :test 'equal))
-
-(defun diff-hl-fringe-spec (type pos)
-  (let* ((key (list type pos diff-hl-fringe-bmp-function))
-         (val (gethash key diff-hl-spec-cache)))
-    (unless val
-      (let* ((face-sym (funcall diff-hl-fringe-face-function type pos))
-             (bmp-sym (funcall diff-hl-fringe-bmp-function type pos)))
-        (setq val (propertize " " 'display `((left-fringe ,bmp-sym 
,face-sym))))
-        (puthash key val diff-hl-spec-cache)))
-    val))
-
-(defun diff-hl-fringe-face-from-type (type _pos)
-  (intern (format "diff-hl-%s" type)))
-
-(defun diff-hl-fringe-bmp-from-pos (_type pos)
-  (intern (format "diff-hl-bmp-%s" pos)))
-
-(defun diff-hl-fringe-bmp-from-type (type _pos)
-  (cl-case type
-    (unknown 'question-mark)
-    (change 'exclamation-mark)
-    (ignored 'diff-hl-bmp-i)
-    (t (intern (format "diff-hl-bmp-%s" type)))))
-
-(defvar vc-svn-diff-switches)
-
-(defmacro diff-hl-with-diff-switches (body)
-  `(let ((vc-git-diff-switches nil)
-         (vc-hg-diff-switches nil)
-         (vc-svn-diff-switches nil)
-         (vc-diff-switches '("-U0"))
-         (vc-disable-async-diff t))
-     ,body))
-
-(defun diff-hl-changes ()
-  (let* ((file buffer-file-name)
-         (backend (vc-backend file)))
-    (when backend
-      (let ((state (vc-state file backend)))
-        (cond
-         ((or (eq state 'edited)
-              (and (eq state 'up-to-date)
-                   ;; VC state is stale in after-revert-hook.
-                   (or revert-buffer-in-progress-p
-                       ;; Diffing against an older revision.
-                       diff-hl-reference-revision)))
-          (let* ((buf-name " *diff-hl* ")
-                 diff-auto-refine-mode
-                 res)
-            (diff-hl-with-diff-switches
-             (vc-call-backend backend 'diff (list file)
-                              diff-hl-reference-revision nil
-                              buf-name))
-            (with-current-buffer buf-name
-              (goto-char (point-min))
-              (unless (eobp)
-                (ignore-errors
-                  (diff-beginning-of-hunk t))
-                (while (looking-at diff-hunk-header-re-unified)
-                  (let ((line (string-to-number (match-string 3)))
-                        (len (let ((m (match-string 4)))
-                               (if m (string-to-number m) 1)))
-                        (beg (point)))
-                    (diff-end-of-hunk)
-                    (let* ((inserts (diff-count-matches "^\\+" beg (point)))
-                           (deletes (diff-count-matches "^-" beg (point)))
-                           (type (cond ((zerop deletes) 'insert)
-                                       ((zerop inserts) 'delete)
-                                       (t 'change))))
-                      (when (eq type 'delete)
-                        (setq len 1)
-                        (cl-incf line))
-                      (push (list line len type) res))))))
-            (nreverse res)))
-         ((eq state 'added)
-          `((1 ,(line-number-at-pos (point-max)) insert)))
-         ((eq state 'removed)
-          `((1 ,(line-number-at-pos (point-max)) delete))))))))
-
-(defun diff-hl-update ()
-  (let ((changes (diff-hl-changes))
-        (current-line 1))
-    (diff-hl-remove-overlays)
-    (save-excursion
-      (goto-char (point-min))
-      (dolist (c changes)
-        (cl-destructuring-bind (line len type) c
-          (forward-line (- line current-line))
-          (setq current-line line)
-          (let ((hunk-beg (point)))
-            (while (cl-plusp len)
-              (diff-hl-add-highlighting
-               type
-               (cond
-                ((not diff-hl-draw-borders) 'empty)
-                ((and (= len 1) (= line current-line)) 'single)
-                ((= len 1) 'bottom)
-                ((= line current-line) 'top)
-                (t 'middle)))
-              (forward-line 1)
-              (cl-incf current-line)
-              (cl-decf len))
-            (let ((h (make-overlay hunk-beg (point)))
-                  (hook '(diff-hl-overlay-modified)))
-              (overlay-put h 'diff-hl t)
-              (overlay-put h 'diff-hl-hunk t)
-              (overlay-put h 'modification-hooks hook)
-              (overlay-put h 'insert-in-front-hooks hook)
-              (overlay-put h 'insert-behind-hooks hook))))))))
-
-(defun diff-hl-add-highlighting (type shape)
-  (let ((o (make-overlay (point) (point))))
-    (overlay-put o 'diff-hl t)
-    (funcall diff-hl-highlight-function o type shape)
-    o))
-
-(defun diff-hl-highlight-on-fringe (ovl type shape)
-  (overlay-put ovl 'before-string (diff-hl-fringe-spec type shape)))
-
-(defun diff-hl-remove-overlays ()
-  (dolist (o (overlays-in (point-min) (point-max)))
-    (when (overlay-get o 'diff-hl) (delete-overlay o))))
-
-(defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length)
-  "Delete the hunk overlay and all our line overlays inside it."
-  (unless after-p
-    (when (overlay-buffer ov)
-      (save-restriction
-        (narrow-to-region (overlay-start ov) (overlay-end ov))
-        (diff-hl-remove-overlays))
-      (delete-overlay ov))))
-
-(defvar diff-hl-timer nil)
-
-(defun diff-hl-edit (_beg _end _len)
-  "DTRT when we've `undo'-ne the buffer into unmodified state."
-  (when undo-in-progress
-    (when diff-hl-timer
-      (cancel-timer diff-hl-timer))
-    (setq diff-hl-timer
-          (run-with-idle-timer 0.01 nil #'diff-hl-after-undo 
(current-buffer)))))
-
-(defun diff-hl-after-undo (buffer)
-  (with-current-buffer buffer
-    (unless (buffer-modified-p)
-      (diff-hl-update))))
-
-(defun diff-hl-diff-goto-hunk ()
-  "Run VC diff command and go to the line corresponding to the current."
-  (interactive)
-  (vc-buffer-sync)
-  (let* ((line (line-number-at-pos))
-         (buffer (current-buffer)))
-    (vc-diff-internal t (vc-deduce-fileset) diff-hl-reference-revision nil t)
-    (vc-exec-after `(if (< (line-number-at-pos (point-max)) 3)
-                        (with-current-buffer ,buffer (diff-hl-remove-overlays))
-                      (diff-hl-diff-skip-to ,line)
-                      (setq vc-sentinel-movepoint (point))))))
-
-(defun diff-hl-diff-skip-to (line)
-  "In `diff-mode', skip to the hunk and line corresponding to LINE
-in the source file, or the last line of the hunk above it."
-  (diff-hunk-next)
-  (let (found)
-    (while (and (looking-at diff-hunk-header-re-unified) (not found))
-      (let ((hunk-line (string-to-number (match-string 3)))
-            (len (let ((m (match-string 4)))
-                   (if m (string-to-number m) 1))))
-        (if (> line (+ hunk-line len))
-            (diff-hunk-next)
-          (setq found t)
-          (if (< line hunk-line)
-              ;; Retreat to the previous hunk.
-              (forward-line -1)
-            (let ((to-go (1+ (- line hunk-line))))
-              (while (cl-plusp to-go)
-                (forward-line 1)
-                (unless (looking-at "^-")
-                  (cl-decf to-go))))))))))
-
-(defun diff-hl-revert-hunk ()
-  "Revert the diff hunk with changes at or above the point."
-  (interactive)
-  (vc-buffer-sync)
-  (let ((diff-buffer (generate-new-buffer-name "*diff-hl*"))
-        (buffer (current-buffer))
-        (line (save-excursion
-                (unless (diff-hl-hunk-overlay-at (point))
-                  (diff-hl-previous-hunk))
-                (line-number-at-pos)))
-        (fileset (vc-deduce-fileset)))
-    (unwind-protect
-        (progn
-          (vc-diff-internal nil fileset diff-hl-reference-revision nil
-                            nil diff-buffer)
-          (vc-exec-after
-           `(let (beg-line end-line)
-              (when (eobp)
-                (with-current-buffer ,buffer (diff-hl-remove-overlays))
-                (error "Buffer is up-to-date"))
-              (diff-hl-diff-skip-to ,line)
-              (save-excursion
-                (while (looking-at "[-+]") (forward-line 1))
-                (setq end-line (line-number-at-pos (point)))
-                (unless (eobp) (diff-split-hunk)))
-              (unless (looking-at "[-+]") (forward-line -1))
-              (while (looking-at "[-+]") (forward-line -1))
-              (setq beg-line (line-number-at-pos (point)))
-              (unless (looking-at "@")
-                (forward-line 1)
-                (diff-split-hunk))
-              (let ((wbh (window-body-height)))
-                (if (>= wbh (- end-line beg-line))
-                    (recenter (/ (+ wbh (- beg-line end-line) 2) 2))
-                  (recenter 1)))
-              (unless (yes-or-no-p (format "Revert current hunk in %s?"
-                                           ,(cl-caadr fileset)))
-                (error "Revert canceled"))
-              (let ((diff-advance-after-apply-hunk nil))
-                (diff-apply-hunk t))
-              (with-current-buffer ,buffer
-                (save-buffer))
-              (message "Hunk reverted"))))
-      (quit-windows-on diff-buffer))))
-
-(defun diff-hl-hunk-overlay-at (pos)
-  (cl-loop for o in (overlays-in pos (1+ pos))
-           when (overlay-get o 'diff-hl-hunk)
-           return o))
-
-(defun diff-hl-next-hunk (&optional backward)
-  "Go to the beginning of the next hunk in the current buffer."
-  (interactive)
-  (let ((pos (save-excursion
-               (catch 'found
-                 (while (not (if backward (bobp) (eobp)))
-                   (goto-char (if backward
-                                  (previous-overlay-change (point))
-                                (next-overlay-change (point))))
-                   (let ((o (diff-hl-hunk-overlay-at (point))))
-                     (when (and o (= (overlay-start o) (point)))
-                       (throw 'found (overlay-start o)))))))))
-    (if pos
-        (goto-char pos)
-      (error "No further hunks found"))))
-
-(defun diff-hl-previous-hunk ()
-  "Go to the beginning of the previous hunk in the current buffer."
-  (interactive)
-  (diff-hl-next-hunk t))
-
-(define-prefix-command 'diff-hl-command-map)
-
-(let ((map diff-hl-command-map))
-  (define-key map "n" 'diff-hl-revert-hunk)
-  (define-key map "[" 'diff-hl-previous-hunk)
-  (define-key map "]" 'diff-hl-next-hunk)
-  map)
-
-;;;###autoload
-(define-minor-mode diff-hl-mode
-  "Toggle VC diff highlighting."
-  :lighter "" :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk)
-                        (,diff-hl-command-prefix . diff-hl-command-map))
-  (if diff-hl-mode
-      (progn
-        (diff-hl-maybe-define-bitmaps)
-        (add-hook 'after-save-hook 'diff-hl-update nil t)
-        (add-hook 'after-change-functions 'diff-hl-edit nil t)
-        (add-hook (if vc-mode
-                      ;; Defer until the end of this hook, so that its
-                      ;; elements can modify the update behavior.
-                      'diff-hl-mode-on-hook
-                    ;; If we're only opening the file now,
-                    ;; `vc-find-file-hook' likely hasn't run yet, so
-                    ;; let's wait until the state information is
-                    ;; saved, in order not to fetch it twice.
-                    'find-file-hook)
-                  'diff-hl-update t t)
-        (add-hook 'vc-checkin-hook 'diff-hl-update nil t)
-        (add-hook 'after-revert-hook 'diff-hl-update nil t)
-        ;; Magit does call `auto-revert-handler', but it usually
-        ;; doesn't do much, because `buffer-stale--default-function'
-        ;; doesn't care about changed VC state.
-        ;; https://github.com/magit/magit/issues/603
-        (add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t)
-        ;; Magit 2+ doesn't do the above and calls this instead,
-        ;; but only when it doesn't call `revert-buffer':
-        (add-hook 'magit-not-reverted-hook 'diff-hl-update nil t)
-        (add-hook 'auto-revert-mode-hook 'diff-hl-update nil t)
-        (add-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps nil t))
-    (remove-hook 'after-save-hook 'diff-hl-update t)
-    (remove-hook 'after-change-functions 'diff-hl-edit t)
-    (remove-hook 'find-file-hook 'diff-hl-update t)
-    (remove-hook 'vc-checkin-hook 'diff-hl-update t)
-    (remove-hook 'after-revert-hook 'diff-hl-update t)
-    (remove-hook 'magit-revert-buffer-hook 'diff-hl-update t)
-    (remove-hook 'magit-not-reverted-hook 'diff-hl-update t)
-    (remove-hook 'auto-revert-mode-hook 'diff-hl-update t)
-    (remove-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps t)
-    (diff-hl-remove-overlays)))
-
-(when (require 'smartrep nil t)
-  (let (smart-keys)
-    (cl-labels ((scan (map)
-                      (map-keymap
-                       (lambda (event binding)
-                         (if (consp binding)
-                             (scan binding)
-                           (when (characterp event)
-                             (push (cons (string event) binding) smart-keys))))
-                       map)))
-      (scan diff-hl-command-map)
-      (smartrep-define-key diff-hl-mode-map diff-hl-command-prefix 
smart-keys))))
-
-(defun diff-hl-dir-update ()
-  (dolist (pair (if (vc-dir-marked-files)
-                    (vc-dir-marked-only-files-and-states)
-                  (vc-dir-child-files-and-states)))
-    (when (eq 'up-to-date (cdr pair))
-      (let ((buffer (find-buffer-visiting (car pair))))
-        (when buffer
-          (with-current-buffer buffer
-            (diff-hl-remove-overlays)))))))
-
-(define-minor-mode diff-hl-dir-mode
-  "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer."
-  :lighter ""
-  (if diff-hl-dir-mode
-      (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
-    (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
-
-;;;###autoload
-(defun turn-on-diff-hl-mode ()
-  "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
-  (cond
-   (buffer-file-name
-    (diff-hl-mode 1))
-   ((eq major-mode 'vc-dir-mode)
-    (diff-hl-dir-mode 1))))
-
-;;;###autoload
-(define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
-  turn-on-diff-hl-mode :after-hook (diff-hl-global-mode-change))
-
-(defun diff-hl-global-mode-change ()
-  (unless global-diff-hl-mode
-    (dolist (buf (buffer-list))
-      (with-current-buffer buf
-        (when diff-hl-dir-mode
-          (diff-hl-dir-mode -1))))))
-
-(provide 'diff-hl)
-
-;;; diff-hl.el ends here
+;;; diff-hl.el --- Highlight uncommitted changes -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012-2014  Free Software Foundation, Inc.
+
+;; Author:   Dmitry Gutov <address@hidden>
+;; URL:      https://github.com/dgutov/diff-hl
+;; Keywords: vc, diff
+;; Version:  1.7.0
+;; Package-Requires: ((cl-lib "0.2"))
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; `diff-hl-mode' highlights uncommitted changes on the left side of
+;; the window (using the fringe, by default), allows you to jump
+;; between the hunks and revert them selectively.
+
+;; Provided commands:
+;;
+;; `diff-hl-diff-goto-hunk'  C-x v =
+;; `diff-hl-revert-hunk'     C-x v n
+;; `diff-hl-previous-hunk'   C-x v [
+;; `diff-hl-next-hunk'       C-x v ]
+;;
+;; The mode takes advantage of `smartrep' if it is installed.
+
+;; Add either of the following to your init file.
+;;
+;; To use it in all buffers:
+;;
+;; (global-diff-hl-mode)
+;;
+;; Only in `prog-mode' buffers, with `vc-dir' integration:
+;;
+;; (add-hook 'prog-mode-hook 'turn-on-diff-hl-mode)
+;; (add-hook 'vc-dir-mode-hook 'turn-on-diff-hl-mode)
+
+;;; Code:
+
+(require 'fringe)
+(require 'diff-mode)
+(require 'vc)
+(require 'vc-dir)
+(eval-when-compile
+  (require 'cl-lib)
+  (require 'vc-git)
+  (require 'vc-hg)
+  (require 'face-remap)
+  (declare-function smartrep-define-key 'smartrep))
+
+(defgroup diff-hl nil
+  "VC diff highlighting on the side of a window"
+  :group 'vc)
+
+(defface diff-hl-insert
+  '((default :inherit diff-added)
+    (((class color)) :foreground "green4"))
+  "Face used to highlight inserted lines."
+  :group 'diff-hl)
+
+(defface diff-hl-delete
+  '((default :inherit diff-removed)
+    (((class color)) :foreground "red3"))
+  "Face used to highlight deleted lines."
+  :group 'diff-hl)
+
+(defface diff-hl-change
+  '((default :foreground "blue3")
+    (((class color) (min-colors 88) (background light))
+     :background "#ddddff")
+    (((class color) (min-colors 88) (background dark))
+     :background "#333355"))
+  "Face used to highlight changed lines."
+  :group 'diff-hl)
+
+(defcustom diff-hl-command-prefix (kbd "C-x v")
+  "The prefix for all `diff-hl' commands."
+  :group 'diff-hl
+  :type 'string)
+
+(defcustom diff-hl-draw-borders t
+  "Non-nil to draw borders around fringe indicators."
+  :group 'diff-hl
+  :type 'boolean)
+
+(defcustom diff-hl-highlight-function 'diff-hl-highlight-on-fringe
+  "Function to highlight the current line. Its arguments are
+  overlay, change type and position within a hunk."
+  :group 'diff-hl
+  :type 'function)
+
+(defcustom diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-pos
+  "Function to choose the fringe bitmap for a given change type
+  and position within a hunk.  Should accept two arguments."
+  :group 'diff-hl
+  :type '(choice (const diff-hl-fringe-bmp-from-pos)
+                 (const diff-hl-fringe-bmp-from-type)
+                 function))
+
+(defcustom diff-hl-fringe-face-function 'diff-hl-fringe-face-from-type
+  "Function to choose the fringe face for a given change type
+  and position within a hunk.  Should accept two arguments."
+  :group 'diff-hl
+  :type 'function)
+
+(defvar diff-hl-reference-revision nil
+  "Revision to diff against.  nil means the most recent one.")
+
+(defun diff-hl-define-bitmaps ()
+  (let* ((scale (if (and (boundp 'text-scale-mode-amount)
+                         (numberp text-scale-mode-amount))
+                    (expt text-scale-mode-step text-scale-mode-amount)
+                  1))
+         (spacing (or (and (display-graphic-p) (default-value 'line-spacing)) 
0))
+         (h (+ (ceiling (* (frame-char-height) scale))
+               (if (floatp spacing)
+                   (truncate (* (frame-char-height) spacing))
+                 spacing)))
+         (w (frame-parameter nil 'left-fringe))
+         (middle (make-vector h (expt 2 (1- w))))
+         (ones (1- (expt 2 w)))
+         (top (copy-sequence middle))
+         (bottom (copy-sequence middle))
+         (single (copy-sequence middle)))
+    (aset top 0 ones)
+    (aset bottom (1- h) ones)
+    (aset single 0 ones)
+    (aset single (1- h) ones)
+    (define-fringe-bitmap 'diff-hl-bmp-top top h w 'top)
+    (define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center)
+    (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom)
+    (define-fringe-bitmap 'diff-hl-bmp-single single h w 'top)
+    (define-fringe-bitmap 'diff-hl-bmp-i [3 3 0 3 3 3 3 3 3 3] nil 2 'center)
+    (let* ((w2 (* (/ w 2) 2))
+           ;; When fringes are disabled, it's easier to fix up the width,
+           ;; instead of doing nothing (#20).
+           (w2 (if (zerop w2) 2 w2))
+           (delete-row (- (expt 2 (1- w2)) 2))
+           (middle-pos (1- (/ w2 2)))
+           (middle-bit (expt 2 middle-pos))
+           (insert-bmp (make-vector w2 (* 3 middle-bit))))
+      (define-fringe-bitmap 'diff-hl-bmp-delete (make-vector 2 delete-row) w2 
w2)
+      (aset insert-bmp 0 0)
+      (aset insert-bmp middle-pos delete-row)
+      (aset insert-bmp (1+ middle-pos) delete-row)
+      (aset insert-bmp (1- w2) 0)
+      (define-fringe-bitmap 'diff-hl-bmp-insert insert-bmp w2 w2)
+      )))
+
+(defun diff-hl-maybe-define-bitmaps ()
+  (when (window-system) ;; No fringes in the console.
+    (unless (fringe-bitmap-p 'diff-hl-bmp-empty)
+      (diff-hl-define-bitmaps)
+      (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center))))
+
+(defvar diff-hl-spec-cache (make-hash-table :test 'equal))
+
+(defun diff-hl-fringe-spec (type pos)
+  (let* ((key (list type pos diff-hl-fringe-bmp-function))
+         (val (gethash key diff-hl-spec-cache)))
+    (unless val
+      (let* ((face-sym (funcall diff-hl-fringe-face-function type pos))
+             (bmp-sym (funcall diff-hl-fringe-bmp-function type pos)))
+        (setq val (propertize " " 'display `((left-fringe ,bmp-sym 
,face-sym))))
+        (puthash key val diff-hl-spec-cache)))
+    val))
+
+(defun diff-hl-fringe-face-from-type (type _pos)
+  (intern (format "diff-hl-%s" type)))
+
+(defun diff-hl-fringe-bmp-from-pos (_type pos)
+  (intern (format "diff-hl-bmp-%s" pos)))
+
+(defun diff-hl-fringe-bmp-from-type (type _pos)
+  (cl-case type
+    (unknown 'question-mark)
+    (change 'exclamation-mark)
+    (ignored 'diff-hl-bmp-i)
+    (t (intern (format "diff-hl-bmp-%s" type)))))
+
+(defvar vc-svn-diff-switches)
+
+(defmacro diff-hl-with-diff-switches (body)
+  `(let ((vc-git-diff-switches nil)
+         (vc-hg-diff-switches nil)
+         (vc-svn-diff-switches nil)
+         (vc-diff-switches '("-U0"))
+         (vc-disable-async-diff t))
+     ,body))
+
+(defun diff-hl-changes ()
+  (let* ((file buffer-file-name)
+         (backend (vc-backend file)))
+    (when backend
+      (let ((state (vc-state file backend)))
+        (cond
+         ((or (eq state 'edited)
+              (and (eq state 'up-to-date)
+                   ;; VC state is stale in after-revert-hook.
+                   (or revert-buffer-in-progress-p
+                       ;; Diffing against an older revision.
+                       diff-hl-reference-revision)))
+          (let* ((buf-name " *diff-hl* ")
+                 diff-auto-refine-mode
+                 res)
+            (diff-hl-with-diff-switches
+             (vc-call-backend backend 'diff (list file)
+                              diff-hl-reference-revision nil
+                              buf-name))
+            (with-current-buffer buf-name
+              (goto-char (point-min))
+              (unless (eobp)
+                (ignore-errors
+                  (diff-beginning-of-hunk t))
+                (while (looking-at diff-hunk-header-re-unified)
+                  (let ((line (string-to-number (match-string 3)))
+                        (len (let ((m (match-string 4)))
+                               (if m (string-to-number m) 1)))
+                        (beg (point)))
+                    (diff-end-of-hunk)
+                    (let* ((inserts (diff-count-matches "^\\+" beg (point)))
+                           (deletes (diff-count-matches "^-" beg (point)))
+                           (type (cond ((zerop deletes) 'insert)
+                                       ((zerop inserts) 'delete)
+                                       (t 'change))))
+                      (when (eq type 'delete)
+                        (setq len 1)
+                        (cl-incf line))
+                      (push (list line len type) res))))))
+            (nreverse res)))
+         ((eq state 'added)
+          `((1 ,(line-number-at-pos (point-max)) insert)))
+         ((eq state 'removed)
+          `((1 ,(line-number-at-pos (point-max)) delete))))))))
+
+(defun diff-hl-update ()
+  (let ((changes (diff-hl-changes))
+        (current-line 1))
+    (diff-hl-remove-overlays)
+    (save-excursion
+      (goto-char (point-min))
+      (dolist (c changes)
+        (cl-destructuring-bind (line len type) c
+          (forward-line (- line current-line))
+          (setq current-line line)
+          (let ((hunk-beg (point)))
+            (while (cl-plusp len)
+              (diff-hl-add-highlighting
+               type
+               (cond
+                ((not diff-hl-draw-borders) 'empty)
+                ((and (= len 1) (= line current-line)) 'single)
+                ((= len 1) 'bottom)
+                ((= line current-line) 'top)
+                (t 'middle)))
+              (forward-line 1)
+              (cl-incf current-line)
+              (cl-decf len))
+            (let ((h (make-overlay hunk-beg (point)))
+                  (hook '(diff-hl-overlay-modified)))
+              (overlay-put h 'diff-hl t)
+              (overlay-put h 'diff-hl-hunk t)
+              (overlay-put h 'modification-hooks hook)
+              (overlay-put h 'insert-in-front-hooks hook)
+              (overlay-put h 'insert-behind-hooks hook))))))))
+
+(defun diff-hl-add-highlighting (type shape)
+  (let ((o (make-overlay (point) (point))))
+    (overlay-put o 'diff-hl t)
+    (funcall diff-hl-highlight-function o type shape)
+    o))
+
+(defun diff-hl-highlight-on-fringe (ovl type shape)
+  (overlay-put ovl 'before-string (diff-hl-fringe-spec type shape)))
+
+(defun diff-hl-remove-overlays ()
+  (dolist (o (overlays-in (point-min) (point-max)))
+    (when (overlay-get o 'diff-hl) (delete-overlay o))))
+
+(defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length)
+  "Delete the hunk overlay and all our line overlays inside it."
+  (unless after-p
+    (when (overlay-buffer ov)
+      (save-restriction
+        (narrow-to-region (overlay-start ov) (overlay-end ov))
+        (diff-hl-remove-overlays))
+      (delete-overlay ov))))
+
+(defvar diff-hl-timer nil)
+
+(defun diff-hl-edit (_beg _end _len)
+  "DTRT when we've `undo'-ne the buffer into unmodified state."
+  (when undo-in-progress
+    (when diff-hl-timer
+      (cancel-timer diff-hl-timer))
+    (setq diff-hl-timer
+          (run-with-idle-timer 0.01 nil #'diff-hl-after-undo 
(current-buffer)))))
+
+(defun diff-hl-after-undo (buffer)
+  (with-current-buffer buffer
+    (unless (buffer-modified-p)
+      (diff-hl-update))))
+
+(defun diff-hl-diff-goto-hunk ()
+  "Run VC diff command and go to the line corresponding to the current."
+  (interactive)
+  (vc-buffer-sync)
+  (let* ((line (line-number-at-pos))
+         (buffer (current-buffer)))
+    (vc-diff-internal t (vc-deduce-fileset) diff-hl-reference-revision nil t)
+    (vc-exec-after `(if (< (line-number-at-pos (point-max)) 3)
+                        (with-current-buffer ,buffer (diff-hl-remove-overlays))
+                      (diff-hl-diff-skip-to ,line)
+                      (setq vc-sentinel-movepoint (point))))))
+
+(defun diff-hl-diff-skip-to (line)
+  "In `diff-mode', skip to the hunk and line corresponding to LINE
+in the source file, or the last line of the hunk above it."
+  (diff-hunk-next)
+  (let (found)
+    (while (and (looking-at diff-hunk-header-re-unified) (not found))
+      (let ((hunk-line (string-to-number (match-string 3)))
+            (len (let ((m (match-string 4)))
+                   (if m (string-to-number m) 1))))
+        (if (> line (+ hunk-line len))
+            (diff-hunk-next)
+          (setq found t)
+          (if (< line hunk-line)
+              ;; Retreat to the previous hunk.
+              (forward-line -1)
+            (let ((to-go (1+ (- line hunk-line))))
+              (while (cl-plusp to-go)
+                (forward-line 1)
+                (unless (looking-at "^-")
+                  (cl-decf to-go))))))))))
+
+(defun diff-hl-revert-hunk ()
+  "Revert the diff hunk with changes at or above the point."
+  (interactive)
+  (vc-buffer-sync)
+  (let ((diff-buffer (generate-new-buffer-name "*diff-hl*"))
+        (buffer (current-buffer))
+        (line (save-excursion
+                (unless (diff-hl-hunk-overlay-at (point))
+                  (diff-hl-previous-hunk))
+                (line-number-at-pos)))
+        (fileset (vc-deduce-fileset)))
+    (unwind-protect
+        (progn
+          (vc-diff-internal nil fileset diff-hl-reference-revision nil
+                            nil diff-buffer)
+          (vc-exec-after
+           `(let (beg-line end-line)
+              (when (eobp)
+                (with-current-buffer ,buffer (diff-hl-remove-overlays))
+                (error "Buffer is up-to-date"))
+              (diff-hl-diff-skip-to ,line)
+              (save-excursion
+                (while (looking-at "[-+]") (forward-line 1))
+                (setq end-line (line-number-at-pos (point)))
+                (unless (eobp) (diff-split-hunk)))
+              (unless (looking-at "[-+]") (forward-line -1))
+              (while (looking-at "[-+]") (forward-line -1))
+              (setq beg-line (line-number-at-pos (point)))
+              (unless (looking-at "@")
+                (forward-line 1)
+                (diff-split-hunk))
+              (let ((wbh (window-body-height)))
+                (if (>= wbh (- end-line beg-line))
+                    (recenter (/ (+ wbh (- beg-line end-line) 2) 2))
+                  (recenter 1)))
+              (unless (yes-or-no-p (format "Revert current hunk in %s?"
+                                           ,(cl-caadr fileset)))
+                (error "Revert canceled"))
+              (let ((diff-advance-after-apply-hunk nil))
+                (diff-apply-hunk t))
+              (with-current-buffer ,buffer
+                (save-buffer))
+              (message "Hunk reverted"))))
+      (quit-windows-on diff-buffer))))
+
+(defun diff-hl-hunk-overlay-at (pos)
+  (cl-loop for o in (overlays-in pos (1+ pos))
+           when (overlay-get o 'diff-hl-hunk)
+           return o))
+
+(defun diff-hl-next-hunk (&optional backward)
+  "Go to the beginning of the next hunk in the current buffer."
+  (interactive)
+  (let ((pos (save-excursion
+               (catch 'found
+                 (while (not (if backward (bobp) (eobp)))
+                   (goto-char (if backward
+                                  (previous-overlay-change (point))
+                                (next-overlay-change (point))))
+                   (let ((o (diff-hl-hunk-overlay-at (point))))
+                     (when (and o (= (overlay-start o) (point)))
+                       (throw 'found (overlay-start o)))))))))
+    (if pos
+        (goto-char pos)
+      (error "No further hunks found"))))
+
+(defun diff-hl-previous-hunk ()
+  "Go to the beginning of the previous hunk in the current buffer."
+  (interactive)
+  (diff-hl-next-hunk t))
+
+(define-prefix-command 'diff-hl-command-map)
+
+(let ((map diff-hl-command-map))
+  (define-key map "n" 'diff-hl-revert-hunk)
+  (define-key map "[" 'diff-hl-previous-hunk)
+  (define-key map "]" 'diff-hl-next-hunk)
+  map)
+
+;;;###autoload
+(define-minor-mode diff-hl-mode
+  "Toggle VC diff highlighting."
+  :lighter "" :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk)
+                        (,diff-hl-command-prefix . diff-hl-command-map))
+  (if diff-hl-mode
+      (progn
+        (diff-hl-maybe-define-bitmaps)
+        (add-hook 'after-save-hook 'diff-hl-update nil t)
+        (add-hook 'after-change-functions 'diff-hl-edit nil t)
+        (add-hook (if vc-mode
+                      ;; Defer until the end of this hook, so that its
+                      ;; elements can modify the update behavior.
+                      'diff-hl-mode-on-hook
+                    ;; If we're only opening the file now,
+                    ;; `vc-find-file-hook' likely hasn't run yet, so
+                    ;; let's wait until the state information is
+                    ;; saved, in order not to fetch it twice.
+                    'find-file-hook)
+                  'diff-hl-update t t)
+        (add-hook 'vc-checkin-hook 'diff-hl-update nil t)
+        (add-hook 'after-revert-hook 'diff-hl-update nil t)
+        ;; Magit does call `auto-revert-handler', but it usually
+        ;; doesn't do much, because `buffer-stale--default-function'
+        ;; doesn't care about changed VC state.
+        ;; https://github.com/magit/magit/issues/603
+        (add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t)
+        ;; Magit 2+ doesn't do the above and calls this instead,
+        ;; but only when it doesn't call `revert-buffer':
+        (add-hook 'magit-not-reverted-hook 'diff-hl-update nil t)
+        (add-hook 'auto-revert-mode-hook 'diff-hl-update nil t)
+        (add-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps nil t))
+    (remove-hook 'after-save-hook 'diff-hl-update t)
+    (remove-hook 'after-change-functions 'diff-hl-edit t)
+    (remove-hook 'find-file-hook 'diff-hl-update t)
+    (remove-hook 'vc-checkin-hook 'diff-hl-update t)
+    (remove-hook 'after-revert-hook 'diff-hl-update t)
+    (remove-hook 'magit-revert-buffer-hook 'diff-hl-update t)
+    (remove-hook 'magit-not-reverted-hook 'diff-hl-update t)
+    (remove-hook 'auto-revert-mode-hook 'diff-hl-update t)
+    (remove-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps t)
+    (diff-hl-remove-overlays)))
+
+(when (require 'smartrep nil t)
+  (let (smart-keys)
+    (cl-labels ((scan (map)
+                      (map-keymap
+                       (lambda (event binding)
+                         (if (consp binding)
+                             (scan binding)
+                           (when (characterp event)
+                             (push (cons (string event) binding) smart-keys))))
+                       map)))
+      (scan diff-hl-command-map)
+      (smartrep-define-key diff-hl-mode-map diff-hl-command-prefix 
smart-keys))))
+
+(defun diff-hl-dir-update ()
+  (dolist (pair (if (vc-dir-marked-files)
+                    (vc-dir-marked-only-files-and-states)
+                  (vc-dir-child-files-and-states)))
+    (when (eq 'up-to-date (cdr pair))
+      (let ((buffer (find-buffer-visiting (car pair))))
+        (when buffer
+          (with-current-buffer buffer
+            (diff-hl-remove-overlays)))))))
+
+(define-minor-mode diff-hl-dir-mode
+  "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer."
+  :lighter ""
+  (if diff-hl-dir-mode
+      (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
+    (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
+
+;;;###autoload
+(defun turn-on-diff-hl-mode ()
+  "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
+  (cond
+   (buffer-file-name
+    (diff-hl-mode 1))
+   ((eq major-mode 'vc-dir-mode)
+    (diff-hl-dir-mode 1))))
+
+;;;###autoload
+(define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
+  turn-on-diff-hl-mode :after-hook (diff-hl-global-mode-change))
+
+(defun diff-hl-global-mode-change ()
+  (unless global-diff-hl-mode
+    (dolist (buf (buffer-list))
+      (with-current-buffer buf
+        (when diff-hl-dir-mode
+          (diff-hl-dir-mode -1))))))
+
+(provide 'diff-hl)
+
+;;; diff-hl.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]