add lisp packages
This commit is contained in:
68
lisp/diff-hl/diff-hl-amend.el
Normal file
68
lisp/diff-hl/diff-hl-amend.el
Normal file
@@ -0,0 +1,68 @@
|
||||
;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Dmitry Gutov <dgutov@yandex.ru>
|
||||
;; URL: https://github.com/dgutov/diff-hl
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Toggle in the current buffer with `M-x diff-hl-amend-mode'.
|
||||
;; Toggle in all buffers with `M-x global-diff-hl-amend-mode'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'diff-hl)
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode diff-hl-amend-mode
|
||||
"Show changes against the second-last revision in `diff-hl-mode'.
|
||||
Most useful with backends that support rewriting local commits,
|
||||
and most importantly, 'amending' the most recent one.
|
||||
Currently only supports Git, Mercurial and Bazaar."
|
||||
:lighter " Amend"
|
||||
(if diff-hl-amend-mode
|
||||
(progn
|
||||
(diff-hl-amend-setup)
|
||||
(add-hook 'after-revert-hook 'diff-hl-amend-setup nil t))
|
||||
(remove-hook 'after-revert-hook 'diff-hl-amend-setup t)
|
||||
(setq-local diff-hl-reference-revision nil))
|
||||
(when diff-hl-mode
|
||||
(diff-hl-update)))
|
||||
|
||||
(defun diff-hl-amend-setup ()
|
||||
(let ((backend (vc-backend buffer-file-name)))
|
||||
(when backend
|
||||
(setq-local diff-hl-reference-revision
|
||||
(cl-case backend
|
||||
(Git
|
||||
"HEAD^")
|
||||
(Hg
|
||||
"-2")
|
||||
(Bzr
|
||||
"revno:-2"))))))
|
||||
|
||||
;;;###autoload
|
||||
(define-globalized-minor-mode global-diff-hl-amend-mode diff-hl-amend-mode
|
||||
turn-on-diff-hl-amend-mode)
|
||||
|
||||
(defun turn-on-diff-hl-amend-mode ()
|
||||
"Turn on `diff-hl-amend-mode' in a buffer if appropriate."
|
||||
(and buffer-file-name (diff-hl-amend-mode 1)))
|
||||
|
||||
(provide 'diff-hl-amend)
|
||||
|
||||
;;; diff-hl-amend.el ends here
|
||||
184
lisp/diff-hl/diff-hl-dired.el
Normal file
184
lisp/diff-hl/diff-hl-dired.el
Normal file
@@ -0,0 +1,184 @@
|
||||
;;; diff-hl-dired.el --- Highlight changed files in Dired -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; 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:
|
||||
|
||||
;; To enable in all Dired buffers, add this to your init file:
|
||||
;;
|
||||
;; (add-hook 'dired-mode-hook 'diff-hl-dired-mode)
|
||||
;;
|
||||
;; or
|
||||
;;
|
||||
;; (add-hook 'dired-mode-hook 'diff-hl-dired-mode-unless-remote)
|
||||
;;
|
||||
;; to do it only in local Dired buffers.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'diff-hl)
|
||||
(require 'dired)
|
||||
(require 'vc-hooks)
|
||||
|
||||
(defvar diff-hl-dired-process-buffer nil)
|
||||
|
||||
(defgroup diff-hl-dired nil
|
||||
"VC diff highlighting on the side of a Dired window."
|
||||
:group 'diff-hl)
|
||||
|
||||
(defface diff-hl-dired-insert
|
||||
'((default :inherit diff-hl-insert))
|
||||
"Face used to highlight added files.")
|
||||
|
||||
(defface diff-hl-dired-delete
|
||||
'((default :inherit diff-hl-delete))
|
||||
"Face used to highlight directories with deleted files.")
|
||||
|
||||
(defface diff-hl-dired-change
|
||||
'((default :inherit diff-hl-change))
|
||||
"Face used to highlight changed files.")
|
||||
|
||||
(defface diff-hl-dired-unknown
|
||||
'((default :inherit dired-ignored))
|
||||
"Face used to highlight unregistered files.")
|
||||
|
||||
(defface diff-hl-dired-ignored
|
||||
'((default :inherit dired-ignored))
|
||||
"Face used to highlight unregistered files.")
|
||||
|
||||
(defcustom diff-hl-dired-extra-indicators t
|
||||
"Non-nil to indicate ignored files."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom diff-hl-dired-ignored-backends '(RCS)
|
||||
"VC backends to ignore.
|
||||
The directories registered to one of these backends won't have
|
||||
status indicators."
|
||||
:type `(repeat (choice ,@(mapcar
|
||||
(lambda (name)
|
||||
`(const :tag ,(symbol-name name) ,name))
|
||||
vc-handled-backends))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode diff-hl-dired-mode
|
||||
"Toggle VC diff highlighting on the side of a Dired window."
|
||||
:lighter ""
|
||||
(if diff-hl-dired-mode
|
||||
(progn
|
||||
(diff-hl-maybe-define-bitmaps)
|
||||
(set (make-local-variable 'diff-hl-dired-process-buffer) nil)
|
||||
(add-hook 'dired-after-readin-hook 'diff-hl-dired-update nil t))
|
||||
(remove-hook 'dired-after-readin-hook 'diff-hl-dired-update t)
|
||||
(diff-hl-dired-clear)))
|
||||
|
||||
(defun diff-hl-dired-update ()
|
||||
"Highlight the Dired buffer."
|
||||
(let ((backend (ignore-errors (vc-responsible-backend default-directory)))
|
||||
(def-dir default-directory)
|
||||
(buffer (current-buffer))
|
||||
dirs-alist files-alist)
|
||||
(when (and backend (not (memq backend diff-hl-dired-ignored-backends)))
|
||||
(diff-hl-dired-clear)
|
||||
(if (buffer-live-p diff-hl-dired-process-buffer)
|
||||
(let ((proc (get-buffer-process diff-hl-dired-process-buffer)))
|
||||
(when proc (kill-process proc)))
|
||||
(setq diff-hl-dired-process-buffer
|
||||
(generate-new-buffer " *diff-hl-dired* tmp status")))
|
||||
(with-current-buffer diff-hl-dired-process-buffer
|
||||
(setq default-directory (expand-file-name def-dir))
|
||||
(erase-buffer)
|
||||
(diff-hl-dired-status-files
|
||||
backend def-dir
|
||||
(when diff-hl-dired-extra-indicators
|
||||
(cl-loop for file in (directory-files def-dir)
|
||||
unless (member file '("." ".." ".hg"))
|
||||
collect file))
|
||||
(lambda (entries &optional more-to-come)
|
||||
(when (buffer-live-p buffer)
|
||||
(with-current-buffer buffer
|
||||
(dolist (entry entries)
|
||||
(cl-destructuring-bind (file state &rest r) entry
|
||||
;; Work around http://debbugs.gnu.org/18605
|
||||
(setq file (replace-regexp-in-string "\\` " "" file))
|
||||
(let ((type (plist-get
|
||||
'(edited change added insert removed delete
|
||||
unregistered unknown ignored ignored)
|
||||
state)))
|
||||
(if (string-match "\\`\\([^/]+\\)/" file)
|
||||
(let* ((dir (match-string 1 file))
|
||||
(value (cdr (assoc dir dirs-alist))))
|
||||
(unless (eq value type)
|
||||
(cond
|
||||
((eq state 'up-to-date))
|
||||
((null value)
|
||||
(push (cons dir type) dirs-alist))
|
||||
((not (eq type 'ignored))
|
||||
(setcdr (assoc dir dirs-alist) 'change)))))
|
||||
(push (cons file type) files-alist)))))
|
||||
(unless more-to-come
|
||||
(diff-hl-dired-highlight-items
|
||||
(append dirs-alist files-alist))))
|
||||
(unless more-to-come
|
||||
(kill-buffer diff-hl-dired-process-buffer))))
|
||||
)))))
|
||||
|
||||
(defun diff-hl-dired-status-files (backend dir files update-function)
|
||||
"Using version control BACKEND, return list of (FILE STATE EXTRA) entries
|
||||
for DIR containing FILES. Call UPDATE-FUNCTION as entries are added."
|
||||
(if (version< "25" emacs-version)
|
||||
(vc-call-backend backend 'dir-status-files dir files update-function)
|
||||
(vc-call-backend backend 'dir-status-files dir files nil update-function)))
|
||||
|
||||
(when (version< emacs-version "24.4.51.5")
|
||||
;; Work around http://debbugs.gnu.org/19386
|
||||
(defadvice vc-git-dir-status-goto-stage (around
|
||||
diff-hl-dired-skip-up-to-date
|
||||
(stage files update-function)
|
||||
activate)
|
||||
(when (eq stage 'ls-files-up-to-date)
|
||||
(setq stage 'diff-index))
|
||||
ad-do-it))
|
||||
|
||||
(defun diff-hl-dired-highlight-items (alist)
|
||||
"Highlight ALIST containing (FILE . TYPE) elements."
|
||||
(dolist (pair alist)
|
||||
(let ((file (car pair))
|
||||
(type (cdr pair)))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (and type (dired-goto-file-1
|
||||
file (expand-file-name file) nil))
|
||||
(let* ((diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-type)
|
||||
(diff-hl-fringe-face-function 'diff-hl-dired-face-from-type)
|
||||
(o (diff-hl-add-highlighting type 'single)))
|
||||
(overlay-put o 'modification-hooks '(diff-hl-overlay-modified))
|
||||
))))))
|
||||
|
||||
(defun diff-hl-dired-face-from-type (type _pos)
|
||||
(intern (format "diff-hl-dired-%s" type)))
|
||||
|
||||
(defalias 'diff-hl-dired-clear 'diff-hl-remove-overlays)
|
||||
|
||||
;;;###autoload
|
||||
(defun diff-hl-dired-mode-unless-remote ()
|
||||
(unless (file-remote-p default-directory)
|
||||
(diff-hl-dired-mode)))
|
||||
|
||||
(provide 'diff-hl-dired)
|
||||
|
||||
;;; diff-hl-dired.el ends here
|
||||
177
lisp/diff-hl/diff-hl-flydiff.el
Normal file
177
lisp/diff-hl/diff-hl-flydiff.el
Normal file
@@ -0,0 +1,177 @@
|
||||
;; Copyright (C) 2015-2018 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jonathan Hayase <PythonNut@gmail.com>
|
||||
;; URL: https://github.com/dgutov/diff-hl
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This mode enables diffing on-the-fly (i.e. without saving the buffer first)
|
||||
;; Toggle in all buffers with M-x diff-hl-flydiff-mode
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'diff-hl)
|
||||
(require 'diff)
|
||||
(unless (require 'nadvice nil t)
|
||||
(error "`diff-hl-flydiff-mode' requires Emacs 24.4 or newer"))
|
||||
|
||||
(defgroup diff-hl-flydiff nil
|
||||
"Highlight changes on the fly"
|
||||
:group 'diff-hl)
|
||||
|
||||
(defcustom diff-hl-flydiff-delay 0.3
|
||||
"The idle delay in seconds before highlighting is updated."
|
||||
:type 'number)
|
||||
|
||||
(defvar diff-hl-flydiff-modified-tick nil)
|
||||
(defvar diff-hl-flydiff-timer nil)
|
||||
(make-variable-buffer-local 'diff-hl-flydiff-modified-tick)
|
||||
|
||||
(defun diff-hl-flydiff/vc-git--symbolic-ref (file)
|
||||
(or
|
||||
(vc-file-getprop file 'vc-git-symbolic-ref)
|
||||
(let* (process-file-side-effects
|
||||
(str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
|
||||
(vc-file-setprop file 'vc-git-symbolic-ref
|
||||
(if str
|
||||
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
|
||||
(match-string 2 str)
|
||||
str))))))
|
||||
|
||||
(defun diff-hl-flydiff/vc-git-working-revision (_file)
|
||||
"Git-specific version of `vc-working-revision'."
|
||||
(let (process-file-side-effects)
|
||||
(vc-git--rev-parse "HEAD")))
|
||||
|
||||
(defun diff-hl-flydiff/vc-git-mode-line-string (file)
|
||||
"Return a string for `vc-mode-line' to put in the mode line for FILE."
|
||||
(let* ((rev (vc-working-revision file))
|
||||
(disp-rev (or (diff-hl-flydiff/vc-git--symbolic-ref file)
|
||||
(substring rev 0 7)))
|
||||
(def-ml (vc-default-mode-line-string 'Git file))
|
||||
(help-echo (get-text-property 0 'help-echo def-ml))
|
||||
(face (get-text-property 0 'face def-ml)))
|
||||
(propertize (replace-regexp-in-string (concat rev "\\'") disp-rev def-ml t t)
|
||||
'face face
|
||||
'help-echo (concat help-echo "\nCurrent revision: " rev))))
|
||||
|
||||
;; Polyfill concrete revisions for vc-git-working-revision in Emacs 24.4, 24.5
|
||||
(when (version<= emacs-version "25.0")
|
||||
(with-eval-after-load 'vc-git
|
||||
(advice-add 'vc-git-working-revision :override
|
||||
#'diff-hl-flydiff/vc-git-working-revision)
|
||||
(advice-add 'vc-git-mode-line-string :override
|
||||
#'diff-hl-flydiff/vc-git-mode-line-string)))
|
||||
|
||||
(defun diff-hl-flydiff/working-revision (file)
|
||||
"Like vc-working-revision, but always up-to-date"
|
||||
(vc-file-setprop file 'vc-working-revision
|
||||
(vc-call-backend (vc-backend file) 'working-revision file)))
|
||||
|
||||
(defun diff-hl-flydiff-make-temp-file-name (file rev &optional manual)
|
||||
"Return a backup file name for REV or the current version of FILE.
|
||||
If MANUAL is non-nil it means that a name for backups created by
|
||||
the user should be returned."
|
||||
(let* ((auto-save-file-name-transforms
|
||||
`((".*" ,temporary-file-directory t))))
|
||||
(expand-file-name
|
||||
(concat (make-auto-save-file-name)
|
||||
".~" (subst-char-in-string
|
||||
?/ ?_ rev)
|
||||
(unless manual ".") "~")
|
||||
temporary-file-directory)))
|
||||
|
||||
(defun diff-hl-flydiff-create-revision (file revision)
|
||||
"Read REVISION of FILE into a buffer and return the buffer."
|
||||
(let ((automatic-backup (diff-hl-flydiff-make-temp-file-name file revision))
|
||||
(filebuf (get-file-buffer file))
|
||||
(filename (diff-hl-flydiff-make-temp-file-name file revision 'manual)))
|
||||
(unless (file-exists-p filename)
|
||||
(if (file-exists-p automatic-backup)
|
||||
(rename-file automatic-backup filename nil)
|
||||
(with-current-buffer filebuf
|
||||
(let ((coding-system-for-read 'no-conversion)
|
||||
(coding-system-for-write 'no-conversion))
|
||||
(condition-case nil
|
||||
(with-temp-file filename
|
||||
(let ((outbuf (current-buffer)))
|
||||
;; Change buffer to get local value of
|
||||
;; vc-checkout-switches.
|
||||
(with-current-buffer filebuf
|
||||
(vc-call find-revision file revision outbuf))))
|
||||
(error
|
||||
(when (file-exists-p filename)
|
||||
(delete-file filename))))))))
|
||||
filename))
|
||||
|
||||
(defun diff-hl-flydiff-buffer-with-head (file &optional backend)
|
||||
"View the differences between BUFFER and its associated file.
|
||||
This requires the external program `diff' to be in your `exec-path'."
|
||||
(interactive)
|
||||
(vc-ensure-vc-buffer)
|
||||
(setq diff-hl-flydiff-modified-tick (buffer-chars-modified-tick))
|
||||
(save-current-buffer
|
||||
(let* ((temporary-file-directory
|
||||
(if (file-directory-p "/dev/shm/")
|
||||
"/dev/shm/"
|
||||
temporary-file-directory))
|
||||
(rev (diff-hl-flydiff-create-revision
|
||||
file
|
||||
(or diff-hl-reference-revision
|
||||
(diff-hl-flydiff/working-revision file)))))
|
||||
;; FIXME: When against staging, do it differently!
|
||||
(diff-no-select rev (current-buffer) "-U 0 --strip-trailing-cr" 'noasync
|
||||
(get-buffer-create " *diff-hl-diff*")))))
|
||||
|
||||
(defun diff-hl-flydiff-update ()
|
||||
(unless (or
|
||||
(not diff-hl-mode)
|
||||
(eq diff-hl-flydiff-modified-tick (buffer-chars-modified-tick))
|
||||
(not buffer-file-name)
|
||||
(not (file-exists-p buffer-file-name))
|
||||
(file-remote-p default-directory))
|
||||
(diff-hl-update)))
|
||||
|
||||
(defun diff-hl-flydiff/modified-p (state)
|
||||
(buffer-modified-p))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode diff-hl-flydiff-mode
|
||||
"Perform highlighting on-the-fly.
|
||||
This is a global minor mode. It alters how `diff-hl-mode' works."
|
||||
:lighter "" :global t
|
||||
(if diff-hl-flydiff-mode
|
||||
(progn
|
||||
(advice-add 'diff-hl-overlay-modified :override #'ignore)
|
||||
|
||||
(advice-add 'diff-hl-modified-p :before-until
|
||||
#'diff-hl-flydiff/modified-p)
|
||||
(advice-add 'diff-hl-changes-buffer :override
|
||||
#'diff-hl-flydiff-buffer-with-head)
|
||||
(setq diff-hl-flydiff-timer
|
||||
(run-with-idle-timer diff-hl-flydiff-delay t #'diff-hl-flydiff-update)))
|
||||
|
||||
(advice-remove 'diff-hl-overlay-modified #'ignore)
|
||||
|
||||
(advice-remove 'diff-hl-modified-p #'diff-hl-flydiff/modified-p)
|
||||
(advice-remove 'diff-hl-changes-buffer #'diff-hl-flydiff-buffer-with-head)
|
||||
|
||||
(and diff-hl-flydiff-timer
|
||||
(cancel-timer diff-hl-flydiff-timer))))
|
||||
|
||||
(provide 'diff-hl-flydiff)
|
||||
154
lisp/diff-hl/diff-hl-margin.el
Normal file
154
lisp/diff-hl/diff-hl-margin.el
Normal file
@@ -0,0 +1,154 @@
|
||||
;;; diff-hl-margin.el --- Highlight buffer changes on margins -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This is a global mode, it modifies `diff-hl-mode' to use the margin
|
||||
;; instead of the fringe. To toggle, type `M-x diff-hl-margin-mode'.
|
||||
;;
|
||||
;; Compared to the default behavior, this makes `diff-hl-mode'
|
||||
;; indicators show up even when Emacs is running in a terminal.
|
||||
;;
|
||||
;; On the flip side, the indicators look simpler, and they are
|
||||
;; incompatible with `linum-mode' or any other mode that uses the
|
||||
;; margin.
|
||||
;;
|
||||
;; You might want to enable it conditionally in your init file
|
||||
;; depending on whether Emacs is running in graphical mode:
|
||||
;;
|
||||
;; (unless (window-system) (diff-hl-margin-mode))
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'diff-hl)
|
||||
(require 'diff-hl-dired)
|
||||
|
||||
(defvar diff-hl-margin-old-highlight-function nil)
|
||||
|
||||
(defgroup diff-hl-margin nil
|
||||
"Highlight buffer changes on margin"
|
||||
:group 'diff-hl)
|
||||
|
||||
(defface diff-hl-margin-insert
|
||||
'((default :inherit diff-hl-insert))
|
||||
"Face used to highlight inserted lines on the margin.")
|
||||
|
||||
(defface diff-hl-margin-delete
|
||||
'((default :inherit diff-hl-delete))
|
||||
"Face used to highlight deleted lines on the margin.")
|
||||
|
||||
(defface diff-hl-margin-change
|
||||
'((default :inherit diff-hl-change))
|
||||
"Face used to highlight changed lines on the margin.")
|
||||
|
||||
(defface diff-hl-margin-ignored
|
||||
'((default :inherit dired-ignored))
|
||||
"Face used to highlight changed lines on the margin.")
|
||||
|
||||
(defface diff-hl-margin-unknown
|
||||
'((default :inherit dired-ignored))
|
||||
"Face used to highlight changed lines on the margin.")
|
||||
|
||||
(defcustom diff-hl-margin-symbols-alist
|
||||
'((insert . "+") (delete . "-") (change . "!")
|
||||
(unknown . "?") (ignored . "i"))
|
||||
"Associative list from symbols to strings."
|
||||
:type '(alist :key-type symbol
|
||||
:value-type string
|
||||
:options (insert delete change unknown ignored))
|
||||
:set (lambda (symbol value)
|
||||
(defvar diff-hl-margin-spec-cache)
|
||||
(set-default symbol value)
|
||||
(setq diff-hl-margin-spec-cache nil)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode diff-hl-margin-mode
|
||||
"Toggle displaying `diff-hl-mode' highlights on the margin."
|
||||
:lighter "" :global t
|
||||
(if diff-hl-margin-mode
|
||||
(progn
|
||||
(add-hook 'diff-hl-mode-on-hook 'diff-hl-margin-minor-mode)
|
||||
(add-hook 'diff-hl-mode-off-hook 'diff-hl-margin-minor-mode-off)
|
||||
(add-hook 'diff-hl-dired-mode-on-hook 'diff-hl-margin-minor-mode)
|
||||
(add-hook 'diff-hl-dired-mode-off-hook 'diff-hl-margin-minor-mode-off))
|
||||
(remove-hook 'diff-hl-mode-on-hook 'diff-hl-margin-minor-mode)
|
||||
(remove-hook 'diff-hl-mode-off-hook 'diff-hl-margin-minor-mode-off)
|
||||
(remove-hook 'diff-hl-dired-mode-on-hook 'diff-hl-margin-minor-mode)
|
||||
(remove-hook 'diff-hl-dired-mode-off-hook 'diff-hl-margin-minor-mode-off))
|
||||
(dolist (buf (buffer-list))
|
||||
(with-current-buffer buf
|
||||
(cond
|
||||
(diff-hl-mode
|
||||
(diff-hl-margin-minor-mode (if diff-hl-margin-mode 1 -1))
|
||||
(diff-hl-update))
|
||||
(diff-hl-dired-mode
|
||||
(diff-hl-margin-minor-mode (if diff-hl-margin-mode 1 -1))
|
||||
(diff-hl-dired-update))))))
|
||||
|
||||
(define-minor-mode diff-hl-margin-minor-mode
|
||||
"Toggle displaying `diff-hl-mode' highlights on the margin locally.
|
||||
You probably shouldn't use this function directly."
|
||||
:lighter ""
|
||||
(let ((width-var (intern (format "%s-margin-width" diff-hl-side))))
|
||||
(if diff-hl-margin-minor-mode
|
||||
(progn
|
||||
(set (make-local-variable 'diff-hl-margin-old-highlight-function)
|
||||
diff-hl-highlight-function)
|
||||
(set (make-local-variable 'diff-hl-highlight-function)
|
||||
'diff-hl-highlight-on-margin)
|
||||
(set width-var 1))
|
||||
(when diff-hl-margin-old-highlight-function
|
||||
(setq diff-hl-highlight-function diff-hl-margin-old-highlight-function
|
||||
diff-hl-margin-old-highlight-function nil))
|
||||
(set width-var 0)))
|
||||
(dolist (win (get-buffer-window-list))
|
||||
(set-window-buffer win (current-buffer))))
|
||||
|
||||
(define-obsolete-variable-alias 'diff-hl-margin-side 'diff-hl-side "1.7.1")
|
||||
|
||||
(defun diff-hl-margin-minor-mode-off ()
|
||||
(diff-hl-margin-minor-mode -1))
|
||||
|
||||
(defvar diff-hl-margin-spec-cache nil)
|
||||
|
||||
(defun diff-hl-margin-spec-cache ()
|
||||
(or diff-hl-margin-spec-cache
|
||||
(setq diff-hl-margin-spec-cache
|
||||
(diff-hl-margin-build-spec-cache))))
|
||||
|
||||
(defun diff-hl-margin-build-spec-cache ()
|
||||
(cl-loop for (type . char) in diff-hl-margin-symbols-alist
|
||||
nconc
|
||||
(cl-loop for side in '(left right)
|
||||
collect
|
||||
(cons
|
||||
(cons type side)
|
||||
(propertize
|
||||
" " 'display
|
||||
`((margin ,(intern (format "%s-margin" side)))
|
||||
,(propertize char 'face
|
||||
(intern (format "diff-hl-margin-%s" type)))))))))
|
||||
|
||||
(defun diff-hl-highlight-on-margin (ovl type _shape)
|
||||
(let ((spec (cdr (assoc (cons type diff-hl-side)
|
||||
(diff-hl-margin-spec-cache)))))
|
||||
(overlay-put ovl 'before-string spec)))
|
||||
|
||||
(provide 'diff-hl-margin)
|
||||
|
||||
;;; diff-hl-margin.el ends here
|
||||
13
lisp/diff-hl/diff-hl-pkg.el
Normal file
13
lisp/diff-hl/diff-hl-pkg.el
Normal file
@@ -0,0 +1,13 @@
|
||||
(define-package "diff-hl" "20200604.1223" "Highlight uncommitted changes using VC"
|
||||
'((cl-lib "0.2")
|
||||
(emacs "24.3"))
|
||||
:commit "176f931a9bfc6bc6fc5360c6ed7128ff96b21289" :keywords
|
||||
'("vc" "diff")
|
||||
:authors
|
||||
'(("Dmitry Gutov" . "dgutov@yandex.ru"))
|
||||
:maintainer
|
||||
'("Dmitry Gutov" . "dgutov@yandex.ru")
|
||||
:url "https://github.com/dgutov/diff-hl")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
669
lisp/diff-hl/diff-hl.el
Normal file
669
lisp/diff-hl/diff-hl.el
Normal file
@@ -0,0 +1,669 @@
|
||||
;;; diff-hl.el --- Highlight uncommitted changes using VC -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Dmitry Gutov <dgutov@yandex.ru>
|
||||
;; URL: https://github.com/dgutov/diff-hl
|
||||
;; Keywords: vc, diff
|
||||
;; Version: 1.8.7
|
||||
;; Package-Requires: ((cl-lib "0.2") (emacs "24.3"))
|
||||
|
||||
;; 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 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-ask-before-revert-hunk t
|
||||
"Non-nil to ask for confirmation before revert a hunk."
|
||||
: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)
|
||||
|
||||
(defcustom diff-hl-side 'left
|
||||
"Which side to use for indicators."
|
||||
:type '(choice (const left)
|
||||
(const right))
|
||||
:set (lambda (var value)
|
||||
(let ((on (bound-and-true-p global-diff-hl-mode)))
|
||||
(when on (global-diff-hl-mode -1))
|
||||
(set-default var value)
|
||||
(when on (global-diff-hl-mode 1)))))
|
||||
|
||||
(defcustom diff-hl-highlight-revert-hunk-function
|
||||
#'diff-hl-revert-highlight-first-column
|
||||
"Function to highlight the current hunk in `diff-hl-revert-hunk'.
|
||||
The function is called at the beginning of the hunk and passed
|
||||
the end position as its only argument."
|
||||
:type '(choice (const :tag "Do nothing" ignore)
|
||||
(const :tag "Highlight the first column"
|
||||
diff-hl-revert-highlight-first-column)))
|
||||
|
||||
(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 (min (frame-parameter nil (intern (format "%s-fringe" diff-hl-side)))
|
||||
16))
|
||||
(_ (when (zerop w) (setq w 16)))
|
||||
(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))))
|
||||
|
||||
(defun diff-hl-maybe-redefine-bitmaps ()
|
||||
(when (window-system)
|
||||
(diff-hl-define-bitmaps)))
|
||||
|
||||
(defvar diff-hl-spec-cache (make-hash-table :test 'equal))
|
||||
|
||||
(defun diff-hl-fringe-spec (type pos side)
|
||||
(let* ((key (list type pos side
|
||||
diff-hl-fringe-face-function
|
||||
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 `((,(intern (format "%s-fringe" side))
|
||||
,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
|
||||
;; https://github.com/dgutov/diff-hl/issues/67
|
||||
(cons "-U0"
|
||||
;; https://github.com/dgutov/diff-hl/issues/9
|
||||
(and (boundp 'vc-git-diff-switches)
|
||||
(listp vc-git-diff-switches)
|
||||
(cl-remove-if-not
|
||||
(lambda (arg)
|
||||
(member arg '("--histogram" "--patience" "--minimal")))
|
||||
vc-git-diff-switches))))
|
||||
(vc-hg-diff-switches nil)
|
||||
(vc-svn-diff-switches nil)
|
||||
(vc-diff-switches '("-U0"))
|
||||
,@(when (boundp 'vc-disable-async-diff)
|
||||
'((vc-disable-async-diff t))))
|
||||
,body))
|
||||
|
||||
(defun diff-hl-modified-p (state)
|
||||
(or (memq state '(edited conflict))
|
||||
(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))))
|
||||
|
||||
(defun diff-hl-changes-buffer (file backend)
|
||||
;; FIXME: To diff against the staging area, call 'git diff-files -p'.
|
||||
(let ((buf-name " *diff-hl* "))
|
||||
(condition-case err
|
||||
(diff-hl-with-diff-switches
|
||||
(vc-call-backend backend 'diff (list file)
|
||||
diff-hl-reference-revision nil
|
||||
buf-name))
|
||||
(error
|
||||
;; https://github.com/dgutov/diff-hl/issues/117
|
||||
(when (string-match-p "\\`Failed (status 128)" (error-message-string err))
|
||||
(diff-hl-with-diff-switches
|
||||
(vc-call-backend backend 'diff (list file)
|
||||
"4b825dc642cb6eb9a060e54bf8d69288fbee4904"
|
||||
nil
|
||||
buf-name)))))
|
||||
buf-name))
|
||||
|
||||
(defun diff-hl-changes ()
|
||||
(let* ((file buffer-file-name)
|
||||
(backend (vc-backend file)))
|
||||
(when backend
|
||||
(let ((state (vc-state file backend)))
|
||||
(cond
|
||||
((diff-hl-modified-p state)
|
||||
(let* (diff-auto-refine-mode res)
|
||||
(with-current-buffer (diff-hl-changes-buffer file backend)
|
||||
(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
|
||||
(save-restriction
|
||||
(widen)
|
||||
(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
|
||||
diff-hl-side)))
|
||||
|
||||
(defun diff-hl-remove-overlays (&optional beg end)
|
||||
(save-restriction
|
||||
(widen)
|
||||
(dolist (o (overlays-in (or beg (point-min)) (or end (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)
|
||||
(diff-hl-remove-overlays (overlay-start ov) (overlay-end ov))
|
||||
(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-1 ()
|
||||
(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-goto-hunk ()
|
||||
"Run VC diff command and go to the line corresponding to the current."
|
||||
(interactive)
|
||||
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
|
||||
(diff-hl-diff-goto-hunk-1)))
|
||||
|
||||
(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))))))))))
|
||||
|
||||
(defface diff-hl-reverted-hunk-highlight
|
||||
'((default :inverse-video t))
|
||||
"Face used to highlight the first column of the hunk to be reverted.")
|
||||
|
||||
(defun diff-hl-revert-highlight-first-column (end)
|
||||
(let ((inhibit-read-only t))
|
||||
(save-excursion
|
||||
(while (< (point) end)
|
||||
(font-lock-prepend-text-property (point) (1+ (point)) 'font-lock-face
|
||||
'diff-hl-reverted-hunk-highlight)
|
||||
(forward-line 1)))))
|
||||
|
||||
(defun diff-hl-revert-hunk-1 ()
|
||||
(save-restriction
|
||||
(widen)
|
||||
(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 m-end)
|
||||
(when (eobp)
|
||||
(with-current-buffer ,buffer (diff-hl-remove-overlays))
|
||||
(user-error "Buffer is up-to-date"))
|
||||
(let (diff-auto-refine-mode)
|
||||
(diff-hl-diff-skip-to ,line))
|
||||
(save-excursion
|
||||
(while (looking-at "[-+]") (forward-line 1))
|
||||
(setq end-line (line-number-at-pos (point)))
|
||||
(setq m-end (point-marker))
|
||||
(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))
|
||||
(funcall diff-hl-highlight-revert-hunk-function m-end)
|
||||
(let ((wbh (window-body-height)))
|
||||
(if (>= wbh (- end-line beg-line))
|
||||
(recenter (/ (+ wbh (- beg-line end-line) 2) 2))
|
||||
(recenter 1)))
|
||||
(when diff-auto-refine-mode
|
||||
(diff-refine-hunk))
|
||||
(if diff-hl-ask-before-revert-hunk
|
||||
(unless (yes-or-no-p (format "Revert current hunk in %s? "
|
||||
,(cl-caadr fileset)))
|
||||
(user-error "Revert canceled")))
|
||||
(let ((diff-advance-after-apply-hunk nil))
|
||||
(save-window-excursion
|
||||
(diff-apply-hunk t)))
|
||||
(with-current-buffer ,buffer
|
||||
(save-buffer))
|
||||
(message "Hunk reverted"))))
|
||||
(quit-windows-on diff-buffer t)))))
|
||||
|
||||
(defun diff-hl-revert-hunk ()
|
||||
"Revert the diff hunk with changes at or above the point."
|
||||
(interactive)
|
||||
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
|
||||
(diff-hl-revert-hunk-1)))
|
||||
|
||||
(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)
|
||||
(user-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))
|
||||
|
||||
(defun diff-hl-mark-hunk ()
|
||||
(interactive)
|
||||
(let ((hunk (diff-hl-hunk-overlay-at (point))))
|
||||
(unless hunk
|
||||
(user-error "No hunk at point"))
|
||||
(goto-char (overlay-start hunk))
|
||||
(push-mark (overlay-end hunk) nil t)))
|
||||
|
||||
(defvar diff-hl-command-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "n" 'diff-hl-revert-hunk)
|
||||
(define-key map "[" 'diff-hl-previous-hunk)
|
||||
(define-key map "]" 'diff-hl-next-hunk)
|
||||
map))
|
||||
(fset 'diff-hl-command-map diff-hl-command-map)
|
||||
|
||||
(defvar diff-hl-lighter ""
|
||||
"Mode line lighter for Diff Hl.
|
||||
|
||||
The value of this variable is a mode line template as in
|
||||
`mode-line-format'.")
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode diff-hl-mode
|
||||
"Toggle VC diff highlighting."
|
||||
:lighter diff-hl-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 versions 2.0-2.3 don't do the above and call this
|
||||
;; instead, but only when they don't call `revert-buffer':
|
||||
(add-hook 'magit-not-reverted-hook 'diff-hl-update nil t)
|
||||
(add-hook 'text-scale-mode-hook 'diff-hl-maybe-redefine-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 'text-scale-mode-hook 'diff-hl-maybe-redefine-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))))
|
||||
|
||||
(declare-function magit-toplevel "magit-git")
|
||||
(declare-function magit-unstaged-files "magit-git")
|
||||
|
||||
(defvar diff-hl--magit-unstaged-files nil)
|
||||
|
||||
(defun diff-hl-magit-pre-refresh ()
|
||||
(setq diff-hl--magit-unstaged-files (magit-unstaged-files t)))
|
||||
|
||||
(defun diff-hl-magit-post-refresh ()
|
||||
(let* ((topdir (magit-toplevel))
|
||||
(modified-files
|
||||
(mapcar (lambda (file) (expand-file-name file topdir))
|
||||
(delete-consecutive-dups
|
||||
(sort
|
||||
(nconc (magit-unstaged-files t)
|
||||
diff-hl--magit-unstaged-files)
|
||||
#'string<))))
|
||||
(unmodified-states '(up-to-date ignored unregistered)))
|
||||
(setq diff-hl--magit-unstaged-files nil)
|
||||
(dolist (buf (buffer-list))
|
||||
(when (and (buffer-local-value 'diff-hl-mode buf)
|
||||
(not (buffer-modified-p buf))
|
||||
;; Solve the "cloned indirect buffer" problem
|
||||
;; (diff-hl-mode could be non-nil there, even if
|
||||
;; buffer-file-name is nil):
|
||||
(buffer-file-name buf)
|
||||
(file-in-directory-p (buffer-file-name buf) topdir)
|
||||
(file-exists-p (buffer-file-name buf)))
|
||||
(with-current-buffer buf
|
||||
(let* ((file buffer-file-name)
|
||||
(backend (vc-backend file)))
|
||||
(when backend
|
||||
(cond
|
||||
((member file modified-files)
|
||||
(when (memq (vc-state file) unmodified-states)
|
||||
(vc-state-refresh file backend))
|
||||
(diff-hl-update))
|
||||
((not (memq (vc-state file backend) unmodified-states))
|
||||
(vc-state-refresh file backend)
|
||||
(diff-hl-update))))))))))
|
||||
|
||||
(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
|
||||
Reference in New Issue
Block a user