diff-hl-inline-popup.el (14247B)
1 ;;; diff-hl-inline-popup.el --- inline popup using phantom overlays -*- 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 ;; Shows inline popups using phantom overlays. The lines of the popup 24 ;; can be scrolled. 25 ;;; Code: 26 27 (require 'subr-x) 28 29 (defvar diff-hl-inline-popup--current-popup nil "The overlay of the current inline popup.") 30 (defvar diff-hl-inline-popup--current-lines nil "A list of the lines to show in the popup.") 31 (defvar diff-hl-inline-popup--current-index nil "First line showed in popup.") 32 (defvar diff-hl-inline-popup--invokinkg-command nil "Command that invoked the popup.") 33 (defvar diff-hl-inline-popup--current-footer nil "String to be displayed in the footer.") 34 (defvar diff-hl-inline-popup--current-header nil "String to be displayed in the header.") 35 (defvar diff-hl-inline-popup--height nil "Height of the popup.") 36 (defvar diff-hl-inline-popup--current-custom-keymap nil "Keymap to be added to the keymap of the inline popup.") 37 (defvar diff-hl-inline-popup--close-hook nil "Function to be called when the popup closes.") 38 39 (make-variable-buffer-local 'diff-hl-inline-popup--current-popup) 40 (make-variable-buffer-local 'diff-hl-inline-popup--current-lines) 41 (make-variable-buffer-local 'diff-hl-inline-popup--current-index) 42 (make-variable-buffer-local 'diff-hl-inline-popup--current-header) 43 (make-variable-buffer-local 'diff-hl-inline-popup--current-footer) 44 (make-variable-buffer-local 'diff-hl-inline-popup--invokinkg-command) 45 (make-variable-buffer-local 'diff-hl-inline-popup--current-custom-keymap) 46 (make-variable-buffer-local 'diff-hl-inline-popup--height) 47 (make-variable-buffer-local 'diff-hl-inline-popup--close-hook) 48 49 (defun diff-hl-inline-popup--splice (list offset length) 50 "Compute a sublist of LIST starting at OFFSET, of LENGTH." 51 (butlast 52 (nthcdr offset list) 53 (- (length list) length offset))) 54 55 (defun diff-hl-inline-popup--ensure-enough-lines (pos content-height) 56 "Ensure there is enough lines below POS to show the inline popup with CONTENT-HEIGHT height." 57 (let* ((line (line-number-at-pos pos)) 58 (end (line-number-at-pos (window-end nil t))) 59 (height (+ 6 content-height)) 60 (overflow (- (+ line height) end))) 61 (when (< 0 overflow) 62 (run-with-timer 0.1 nil #'scroll-up overflow)))) 63 64 (defun diff-hl-inline-popup--compute-content-height (&optional content-size) 65 "Compute the height of the inline popup. 66 Default for CONTENT-SIZE is the size of the current lines" 67 (let ((content-size (or content-size (length diff-hl-inline-popup--current-lines))) 68 (max-size (- (/(window-height) 2) 3))) 69 (min content-size max-size))) 70 71 (defun diff-hl-inline-popup--compute-content-lines (lines index window-size) 72 "Compute the lines to show in the popup, from LINES starting at INDEX with a WINDOW-SIZE." 73 (let* ((len (length lines)) 74 (window-size (min window-size len)) 75 (index (min index (- len window-size)))) 76 (diff-hl-inline-popup--splice lines index window-size))) 77 78 (defun diff-hl-inline-popup--compute-header (width &optional header) 79 "Compute the header of the popup, with some WIDTH, and some optional HEADER text." 80 (let* ((scroll-indicator (if (eq diff-hl-inline-popup--current-index 0) " " " ⬆ ")) 81 (header (or header "")) 82 (new-width (- width (length header) (length scroll-indicator))) 83 (header (if (< new-width 0) "" header)) 84 (new-width (- width (length header) (length scroll-indicator))) 85 (line (propertize (concat (diff-hl-inline-popup--separator new-width) 86 header scroll-indicator ) 87 'face '(:underline t)))) 88 (concat line "\n") )) 89 90 (defun diff-hl-inline-popup--compute-footer (width &optional footer) 91 "Compute the header of the popup, with some WIDTH, and some optional FOOTER text." 92 (let* ((scroll-indicator (if (>= diff-hl-inline-popup--current-index 93 (- (length diff-hl-inline-popup--current-lines) 94 diff-hl-inline-popup--height)) 95 " " 96 " ⬇ ")) 97 (footer (or footer "")) 98 (new-width (- width (length footer) (length scroll-indicator))) 99 (footer (if (< new-width 0) "" footer)) 100 (new-width (- width (length footer) (length scroll-indicator))) 101 (blank-line (if (display-graphic-p) 102 "" 103 (concat "\n" (propertize (diff-hl-inline-popup--separator width) 104 'face '(:underline t))))) 105 (line (propertize (concat (diff-hl-inline-popup--separator new-width) 106 footer scroll-indicator) 107 'face '(:overline t)))) 108 (concat blank-line "\n" line))) 109 110 (defun diff-hl-inline-popup--separator (width &optional sep) 111 "Return the horizontal separator with character SEP and a WIDTH." 112 (let ((sep (or sep ?\s))) 113 (make-string width sep))) 114 115 (defun diff-hl-inline-popup--available-width () 116 "Compute the available width in chars." 117 (let ((magic-adjust 3)) 118 (if (not (display-graphic-p)) 119 (let* ((linumber-width (line-number-display-width nil)) 120 (width (- (window-body-width) linumber-width magic-adjust))) 121 width) 122 (let* ((font-width (window-font-width)) 123 (window-width (window-body-width nil t)) 124 (linenumber-width (line-number-display-width t)) 125 (available-pixels (- window-width linenumber-width)) 126 (width (- (/ available-pixels font-width) magic-adjust))) 127 128 ;; https://emacs.stackexchange.com/questions/5495/how-can-i-determine-the-width-of-characters-on-the-screen 129 width)))) 130 131 (defun diff-hl-inline-popup--compute-popup-str (lines index window-size header footer) 132 "Compute the string that represents the popup. 133 There are some content LINES starting at INDEX, with a WINDOW-SIZE. HEADER and 134 FOOTER are showed at start and end." 135 (let* ((width (diff-hl-inline-popup--available-width)) 136 (content-lines (diff-hl-inline-popup--compute-content-lines lines index window-size)) 137 (header (diff-hl-inline-popup--compute-header width header)) 138 (footer (diff-hl-inline-popup--compute-footer width footer))) 139 (concat header (string-join content-lines "\n") footer "\n"))) 140 141 (defun diff-hl-inline-popup-scroll-to (index) 142 "Scroll the inline popup to make visible the line at position INDEX." 143 (when diff-hl-inline-popup--current-popup 144 (setq diff-hl-inline-popup--current-index (max 0 (min index (- (length diff-hl-inline-popup--current-lines) diff-hl-inline-popup--height)))) 145 (let* ((str (diff-hl-inline-popup--compute-popup-str 146 diff-hl-inline-popup--current-lines 147 diff-hl-inline-popup--current-index 148 diff-hl-inline-popup--height 149 diff-hl-inline-popup--current-header 150 diff-hl-inline-popup--current-footer))) 151 ;; https://debbugs.gnu.org/38563, `company--replacement-string'. 152 (add-face-text-property 0 (length str) 'default t str) 153 (overlay-put diff-hl-inline-popup--current-popup 'after-string str)))) 154 155 (defun diff-hl-inline-popup--popup-down() 156 "Scrolls one line down." 157 (interactive) 158 (diff-hl-inline-popup-scroll-to (1+ diff-hl-inline-popup--current-index) )) 159 160 (defun diff-hl-inline-popup--popup-up() 161 "Scrolls one line up." 162 (interactive) 163 (diff-hl-inline-popup-scroll-to (1- diff-hl-inline-popup--current-index) )) 164 165 (defun diff-hl-inline-popup--popup-pagedown() 166 "Scrolls one page down." 167 (interactive) 168 (diff-hl-inline-popup-scroll-to (+ diff-hl-inline-popup--current-index diff-hl-inline-popup--height) )) 169 170 (defun diff-hl-inline-popup--popup-pageup() 171 "Scrolls one page up." 172 (interactive) 173 (diff-hl-inline-popup-scroll-to (- diff-hl-inline-popup--current-index diff-hl-inline-popup--height) )) 174 175 (defvar diff-hl-inline-popup-transient-mode-map 176 (let ((map (make-sparse-keymap))) 177 (define-key map (kbd "<prior>") #'diff-hl-inline-popup--popup-pageup) 178 (define-key map (kbd "M-v") #'diff-hl-inline-popup--popup-pageup) 179 (define-key map (kbd "<next>") #'diff-hl-inline-popup--popup-pagedown) 180 (define-key map (kbd "C-v") #'diff-hl-inline-popup--popup-pagedown) 181 (define-key map (kbd "<up>") #'diff-hl-inline-popup--popup-up) 182 (define-key map (kbd "C-p") #'diff-hl-inline-popup--popup-up) 183 (define-key map (kbd "<down>") #'diff-hl-inline-popup--popup-down) 184 (define-key map (kbd "C-n") #'diff-hl-inline-popup--popup-down) 185 (define-key map (kbd "C-g") #'diff-hl-inline-popup-hide) 186 (define-key map [escape] #'diff-hl-inline-popup-hide) 187 (define-key map (kbd "q") #'diff-hl-inline-popup-hide) 188 ;;http://ergoemacs.org/emacs/emacs_mouse_wheel_config.html 189 (define-key map (kbd "<mouse-4>") #'diff-hl-inline-popup--popup-up) 190 (define-key map (kbd "<wheel-up>") #'diff-hl-inline-popup--popup-up) 191 (define-key map (kbd "<mouse-5>") #'diff-hl-inline-popup--popup-down) 192 (define-key map (kbd "<wheel-down>") #'diff-hl-inline-popup--popup-down) 193 map) 194 "Keymap for command `diff-hl-inline-popup-transient-mode'. 195 Capture all the vertical movement of the point, and converts it 196 to scroll in the popup") 197 198 (defun diff-hl-inline-popup--ignorable-command-p (command) 199 "Decide if COMMAND is a command allowed while showing an inline popup." 200 ;; https://emacs.stackexchange.com/questions/653/how-can-i-find-out-in-which-keymap-a-key-is-bound 201 (let ((keys (where-is-internal command (list diff-hl-inline-popup--current-custom-keymap 202 diff-hl-inline-popup-transient-mode-map ) t)) 203 (invoking (eq command diff-hl-inline-popup--invokinkg-command))) 204 (or keys invoking))) 205 206 (defun diff-hl-inline-popup--post-command-hook () 207 "Called each time a command is executed." 208 (let ((allowed-command (or 209 (string-match-p "diff-hl-inline-popup-" (symbol-name this-command)) 210 (diff-hl-inline-popup--ignorable-command-p this-command)))) 211 (unless allowed-command 212 (diff-hl-inline-popup-hide)))) 213 214 (define-minor-mode diff-hl-inline-popup-transient-mode 215 "Temporal minor mode to control an inline popup" 216 :global nil 217 (remove-hook 'post-command-hook #'diff-hl-inline-popup--post-command-hook t) 218 (set-keymap-parent diff-hl-inline-popup-transient-mode-map nil) 219 220 (when diff-hl-inline-popup-transient-mode 221 (set-keymap-parent diff-hl-inline-popup-transient-mode-map 222 diff-hl-inline-popup--current-custom-keymap) 223 (add-hook 'post-command-hook #'diff-hl-inline-popup--post-command-hook 0 t))) 224 225 ;;;###autoload 226 (defun diff-hl-inline-popup-hide() 227 "Hide the current inline popup." 228 (interactive) 229 (when diff-hl-inline-popup-transient-mode 230 (diff-hl-inline-popup-transient-mode -1)) 231 (when diff-hl-inline-popup--close-hook 232 (funcall diff-hl-inline-popup--close-hook) 233 (setq diff-hl-inline-popup--close-hook nil)) 234 (when diff-hl-inline-popup--current-popup 235 (delete-overlay diff-hl-inline-popup--current-popup) 236 (setq diff-hl-inline-popup--current-popup nil))) 237 238 ;;;###autoload 239 (defun diff-hl-inline-popup-show (lines &optional header footer keymap close-hook point height) 240 "Create a phantom overlay to show the inline popup, with some 241 content LINES, and a HEADER and a FOOTER, at POINT. KEYMAP is 242 added to the current keymaps. CLOSE-HOOK is called when the popup 243 is closed." 244 (when diff-hl-inline-popup--current-popup 245 (delete-overlay diff-hl-inline-popup--current-popup) 246 (setq diff-hl-inline-popup--current-popup nil)) 247 248 (when (< (diff-hl-inline-popup--compute-content-height 99) 2) 249 (user-error "There is no enough vertical space to show the inline popup")) 250 (let* ((the-point (or point (line-end-position))) 251 (the-buffer (current-buffer)) 252 (overlay (make-overlay the-point the-point the-buffer))) 253 (overlay-put overlay 'phantom t) 254 (overlay-put overlay 'diff-hl-inline-popup t) 255 (setq diff-hl-inline-popup--current-popup overlay) 256 257 (setq diff-hl-inline-popup--current-lines 258 (mapcar (lambda (s) (replace-regexp-in-string "\n" " " s)) lines)) 259 (setq diff-hl-inline-popup--current-header header) 260 (setq diff-hl-inline-popup--current-footer footer) 261 (setq diff-hl-inline-popup--invokinkg-command this-command) 262 (setq diff-hl-inline-popup--current-custom-keymap keymap) 263 (setq diff-hl-inline-popup--close-hook close-hook) 264 (setq diff-hl-inline-popup--height (diff-hl-inline-popup--compute-content-height height)) 265 (setq diff-hl-inline-popup--height (min diff-hl-inline-popup--height 266 (length diff-hl-inline-popup--current-lines))) 267 ;; (diff-hl-inline-popup--ensure-enough-lines point diff-hl-inline-popup--height) 268 (diff-hl-inline-popup-transient-mode 1) 269 (diff-hl-inline-popup-scroll-to 0) 270 overlay)) 271 272 (defun diff-hl-inline-popup--hide-all () 273 "Testing purposes, use in case some inline popups get stuck in a buffer." 274 (interactive) 275 (when diff-hl-inline-popup-transient-mode 276 (diff-hl-inline-popup-transient-mode -1)) 277 (setq diff-hl-inline-popup--current-popup nil) 278 (let* ((all-overlays (overlays-in (point-min) (point-max))) 279 (overlays (cl-remove-if-not (lambda (o)(overlay-get o 'diff-hl-inline-popup)) all-overlays))) 280 (dolist (o overlays) 281 (delete-overlay o)))) 282 283 (provide 'diff-hl-inline-popup) 284 ;;; diff-hl-inline-popup ends here