branch: externals/diff-hl
commit 679f557305030d14cba001954acaf358363ebbfe
Author: Álvaro González <alvarogonzalezsoti...@gmail.com>
Commit: Dmitry Gutov <dgu...@yandex.ru>
New feature: diff-hl-show-hunk
Resolves #147, resolves #112.
This adds new commands, an optional minor mode, and two backends, one
of which depends on`posframe`, an external package.
See https://github.com/dgutov/diff-hl/pull/147 for general discussion.
---
README.md | 3 +
diff-hl-flydiff.el | 64 +-----
diff-hl-inline-popup.el | 275 ++++++++++++++++++++++++++
diff-hl-show-hunk-posframe.el | 238 +++++++++++++++++++++++
diff-hl-show-hunk.el | 439 ++++++++++++++++++++++++++++++++++++++++++
diff-hl.el | 95 +++++++--
6 files changed, 1044 insertions(+), 70 deletions(-)
diff --git a/README.md b/README.md
index b64d228..13c63d3 100644
--- a/README.md
+++ b/README.md
@@ -19,6 +19,9 @@ The package also contains auxiliary modes:
it to any revision, see its docstring for details.
* `diff-hl-flydiff-mode` implements highlighting changes on the fly.
It requires Emacs 24.4 or newer.
+* `diff-hl-show-hunk-mouse-mode` makes fringe and margin react to
+ mouse clicks to show the curresponding hunk. That's the alternative
+ to using the `diff-hl-show-hunk` family of commands.
Usage
=====
diff --git a/diff-hl-flydiff.el b/diff-hl-flydiff.el
index 3f8c926..51ba0af 100644
--- a/diff-hl-flydiff.el
+++ b/diff-hl-flydiff.el
@@ -78,65 +78,11 @@
(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-buffer-with-head (file &optional _backend)
+ "View the differences between FILE and its associated file in HEAD revision.
+This requires the external program `diff' to be in your
+`exec-path'."
+ (diff-hl-diff-buffer-with-head file " *diff-hl-diff*"))
(defun diff-hl-flydiff-update ()
(unless (or
diff --git a/diff-hl-inline-popup.el b/diff-hl-inline-popup.el
new file mode 100644
index 0000000..dee159e
--- /dev/null
+++ b/diff-hl-inline-popup.el
@@ -0,0 +1,275 @@
+;;; diff-hl-inline-popup.el --- inline popup using phantom overlays -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Álvaro González <alvarogonzalezsoti...@gmail.com>
+
+;; 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:
+;; Shows inline popups using phantom overlays. The lines of the popup
+;; can be scrolled.
+;;; Code:
+
+(require 'subr-x)
+
+(defvar diff-hl-inline-popup--current-popup nil "The overlay of the current
inline popup.")
+(defvar diff-hl-inline-popup--current-lines nil "A list of the lines to show
in the popup.")
+(defvar diff-hl-inline-popup--current-index nil "First line showed in popup.")
+(defvar diff-hl-inline-popup--invokinkg-command nil "Command that invoked the
popup.")
+(defvar diff-hl-inline-popup--current-footer nil "String to be displayed in
the footer.")
+(defvar diff-hl-inline-popup--current-header nil "String to be displayed in
the header.")
+(defvar diff-hl-inline-popup--height nil "Height of the popup.")
+(defvar diff-hl-inline-popup--current-custom-keymap nil "Keymap to be added to
the keymap of the inline popup.")
+(defvar diff-hl-inline-popup--close-hook nil "Function to be called when the
popup closes.")
+
+(make-variable-buffer-local 'diff-hl-inline-popup--current-popup)
+(make-variable-buffer-local 'diff-hl-inline-popup--current-lines)
+(make-variable-buffer-local 'diff-hl-inline-popup--current-index)
+(make-variable-buffer-local 'diff-hl-inline-popup--current-header)
+(make-variable-buffer-local 'diff-hl-inline-popup--current-footer)
+(make-variable-buffer-local 'diff-hl-inline-popup--invokinkg-command)
+(make-variable-buffer-local 'diff-hl-inline-popup--current-custom-keymap)
+(make-variable-buffer-local 'diff-hl-inline-popup--height)
+(make-variable-buffer-local 'diff-hl-inline-popup--close-hook)
+
+(defun diff-hl-inline-popup--splice (list offset length)
+ "Compute a sublist of LIST starting at OFFSET, of LENGTH."
+ (butlast
+ (nthcdr offset list)
+ (- (length list) length offset)))
+
+(defun diff-hl-inline-popup--first-visible-line-in-window ()
+ "Return first visible line in current window."
+ (line-number-at-pos (window-start)))
+
+(defun diff-hl-inline-popup--ensure-enough-lines (pos content-height)
+ "Ensure there is enough lines below POS to show the inline popup with
CONTENT-HEIGHT height."
+ (let* ((line (line-number-at-pos pos))
+ (end (line-number-at-pos (window-end nil t)))
+ (height (+ 6 content-height))
+ (overflow (- (+ line height) end)))
+ (when (< 0 overflow)
+ (run-with-timer 0.1 nil #'scroll-up overflow))))
+
+(defun diff-hl-inline-popup--compute-content-height (&optional content-size)
+ "Compute the height of the inline popup.
+Default for CONTENT-SIZE is the size of the current lines"
+ (let ((content-size (or content-size (length
diff-hl-inline-popup--current-lines)))
+ (max-size (- (/(window-height) 2) 3)))
+ (min content-size max-size)))
+
+(defun diff-hl-inline-popup--compute-content-lines (lines index window-size)
+ "Compute the lines to show in the popup, from LINES starting at INDEX with a
WINDOW-SIZE."
+ (let* ((len (length lines))
+ (window-size (min window-size len))
+ (index (min index (- len window-size))))
+ (diff-hl-inline-popup--splice lines index window-size)))
+
+(defun diff-hl-inline-popup--compute-header (width &optional header)
+ "Compute the header of the popup, with some WIDTH, and some optional HEADER
text."
+ (let* ((scroll-indicator (if (eq diff-hl-inline-popup--current-index 0) "
" " ⬆ "))
+ (header (or header ""))
+ (new-width (- width (length header) (length scroll-indicator)))
+ (header (if (< new-width 0) "" header))
+ (new-width (- width (length header) (length scroll-indicator)))
+ (line (propertize (concat (diff-hl-inline-popup--separator new-width)
header scroll-indicator ) 'face '(:underline t))))
+ (concat line "\n") ))
+
+(defun diff-hl-inline-popup--compute-footer (width &optional footer)
+ "Compute the header of the popup, with some WIDTH, and some optional FOOTER
text."
+ (let* ((scroll-indicator (if (>= diff-hl-inline-popup--current-index (-
(length diff-hl-inline-popup--current-lines) diff-hl-inline-popup--height)) "
" " ⬇ "))
+ (footer (or footer ""))
+ (new-width (- width (length footer) (length scroll-indicator)))
+ (footer (if (< new-width 0) "" footer))
+ (new-width (- width (length footer) (length scroll-indicator)))
+ (blank-line (if (display-graphic-p)
+ ""
+ (propertize (concat "\n"
(diff-hl-inline-popup--separator width)) 'face '(:underline t))))
+ (line (propertize (concat (diff-hl-inline-popup--separator new-width)
footer scroll-indicator) 'face '(:overline t))))
+ (concat blank-line "\n" line)))
+
+(defun diff-hl-inline-popup--separator (width &optional sep)
+ "Return the horizontal separator with character SEP and a WIDTH."
+ (let ((sep (or sep ?\s)))
+ (make-string width sep)))
+
+(defun diff-hl-inline-popup--available-width ()
+ "Compute the available width in chars."
+ (let ((magic-adjust 3))
+ (if (not (display-graphic-p))
+ (let* ((linumber-width (line-number-display-width nil))
+ (width (- (window-body-width) linumber-width magic-adjust)))
+ width)
+ (let* ((font-width (window-font-width))
+ (window-width (window-body-width nil t))
+ (linenumber-width (line-number-display-width t))
+ (available-pixels (- window-width linenumber-width))
+ (width (- (/ available-pixels font-width) magic-adjust)))
+
+ ;;
https://emacs.stackexchange.com/questions/5495/how-can-i-determine-the-width-of-characters-on-the-screen
+ width))))
+
+
+(defun diff-hl-inline-popup--compute-popup-str (lines index window-size header
footer)
+ "Compute the string that represents the popup.
+There are some content LINES starting at INDEX, with a WINDOW-SIZE. HEADER and
+FOOTER are showed at start and end."
+ (let* ((width (diff-hl-inline-popup--available-width))
+ (content-lines (diff-hl-inline-popup--compute-content-lines lines
index window-size))
+ (header (diff-hl-inline-popup--compute-header width header))
+ (footer (diff-hl-inline-popup--compute-footer width footer)))
+ (concat header (string-join content-lines "\n" ) footer "\n")))
+
+(defun diff-hl-inline-popup-scroll-to (index)
+ "Scroll the inline popup to make visible the line at position INDEX."
+ (when diff-hl-inline-popup--current-popup
+ (setq diff-hl-inline-popup--current-index (max 0 (min index (- (length
diff-hl-inline-popup--current-lines) diff-hl-inline-popup--height))))
+ (let* ((str (diff-hl-inline-popup--compute-popup-str
+ diff-hl-inline-popup--current-lines
+ diff-hl-inline-popup--current-index
+ diff-hl-inline-popup--height
+ diff-hl-inline-popup--current-header
+ diff-hl-inline-popup--current-footer)))
+ (overlay-put diff-hl-inline-popup--current-popup 'after-string str))))
+
+(defun diff-hl-inline-popup--popup-down()
+ "Scrolls one line down."
+ (interactive)
+ (diff-hl-inline-popup-scroll-to (1+ diff-hl-inline-popup--current-index) ))
+
+(defun diff-hl-inline-popup--popup-up()
+ "Scrolls one line up."
+ (interactive)
+ (diff-hl-inline-popup-scroll-to (1- diff-hl-inline-popup--current-index) ))
+
+(defun diff-hl-inline-popup--popup-pagedown()
+ "Scrolls one page down."
+ (interactive)
+ (diff-hl-inline-popup-scroll-to (+ diff-hl-inline-popup--current-index
diff-hl-inline-popup--height) ))
+
+(defun diff-hl-inline-popup--popup-pageup()
+ "Scrolls one page up."
+ (interactive)
+ (diff-hl-inline-popup-scroll-to (- diff-hl-inline-popup--current-index
diff-hl-inline-popup--height) ))
+
+(defvar diff-hl-inline-popup-transient-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<prior>") #'diff-hl-inline-popup--popup-pageup)
+ (define-key map (kbd "M-v") #'diff-hl-inline-popup--popup-pageup)
+ (define-key map (kbd "<next>") #'diff-hl-inline-popup--popup-pagedown)
+ (define-key map (kbd "C-v") #'diff-hl-inline-popup--popup-pagedown)
+ (define-key map (kbd "<up>") #'diff-hl-inline-popup--popup-up)
+ (define-key map (kbd "C-p") #'diff-hl-inline-popup--popup-up)
+ (define-key map (kbd "<down>") #'diff-hl-inline-popup--popup-down)
+ (define-key map (kbd "C-n") #'diff-hl-inline-popup--popup-down)
+ (define-key map (kbd "C-g") #'diff-hl-inline-popup-hide)
+ (define-key map [escape] #'diff-hl-inline-popup-hide)
+ (define-key map (kbd "q") #'diff-hl-inline-popup-hide)
+ ;;http://ergoemacs.org/emacs/emacs_mouse_wheel_config.html
+ (define-key map (kbd "<mouse-4>") #'diff-hl-inline-popup--popup-up)
+ (define-key map (kbd "<wheel-up>") #'diff-hl-inline-popup--popup-up)
+ (define-key map (kbd "<mouse-5>") #'diff-hl-inline-popup--popup-down)
+ (define-key map (kbd "<wheel-down>") #'diff-hl-inline-popup--popup-down)
+ map)
+ "Keymap for command `diff-hl-inline-popup-transient-mode'.
+Capture all the vertical movement of the point, and converts it
+to scroll in the popup")
+
+(defun diff-hl-inline-popup--ignorable-command-p (command)
+ "Decide if COMMAND is a command allowed while showing an inline popup."
+ ;;
https://emacs.stackexchange.com/questions/653/how-can-i-find-out-in-which-keymap-a-key-is-bound
+ (let ((keys (where-is-internal command (list
diff-hl-inline-popup--current-custom-keymap
diff-hl-inline-popup-transient-mode-map ) t))
+ (invoking (eq command diff-hl-inline-popup--invokinkg-command)))
+ (or keys invoking)))
+
+(defun diff-hl-inline-popup--post-command-hook ()
+ "Called each time a command is executed."
+ (let ((allowed-command (or
+ (string-match-p "diff-hl-inline-popup-" (symbol-name
this-command))
+ (diff-hl-inline-popup--ignorable-command-p
this-command))))
+ (unless allowed-command
+ (diff-hl-inline-popup-hide))))
+
+(define-minor-mode diff-hl-inline-popup-transient-mode
+ "Temporal minor mode to control an inline popup"
+ :global nil
+ (remove-hook 'post-command-hook #'diff-hl-inline-popup--post-command-hook t)
+ (set-keymap-parent diff-hl-inline-popup-transient-mode-map nil)
+
+ (when diff-hl-inline-popup-transient-mode
+ (set-keymap-parent diff-hl-inline-popup-transient-mode-map
diff-hl-inline-popup--current-custom-keymap)
+ (add-hook 'post-command-hook #'diff-hl-inline-popup--post-command-hook 0
t)))
+
+;;;###autoload
+(defun diff-hl-inline-popup-hide()
+ "Hide the current inline popup."
+ (interactive)
+ (when diff-hl-inline-popup-transient-mode
+ (diff-hl-inline-popup-transient-mode -1))
+ (when diff-hl-inline-popup--close-hook
+ (funcall diff-hl-inline-popup--close-hook)
+ (setq diff-hl-inline-popup--close-hook nil))
+ (when diff-hl-inline-popup--current-popup
+ (delete-overlay diff-hl-inline-popup--current-popup)
+ (setq diff-hl-inline-popup--current-popup nil)))
+
+;;;###autoload
+(defun diff-hl-inline-popup-show (lines &optional header footer keymap
close-hook point height)
+ "Create a phantom overlay to show the inline popup, with some
+content LINES, and a HEADER and a FOOTER, at POINT. KEYMAP is
+added to the current keymaps. CLOSE-HOOK is called when the popup
+is closed."
+ (when diff-hl-inline-popup--current-popup
+ (delete-overlay diff-hl-inline-popup--current-popup)
+ (setq diff-hl-inline-popup--current-popup nil))
+
+ (when (< (diff-hl-inline-popup--compute-content-height 99) 2)
+ (user-error "There is no enough vertical space to show the inline popup"))
+ (let* ((the-point (or point (point-at-eol)))
+ (the-buffer (current-buffer))
+ (overlay (make-overlay the-point the-point the-buffer)))
+ (overlay-put overlay 'phantom t)
+ (overlay-put overlay 'diff-hl-inline-popup t)
+ (setq diff-hl-inline-popup--current-popup overlay)
+
+ (setq diff-hl-inline-popup--current-lines
+ (mapcar (lambda (s) (replace-regexp-in-string "\n" " " s)) lines))
+ (setq diff-hl-inline-popup--current-header header)
+ (setq diff-hl-inline-popup--current-footer footer)
+ (setq diff-hl-inline-popup--invokinkg-command this-command)
+ (setq diff-hl-inline-popup--current-custom-keymap keymap)
+ (setq diff-hl-inline-popup--close-hook close-hook)
+ (setq diff-hl-inline-popup--height
(diff-hl-inline-popup--compute-content-height height))
+ (setq diff-hl-inline-popup--height (min diff-hl-inline-popup--height
(length diff-hl-inline-popup--current-lines)))
+ (diff-hl-inline-popup--ensure-enough-lines point
diff-hl-inline-popup--height)
+ (diff-hl-inline-popup-transient-mode 1)
+ (diff-hl-inline-popup-scroll-to 0)
+ overlay))
+
+(defun diff-hl-inline-popup--hide-all ()
+ "Testing purposes, use in case some inline popups get stuck in a buffer."
+ (interactive)
+ (when diff-hl-inline-popup-transient-mode
+ (diff-hl-inline-popup-transient-mode -1))
+ (setq diff-hl-inline-popup--current-popup nil)
+ (let* ((all-overlays (overlays-in (point-min) (point-max)))
+ (overlays (cl-remove-if-not (lambda (o)(overlay-get o
'diff-hl-inline-popup)) all-overlays)))
+ (dolist (o overlays)
+ (delete-overlay o))))
+
+(provide 'diff-hl-inline-popup)
+;;; diff-hl-inline-popup ends here
diff --git a/diff-hl-show-hunk-posframe.el b/diff-hl-show-hunk-posframe.el
new file mode 100644
index 0000000..522a6bc
--- /dev/null
+++ b/diff-hl-show-hunk-posframe.el
@@ -0,0 +1,238 @@
+;;; diff-hl-show-hunk-posframe.el --- posframe backend for diff-hl-show-hunk
-*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Álvaro González <alvarogonzalezsoti...@gmail.com>
+
+;; 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 provides `diff-hl-show-hunk-posframe' than can be used as
+;; `diff-hl-show-hunk-function'. `posframe' is a runtime dependency,
+;; it is not required by this package, but it should be installed.
+;;
+;;; Code:
+
+(require 'diff-hl-show-hunk)
+
+;; This package uses some runtime dependencies, so we need to declare
+;; the external functions and variables
+(declare-function posframe-workable-p "posframe")
+(declare-function posframe-show "posframe")
+(defvar posframe-mouse-banish)
+
+(defgroup diff-hl-show-hunk-posframe nil
+ "Show vc diffs in a posframe."
+ :group 'diff-hl-show-hunk)
+
+(defcustom diff-hl-show-hunk-posframe-show-header-line t
+ "Show some useful buttons at the top of the diff-hl posframe."
+ :type 'boolean)
+
+(defcustom diff-hl-show-hunk-posframe-internal-border-width 2
+ "Internal border width of the posframe."
+ :type 'integer)
+
+(defcustom diff-hl-show-hunk-posframe-internal-border-color "#00ffff"
+ "Internal border color of the posframe."
+ :type 'color)
+
+(defcustom diff-hl-show-hunk-posframe-poshandler nil
+ "Poshandler of the posframe (see `posframe-show`)."
+ :type 'function)
+
+(defcustom diff-hl-show-hunk-posframe-parameters nil
+ "The frame parameters used by helm-posframe."
+ :type 'string)
+
+(defface diff-hl-show-hunk-posframe '((t nil))
+ "Face for the posframe buffer.
+Customize it to change the base properties of the text.")
+
+(defface diff-hl-show-hunk-posframe-button-face '((t . (:height 0.9)))
+ "Face for the posframe buttons" )
+
+(defvar diff-hl-show-hunk--frame nil "The postframe frame used in function
`diff-hl-show-hunk-posframe'.")
+(defvar diff-hl-show-hunk--original-frame nil "The frame from which the hunk
is shown.")
+
+(defun diff-hl-show-hunk--posframe-hide ()
+ "Hide the posframe and clean up buffer."
+ (interactive)
+ (diff-hl-show-hunk-posframe--transient-mode -1)
+ (when (frame-live-p diff-hl-show-hunk--frame)
+ (make-frame-invisible diff-hl-show-hunk--frame))
+ (when diff-hl-show-hunk--original-frame
+ (when (frame-live-p diff-hl-show-hunk--original-frame)
+ (let ((frame diff-hl-show-hunk--original-frame))
+ (select-frame-set-input-focus frame)
+ ;; In Gnome, sometimes the input focus is not restored to the
+ ;; original frame, so we try harder in a while
+ (run-with-timer 0.1 nil (lambda () (select-frame-set-input-focus
frame)))))
+ (setq diff-hl-show-hunk--original-frame nil)))
+
+(defvar diff-hl-show-hunk-posframe--transient-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [escape] #'diff-hl-show-hunk-hide)
+ (define-key map (kbd "q") #'diff-hl-show-hunk-hide)
+ (define-key map (kbd "C-g") #'diff-hl-show-hunk-hide)
+ (define-key map (kbd "p") #'diff-hl-show-hunk-previous)
+ (define-key map (kbd "n") #'diff-hl-show-hunk-next)
+ (define-key map (kbd "c") #'diff-hl-show-hunk-copy-original-text)
+ (define-key map (kbd "r") #'diff-hl-show-hunk-revert-hunk)
+ (define-key map (kbd "[") #'diff-hl-show-hunk-previous)
+ (define-key map (kbd "]") #'diff-hl-show-hunk-next)
+ (define-key map (kbd "{") #'diff-hl-show-hunk-previous)
+ (define-key map (kbd "}") #'diff-hl-show-hunk-next)
+ map)
+ "Keymap for command `diff-hl-show-hunk-posframe--transient-mode'.
+Capture all the vertical movement of the point, and converts it
+to scroll in the posframe")
+
+(define-minor-mode diff-hl-show-hunk-posframe--transient-mode
+ "Temporal minor mode to control diff-hl posframe."
+ :lighter ""
+ :global t
+ (if diff-hl-show-hunk-posframe--transient-mode
+ (add-hook 'post-command-hook
#'diff-hl-show-hunk--posframe-post-command-hook nil)
+ (remove-hook 'post-command-hook
#'diff-hl-show-hunk--posframe-post-command-hook nil)))
+
+(defun diff-hl-show-hunk--posframe-post-command-hook ()
+ "Called for each command while in
`diff-hl-show-hunk-posframe--transient-mode."
+ (let* ((allowed-command (or
+ (diff-hl-show-hunk-ignorable-command-p this-command)
+ (and (symbolp this-command)
+ (string-match-p "diff-hl-" (symbol-name
this-command)))))
+ (event-in-frame (eq last-event-frame diff-hl-show-hunk--frame))
+ (has-focus (and (frame-live-p diff-hl-show-hunk--frame)
+ (functionp 'frame-focus-state)
+ (eq (frame-focus-state diff-hl-show-hunk--frame) t)))
+ (still-visible (or event-in-frame allowed-command has-focus)))
+ (unless still-visible
+ (diff-hl-show-hunk--posframe-hide))))
+
+(defun diff-hl-show-hunk--posframe-button (text help-echo action)
+ "Make a string implementing a button with TEXT and a HELP-ECHO.
+The button calls an ACTION."
+ (concat
+ (propertize (concat " " text " ")
+ 'help-echo (if action help-echo "Not available")
+ 'face 'diff-hl-show-hunk-posframe-button-face
+ 'mouse-face (when action '(:box (:style released-button)))
+ 'keymap (when action
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<header-line> <mouse-1>")
action)
+ map)))
+ " "))
+
+(defun diff-hl-show-hunk-posframe--header-line ()
+ "Make the header line of the posframe."
+ (concat
+ (diff-hl-show-hunk--posframe-button
+ "⨯ Close"
+ "Close (\\[diff-hl-show-hunk-hide])"
+ #'diff-hl-show-hunk-hide)
+ (diff-hl-show-hunk--posframe-button
+ "⬆ Previous change"
+ "Previous change in hunk (\\[diff-hl-show-hunk-previous])"
+ #'diff-hl-show-hunk-previous)
+
+ (diff-hl-show-hunk--posframe-button
+ "⬇ Next change"
+ "Next change in hunk (\\[diff-hl-show-hunk-next])"
+ #'diff-hl-show-hunk-next)
+
+ (diff-hl-show-hunk--posframe-button
+ "⊚ Copy original"
+ "Copy original (\\[diff-hl-show-hunk-copy-original-text])"
+ #'diff-hl-show-hunk-copy-original-text)
+
+ (diff-hl-show-hunk--posframe-button
+ "♻ Revert hunk"
+ "Revert hunk (\\[diff-hl-show-hunk-revert-hunk])"
+ #'diff-hl-show-hunk-revert-hunk)))
+
+;;;###autoload
+(defun diff-hl-show-hunk-posframe (buffer &optional _line)
+ "Implementation to show the hunk in a posframe."
+
+ (unless (require 'posframe nil t)
+ (user-error
+ (concat
+ "`diff-hl-show-hunk-posframe' requires the `posframe' package."
+ " Please install it or customize `diff-hl-show-hunk-function'.")))
+
+ (unless (posframe-workable-p)
+ (user-error
+ "Package `posframe' is not workable. Please customize
diff-hl-show-hunk-function"))
+
+ (diff-hl-show-hunk--posframe-hide)
+ (setq diff-hl-show-hunk--hide-function #'diff-hl-show-hunk--posframe-hide)
+
+ ;; put an overlay to override read-only-mode keymap
+ (with-current-buffer buffer
+ ;; Change face size
+ (buffer-face-set 'diff-hl-show-hunk-posframe)
+
+ (let ((full-overlay (make-overlay 1 (1+ (buffer-size)))))
+ (overlay-put full-overlay
+ 'keymap diff-hl-show-hunk-posframe--transient-mode-map)))
+
+ (setq posframe-mouse-banish nil)
+ (setq diff-hl-show-hunk--original-frame last-event-frame)
+
+ (let* ((hunk-overlay diff-hl-show-hunk--original-overlay)
+ (position (overlay-end hunk-overlay)))
+ (setq
+ diff-hl-show-hunk--frame
+ (posframe-show buffer
+ :position position
+ :poshandler diff-hl-show-hunk-posframe-poshandler
+ :internal-border-width
diff-hl-show-hunk-posframe-internal-border-width
+ :accept-focus t
+ ;; internal-border-color Doesn't always work, if not
customize internal-border face
+ :internal-border-color
diff-hl-show-hunk-posframe-internal-border-color
+ :hidehandler nil
+ ;; Sometimes, header-line is not taken into account, so
put a min height and a min width
+ :min-height (when
diff-hl-show-hunk-posframe-show-header-line 10)
+ :min-width (when
diff-hl-show-hunk-posframe-show-header-line
+ (length
(diff-hl-show-hunk-posframe--header-line)))
+ :respect-header-line
diff-hl-show-hunk-posframe-show-header-line
+ :respect-tab-line nil
+ :respect-mode-line nil
+ :override-parameters
diff-hl-show-hunk-posframe-parameters)))
+
+ (set-frame-parameter diff-hl-show-hunk--frame 'drag-internal-border t)
+ (set-frame-parameter diff-hl-show-hunk--frame 'drag-with-header-line t)
+
+ (with-selected-frame diff-hl-show-hunk--frame
+ (with-current-buffer buffer
+ (diff-hl-show-hunk-posframe--transient-mode 1)
+ (when diff-hl-show-hunk-posframe-show-header-line
+ (setq header-line-format (diff-hl-show-hunk-posframe--header-line)))
+ (goto-char (point-min))
+ (setq buffer-quit-function #'diff-hl-show-hunk--posframe-hide)
+ (select-window (window-main-window diff-hl-show-hunk--frame))
+
+ ;; Make cursor visible (mainly for selecting text in posframe)
+ (setq cursor-type 'box)
+
+ ;; Recenter arround point
+ (recenter)))
+ (select-frame-set-input-focus diff-hl-show-hunk--frame))
+
+(provide 'diff-hl-show-hunk-posframe)
+;;; diff-hl-show-hunk-posframe.el ends here
diff --git a/diff-hl-show-hunk.el b/diff-hl-show-hunk.el
new file mode 100644
index 0000000..bb9bf8c
--- /dev/null
+++ b/diff-hl-show-hunk.el
@@ -0,0 +1,439 @@
+;;; diff-hl-show-hunk.el --- Integrate popup/posframe and
diff-hl-diff-goto-hunk -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Álvaro González <alvarogonzalezsoti...@gmail.com>
+
+;; 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-show-hunk' shows a popup with the modified hunk at point.
+;; `diff-hl-show-hunk-function' contains the backend used to show the
+;; hunk. Its default value is `diff-hl-show-hunk-inline-popup', that
+;; shows diffs inline using overlay. There is another built-in backend:
+;; `diff-hl-show-hunk-posframe' (based on posframe). Other backends (for
+;; example based on `pos-tip') could also be implemented.
+;;
+;; `diff-hl-show-hunk-mode' adds the following keybindings:
+;;
+;; - `diff-hl-show-hunk': C-x v *
+;; - `diff-hl-show-hunk-next': C-x v }
+;; - `diff-hl-show-hunk-previous': C-x v {
+;;
+;; `diff-hl-show-hunk-mouse-mode' includes all the keybindings of
+;; `diff-hl-show-hunk-mode', and adds `diff-hl-show-hunk' when
+;; clicking in the margin or the fringe.
+;;
+;; To use one or both in all buffers:
+;;
+;; (global-diff-hl-show-hunk-mode)
+;;
+;; and/or
+;;
+;; (global-diff-hl-show-hunk-mouse-mode)
+
+;;; Code:
+
+(require 'diff-hl-inline-popup)
+(require 'diff-hl)
+
+(defvar diff-hl-show-hunk-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (concat diff-hl-command-prefix "*") #'diff-hl-show-hunk)
+ (define-key map (concat diff-hl-command-prefix "{")
#'diff-hl-show-hunk-previous)
+ (define-key map (concat diff-hl-command-prefix "}")
#'diff-hl-show-hunk-next)
+ map)
+ "Keymap for command `diff-hl-show-hunk-mode'.")
+
+(defvar diff-hl-show-hunk-mouse-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<left-margin> <mouse-1>") 'diff-hl-show-hunk--click)
+ (define-key map (kbd "<right-margin> <mouse-1>") 'diff-hl-show-hunk--click)
+ (define-key map (kbd "<left-fringe> <mouse-1>") 'diff-hl-show-hunk--click)
+ (define-key map (kbd "<right-fringe> <mouse-1>") 'diff-hl-show-hunk--click)
+ (set-keymap-parent map diff-hl-show-hunk-mode-map)
+ map)
+ "Keymap for command `diff-hl-show-hunk-mouse-mode'.")
+
+(defvar diff-hl-show-hunk-buffer-name "*diff-hl-show-hunk-buffer*"
+ "Name of the posframe used by diff-hl-show-hunk.")
+
+(defvar diff-hl-show-hunk--original-window nil
+ "The vc window of which the hunk is shown.")
+
+(defvar diff-hl-show-hunk--original-buffer nil
+ "The vc buffer of which the hunk is shown.")
+
+(defvar diff-hl-show-hunk--original-content nil
+ "The original content of the hunk.")
+
+(defvar diff-hl-show-hunk--original-overlay nil
+ "Copy of the diff-hl hunk overlay.")
+
+(defgroup diff-hl-show-hunk nil
+ "Show vc diffs in a posframe or popup."
+ :group 'diff-hl)
+
+(defconst diff-hl-show-hunk-boundary "^@@.*@@")
+(defconst diff-hl-show-hunk--no-lines-removed-message (list "<<no lines
removed>>"))
+
+(defcustom diff-hl-show-hunk-inline-popup-hide-hunk nil
+ "If t, inline-popup is shown over the hunk, hiding it."
+ :type 'boolean)
+
+(defcustom diff-hl-show-hunk-inline-popup-smart-lines t
+ "If t, inline-popup tries to show only the deleted lines of the
+hunk. The added lines are shown when scrolling the popup. If
+the hunk consist only on added lines, then
+`diff-hl-show-hunk--no-lines-removed-message' it is shown."
+ :type 'boolean)
+
+(defcustom diff-hl-show-hunk-function 'diff-hl-show-hunk-inline-popup
+ "The function used to render the hunk.
+The function receives as first parameter a buffer with the
+contents of the hunk, and as second parameter the line number
+corresponding to the clicked line in the original buffer."
+ :type '(choice
+ (const :tag "Show inline" diff-hl-show-hunk-inline-popup)
+ (const :tag "Show using posframe" diff-hl-show-hunk-posframe)))
+
+(defvar diff-hl-show-hunk--hide-function nil
+ "Function to call to close the shown hunk.")
+
+(defun diff-hl-show-hunk-hide ()
+ "Hide the current shown hunk."
+ (interactive)
+ (if (and diff-hl-show-hunk--original-window (window-live-p
diff-hl-show-hunk--original-window))
+ (select-window diff-hl-show-hunk--original-window))
+ (setq diff-hl-show-hunk--original-window nil)
+ (if (buffer-live-p diff-hl-show-hunk--original-buffer)
+ (switch-to-buffer diff-hl-show-hunk--original-buffer))
+ (setq diff-hl-show-hunk--original-buffer nil)
+ (with-current-buffer (get-buffer-create diff-hl-show-hunk-buffer-name)
+ (read-only-mode -1)
+ (erase-buffer))
+ (when diff-hl-show-hunk--hide-function
+ (let ((hidefunc diff-hl-show-hunk--hide-function))
+ (setq diff-hl-show-hunk--hide-function nil)
+ (funcall hidefunc)))
+ (when diff-hl-show-hunk--original-overlay
+ (diff-hl-show-hunk--goto-hunk-overlay diff-hl-show-hunk--original-overlay))
+ (when diff-hl-show-hunk--original-overlay
+ (delete-overlay diff-hl-show-hunk--original-overlay))
+ (setq diff-hl-show-hunk--original-overlay nil))
+
+(defun diff-hl-show-hunk-ignorable-command-p (command)
+ "Decide if COMMAND is a command allowed while showing the current hunk."
+ (member command '(ignore diff-hl-show-hunk handle-switch-frame
diff-hl-show-hunk--click)))
+
+(defun diff-hl-show-hunk--compute-diffs ()
+ "Compute diffs using funcions of diff-hl.
+Then put the differences in *diff-hl-show-hunk-diff-buffer*
+buffer, and set the point in that buffer to the corresponding
+line of the original buffer."
+ (defvar vc-sentinel-movepoint)
+ (let* ((buffer (or (buffer-base-buffer) (current-buffer)))
+ (line (line-number-at-pos))
+ (dest-buffer "*diff-hl-show-hunk-diff-buffer*"))
+ (with-current-buffer buffer
+ (diff-hl-diff-buffer-with-head (buffer-file-name buffer) dest-buffer)
+ (switch-to-buffer dest-buffer)
+ (diff-hl-diff-skip-to line)
+ (setq vc-sentinel-movepoint (point)))
+ dest-buffer))
+
+(defun diff-hl-show-hunk--get-original-lines (content)
+ "Extracts the lines starting with '-' from CONTENT and save them."
+ (let* ((lines (split-string content "[\n\r]+" )))
+ (cl-remove-if-not (lambda (l) (string-match-p "^-.*" l)) lines)))
+
+(defun diff-hl-show-hunk--fill-original-content (content)
+ "Extracts the lines starting with '-' from CONTENT and save them."
+ (let* ((original-lines (diff-hl-show-hunk--get-original-lines content))
+ (original-lines (mapcar (lambda (l) (substring l 1)) original-lines))
+ (content (string-join original-lines "\n")))
+ (setq diff-hl-show-hunk--original-content content)))
+
+(defun diff-hl-show-hunk-buffer ()
+ "Create the buffer with the contents of the hunk at point.
+The buffer has the point in the corresponding line of the hunk.
+Returns a list with the buffer and the line number of the clicked line."
+ (let ((content)
+ (point-in-buffer)
+ (line)
+ (line-overlay)
+ ;;
https://emacs.stackexchange.com/questions/35680/stop-emacs-from-updating-display
+ (inhibit-redisplay t)
+ (buffer (get-buffer-create diff-hl-show-hunk-buffer-name)))
+
+ ;; Get differences
+ (save-window-excursion
+ (save-excursion
+ (with-current-buffer (diff-hl-show-hunk--compute-diffs)
+ (setq content (buffer-substring-no-properties (point-min)
(point-max)))
+ (setq point-in-buffer (point)))))
+
+ (with-current-buffer buffer
+ (read-only-mode -1)
+ (erase-buffer)
+ (insert content)
+
+ ;; Highlight the clicked line
+ (goto-char point-in-buffer)
+ (setq line-overlay (make-overlay (point-at-bol) (min (point-max) (1+
(point-at-eol)))))
+
+ ;; diff-mode
+ (diff-mode)
+ (read-only-mode 1)
+
+ ;; Find the hunk and narrow to it
+ (re-search-backward diff-hl-show-hunk-boundary nil 1)
+ (forward-line 1)
+ (let* ((start (point)))
+ (re-search-forward diff-hl-show-hunk-boundary nil 1)
+ (move-beginning-of-line nil)
+ (narrow-to-region start (point)))
+
+ ;; Store original content
+ (let ((content (buffer-string)))
+ (diff-hl-show-hunk--fill-original-content content))
+
+ ;; Come back to the clicked line
+ (goto-char (overlay-start line-overlay))
+ (setq line (line-number-at-pos)))
+
+ (list buffer line)))
+
+(defun diff-hl-show-hunk--click (event)
+ "Called when user clicks on margins. EVENT is click information."
+ (interactive "e")
+ ;; Go the click's position.
+ (posn-set-point (event-start event))
+ (diff-hl-show-hunk))
+
+(defvar diff-hl-show-hunk--inline-popup-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "p") #'diff-hl-show-hunk-previous)
+ (define-key map (kbd "n") #'diff-hl-show-hunk-next)
+ (define-key map (kbd "c") #'diff-hl-show-hunk-copy-original-text)
+ (define-key map (kbd "r") #'diff-hl-show-hunk-revert-hunk)
+ (define-key map (kbd "[") #'diff-hl-show-hunk-previous)
+ (define-key map (kbd "]") #'diff-hl-show-hunk-next)
+ (define-key map (kbd "{") #'diff-hl-show-hunk-previous)
+ (define-key map (kbd "}") #'diff-hl-show-hunk-next)
+ map))
+
+(defvar diff-hl-show-hunk--hide-function)
+
+;;;###autoload
+(defun diff-hl-show-hunk-inline-popup (buffer &optional _ignored-line)
+ "Implementation to show the hunk in a inline popup.
+BUFFER is a buffer with the hunk."
+ (diff-hl-inline-popup-hide)
+ (setq diff-hl-show-hunk--hide-function #'inline-popup-hide)
+ (let* ((lines (split-string (with-current-buffer buffer (buffer-string))
"[\n\r]+" ))
+ (smart-lines diff-hl-show-hunk-inline-popup-smart-lines)
+ (original-lines-number (cl-count-if (lambda (s) (string-prefix-p "-"
s)) lines))
+ (lines (if (string= (car (last lines)) "" ) (butlast lines) lines))
+ (lines (if (and (eq original-lines-number 0) smart-lines)
+ diff-hl-show-hunk--no-lines-removed-message
+ lines))
+ (overlay diff-hl-show-hunk--original-overlay)
+ (type (overlay-get overlay 'diff-hl-hunk-type))
+ (point (if (eq type 'delete) (overlay-start overlay) (overlay-end
overlay)))
+ (propertize-line (lambda (l)
+ (propertize l 'face
+ (cond ((string-prefix-p "+" l)
+ 'diff-added)
+ ((string-prefix-p "-" l)
+ 'diff-removed)))))
+ (propertized-lines (mapcar propertize-line lines)))
+
+ (save-excursion
+ ;; Save point in case the hunk is hidden, so next/previous works as
expected
+ ;; If the hunk is delete type, then don't hide the hunk
+ ;; (because the hunk is located in a non deleted line)
+ (when (and diff-hl-show-hunk-inline-popup-hide-hunk
+ (not (eq type 'delete)))
+ (let* ((invisible-overlay (make-overlay (overlay-start overlay)
+ (overlay-end overlay))))
+ ;; Make new overlay, since the diff-hl overlay can be changed by
diff-hl-flydiff
+ (overlay-put invisible-overlay 'invisible t)
+ ;; Change default hide popup function, to make the overlay visible
+ (setq diff-hl-show-hunk--hide-function
+ (lambda ()
+ (overlay-put invisible-overlay 'invisible nil)
+ (delete-overlay invisible-overlay)
+ (diff-hl-inline-popup-hide)))))
+ (let ((height
+ (when smart-lines
+ (when (not (eq 0 original-lines-number))
+ original-lines-number))))
+ (diff-hl-inline-popup-show
+ propertized-lines
+ (if (and (boundp 'diff-hl-reference-revision)
diff-hl-reference-revision)
+ (concat "Diff with " diff-hl-reference-revision)
+ "Diff with HEAD")
+ "(q)Quit (p)Previous (n)Next (r)Revert (c)Copy original"
+ diff-hl-show-hunk--inline-popup-map
+ #'diff-hl-show-hunk-hide
+ point
+ height))
+ (diff-hl-show-hunk--goto-hunk-overlay overlay))))
+
+(defun diff-hl-show-hunk-copy-original-text ()
+ "Extracts all the lines from BUFFER starting with '-' to the kill ring."
+ (interactive)
+ (kill-new diff-hl-show-hunk--original-content)
+ (message "Original hunk content added to kill-ring"))
+
+(defun diff-hl-show-hunk-revert-hunk ()
+ "Dismiss the popup and prompt to revert the current diff hunk."
+ (interactive)
+ (diff-hl-show-hunk-hide)
+ (diff-hl-revert-hunk))
+
+(defun diff-hl-show-hunk-ensure-hunk-visible (&optional goto-start)
+ "Ensure that the end of `diff-hl-show-hunk--original-overlay',
+and maybe the start (if GOTO-START), is visible."
+ (let* ((overlay diff-hl-show-hunk--original-overlay))
+ (when overlay
+ (goto-char (overlay-end overlay)))
+ ;; Window scrolls to position only on next redisplay
+ (redisplay t)
+ (when goto-start
+ (goto-char (overlay-start overlay)))))
+
+;;;###autoload
+(defun diff-hl-show-hunk-previous ()
+ "Go to previous hunk/change and show it."
+ (interactive)
+ (let* ((point (if diff-hl-show-hunk--original-overlay
+ (overlay-start diff-hl-show-hunk--original-overlay)
+ nil))
+ (previous-overlay (diff-hl-show-hunk--next-hunk t point)))
+ (if (not previous-overlay)
+ (message "There is no previous change")
+ (diff-hl-show-hunk-hide)
+ (diff-hl-show-hunk--goto-hunk-overlay previous-overlay)
+ (recenter)
+ (diff-hl-show-hunk))))
+
+(defun diff-hl-show-hunk--next-hunk (backward point)
+ "Same as `diff-hl-search-next-hunk', but in the current buffer
+of `diff-hl-show-hunk'."
+ (with-current-buffer (or diff-hl-show-hunk--original-buffer (current-buffer))
+ (diff-hl-search-next-hunk backward point)))
+
+(defun diff-hl-show-hunk--goto-hunk-overlay (overlay)
+ "Tries to display the whole overlay, and place the point at the
+end of the OVERLAY, so posframe/inline is placed below the hunk."
+ (goto-char (overlay-start overlay))
+ (redisplay)
+ (goto-char (1- (overlay-end overlay))))
+
+;;;###autoload
+(defun diff-hl-show-hunk-next ()
+ "Go to next hunk/change and show it."
+ (interactive)
+ (let* ((point (if diff-hl-show-hunk--original-overlay
+ (overlay-start diff-hl-show-hunk--original-overlay)
+ nil))
+ (next-overlay (diff-hl-show-hunk--next-hunk nil point)))
+ (if (not next-overlay)
+ (message "There is no next change")
+ (diff-hl-show-hunk-hide)
+ (diff-hl-show-hunk--goto-hunk-overlay next-overlay)
+ (recenter)
+ (diff-hl-show-hunk))))
+
+;;;###autoload
+(defun diff-hl-show-hunk ()
+ "Show the VC diff hunk at point.
+The backend is determined by `diff-hl-show-hunk-function'."
+ (interactive)
+
+ ;; Close any previous hunk
+ (save-excursion
+ (diff-hl-show-hunk-hide))
+
+ (cond
+ ((not (vc-backend buffer-file-name))
+ (user-error "The buffer is not under version control"))
+ ((not (diff-hl-hunk-overlay-at (point)))
+ (diff-hl-previous-hunk)))
+
+ (setq diff-hl-show-hunk--original-overlay nil)
+
+ ;; Store begining and end of hunk overlay
+ (let ((overlay (diff-hl-hunk-overlay-at (point))))
+ (when overlay
+ (let ((start (overlay-start overlay))
+ (end (overlay-end overlay))
+ (type (overlay-get overlay 'diff-hl-hunk-type)))
+ (setq diff-hl-show-hunk--original-overlay (make-overlay start end))
+ (overlay-put diff-hl-show-hunk--original-overlay 'diff-hl-hunk-type
type)))
+
+ (unless overlay
+ (user-error "Not in a hunk")))
+
+ (cond
+ ((not diff-hl-show-hunk-function)
+ (message "Please configure `diff-hl-show-hunk-function'")
+ (diff-hl-diff-goto-hunk))
+ ((let ((buffer-and-line (diff-hl-show-hunk-buffer)))
+ (setq diff-hl-show-hunk--original-buffer (current-buffer))
+ (setq diff-hl-show-hunk--original-window (selected-window))
+ (diff-hl-show-hunk-ensure-hunk-visible)
+ (apply diff-hl-show-hunk-function buffer-and-line))
+ ;; We could fall back to `diff-hl-diff-goto-hunk', but the
+ ;; current default should work in all environments (both GUI
+ ;; and terminal), and if something goes wrong we better show
+ ;; the error to the user.
+ )))
+
+;;;###autoload
+(define-minor-mode diff-hl-show-hunk-mouse-mode
+ "Enables the margin and fringe to show a posframe/popup with vc diffs when
clicked.
+By default, the posframe/popup shows only the current hunk, and
+the line of the hunk that matches the current position is
+highlighted. The face, border and other visual preferences are
+customizable. It can be also invoked with the command
+`diff-hl-show-hunk'
+\\{diff-hl-show-hunk-mouse-mode-map}"
+ :group 'diff-hl-show-hunk
+ :lighter "")
+
+;;;###autoload
+(define-globalized-minor-mode global-diff-hl-show-hunk-mouse-mode
+ diff-hl-show-hunk-mouse-mode
+ diff-hl-show-hunk-mouse-mode)
+
+;;;###autoload
+(define-minor-mode diff-hl-show-hunk-mode
+ "Enables a keymap with some commands of the `diff-hl-show-hunk' package
+\\{diff-hl-show-hunk-mode-map}"
+ :group 'diff-hl-show-hunk
+ :lighter "")
+
+;;;###autoload
+(define-globalized-minor-mode global-diff-hl-show-hunk-mode
+ diff-hl-show-hunk-mode
+ diff-hl-show-hunk-mode)
+
+(provide 'diff-hl-show-hunk)
+;;; diff-hl-show-hunk.el ends here
diff --git a/diff-hl.el b/diff-hl.el
index f12d4a7..7cb2f6d 100644
--- a/diff-hl.el
+++ b/diff-hl.el
@@ -358,6 +358,7 @@ performance when viewing such files in certain conditions."
(hook '(diff-hl-overlay-modified)))
(overlay-put h 'diff-hl t)
(overlay-put h 'diff-hl-hunk t)
+ (overlay-put h 'diff-hl-hunk-type type)
(overlay-put h 'modification-hooks hook)
(overlay-put h 'insert-in-front-hooks hook)
(overlay-put h 'insert-behind-hooks hook)))))))))
@@ -562,20 +563,26 @@ in the source file, or the last line of the hunk above
it."
when (overlay-get o 'diff-hl-hunk)
return o))
+(defun diff-hl-search-next-hunk (&optional backward point)
+ "Search the next hunk in the current buffer, or previous if BACKWARD."
+ (save-excursion
+ (when point
+ (goto-char point))
+ (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 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)
+ (let ((overlay (diff-hl-search-next-hunk backward)))
+ (if overlay
+ (goto-char (overlay-start overlay))
(user-error "No further hunks found"))))
(defun diff-hl-previous-hunk ()
@@ -718,6 +725,72 @@ The value of this variable is a mode line template as in
(add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
(remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
+(defun diff-hl-make-temp-file-name (buffer rev &optional manual)
+ "Return a backup file name for REV or the current version of BUFFER.
+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-create-revision (file revision)
+ "Read REVISION of BUFFER into a buffer and return the buffer."
+ (let ((automatic-backup (diff-hl-make-temp-file-name file revision))
+ (filebuf (get-file-buffer file))
+ (filename (diff-hl-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-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-diff-buffer-with-head (file &optional dest-buffer)
+ "Compute the differences between FILE and its associated file
+in head revision. The diffs are computed in the buffer
+DEST-BUFFER. This requires the external program `diff' to be in
+your `exec-path'."
+ (vc-ensure-vc-buffer)
+ (save-current-buffer
+ (let* ((dest-buffer (or dest-buffer "*diff-hl-diff-bufer-with-head*"))
+ (temporary-file-directory
+ (if (file-directory-p "/dev/shm/")
+ "/dev/shm/"
+ temporary-file-directory))
+ (rev (diff-hl-create-revision
+ file
+ (or diff-hl-reference-revision
+ (diff-hl-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 dest-buffer))
+ (with-current-buffer dest-buffer
+ (let ((inhibit-read-only t))
+ ;; Function `diff-sentinel' adds a final line, so remove it
+ (delete-matching-lines "^Diff finished.*")))
+ (get-buffer-create dest-buffer))))
+
;;;###autoload
(defun turn-on-diff-hl-mode ()
"Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
