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  
 81  (defvar diff-hl-show-hunk-posframe--transient-mode-map
 82    (let ((map (make-sparse-keymap)))
 83      (define-key map [escape]    #'diff-hl-show-hunk-hide)
 84      (define-key map (kbd "q")   #'diff-hl-show-hunk-hide)
 85      (define-key map (kbd "C-g") #'diff-hl-show-hunk-hide)
 86      (set-keymap-parent map diff-hl-show-hunk-map)
 87      map)
 88    "Keymap for command `diff-hl-show-hunk-posframe--transient-mode'.")
 89  
 90  (define-minor-mode diff-hl-show-hunk-posframe--transient-mode
 91    "Temporal minor mode to control diff-hl posframe."
 92    :lighter ""
 93    :global t
 94    (if diff-hl-show-hunk-posframe--transient-mode
 95        (add-hook 'post-command-hook #'diff-hl-show-hunk--posframe-post-command-hook nil)
 96      (remove-hook 'post-command-hook #'diff-hl-show-hunk--posframe-post-command-hook nil)))
 97  
 98  (defun diff-hl-show-hunk--posframe-post-command-hook ()
 99    "Called for each command while in `diff-hl-show-hunk-posframe--transient-mode."
100    (let* ((allowed-command (or
101                             (diff-hl-show-hunk-ignorable-command-p this-command)
102                             (and (symbolp this-command)
103                                  (string-match-p "diff-hl-" (symbol-name this-command)))))
104           (event-in-frame (eq last-event-frame diff-hl-show-hunk--frame))
105           (has-focus (and (frame-live-p diff-hl-show-hunk--frame)
106                           (functionp 'frame-focus-state)
107                           (eq (frame-focus-state diff-hl-show-hunk--frame) t)))
108           (still-visible (or event-in-frame allowed-command has-focus)))
109      (unless still-visible
110        (diff-hl-show-hunk--posframe-hide))))
111  
112  (defun diff-hl-show-hunk--posframe-button (text help-echo action)
113    "Make a string implementing a button with TEXT and a HELP-ECHO.
114  The button calls an ACTION."
115    (concat
116     (propertize (concat " " text " ")
117                 'help-echo (if action help-echo "Not available")
118                 'face 'diff-hl-show-hunk-posframe-button-face
119                 'mouse-face (when action '(:box (:style released-button)))
120                 'keymap (when action
121                           (let ((map (make-sparse-keymap)))
122                             (define-key map (kbd "<header-line> <mouse-1>") action)
123                             map)))
124     " "))
125  
126  (defun diff-hl-show-hunk-posframe--header-line ()
127    "Make the header line of the posframe."
128    (concat
129     (diff-hl-show-hunk--posframe-button
130      "⨯ Close"
131      "Close (\\[diff-hl-show-hunk-hide])"
132      #'diff-hl-show-hunk-hide)
133     (diff-hl-show-hunk--posframe-button
134      "⬆ Previous change"
135      "Previous change in hunk (\\[diff-hl-show-hunk-previous])"
136      #'diff-hl-show-hunk-previous)
137  
138     (diff-hl-show-hunk--posframe-button
139      "⬇ Next change"
140      "Next change in hunk (\\[diff-hl-show-hunk-next])"
141      #'diff-hl-show-hunk-next)
142  
143     (diff-hl-show-hunk--posframe-button
144      "⊚ Copy original"
145      "Copy original (\\[diff-hl-show-hunk-copy-original-text])"
146      #'diff-hl-show-hunk-copy-original-text)
147  
148     (diff-hl-show-hunk--posframe-button
149      "♻ Revert hunk"
150      "Revert hunk (\\[diff-hl-show-hunk-revert-hunk])"
151      #'diff-hl-show-hunk-revert-hunk)
152  
153     (unless diff-hl-show-staged-changes
154       (diff-hl-show-hunk--posframe-button
155        "⊕ Stage hunk"
156        "Stage hunk (\\[diff-hl-show-hunk-stage-hunk])"
157        #'diff-hl-show-hunk-stage-hunk))
158     ))
159  
160  ;;;###autoload
161  (defun diff-hl-show-hunk-posframe (buffer &optional _line)
162    "Implementation to show the hunk in a posframe."
163  
164    (unless (require 'posframe nil t)
165      (user-error
166       (concat
167        "`diff-hl-show-hunk-posframe' requires the `posframe' package."
168        "  Please install it or customize `diff-hl-show-hunk-function'.")))
169  
170    (unless (posframe-workable-p)
171      (user-error
172       "Package `posframe' is not workable.  Please customize diff-hl-show-hunk-function"))
173  
174    (setq diff-hl-show-hunk--hide-function #'diff-hl-show-hunk--posframe-hide)
175  
176    ;; put an overlay to override read-only-mode keymap
177    (with-current-buffer buffer
178      ;; Change face size
179      (buffer-face-set 'diff-hl-show-hunk-posframe)
180  
181      (let ((full-overlay (make-overlay 1 (1+ (buffer-size)))))
182        (overlay-put full-overlay
183                     'keymap diff-hl-show-hunk-posframe--transient-mode-map)))
184  
185    (setq posframe-mouse-banish nil)
186    (setq diff-hl-show-hunk--original-frame (selected-frame))
187  
188    (let* ((overlay diff-hl-show-hunk--original-overlay)
189           (type (overlay-get overlay 'diff-hl-hunk-type))
190           (position (save-excursion
191                       (goto-char (overlay-end overlay))
192                       (forward-line -1)
193                       (point))))
194      (setq
195       diff-hl-show-hunk--frame
196       (posframe-show buffer
197                      :position position
198                      :poshandler diff-hl-show-hunk-posframe-poshandler
199                      :internal-border-width diff-hl-show-hunk-posframe-internal-border-width
200                      :accept-focus t
201                      ;; internal-border-color Doesn't always work, if not customize internal-border face
202                      :internal-border-color diff-hl-show-hunk-posframe-internal-border-color
203                      :hidehandler nil
204                      ;; Sometimes, header-line is not taken into account, so put a min height and a min width
205                      :min-width (when diff-hl-show-hunk-posframe-show-header-line
206                                   (length (diff-hl-show-hunk-posframe--header-line)))
207                      :respect-header-line diff-hl-show-hunk-posframe-show-header-line
208                      :respect-tab-line nil
209                      :respect-mode-line nil
210                      :y-pixel-offset (if (eq type 'delete) (- (default-line-height)))
211                      :override-parameters diff-hl-show-hunk-posframe-parameters)))
212  
213    (set-frame-parameter diff-hl-show-hunk--frame 'drag-internal-border t)
214    (set-frame-parameter diff-hl-show-hunk--frame 'drag-with-header-line t)
215  
216    (with-selected-frame diff-hl-show-hunk--frame
217      (with-current-buffer buffer
218        (diff-hl-show-hunk-posframe--transient-mode 1)
219        (when diff-hl-show-hunk-posframe-show-header-line
220          (setq header-line-format (diff-hl-show-hunk-posframe--header-line)))
221        (goto-char (point-min))
222        (setq buffer-quit-function #'diff-hl-show-hunk--posframe-hide)
223        (select-window (window-main-window diff-hl-show-hunk--frame))
224  
225        ;; Make cursor visible (mainly for selecting text in posframe)
226        (setq cursor-type 'box)
227  
228        ;; Recenter around point
229        (recenter))))
230  
231  (provide 'diff-hl-show-hunk-posframe)
232  ;;; diff-hl-show-hunk-posframe.el ends here