diff-hl-show-hunk.el (16903B)
1 ;;; diff-hl-show-hunk.el --- Integrate popup/posframe and diff-hl-diff-goto-hunk -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2020-2021 Free Software Foundation, Inc. 4 5 ;; Author: Álvaro González <alvarogonzalezsotillo@gmail.com> 6 7 ;; This file is part of GNU Emacs. 8 9 ;; GNU Emacs is free software: you can redistribute it and/or modify 10 ;; it under the terms of the GNU General Public License as published by 11 ;; the Free Software Foundation, either version 3 of the License, or 12 ;; (at your option) any later version. 13 14 ;; GNU Emacs is distributed in the hope that it will be useful, 15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;; GNU General Public License for more details. 18 19 ;; You should have received a copy of the GNU General Public License 20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 21 22 ;;; Commentary: 23 24 ;; `diff-hl-show-hunk' shows a popup with the modification hunk at point. 25 ;; `diff-hl-show-hunk-function' points to the backend used to show the 26 ;; hunk. Its default value is `diff-hl-show-hunk-inline-popup', that 27 ;; shows diffs inline using overlay. There is another built-in backend: 28 ;; `diff-hl-show-hunk-posframe' (based on posframe). 29 ;; 30 ;; `diff-hl-show-hunk-mouse-mode' adds interaction on clicking in the 31 ;; margin or the fringe (shows the current hunk as well). 32 ;; 33 ;; To use it in all buffers: 34 ;; 35 ;; (global-diff-hl-show-hunk-mouse-mode) 36 37 ;;; Code: 38 39 (require 'diff-hl-inline-popup) 40 (require 'diff-hl) 41 42 (defvar diff-hl-show-hunk-mouse-mode-map 43 (let ((map (make-sparse-keymap))) 44 (define-key map (kbd "<left-margin> <mouse-1>") 'diff-hl-show-hunk--click) 45 (define-key map (kbd "<right-margin> <mouse-1>") 'diff-hl-show-hunk--click) 46 (define-key map (kbd "<left-fringe> <mouse-1>") 'diff-hl-show-hunk--click) 47 (define-key map (kbd "<right-fringe> <mouse-1>") 'diff-hl-show-hunk--click) 48 map) 49 "Keymap for command `diff-hl-show-hunk-mouse-mode'.") 50 51 (defvar diff-hl-show-hunk-buffer-name "*diff-hl-show-hunk-buffer*" 52 "Name of the buffer used by diff-hl-show-hunk.") 53 54 (defvar diff-hl-show-hunk-diff-buffer-name "*diff-hl-show-hunk-diff-buffer*" 55 "Name of the buffer used by diff-hl-show-hunk to show the diff.") 56 57 (defvar diff-hl-show-hunk--original-window nil 58 "The vc window of which the hunk is shown.") 59 60 (defvar diff-hl-show-hunk--original-buffer nil 61 "The vc buffer of which the hunk is shown.") 62 63 (defvar diff-hl-show-hunk--original-content nil 64 "The original content of the hunk.") 65 66 (defvar diff-hl-show-hunk--original-overlay nil 67 "Copy of the diff-hl hunk overlay.") 68 69 (defgroup diff-hl-show-hunk nil 70 "Show vc diffs in a posframe or popup." 71 :group 'diff-hl) 72 73 (defconst diff-hl-show-hunk-boundary "^@@.*@@") 74 (defconst diff-hl-show-hunk--no-lines-removed-message (list "<<no lines removed>>")) 75 76 (defcustom diff-hl-show-hunk-inline-popup-hide-hunk nil 77 "If t, inline-popup is shown over the hunk, hiding it." 78 :type 'boolean) 79 80 (defcustom diff-hl-show-hunk-inline-popup-smart-lines t 81 "If t, inline-popup tries to show only the deleted lines of the 82 hunk. The added lines are shown when scrolling the popup. If 83 the hunk consist only on added lines, then 84 `diff-hl-show-hunk--no-lines-removed-message' it is shown." 85 :type 'boolean) 86 87 (defcustom diff-hl-show-hunk-function 'diff-hl-show-hunk-inline-popup 88 "The function used to render the hunk. 89 The function receives as first parameter a buffer with the 90 contents of the hunk, and as second parameter the line number 91 corresponding to the clicked line in the original buffer." 92 :type '(choice 93 (const :tag "Show inline" diff-hl-show-hunk-inline-popup) 94 (const :tag "Show using posframe" diff-hl-show-hunk-posframe))) 95 96 (defvar diff-hl-show-hunk--hide-function nil 97 "Function to call to close the shown hunk.") 98 99 (defun diff-hl-show-hunk-hide () 100 "Hide the current shown hunk." 101 (interactive) 102 (if (and diff-hl-show-hunk--original-window (window-live-p diff-hl-show-hunk--original-window)) 103 (select-window diff-hl-show-hunk--original-window)) 104 (setq diff-hl-show-hunk--original-window nil) 105 (if (buffer-live-p diff-hl-show-hunk--original-buffer) 106 (switch-to-buffer diff-hl-show-hunk--original-buffer)) 107 (setq diff-hl-show-hunk--original-buffer nil) 108 (with-current-buffer (get-buffer-create diff-hl-show-hunk-buffer-name) 109 (read-only-mode -1) 110 (erase-buffer)) 111 (bury-buffer diff-hl-show-hunk-buffer-name) 112 (when (get-buffer diff-hl-show-hunk-diff-buffer-name) 113 (bury-buffer diff-hl-show-hunk-diff-buffer-name)) 114 (when diff-hl-show-hunk--hide-function 115 (let ((hidefunc diff-hl-show-hunk--hide-function)) 116 (setq diff-hl-show-hunk--hide-function nil) 117 (funcall hidefunc))) 118 (when diff-hl-show-hunk--original-overlay 119 (diff-hl-show-hunk--goto-hunk-overlay diff-hl-show-hunk--original-overlay)) 120 (when diff-hl-show-hunk--original-overlay 121 (delete-overlay diff-hl-show-hunk--original-overlay)) 122 (setq diff-hl-show-hunk--original-overlay nil)) 123 124 (defun diff-hl-show-hunk-ignorable-command-p (command) 125 "Decide if COMMAND is a command allowed while showing the current hunk." 126 (member command '(ignore diff-hl-show-hunk handle-switch-frame diff-hl-show-hunk--click))) 127 128 (defun diff-hl-show-hunk--compute-diffs () 129 "Compute diffs using functions of diff-hl. 130 Then put the differences inside a special buffer and set the 131 point in that buffer to the corresponding line of the original 132 buffer." 133 (defvar vc-sentinel-movepoint) 134 (let* ((buffer (or (buffer-base-buffer) (current-buffer))) 135 (line (line-number-at-pos)) 136 (dest-buffer diff-hl-show-hunk-diff-buffer-name)) 137 (with-current-buffer buffer 138 (diff-hl-diff-buffer-with-reference (buffer-file-name buffer) dest-buffer) 139 (switch-to-buffer dest-buffer) 140 (diff-hl-diff-skip-to line) 141 (setq vc-sentinel-movepoint (point))) 142 dest-buffer)) 143 144 (defun diff-hl-show-hunk--get-original-lines (content) 145 "Extracts the lines starting with '-' from CONTENT and save them." 146 (let* ((lines (split-string content "[\n\r]+" ))) 147 (cl-remove-if-not (lambda (l) (string-match-p "^-.*" l)) lines))) 148 149 (defun diff-hl-show-hunk--fill-original-content (content) 150 "Extracts the lines starting with '-' from CONTENT and save them." 151 (let* ((original-lines (diff-hl-show-hunk--get-original-lines content)) 152 (original-lines (mapcar (lambda (l) (substring l 1)) original-lines)) 153 (content (string-join original-lines "\n"))) 154 (setq diff-hl-show-hunk--original-content content))) 155 156 (defun diff-hl-show-hunk-buffer () 157 "Create the buffer with the contents of the hunk at point. 158 The buffer has the point in the corresponding line of the hunk. 159 Returns a list with the buffer and the line number of the clicked line." 160 (let ((content) 161 (point-in-buffer) 162 (line) 163 (line-overlay) 164 ;; https://emacs.stackexchange.com/questions/35680/stop-emacs-from-updating-display 165 (inhibit-redisplay t) 166 (buffer (get-buffer-create diff-hl-show-hunk-buffer-name))) 167 168 ;; Get differences 169 (save-window-excursion 170 (save-excursion 171 (with-current-buffer (diff-hl-show-hunk--compute-diffs) 172 (setq content (buffer-substring-no-properties (point-min) (point-max))) 173 (setq point-in-buffer (point))))) 174 175 (with-current-buffer buffer 176 (read-only-mode -1) 177 (erase-buffer) 178 (insert content) 179 180 ;; Highlight the clicked line 181 (goto-char point-in-buffer) 182 (setq line-overlay (make-overlay (line-beginning-position) 183 (min (point-max) 184 (1+ (line-end-position))))) 185 186 ;; diff-mode 187 (diff-mode) 188 (read-only-mode 1) 189 190 ;; Find the hunk and narrow to it 191 (re-search-backward diff-hl-show-hunk-boundary nil 1) 192 (forward-line 1) 193 (let* ((start (point))) 194 (re-search-forward diff-hl-show-hunk-boundary nil 1) 195 (move-beginning-of-line nil) 196 (narrow-to-region start (point))) 197 198 ;; Store original content 199 (let ((content (buffer-string))) 200 (diff-hl-show-hunk--fill-original-content content)) 201 202 ;; Come back to the clicked line 203 (goto-char (overlay-start line-overlay)) 204 (setq line (line-number-at-pos))) 205 206 (list buffer line))) 207 208 (defun diff-hl-show-hunk--click (event) 209 "Called when user clicks on margins. EVENT is click information." 210 (interactive "e") 211 ;; Go the click's position. 212 (posn-set-point (event-start event)) 213 (diff-hl-show-hunk)) 214 215 (defvar diff-hl-show-hunk-map 216 (let ((map (make-sparse-keymap))) 217 (define-key map (kbd "p") #'diff-hl-show-hunk-previous) 218 (define-key map (kbd "n") #'diff-hl-show-hunk-next) 219 (define-key map (kbd "c") #'diff-hl-show-hunk-copy-original-text) 220 (define-key map (kbd "r") #'diff-hl-show-hunk-revert-hunk) 221 (define-key map (kbd "[") #'diff-hl-show-hunk-previous) 222 (define-key map (kbd "]") #'diff-hl-show-hunk-next) 223 (define-key map (kbd "{") #'diff-hl-show-hunk-previous) 224 (define-key map (kbd "}") #'diff-hl-show-hunk-next) 225 (define-key map (kbd "S") #'diff-hl-show-hunk-stage-hunk) 226 map)) 227 228 (defvar diff-hl-show-hunk--hide-function) 229 230 ;;;###autoload 231 (defun diff-hl-show-hunk-inline-popup (buffer &optional _ignored-line) 232 "Implementation to show the hunk in a inline popup. 233 BUFFER is a buffer with the hunk." 234 (diff-hl-inline-popup-hide) 235 (setq diff-hl-show-hunk--hide-function #'diff-hl-inline-popup-hide) 236 (let* ((lines (split-string (with-current-buffer buffer (buffer-string)) "[\n\r]+" )) 237 (smart-lines diff-hl-show-hunk-inline-popup-smart-lines) 238 (original-lines-number (cl-count-if (lambda (s) (string-prefix-p "-" s)) lines)) 239 (lines (if (string= (car (last lines)) "" ) (butlast lines) lines)) 240 (lines (if (and (eq original-lines-number 0) smart-lines) 241 diff-hl-show-hunk--no-lines-removed-message 242 lines)) 243 (overlay diff-hl-show-hunk--original-overlay) 244 (type (overlay-get overlay 'diff-hl-hunk-type)) 245 (point (if (eq type 'delete) (overlay-start overlay) (overlay-end overlay))) 246 (propertize-line (lambda (l) 247 (propertize l 'face 248 (cond ((string-prefix-p "+" l) 249 'diff-added) 250 ((string-prefix-p "-" l) 251 'diff-removed))))) 252 (propertized-lines (mapcar propertize-line lines))) 253 254 (save-excursion 255 ;; Save point in case the hunk is hidden, so next/previous works as expected 256 ;; If the hunk is delete type, then don't hide the hunk 257 ;; (because the hunk is located in a non deleted line) 258 (when (and diff-hl-show-hunk-inline-popup-hide-hunk 259 (not (eq type 'delete))) 260 (let* ((invisible-overlay (make-overlay (overlay-start overlay) 261 (overlay-end overlay)))) 262 ;; Make new overlay, since the diff-hl overlay can be changed by diff-hl-flydiff 263 (overlay-put invisible-overlay 'invisible t) 264 ;; Change default hide popup function, to make the overlay visible 265 (setq diff-hl-show-hunk--hide-function 266 (lambda () 267 (overlay-put invisible-overlay 'invisible nil) 268 (delete-overlay invisible-overlay) 269 (diff-hl-inline-popup-hide))))) 270 (diff-hl-show-hunk--goto-hunk-overlay overlay) 271 (let ((height 272 (when smart-lines 273 (when (not (eq 0 original-lines-number)) 274 original-lines-number))) 275 (footer "(q)Quit (p)Previous (n)Next (r)Revert (c)Copy original")) 276 (unless diff-hl-show-staged-changes 277 (setq footer (concat footer " (S)Stage"))) 278 (diff-hl-inline-popup-show 279 propertized-lines 280 (if (and (boundp 'diff-hl-reference-revision) diff-hl-reference-revision) 281 (concat "Diff with " diff-hl-reference-revision) 282 "Diff with HEAD") 283 footer 284 diff-hl-show-hunk-map 285 #'diff-hl-show-hunk-hide 286 point 287 height)) 288 ))) 289 290 (defun diff-hl-show-hunk-copy-original-text () 291 "Extracts all the lines from BUFFER starting with '-' to the kill ring." 292 (interactive) 293 (kill-new diff-hl-show-hunk--original-content) 294 (message "Original hunk content added to kill-ring")) 295 296 (defun diff-hl-show-hunk-revert-hunk () 297 "Dismiss the popup and revert the current diff hunk." 298 (interactive) 299 (diff-hl-show-hunk-hide) 300 (let (diff-hl-ask-before-revert-hunk) 301 (diff-hl-revert-hunk))) 302 303 (defun diff-hl-show-hunk-stage-hunk () 304 "Dismiss the popup and stage the current hunk." 305 (interactive) 306 (diff-hl-show-hunk-hide) 307 (diff-hl-stage-current-hunk)) 308 309 ;;;###autoload 310 (defun diff-hl-show-hunk-previous () 311 "Go to previous hunk/change and show it." 312 (interactive) 313 (let* ((point (if diff-hl-show-hunk--original-overlay 314 (overlay-start diff-hl-show-hunk--original-overlay) 315 nil)) 316 (previous-overlay (diff-hl-show-hunk--next-hunk t point))) 317 (if (not previous-overlay) 318 (message "There is no previous change") 319 (diff-hl-show-hunk-hide) 320 (diff-hl-show-hunk--goto-hunk-overlay previous-overlay) 321 (recenter) 322 (diff-hl-show-hunk)))) 323 324 (defun diff-hl-show-hunk--next-hunk (backward point) 325 "Same as `diff-hl-search-next-hunk', but in the current buffer 326 of `diff-hl-show-hunk'." 327 (with-current-buffer (or diff-hl-show-hunk--original-buffer (current-buffer)) 328 (diff-hl-search-next-hunk backward point))) 329 330 (defun diff-hl-show-hunk--goto-hunk-overlay (overlay) 331 "Tries to display the whole overlay, and place the point at the 332 end of the OVERLAY, so posframe/inline is placed below the hunk." 333 (when (and (overlayp overlay) (overlay-buffer overlay)) 334 (let ((pt (point))) 335 (goto-char (overlay-start overlay)) 336 (cond 337 ((< (point) (window-start)) 338 (set-window-start nil (point))) 339 ((> (point) pt) 340 (redisplay)))) 341 (goto-char (1- (overlay-end overlay))))) 342 343 ;;;###autoload 344 (defun diff-hl-show-hunk-next () 345 "Go to next hunk/change and show it." 346 (interactive) 347 (let* ((point (if diff-hl-show-hunk--original-overlay 348 (overlay-start diff-hl-show-hunk--original-overlay) 349 nil)) 350 (next-overlay (diff-hl-show-hunk--next-hunk nil point))) 351 (if (not next-overlay) 352 (message "There is no next change") 353 (diff-hl-show-hunk-hide) 354 (diff-hl-show-hunk--goto-hunk-overlay next-overlay) 355 (recenter) 356 (diff-hl-show-hunk)))) 357 358 ;;;###autoload 359 (defun diff-hl-show-hunk () 360 "Show the VC diff hunk at point. 361 The backend is determined by `diff-hl-show-hunk-function'." 362 (interactive) 363 364 ;; Close any previous hunk 365 (save-excursion 366 (diff-hl-show-hunk-hide)) 367 368 (unless (vc-backend buffer-file-name) 369 (user-error "The buffer is not under version control")) 370 371 (diff-hl-find-current-hunk) 372 373 (setq diff-hl-show-hunk--original-overlay nil) 374 375 ;; Store begining and end of hunk overlay 376 (let ((overlay (diff-hl-hunk-overlay-at (point)))) 377 (when overlay 378 (let ((start (overlay-start overlay)) 379 (end (overlay-end overlay)) 380 (type (overlay-get overlay 'diff-hl-hunk-type))) 381 (setq diff-hl-show-hunk--original-overlay (make-overlay start end)) 382 (overlay-put diff-hl-show-hunk--original-overlay 'diff-hl-hunk-type type))) 383 384 (unless overlay 385 (user-error "Not in a hunk"))) 386 387 (cond 388 ((not diff-hl-show-hunk-function) 389 (message "Please configure `diff-hl-show-hunk-function'") 390 (diff-hl-diff-goto-hunk)) 391 ((let ((buffer-and-line (diff-hl-show-hunk-buffer))) 392 (setq diff-hl-show-hunk--original-buffer (current-buffer)) 393 (setq diff-hl-show-hunk--original-window (selected-window)) 394 (apply diff-hl-show-hunk-function buffer-and-line)) 395 ;; We could fall back to `diff-hl-diff-goto-hunk', but the 396 ;; current default should work in all environments (both GUI 397 ;; and terminal), and if something goes wrong we better show 398 ;; the error to the user. 399 ))) 400 401 ;;;###autoload 402 (define-minor-mode diff-hl-show-hunk-mouse-mode 403 "Enables the margin and fringe to show a posframe/popup with vc diffs when clicked. 404 By default, the popup shows only the current hunk, and 405 the line of the hunk that matches the current position is 406 highlighted. The face, border and other visual preferences are 407 customizable. It can be also invoked with the command 408 `diff-hl-show-hunk' 409 \\{diff-hl-show-hunk-mouse-mode-map}" 410 :group 'diff-hl-show-hunk 411 :lighter "") 412 413 ;;;###autoload 414 (define-globalized-minor-mode global-diff-hl-show-hunk-mouse-mode 415 diff-hl-show-hunk-mouse-mode 416 diff-hl-show-hunk-mouse-mode) 417 418 (provide 'diff-hl-show-hunk) 419 ;;; diff-hl-show-hunk.el ends here