diff-hl-show-hunk-posframe.el (9829B)
1 ;;; diff-hl-show-hunk-posframe.el --- posframe backend for diff-hl-show-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 ;; This provides `diff-hl-show-hunk-posframe' than can be used as 25 ;; `diff-hl-show-hunk-function'. `posframe' is a runtime dependency, 26 ;; it is not required by this package, but it should be installed. 27 ;; 28 ;;; Code: 29 30 (require 'diff-hl-show-hunk) 31 32 ;; This package uses some runtime dependencies, so we need to declare 33 ;; the external functions and variables 34 (declare-function posframe-workable-p "posframe") 35 (declare-function posframe-show "posframe") 36 (defvar posframe-mouse-banish) 37 38 (defgroup diff-hl-show-hunk-posframe nil 39 "Show vc diffs in a posframe." 40 :group 'diff-hl-show-hunk) 41 42 (defcustom diff-hl-show-hunk-posframe-show-header-line t 43 "Show some useful buttons at the top of the diff-hl posframe." 44 :type 'boolean) 45 46 (defcustom diff-hl-show-hunk-posframe-internal-border-width 2 47 "Internal border width of the posframe." 48 :type 'integer) 49 50 (defcustom diff-hl-show-hunk-posframe-internal-border-color "#00ffff" 51 "Internal border color of the posframe." 52 :type 'color) 53 54 (defcustom diff-hl-show-hunk-posframe-poshandler nil 55 "Poshandler of the posframe (see `posframe-show`)." 56 :type '(choice function 57 (const :tag "None" nil))) 58 59 (defcustom diff-hl-show-hunk-posframe-parameters nil 60 "The frame parameters used by helm-posframe." 61 :type '(choice string 62 (const :tag "None" nil))) 63 64 (defface diff-hl-show-hunk-posframe '((t nil)) 65 "Face for the posframe buffer. 66 Customize it to change the base properties of the text.") 67 68 (defface diff-hl-show-hunk-posframe-button-face '((t . (:height 0.9))) 69 "Face for the posframe buttons" ) 70 71 (defvar diff-hl-show-hunk--frame nil "The postframe frame used in function `diff-hl-show-hunk-posframe'.") 72 (defvar diff-hl-show-hunk--original-frame nil "The frame from which the hunk is shown.") 73 74 (defun diff-hl-show-hunk--posframe-hide () 75 "Hide the posframe and clean up buffer." 76 (interactive) 77 (diff-hl-show-hunk-posframe--transient-mode -1) 78 (when (frame-live-p diff-hl-show-hunk--frame) 79 (make-frame-invisible diff-hl-show-hunk--frame)) 80 (when diff-hl-show-hunk--original-frame 81 (when (frame-live-p diff-hl-show-hunk--original-frame) 82 (let ((frame diff-hl-show-hunk--original-frame)) 83 (select-frame-set-input-focus frame) 84 ;; In Gnome, sometimes the input focus is not restored to the 85 ;; original frame, so we try harder in a while 86 (run-with-timer 0.1 nil (lambda () (select-frame-set-input-focus frame))))) 87 (setq diff-hl-show-hunk--original-frame nil))) 88 89 (defvar diff-hl-show-hunk-posframe--transient-mode-map 90 (let ((map (make-sparse-keymap))) 91 (define-key map [escape] #'diff-hl-show-hunk-hide) 92 (define-key map (kbd "q") #'diff-hl-show-hunk-hide) 93 (define-key map (kbd "C-g") #'diff-hl-show-hunk-hide) 94 (set-keymap-parent map diff-hl-show-hunk-map) 95 map) 96 "Keymap for command `diff-hl-show-hunk-posframe--transient-mode'.") 97 98 (define-minor-mode diff-hl-show-hunk-posframe--transient-mode 99 "Temporal minor mode to control diff-hl posframe." 100 :lighter "" 101 :global t 102 (if diff-hl-show-hunk-posframe--transient-mode 103 (add-hook 'post-command-hook #'diff-hl-show-hunk--posframe-post-command-hook nil) 104 (remove-hook 'post-command-hook #'diff-hl-show-hunk--posframe-post-command-hook nil))) 105 106 (defun diff-hl-show-hunk--posframe-post-command-hook () 107 "Called for each command while in `diff-hl-show-hunk-posframe--transient-mode." 108 (let* ((allowed-command (or 109 (diff-hl-show-hunk-ignorable-command-p this-command) 110 (and (symbolp this-command) 111 (string-match-p "diff-hl-" (symbol-name this-command))))) 112 (event-in-frame (eq last-event-frame diff-hl-show-hunk--frame)) 113 (has-focus (and (frame-live-p diff-hl-show-hunk--frame) 114 (functionp 'frame-focus-state) 115 (eq (frame-focus-state diff-hl-show-hunk--frame) t))) 116 (still-visible (or event-in-frame allowed-command has-focus))) 117 (unless still-visible 118 (diff-hl-show-hunk--posframe-hide)))) 119 120 (defun diff-hl-show-hunk--posframe-button (text help-echo action) 121 "Make a string implementing a button with TEXT and a HELP-ECHO. 122 The button calls an ACTION." 123 (concat 124 (propertize (concat " " text " ") 125 'help-echo (if action help-echo "Not available") 126 'face 'diff-hl-show-hunk-posframe-button-face 127 'mouse-face (when action '(:box (:style released-button))) 128 'keymap (when action 129 (let ((map (make-sparse-keymap))) 130 (define-key map (kbd "<header-line> <mouse-1>") action) 131 map))) 132 " ")) 133 134 (defun diff-hl-show-hunk-posframe--header-line () 135 "Make the header line of the posframe." 136 (concat 137 (diff-hl-show-hunk--posframe-button 138 "⨯ Close" 139 "Close (\\[diff-hl-show-hunk-hide])" 140 #'diff-hl-show-hunk-hide) 141 (diff-hl-show-hunk--posframe-button 142 "⬆ Previous change" 143 "Previous change in hunk (\\[diff-hl-show-hunk-previous])" 144 #'diff-hl-show-hunk-previous) 145 146 (diff-hl-show-hunk--posframe-button 147 "⬇ Next change" 148 "Next change in hunk (\\[diff-hl-show-hunk-next])" 149 #'diff-hl-show-hunk-next) 150 151 (diff-hl-show-hunk--posframe-button 152 "⊚ Copy original" 153 "Copy original (\\[diff-hl-show-hunk-copy-original-text])" 154 #'diff-hl-show-hunk-copy-original-text) 155 156 (diff-hl-show-hunk--posframe-button 157 "♻ Revert hunk" 158 "Revert hunk (\\[diff-hl-show-hunk-revert-hunk])" 159 #'diff-hl-show-hunk-revert-hunk) 160 161 (unless diff-hl-show-staged-changes 162 (diff-hl-show-hunk--posframe-button 163 "⊕ Stage hunk" 164 "Stage hunk (\\[diff-hl-show-hunk-stage-hunk])" 165 #'diff-hl-show-hunk-stage-hunk)) 166 )) 167 168 ;;;###autoload 169 (defun diff-hl-show-hunk-posframe (buffer &optional _line) 170 "Implementation to show the hunk in a posframe." 171 172 (unless (require 'posframe nil t) 173 (user-error 174 (concat 175 "`diff-hl-show-hunk-posframe' requires the `posframe' package." 176 " Please install it or customize `diff-hl-show-hunk-function'."))) 177 178 (unless (posframe-workable-p) 179 (user-error 180 "Package `posframe' is not workable. Please customize diff-hl-show-hunk-function")) 181 182 (diff-hl-show-hunk--posframe-hide) 183 (setq diff-hl-show-hunk--hide-function #'diff-hl-show-hunk--posframe-hide) 184 185 ;; put an overlay to override read-only-mode keymap 186 (with-current-buffer buffer 187 ;; Change face size 188 (buffer-face-set 'diff-hl-show-hunk-posframe) 189 190 (let ((full-overlay (make-overlay 1 (1+ (buffer-size))))) 191 (overlay-put full-overlay 192 'keymap diff-hl-show-hunk-posframe--transient-mode-map))) 193 194 (setq posframe-mouse-banish nil) 195 (setq diff-hl-show-hunk--original-frame last-event-frame) 196 197 (let* ((hunk-overlay diff-hl-show-hunk--original-overlay) 198 (position (overlay-end hunk-overlay))) 199 (setq 200 diff-hl-show-hunk--frame 201 (posframe-show buffer 202 :position position 203 :poshandler diff-hl-show-hunk-posframe-poshandler 204 :internal-border-width diff-hl-show-hunk-posframe-internal-border-width 205 :accept-focus t 206 ;; internal-border-color Doesn't always work, if not customize internal-border face 207 :internal-border-color diff-hl-show-hunk-posframe-internal-border-color 208 :hidehandler nil 209 ;; Sometimes, header-line is not taken into account, so put a min height and a min width 210 :min-height (when diff-hl-show-hunk-posframe-show-header-line 10) 211 :min-width (when diff-hl-show-hunk-posframe-show-header-line 212 (length (diff-hl-show-hunk-posframe--header-line))) 213 :respect-header-line diff-hl-show-hunk-posframe-show-header-line 214 :respect-tab-line nil 215 :respect-mode-line nil 216 :override-parameters diff-hl-show-hunk-posframe-parameters))) 217 218 (set-frame-parameter diff-hl-show-hunk--frame 'drag-internal-border t) 219 (set-frame-parameter diff-hl-show-hunk--frame 'drag-with-header-line t) 220 221 (with-selected-frame diff-hl-show-hunk--frame 222 (with-current-buffer buffer 223 (diff-hl-show-hunk-posframe--transient-mode 1) 224 (when diff-hl-show-hunk-posframe-show-header-line 225 (setq header-line-format (diff-hl-show-hunk-posframe--header-line))) 226 (goto-char (point-min)) 227 (setq buffer-quit-function #'diff-hl-show-hunk--posframe-hide) 228 (select-window (window-main-window diff-hl-show-hunk--frame)) 229 230 ;; Make cursor visible (mainly for selecting text in posframe) 231 (setq cursor-type 'box) 232 233 ;; Recenter arround point 234 (recenter))) 235 (select-frame-set-input-focus diff-hl-show-hunk--frame)) 236 237 (provide 'diff-hl-show-hunk-posframe) 238 ;;; diff-hl-show-hunk-posframe.el ends here