├── snapshots └── posframe-1.png ├── .gitignore ├── posframe-benchmark.el ├── README.org └── posframe.el /snapshots/posframe-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/posframe/HEAD/snapshots/posframe-1.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ChangeLog 2 | ## Auto generated by package-vc-install 3 | /posframe-autoloads.el 4 | /posframe-benchmark.elc 5 | /posframe-pkg.el 6 | /posframe.elc 7 | -------------------------------------------------------------------------------- /posframe-benchmark.el: -------------------------------------------------------------------------------- 1 | ;;; posframe-benchmark.el --- Benchmark tool for posframe -*- lexical-binding:t -*- 2 | 3 | ;; Copyright (C) 2018-2020 Free Software Foundation, Inc. 4 | 5 | ;; Author: Feng Shu 6 | ;; Maintainer: Feng Shu 7 | ;; URL: https://github.com/tumashu/posframe 8 | ;; Version: 1.0.3 9 | ;; Keywords: convenience, tooltip 10 | ;; Package-Requires: ((emacs "26")) 11 | 12 | ;; This file is part of GNU Emacs. 13 | 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify 15 | ;; it under the terms of the GNU General Public License as published by 16 | ;; the Free Software Foundation, either version 3 of the License, or 17 | ;; (at your option) any later version. 18 | 19 | ;; GNU Emacs is distributed in the hope that it will be useful, 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 | ;; GNU General Public License for more details. 23 | 24 | ;; You should have received a copy of the GNU General Public License 25 | ;; along with GNU Emacs. If not, see . 26 | 27 | ;;; Commentary: 28 | 29 | ;;; Code: 30 | (require 'cl-lib) 31 | (require 'posframe) 32 | 33 | (defvar posframe-benchmark-alist 34 | (let ((str (with-temp-buffer 35 | (insert-file-contents (locate-library "posframe.el")) 36 | (buffer-string)))) 37 | `((font-at 38 | (font-at (point-min))) 39 | (redraw-display 40 | (redraw-display)) 41 | (redraw-frame 42 | (redraw-frame (window-frame))) 43 | (remove-text-properties 44 | (let ((string ,str)) 45 | (remove-text-properties 46 | 0 (length string) '(read-only t) 47 | string))) 48 | (mouse-position 49 | (mouse-position)) 50 | (default-font-width 51 | (default-font-width)) 52 | (posframe--get-font-height 53 | (posframe--get-font-height (point-min))) 54 | (frame-parameter 55 | (frame-parameter (window-frame) 'no-accept-focus)) 56 | (set-mouse-position 57 | (set-mouse-position (window-frame) 0 0)) 58 | (posn-at-point 59 | (posn-at-point)) 60 | (posn-x-y 61 | (posn-x-y (posn-at-point))) 62 | (posn-object-x-y 63 | (posn-object-x-y (posn-at-point))) 64 | (set-frame-parameter 65 | (set-frame-parameter (window-frame) 'test 1)) 66 | (raise-frame 67 | (raise-frame (window-frame)))))) 68 | 69 | ;;;###autoload 70 | (defun posframe-benchmark () 71 | "Benchmark tool for posframe." 72 | (interactive) 73 | (let ((n 1000)) 74 | (message "\n* Posframe Benchmark") 75 | (dolist (x posframe-benchmark-alist) 76 | (message "\n** Benchmark `%S' %s times ..." (car x) n) 77 | (benchmark n (car (cdr x)))) 78 | (message "\n* Finished."))) 79 | 80 | 81 | (provide 'posframe-benchmark) 82 | 83 | ;;; posframe.el ends here 84 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | # Created 2021-06-01 Tue 10:41 2 | #+TITLE: Pop a posframe (just a frame) at point 3 | #+AUTHOR: Feng Shu 4 | 5 | #+html: GNU ELPA 6 | #+html: GNU-devel ELPA 7 | #+html: MELPA 8 | 9 | * What is posframe? 10 | Posframe can pop up a frame at point, this *posframe* is a 11 | child-frame connected to its root window's buffer. 12 | 13 | The main advantages are: 14 | 1. It is fast enough for daily usage :-) 15 | 2. It works well with CJK languages. 16 | 17 | NOTE: 18 | 1. For MacOS users, posframe needs Emacs version >= 26.0.91 19 | 2. GNOME users with GTK3 builds need Emacs 27 or later. 20 | See variable `posframe-gtk-resize-child-frames' 21 | which auto-detects this configuration. 22 | 23 | More details: 24 | 1. [[https://git.savannah.gnu.org/cgit/emacs.git/commit/?h=emacs-27&id=c49d379f17bcb0ce82604def2eaa04bda00bd5ec][Fix some problems with moving and resizing child frames]] 25 | 2. [[https://lists.gnu.org/archive/html/emacs-devel/2020-01/msg00343.html][Emacs's set-frame-size can not work well with gnome-shell?]] 26 | 27 | [[file:./snapshots/posframe-1.png]] 28 | 29 | * Installation 30 | 31 | #+begin_example 32 | (require 'posframe) 33 | #+end_example 34 | 35 | * Usage 36 | 37 | ** Create a posframe 38 | 39 | *** Simple way 40 | #+begin_example 41 | (when (posframe-workable-p) 42 | (posframe-show " *my-posframe-buffer*" 43 | :string "This is a test" 44 | :position (point))) 45 | #+end_example 46 | 47 | *** Advanced way 48 | #+begin_example 49 | (defvar my-posframe-buffer " *my-posframe-buffer*") 50 | 51 | (with-current-buffer (get-buffer-create my-posframe-buffer) 52 | (erase-buffer) 53 | (insert "Hello world")) 54 | 55 | (when (posframe-workable-p) 56 | (posframe-show my-posframe-buffer 57 | :position (point))) 58 | #+end_example 59 | 60 | *** Arguments 61 | 62 | #+begin_example 63 | C-h f posframe-show 64 | #+end_example 65 | 66 | ** Hide a posframe 67 | #+begin_example 68 | (posframe-hide " *my-posframe-buffer*") 69 | #+end_example 70 | 71 | ** Hide all posframes 72 | #+begin_example 73 | M-x posframe-hide-all 74 | #+end_example 75 | 76 | ** Delete a posframe 77 | 1. Delete posframe and its buffer 78 | #+begin_example 79 | (posframe-delete " *my-posframe-buffer*") 80 | #+end_example 81 | 2. Only delete the frame 82 | #+begin_example 83 | (posframe-delete-frame " *my-posframe-buffer*") 84 | #+end_example 85 | ** Delete all posframes 86 | #+begin_example 87 | M-x posframe-delete-all 88 | #+end_example 89 | 90 | Note: this command will delete all posframe buffers. 91 | You probably shouldn't use it if you are sharing a buffer 92 | between posframe and other packages. 93 | 94 | ** posframe-arghandler 95 | 96 | posframe-arghandler feature has been removed from posframe-1.1, 97 | user can use advice feature instead. 98 | 99 | ** Mouse banish 100 | Default setting will work well in most case, but for EXWM user, 101 | suggest use the below config. 102 | 103 | #+begin_src emacs-lisp 104 | (setq posframe-mouse-banish-function #'posframe-mouse-banish-simple) 105 | #+end_src 106 | -------------------------------------------------------------------------------- /posframe.el: -------------------------------------------------------------------------------- 1 | ;;; posframe.el --- Pop a posframe (just a frame) at point -*- lexical-binding:t -*- 2 | 3 | ;; Copyright (C) 2018-2020 Free Software Foundation, Inc. 4 | 5 | ;; Author: Feng Shu 6 | ;; Maintainer: Feng Shu 7 | ;; URL: https://github.com/tumashu/posframe 8 | ;; Version: 1.5.0 9 | ;; Keywords: convenience, tooltip 10 | ;; Package-Requires: ((emacs "26.1")) 11 | 12 | ;; This file is not part of GNU Emacs. 13 | 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify 15 | ;; it under the terms of the GNU General Public License as published by 16 | ;; the Free Software Foundation, either version 3 of the License, or 17 | ;; (at your option) any later version. 18 | 19 | ;; GNU Emacs is distributed in the hope that it will be useful, 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 | ;; GNU General Public License for more details. 23 | 24 | ;; You should have received a copy of the GNU General Public License 25 | ;; along with GNU Emacs. If not, see . 26 | 27 | ;;; Commentary: 28 | ;; * Posframe README :README: 29 | 30 | ;; Posframe can pop up a frame at point, this *posframe* is a 31 | ;; child-frame connected to its root window's buffer. 32 | 33 | ;; The main advantages are: 34 | ;; 1. It is fast enough for daily usage :-) 35 | ;; 2. It works well with CJK languages. 36 | 37 | ;; More info please see: README.org 38 | 39 | ;;; Code: 40 | ;; * posframe's code :CODE: 41 | (require 'cl-lib) 42 | 43 | (defgroup posframe nil 44 | "Pop a posframe (just a frame) at point." 45 | :group 'lisp 46 | :prefix "posframe-") 47 | 48 | (defcustom posframe-inhibit-double-buffering nil 49 | "Set the posframe's frame-parameter: inhibit-double-buffering." 50 | :group 'posframe 51 | :type 'boolean) 52 | 53 | (defcustom posframe-mouse-banish-function #'posframe-mouse-banish-default 54 | "The function used to banish mouse. 55 | 56 | Function `posframe-mouse-banish-default' will work well in most 57 | case, but suggest use function `posframe-mouse-banish-simple' or 58 | custom function for EXWM users." 59 | :type 'function) 60 | 61 | (defcustom posframe-text-scale-factor-function #'posframe-text-scale-factor-default 62 | "The function to adjust value of text-scale of posframe buffer. 63 | 64 | Accepts single argument which is the value of parent buffer 65 | `text-scale-mode-amount' or nil if the `text-scale-mode' is disabled in 66 | the parent buffer." 67 | :group 'posframe 68 | :type 'function) 69 | 70 | (defvar-local posframe--frame nil 71 | "Record posframe's frame.") 72 | 73 | (defvar-local posframe--last-posframe-pixel-position nil 74 | "Record the last pixel position of posframe's frame.") 75 | 76 | (defvar-local posframe--last-posframe-size nil 77 | "Record the last size of posframe's frame.") 78 | 79 | (defvar-local posframe--last-posframe-displayed-size nil 80 | "Record the last displayed size of posframe's frame.") 81 | 82 | (defvar-local posframe--last-parent-frame-size nil 83 | "Record the last size of posframe's parent-frame.") 84 | 85 | (defvar-local posframe--last-poshandler-info nil 86 | "Record the last poshandler info.") 87 | 88 | (defvar-local posframe--last-font-height-info nil 89 | "Record the last font height info.") 90 | 91 | (defvar-local posframe--last-args nil 92 | "Record the last arguments of `posframe--create-posframe'. 93 | 94 | If these args have changed, posframe will recreate its 95 | frame.") 96 | 97 | (defvar-local posframe--timeout-timer nil 98 | "Record the timer to deal with timeout argument of `posframe-show'.") 99 | 100 | (defvar-local posframe--refresh-timer nil 101 | "Record the timer to deal with refresh argument of `posframe-show'.") 102 | 103 | (defvar-local posframe--initialized-p nil 104 | "Record initialize status of `posframe-show'.") 105 | 106 | (defvar-local posframe--accept-focus nil 107 | "Record accept focus status of `posframe-show'.") 108 | 109 | (defvar posframe-hidehandler-timer nil 110 | "Timer used by hidehandler function.") 111 | 112 | ;; Avoid compilation warnings on Emacs < 27. 113 | (defvar x-gtk-resize-child-frames) 114 | 115 | (defvar posframe-gtk-resize-child-frames 116 | (when (and 117 | (> emacs-major-version 26) 118 | (string-match-p "GTK3" system-configuration-features) 119 | (let ((value (or (getenv "XDG_CURRENT_DESKTOP") (getenv "DESKTOP_SESSION")))) 120 | (and (stringp value) 121 | ;; It can be "ubuntu:GNOME". 122 | (string-match-p "GNOME" value)))) 123 | ;; Not future-proof, but we can use it now. 124 | 'resize-mode) 125 | "Value to bind `x-gtk-resize-child-frames' to. 126 | 127 | The value `resize-mode' only has effect on new child frames, so 128 | if you change it, call `posframe-delete-all' for it to take 129 | effect.") 130 | 131 | ;;;###autoload 132 | (defun posframe-workable-p () 133 | "Test posframe workable status." 134 | (and (>= emacs-major-version 26) 135 | (not noninteractive) 136 | (not emacs-basic-display) 137 | (or (display-graphic-p) 138 | (featurep 'tty-child-frames)) 139 | (eq (frame-parameter (selected-frame) 'minibuffer) 't))) 140 | 141 | ;;;###autoload 142 | (cl-defun posframe-show (buffer-or-name 143 | &key 144 | string 145 | position 146 | poshandler 147 | poshandler-extra-info 148 | width 149 | height 150 | max-width 151 | max-height 152 | min-width 153 | min-height 154 | x-pixel-offset 155 | y-pixel-offset 156 | left-fringe 157 | right-fringe 158 | border-width 159 | border-color 160 | internal-border-width 161 | internal-border-color 162 | font 163 | cursor 164 | tty-non-selected-cursor 165 | window-point 166 | foreground-color 167 | background-color 168 | respect-header-line 169 | respect-mode-line 170 | initialize 171 | no-properties 172 | keep-ratio 173 | lines-truncate 174 | override-parameters 175 | timeout 176 | refresh 177 | accept-focus 178 | hidehandler 179 | refposhandler 180 | &allow-other-keys) 181 | "Pop up a posframe to show STRING at POSITION. 182 | 183 | (1) POSITION 184 | 185 | POSITION can be: 186 | 1. An integer, meaning point position. 187 | 2. A cons of two integers, meaning absolute X and Y coordinates. 188 | 3. Other type, in which case the corresponding POSHANDLER should be 189 | provided. 190 | 191 | (2) POSHANDLER 192 | 193 | POSHANDLER is a function of one argument returning an actual 194 | position. Its argument is a plist of the following form: 195 | 196 | (:position xxx 197 | :poshandler xxx 198 | :font-height xxx 199 | :font-width xxx 200 | :posframe xxx 201 | :posframe-width xxx 202 | :posframe-height xxx 203 | :posframe-buffer xxx 204 | :parent-frame xxx 205 | :parent-window-start xxx 206 | :parent-window-end xxx 207 | :parent-window-left xxx 208 | :parent-window-top xxx 209 | :parent-frame-width xxx 210 | :parent-frame-height xxx 211 | :parent-window xxx 212 | :parent-window-width xxx 213 | :parent-window-height xxx 214 | :mouse-x xxx 215 | ;mouse-y xxx 216 | :minibuffer-height xxx 217 | :mode-line-height xxx 218 | :header-line-height xxx 219 | :tab-line-height xxx 220 | :x-pixel-offset xxx 221 | :y-pixel-offset xxx 222 | :parent-text-scale-mode-amount xxx) 223 | 224 | By default, poshandler is auto-selected based on the type of POSITION, 225 | but the selection can be overridden using the POSHANDLER argument. 226 | 227 | The builtin poshandler functions are listed below: 228 | 229 | 1. `posframe-poshandler-frame-center' 230 | 2. `posframe-poshandler-frame-top-center' 231 | 3. `posframe-poshandler-frame-top-left-corner' 232 | 4. `posframe-poshandler-frame-top-right-corner' 233 | 5. `posframe-poshandler-frame-top-left-or-right-other-corner' 234 | 6. `posframe-poshandler-frame-bottom-center' 235 | 7. `posframe-poshandler-frame-bottom-left-corner' 236 | 8. `posframe-poshandler-frame-bottom-right-corner' 237 | 9. `posframe-poshandler-window-center' 238 | 10. `posframe-poshandler-window-top-center' 239 | 11. `posframe-poshandler-window-top-left-corner' 240 | 12. `posframe-poshandler-window-top-right-corner' 241 | 13. `posframe-poshandler-window-bottom-center' 242 | 14. `posframe-poshandler-window-bottom-left-corner' 243 | 15. `posframe-poshandler-window-bottom-right-corner' 244 | 16. `posframe-poshandler-point-top-left-corner' 245 | 17. `posframe-poshandler-point-bottom-left-corner' 246 | 18. `posframe-poshandler-point-bottom-left-corner-upward' 247 | 19. `posframe-poshandler-point-window-center' 248 | 20. `posframe-poshandler-point-frame-center' 249 | 250 | (3) POSHANDLER-EXTRA-INFO 251 | 252 | POSHANDLER-EXTRA-INFO is a plist, which will prepend to the 253 | argument of poshandler function: `info', it will *OVERRIDE* the 254 | exist key in `info'. 255 | 256 | (4) BUFFER-OR-NAME 257 | 258 | This posframe's buffer is BUFFER-OR-NAME, which can be a buffer 259 | or a name of a (possibly nonexistent) buffer. 260 | 261 | buffer name can prefix with space, for example \" *mybuffer*\", so 262 | the buffer name will hide for ibuffer and `list-buffers'. 263 | 264 | (5) NO-PROPERTIES 265 | 266 | If NO-PROPERTIES is non-nil, The STRING's properties will 267 | be removed before being shown in posframe. 268 | 269 | (6) HEIGHT, MAX-HEIGHT, MIN-HEIGHT, WIDTH, MAX-WIDTH and MIN-WIDTH 270 | 271 | These arguments are specified in the canonical character width 272 | and height of posframe, more details can be found in docstring of 273 | function `fit-frame-to-buffer', 274 | 275 | (7) LEFT-FRINGE and RIGHT-FRINGE 276 | 277 | If LEFT-FRINGE or RIGHT-FRINGE is a number, left fringe or 278 | right fringe with be shown with the specified width. 279 | 280 | (8) BORDER-WIDTH, BORDER-COLOR, INTERNAL-BORDER-WIDTH and INTERNAL-BORDER-COLOR 281 | 282 | By default, posframe shows no borders, but users can specify 283 | borders by setting BORDER-WIDTH to a positive number. Border 284 | color can be specified by BORDER-COLOR. 285 | 286 | INTERNAL-BORDER-WIDTH and INTERNAL-BORDER-COLOR are same as 287 | BORDER-WIDTH and BORDER-COLOR, but do not suggest to use for the 288 | reason: 289 | 290 | Add distinct controls for child frames' borders (Bug#45620) 291 | http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=ff7b1a133bfa7f2614650f8551824ffaef13fadc 292 | 293 | (9) FONT, FOREGROUND-COLOR and BACKGROUND-COLOR 294 | 295 | Posframe's font as well as foreground and background colors are 296 | derived from the current frame by default, but can be overridden 297 | using the FONT, FOREGROUND-COLOR and BACKGROUND-COLOR arguments, 298 | respectively. 299 | 300 | (10) CURSOR, TTY-NON-SELECTED-CURSOR and WINDOW-POINT 301 | 302 | By default, cursor is not showed in posframe, user can let cursor 303 | showed with this argument help by set its value to a `cursor-type'. 304 | 305 | TTY-NON-SELECTED-CURSOR will let redisplay put the terminal 306 | cursor in a non-selected frame, which is useful when use 307 | vertico-posframe like package in tty. 308 | 309 | When cursor need to be showed in posframe, user may need to set 310 | WINDOW-POINT to the point of BUFFER, which can let cursor showed 311 | at this point. 312 | 313 | (11) RESPECT-HEADER-LINE and RESPECT-MODE-LINE 314 | 315 | By default, posframe will display no header-line, mode-line and 316 | tab-line. In case a header-line, mode-line or tab-line is 317 | desired, users can set RESPECT-HEADER-LINE and RESPECT-MODE-LINE 318 | to t. 319 | 320 | (12) INITIALIZE 321 | 322 | INITIALIZE is a function with no argument. It will run when 323 | posframe buffer is first selected with `with-current-buffer' 324 | in `posframe-show', and only run once (for performance reasons). 325 | 326 | (13) LINES-TRUNCATE 327 | 328 | If LINES-TRUNCATE is non-nil, then lines will truncate in the 329 | posframe instead of wrap. 330 | 331 | (14) OVERRIDE-PARAMETERS 332 | 333 | OVERRIDE-PARAMETERS is very powful, *all* the valid frame parameters 334 | used by posframe's frame can be overridden by it. 335 | 336 | NOTE: some `posframe-show' arguments are not frame parameters, so they 337 | can not be overrided by this argument. 338 | 339 | (15) TIMEOUT 340 | 341 | TIMEOUT can specify the number of seconds after which the posframe 342 | will auto-hide. 343 | 344 | (15) REFRESH 345 | 346 | If REFRESH is a number, posframe's frame-size will be re-adjusted 347 | every REFRESH seconds. 348 | 349 | (17) ACCEPT-FOCUS 350 | 351 | When ACCEPT-FOCUS is non-nil, posframe will accept focus. 352 | be careful, you may face some bugs when set it to non-nil. 353 | 354 | (18) HIDEHANDLER 355 | 356 | HIDEHANDLER is a function, when it return t, posframe will be 357 | hide, this function has a plist argument: 358 | 359 | (:posframe-buffer xxx 360 | :posframe-parent-buffer xxx) 361 | 362 | The builtin hidehandler functions are listed below: 363 | 364 | 1. `posframe-hidehandler-when-buffer-switch' 365 | 366 | (19) REFPOSHANDLER 367 | 368 | REFPOSHANDLER is a function, a reference position (most is 369 | top-left of current frame) will be returned when call this 370 | function. 371 | 372 | when it is nil or it return nil, child-frame feature will be used 373 | and reference position will be deal with in Emacs. 374 | 375 | The user case I know at the moment is let ivy-posframe work well 376 | in EXWM environment (let posframe show on the other application 377 | window). 378 | 379 | DO NOT USE UNLESS NECESSARY!!! 380 | 381 | An example parent frame poshandler function is: 382 | 383 | 1. `posframe-refposhandler-xwininfo' 384 | 385 | (19) Others 386 | 387 | You can use `posframe-delete-all' to delete all posframes." 388 | (let* ((position (or position (point))) 389 | (max-width (if (numberp max-width) 390 | (min max-width (frame-width)) 391 | (frame-width))) 392 | (max-height (if (numberp max-height) 393 | (min max-height (frame-height)) 394 | (frame-height))) 395 | (min-width (min (or min-width 1) max-width)) 396 | (min-height (min (or min-height 1) max-height)) 397 | (width (when width 398 | (min (max width min-width) max-width))) 399 | (height (when height 400 | (min (max height min-height) max-height))) 401 | (x-pixel-offset (or x-pixel-offset 0)) 402 | (y-pixel-offset (or y-pixel-offset 0)) 403 | (window-point (or window-point 0)) 404 | ;;----------------------------------------------------- 405 | (buffer (get-buffer-create buffer-or-name)) 406 | (parent-window (selected-window)) 407 | (parent-window-start (window-start parent-window)) 408 | (parent-window-end (window-end parent-window)) 409 | (parent-window-top (window-pixel-top parent-window)) 410 | (parent-window-left (window-pixel-left parent-window)) 411 | (parent-window-width (window-pixel-width parent-window)) 412 | (parent-window-height (window-pixel-height parent-window)) 413 | (parent-frame (window-frame parent-window)) 414 | (parent-frame-width (frame-pixel-width parent-frame)) 415 | (parent-frame-height (frame-pixel-height parent-frame)) 416 | (ref-position 417 | (when (functionp refposhandler) 418 | (ignore-errors 419 | (funcall refposhandler parent-frame)))) 420 | (font-width (default-font-width)) 421 | (font-height (with-current-buffer (window-buffer parent-window) 422 | (posframe--get-font-height position))) 423 | (parent-text-scale-mode-amount (with-current-buffer (window-buffer parent-window) 424 | (and (bound-and-true-p text-scale-mode) text-scale-mode-amount))) 425 | (mode-line-height (window-mode-line-height 426 | (and (window-minibuffer-p) 427 | (ignore-errors (window-in-direction 'above))))) 428 | (minibuffer-height (window-pixel-height (minibuffer-window))) 429 | (header-line-height (window-header-line-height parent-window)) 430 | (tab-line-height (if (functionp 'window-tab-line-height) 431 | (window-tab-line-height) 432 | 0)) 433 | (mouse-position (cdr (mouse-pixel-position))) 434 | (frame-resize-pixelwise t) 435 | posframe) 436 | 437 | (with-current-buffer buffer 438 | 439 | ;; Initialize 440 | (unless posframe--initialized-p 441 | (let ((func initialize)) 442 | (when (functionp func) 443 | (funcall func) 444 | (setq posframe--initialized-p t)))) 445 | 446 | ;; Create posframe 447 | (setq posframe 448 | (posframe--create-posframe 449 | buffer 450 | :position position 451 | :font font 452 | :cursor cursor 453 | :tty-non-selected-cursor tty-non-selected-cursor 454 | :parent-frame 455 | (unless ref-position 456 | parent-frame) 457 | :left-fringe left-fringe 458 | :right-fringe right-fringe 459 | :border-width border-width 460 | :border-color border-color 461 | :internal-border-width internal-border-width 462 | :internal-border-color internal-border-color 463 | :foreground-color foreground-color 464 | :background-color background-color 465 | :keep-ratio keep-ratio 466 | :lines-truncate lines-truncate 467 | :respect-header-line respect-header-line 468 | :respect-mode-line respect-mode-line 469 | :override-parameters override-parameters 470 | :accept-focus accept-focus 471 | :parent-text-scale-mode-amount parent-text-scale-mode-amount)) 472 | 473 | ;; Insert string into the posframe buffer 474 | (posframe--insert-string string no-properties) 475 | 476 | (let ((size-info 477 | (list :posframe posframe 478 | :width width 479 | :height height 480 | :max-width max-width 481 | :max-height max-height 482 | :min-width min-width 483 | :min-height min-height))) 484 | ;; Set posframe's size 485 | (posframe--set-frame-size size-info) 486 | ;; Re-adjust posframe's size when buffer's content has changed. 487 | (posframe--run-refresh-timer refresh size-info)) 488 | 489 | ;; Get new position of posframe. 490 | (setq position 491 | (posframe-run-poshandler 492 | ;; All poshandlers will get info from this plist. 493 | `(,@poshandler-extra-info 494 | ,@(list :position position 495 | :poshandler poshandler 496 | :font-height font-height 497 | :font-width font-width 498 | :posframe posframe 499 | :posframe-width (frame-pixel-width posframe) 500 | :posframe-height (frame-pixel-height posframe) 501 | :posframe-buffer buffer 502 | :parent-frame parent-frame 503 | :parent-frame-width parent-frame-width 504 | :parent-frame-height parent-frame-height 505 | :ref-position ref-position 506 | :parent-window parent-window 507 | :parent-window-start parent-window-start 508 | :parent-window-end parent-window-end 509 | :parent-window-top parent-window-top 510 | :parent-window-left parent-window-left 511 | :parent-window-width parent-window-width 512 | :parent-window-height parent-window-height 513 | :mouse-x (car mouse-position) 514 | :mouse-y (cdr mouse-position) 515 | :mode-line-height mode-line-height 516 | :minibuffer-height minibuffer-height 517 | :header-line-height header-line-height 518 | :tab-line-height tab-line-height 519 | :x-pixel-offset x-pixel-offset 520 | :y-pixel-offset y-pixel-offset 521 | :parent-text-scale-mode-amount parent-text-scale-mode-amount)))) 522 | 523 | ;; Move posframe 524 | (posframe--set-frame-position 525 | posframe position parent-frame-width parent-frame-height) 526 | 527 | ;; Delay hide posframe when timeout is a number. 528 | (posframe--run-timeout-timer posframe timeout) 529 | 530 | ;; Make sure not hide buffer's content for scroll down. 531 | (let ((window (frame-root-window posframe--frame))) 532 | (when (window-live-p window) 533 | (set-window-point window window-point))) 534 | 535 | ;; Hide posframe when switch buffer 536 | (let* ((parent-buffer (window-buffer parent-window)) 537 | (parent-buffer-name (buffer-name parent-buffer))) 538 | (set-frame-parameter posframe--frame 'posframe-hidehandler hidehandler) 539 | (set-frame-parameter posframe--frame 'posframe-parent-buffer 540 | (cons parent-buffer-name parent-buffer))) 541 | 542 | ;; Mouse banish 543 | (funcall 544 | posframe-mouse-banish-function 545 | (list :parent-frame parent-frame 546 | :mouse-x (when (car mouse-position) 547 | (+ (or (car ref-position) 0) 548 | (car mouse-position))) 549 | :mouse-y (when (cdr mouse-position) 550 | (+ (or (cdr ref-position) 0) 551 | (cdr mouse-position))) 552 | :posframe-x 553 | (if (>= (car position) 0) 554 | (car position) 555 | (- (frame-pixel-width parent-frame) 556 | (frame-pixel-width posframe))) 557 | :posframe-y 558 | (if (>= (cdr position) 0) 559 | (cdr position) 560 | (- (frame-pixel-height parent-frame) 561 | (frame-pixel-height posframe))) 562 | :posframe-width (frame-pixel-width posframe) 563 | :posframe-height (frame-pixel-height posframe) 564 | :parent-frame-width parent-frame-width 565 | :parent-frame-height parent-frame-height)) 566 | 567 | ;; Return posframe 568 | posframe))) 569 | 570 | (defun posframe--get-font-height (position) 571 | "Get the font's height at POSITION." 572 | (if (eq position (car posframe--last-font-height-info)) 573 | (cdr posframe--last-font-height-info) 574 | (let* ((font (when (and (integerp position) 575 | (not (= position 1))) 576 | (font-at (if (>= position (point-max)) 577 | (- (point-max) 1) 578 | position)))) 579 | (height (when (integerp position) 580 | (if (or (= position 1) (not (fontp font))) 581 | (default-line-height) 582 | (aref (font-info font) 3))))) 583 | (setq posframe--last-font-height-info 584 | (cons position height)) 585 | height))) 586 | 587 | (cl-defun posframe--create-posframe (buffer-or-name 588 | &key 589 | position 590 | parent-frame 591 | foreground-color 592 | background-color 593 | left-fringe 594 | right-fringe 595 | border-width 596 | border-color 597 | internal-border-width 598 | internal-border-color 599 | font 600 | cursor 601 | tty-non-selected-cursor 602 | keep-ratio 603 | lines-truncate 604 | override-parameters 605 | respect-header-line 606 | respect-mode-line 607 | accept-focus 608 | parent-text-scale-mode-amount) 609 | "Create and return a posframe child frame. 610 | This posframe's buffer is BUFFER-OR-NAME. 611 | 612 | The below optional arguments are similar to `posframe-show''s: 613 | PARENT-FRAME, FOREGROUND-COLOR, BACKGROUND-COLOR, LEFT-FRINGE, 614 | RIGHT-FRINGE, BORDER-WIDTH, BORDER-COLOR, INTERNAL-BORDER-WIDTH, 615 | INTERNAL-BORDER-COLOR, FONT, KEEP-RATIO, LINES-TRUNCATE, 616 | OVERRIDE-PARAMETERS, RESPECT-HEADER-LINE, RESPECT-MODE-LINE, 617 | ACCEPT-FOCUS." 618 | (let ((left-fringe (or left-fringe 0)) 619 | (right-fringe (or right-fringe 0)) 620 | ;; See emacs.git: Add distinct controls for child frames' borders (Bug#45620) 621 | ;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=ff7b1a133bfa7f2614650f8551824ffaef13fadc 622 | (border-width (or border-width internal-border-width 0)) 623 | (border-color (or border-color internal-border-color)) 624 | (buffer (get-buffer-create buffer-or-name)) 625 | (after-make-frame-functions nil) 626 | (x-gtk-resize-child-frames posframe-gtk-resize-child-frames) 627 | (args (list "args" 628 | (display-graphic-p) 629 | foreground-color 630 | background-color 631 | right-fringe 632 | left-fringe 633 | border-width 634 | border-color 635 | internal-border-width 636 | internal-border-color 637 | font 638 | keep-ratio 639 | override-parameters 640 | respect-header-line 641 | respect-mode-line 642 | accept-focus))) 643 | (with-current-buffer buffer 644 | ;; Many variables take effect after call `set-window-buffer' 645 | (setq-local display-line-numbers nil) 646 | (setq-local frame-title-format "") 647 | (setq-local left-margin-width nil) 648 | (setq-local right-margin-width nil) 649 | (setq-local left-fringe-width nil) 650 | (setq-local right-fringe-width nil) 651 | (setq-local fringes-outside-margins 0) 652 | (setq-local fringe-indicator-alist nil) 653 | ;; Need to use `lines-truncate' as our keyword variable instead 654 | ;; of `truncate-lines' so we don't shadow the variable that we 655 | ;; are trying to set. 656 | (setq-local truncate-lines lines-truncate) 657 | (setq-local show-trailing-whitespace nil) 658 | (setq-local posframe--accept-focus accept-focus) 659 | (unless respect-mode-line 660 | (setq-local mode-line-format nil)) 661 | (unless respect-header-line 662 | (setq-local header-line-format nil)) 663 | 664 | (if cursor 665 | (progn 666 | (setq-local cursor-type cursor) 667 | (setq-local cursor-in-non-selected-windows cursor)) 668 | (setq-local cursor-type nil) 669 | (setq-local cursor-in-non-selected-windows nil)) 670 | 671 | ;; Find existing posframe: buffer-local variables used by 672 | ;; posframe can be cleaned by other packages, so we should find 673 | ;; existing posframe first if possible. 674 | (unless (or posframe--frame posframe--last-args) 675 | (setq-local posframe--frame 676 | (posframe--find-existing-posframe buffer args)) 677 | (setq-local posframe--last-args args)) 678 | 679 | ;; Create child-frame 680 | (unless (and posframe--frame 681 | (frame-live-p posframe--frame) 682 | ;; For speed reason, posframe will reuse 683 | ;; existing frame at possible, but when 684 | ;; user change args, recreating frame 685 | ;; is needed. 686 | (equal posframe--last-args args)) 687 | (posframe-delete-frame buffer) 688 | (setq-local posframe--last-args args) 689 | (setq-local posframe--last-posframe-pixel-position nil) 690 | (setq-local posframe--last-posframe-size nil) 691 | (setq-local posframe--frame 692 | (make-frame 693 | `(,@override-parameters 694 | ,(when foreground-color 695 | (cons 'foreground-color foreground-color)) 696 | ,(when background-color 697 | (cons 'background-color background-color)) 698 | (title . "posframe") 699 | (parent-frame . ,parent-frame) 700 | (keep-ratio ,keep-ratio) 701 | (posframe-buffer . ,(cons (buffer-name buffer) 702 | buffer)) 703 | (fullscreen . nil) 704 | (no-accept-focus . ,(not accept-focus)) 705 | (min-width . 0) 706 | (min-height . 0) 707 | (border-width . 0) 708 | (internal-border-width . ,border-width) 709 | (child-frame-border-width . ,border-width) 710 | (vertical-scroll-bars . nil) 711 | (horizontal-scroll-bars . nil) 712 | (left-fringe . ,left-fringe) 713 | (right-fringe . ,right-fringe) 714 | (menu-bar-lines . 0) 715 | (tool-bar-lines . 0) 716 | (tab-bar-lines . 0) 717 | (line-spacing . 0) 718 | (unsplittable . t) 719 | (no-other-frame . t) 720 | ;; NOTE: TTY child frame use undecorated to control border. 721 | (undecorated . ,(or (display-graphic-p) 722 | (not (and (> border-width 0) 723 | (featurep 'tty-child-frames))))) 724 | (visibility . nil) 725 | (cursor-type . ,cursor) 726 | (tty-non-selected-cursor . ,tty-non-selected-cursor) 727 | (minibuffer . ,(minibuffer-window parent-frame)) 728 | (left . ,(if (consp position) (car position) 0)) 729 | (top . ,(if (consp position) (cdr position) 0)) 730 | (width . 1) 731 | (height . 1) 732 | (no-special-glyphs . t) 733 | (skip-taskbar . t) 734 | (inhibit-double-buffering . ,posframe-inhibit-double-buffering) 735 | ;; Do not save child-frame when use desktop.el 736 | (desktop-dont-save . t)))) 737 | (set-frame-parameter posframe--frame 'last-args args) 738 | (set-frame-parameter 739 | posframe--frame 'font 740 | (or font (face-attribute 'default :font parent-frame))) 741 | (when border-color 742 | (if parent-frame 743 | (set-face-background 744 | (if (facep 'child-frame-border) 745 | 'child-frame-border 746 | 'internal-border) 747 | border-color posframe--frame) 748 | ;; NOTE: when use refposhander feature, parent-frame will be 749 | ;; nil, we should use internal-border instead. 750 | (set-face-background 751 | 'internal-border 752 | border-color posframe--frame)) 753 | ;; HACK: Set face background after border color, otherwise the 754 | ;; border is not updated (BUG!). 755 | (when (version< emacs-version "28.0") 756 | (set-frame-parameter 757 | posframe--frame 'background-color 758 | (or background-color (face-attribute 'default :background))))) 759 | (let ((posframe-window (frame-root-window posframe--frame))) 760 | ;; This method is more stable than 'setq mode/header-line-format nil' 761 | (unless respect-mode-line 762 | (set-window-parameter posframe-window 'mode-line-format 'none)) 763 | (unless respect-header-line 764 | (set-window-parameter posframe-window 'header-line-format 'none)) 765 | (set-window-buffer posframe-window buffer) 766 | ;; When the buffer of posframe is killed, the child-frame of 767 | ;; this posframe will be deleted too. 768 | (set-window-dedicated-p posframe-window t))) 769 | 770 | ;; Remove tab-bar always. 771 | ;; NOTE: if we do not test the value of frame parameter 772 | ;; 'tab-bar-lines before set it, posframe will flicker when 773 | ;; scroll. 774 | (unless (equal (frame-parameter posframe--frame 'tab-bar-lines) 0) 775 | (set-frame-parameter posframe--frame 'tab-bar-lines 0)) 776 | (when (version< "27.0" emacs-version) 777 | (setq-local tab-line-format nil)) 778 | 779 | ;; If user set 'parent-frame to nil after run posframe-show. 780 | ;; for cache reason, next call to posframe-show will be affected. 781 | ;; so we should force set parent-frame again in this place. 782 | (set-frame-parameter posframe--frame 'parent-frame parent-frame) 783 | 784 | ;; Set text scale based on the parent frame text scale. 785 | (text-scale-set 786 | (funcall posframe-text-scale-factor-function parent-text-scale-mode-amount)) 787 | 788 | posframe--frame))) 789 | 790 | (defun posframe--find-existing-posframe (buffer &optional last-args) 791 | "Find existing posframe with BUFFER and LAST-ARGS." 792 | (let ((posframe 793 | (cl-find-if 794 | (lambda (frame) 795 | (let* ((buffer-info (frame-parameter frame 'posframe-buffer)) 796 | (buffer-equal-p 797 | (or (equal (buffer-name buffer) (car buffer-info)) 798 | (equal buffer (cdr buffer-info))))) 799 | (if last-args 800 | (and buffer-equal-p 801 | (equal last-args (frame-parameter frame 'last-args))) 802 | buffer-equal-p))) 803 | (frame-list)))) 804 | (when posframe 805 | (set-frame-parameter posframe 'existing-posframe t)) 806 | posframe)) 807 | 808 | (defun posframe-delete-frame (buffer-or-name) 809 | "Delete posframe pertaining to BUFFER-OR-NAME. 810 | BUFFER-OR-NAME can be a buffer or a buffer name." 811 | (let* ((buffer (get-buffer buffer-or-name)) 812 | (posframe (when buffer 813 | (posframe--find-existing-posframe buffer))) 814 | ;; NOTE: `delete-frame' runs ‘delete-frame-functions’ before 815 | ;; actually deleting the frame, unless the frame is a 816 | ;; tooltip, posframe is a child-frame, but its function like 817 | ;; a tooltip. 818 | (delete-frame-functions nil)) 819 | (when posframe 820 | (when (buffer-live-p buffer) 821 | (with-current-buffer buffer 822 | (dolist (timer '(posframe--refresh-timer 823 | posframe--timeout-timer)) 824 | (when (timerp timer) 825 | (cancel-timer timer))))) 826 | (delete-frame posframe)))) 827 | 828 | (defun posframe--insert-string (string no-properties) 829 | "Insert STRING to current buffer. 830 | If NO-PROPERTIES is non-nil, all properties of STRING 831 | will be removed." 832 | (when (and string (stringp string)) 833 | (remove-text-properties 834 | 0 (length string) '(read-only t) string) 835 | (let ((str (if no-properties 836 | (substring-no-properties string) 837 | string))) 838 | (erase-buffer) 839 | (insert str)))) 840 | 841 | (defun posframe--set-frame-size (size-info) 842 | "Set POSFRAME's size based on SIZE-INFO." 843 | (let ((posframe (plist-get size-info :posframe)) 844 | (width (plist-get size-info :width)) 845 | (height (plist-get size-info :height)) 846 | (max-width (plist-get size-info :max-width)) 847 | (max-height (plist-get size-info :max-height)) 848 | (min-width (plist-get size-info :min-width)) 849 | (min-height (plist-get size-info :min-height))) 850 | (when height (set-frame-height posframe height)) 851 | (when width (set-frame-width posframe width)) 852 | (unless (and height width) 853 | (posframe--fit-frame-to-buffer 854 | posframe max-height min-height max-width min-width 855 | (cond (width 'vertically) 856 | (height 'horizontally)))) 857 | (setq-local posframe--last-posframe-size size-info))) 858 | 859 | (defun posframe--fit-frame-to-buffer (posframe max-height min-height max-width min-width only) 860 | "POSFRAME version of function `fit-frame-to-buffer'. 861 | Arguments HEIGHT, MAX-HEIGHT, MIN-HEIGHT, WIDTH, MAX-WIDTH, 862 | MIN-WIDTH and ONLY are similar function `fit-frame-to-buffer''s." 863 | ;; This only has effect if the user set the latter var to `hide'. 864 | (let ((x-gtk-resize-child-frames posframe-gtk-resize-child-frames)) 865 | ;; More info: Don't skip empty lines when fitting mini frame to buffer (Bug#44080) 866 | ;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=e0de9f3295b4c46cb7198ec0b9634809d7b7a36d 867 | (if (functionp 'fit-frame-to-buffer-1) 868 | (fit-frame-to-buffer-1 869 | posframe max-height min-height max-width min-width only nil nil) 870 | (fit-frame-to-buffer 871 | posframe max-height min-height max-width min-width only)))) 872 | 873 | (defun posframe--run-refresh-timer (repeat size-info) 874 | "Refresh POSFRAME every REPEAT seconds. 875 | 876 | It will set POSFRAME's size by SIZE-INFO." 877 | (let ((posframe (plist-get size-info :posframe)) 878 | (width (plist-get size-info :width)) 879 | (height (plist-get size-info :height))) 880 | (when (and (numberp repeat) (> repeat 0)) 881 | (unless (and width height) 882 | (when (timerp posframe--refresh-timer) 883 | (cancel-timer posframe--refresh-timer)) 884 | (setq-local posframe--refresh-timer 885 | (run-with-timer 886 | nil repeat 887 | (lambda (size-info) 888 | (let ((frame-resize-pixelwise t)) 889 | (when (and posframe (frame-live-p posframe)) 890 | (posframe--set-frame-size size-info)))) 891 | size-info)))))) 892 | 893 | ;; Posframe's position handler 894 | (defun posframe-run-poshandler (info) 895 | "Run posframe's position handler. 896 | 897 | the structure of INFO can be found in docstring 898 | of `posframe-show'." 899 | (if (equal info posframe--last-poshandler-info) 900 | posframe--last-posframe-pixel-position 901 | (setq posframe--last-poshandler-info info) 902 | (let* ((ref-position (plist-get info :ref-position)) 903 | (poshandler (posframe--get-valid-poshandler info)) 904 | (position (funcall poshandler info))) 905 | (if (not ref-position) 906 | position 907 | (posframe--calculate-new-position 908 | info position ref-position))))) 909 | 910 | (defun posframe--get-valid-poshandler (info) 911 | "Get valid poshandler function with the help of INFO." 912 | (or (plist-get info :poshandler) 913 | (let ((position (plist-get info :position))) 914 | (cond ((integerp position) 915 | #'posframe-poshandler-point-bottom-left-corner) 916 | ((and (consp position) 917 | (integerp (car position)) 918 | (integerp (cdr position))) 919 | #'posframe-poshandler-absolute-x-y) 920 | (t (error "Posframe: have no valid poshandler")))))) 921 | 922 | (defun posframe--calculate-new-position (info position ref-position) 923 | "Calculate new position according to INFO, POSITION and REF-POSITION." 924 | (let* ((parent-frame-width (plist-get info :parent-frame-width)) 925 | (parent-frame-height (plist-get info :parent-frame-height)) 926 | (posframe-width (plist-get info :posframe-width)) 927 | (posframe-height (plist-get info :posframe-height)) 928 | (ref-x (or (car ref-position) 0)) 929 | (ref-y (or (cdr ref-position) 0)) 930 | (x (car position)) 931 | (y (cdr position))) 932 | (when (< x 0) 933 | (setq x (- (+ x parent-frame-width) posframe-width))) 934 | (when (< y 0) 935 | (setq y (- (+ y parent-frame-height) posframe-height))) 936 | (cons (+ ref-x x) 937 | (+ ref-y y)))) 938 | 939 | (defun posframe--set-frame-position (posframe position 940 | parent-frame-width 941 | parent-frame-height) 942 | "Move POSFRAME to POSITION. 943 | This need PARENT-FRAME-WIDTH and PARENT-FRAME-HEIGHT" 944 | (unless (and (equal position posframe--last-posframe-pixel-position) 945 | ;; When working frame's size change, re-posit 946 | ;; the posframe. 947 | (equal posframe--last-parent-frame-size 948 | (cons parent-frame-width parent-frame-height)) 949 | (equal posframe--last-posframe-displayed-size 950 | (cons (frame-pixel-width posframe) 951 | (frame-pixel-height posframe)))) 952 | (set-frame-position posframe (car position) (cdr position)) 953 | (setq-local posframe--last-posframe-pixel-position position) 954 | (setq-local posframe--last-parent-frame-size 955 | (cons parent-frame-width parent-frame-height)) 956 | (setq-local posframe--last-posframe-displayed-size 957 | (cons (frame-pixel-width posframe) 958 | (frame-pixel-height posframe)))) 959 | (posframe--make-frame-visible posframe)) 960 | 961 | (defun posframe--make-frame-visible (posframe) 962 | "Let POSFRAME visible and redraw it when needed." 963 | (unless (frame-visible-p posframe) 964 | (make-frame-visible posframe) 965 | (when (posframe--posframe-need-redraw-p posframe) 966 | (redraw-frame posframe)))) 967 | 968 | (defun posframe--posframe-need-redraw-p (posframe) 969 | "Test POSFRAME need to redraw or not." 970 | ;; When posframe is found by `posframe--find-existing-posframe', 971 | ;; it need to redraw, more info: 972 | ;; 1. https://github.com/tumashu/ivy-posframe/pull/30 973 | ;; 2. https://github.com/tumashu/posframe/pull/118 974 | (frame-parameter posframe 'existing-posframe)) 975 | 976 | (defun posframe--run-timeout-timer (posframe secs) 977 | "Hide POSFRAME after a delay of SECS seconds." 978 | (when (and (numberp secs) (> secs 0)) 979 | (when (timerp posframe--timeout-timer) 980 | (cancel-timer posframe--timeout-timer)) 981 | (setq-local posframe--timeout-timer 982 | (run-with-timer 983 | secs nil #'posframe--make-frame-invisible posframe)))) 984 | 985 | (defun posframe--make-frame-invisible (frame) 986 | "`make-frame-invisible' replacement to hide FRAME safely." 987 | (when (and (frame-live-p frame) 988 | (frame-visible-p frame)) 989 | (make-frame-invisible frame))) 990 | 991 | (defun posframe-mouse-banish-simple (info) 992 | "Banish mouse to (0, 0) of posframe base on INFO." 993 | (let ((parent-frame (plist-get info :parent-frame)) 994 | (x (plist-get info :posframe-x)) 995 | (y (plist-get info :posframe-y)) 996 | (w (plist-get info :posframe-width)) 997 | (h (plist-get info :posframe-height)) 998 | (p-w (plist-get info :parent-frame-width)) 999 | (p-h (plist-get info :parent-frame-height))) 1000 | (set-mouse-pixel-position 1001 | parent-frame 1002 | (if (= x 0) 1003 | (min p-w (+ w 5)) 1004 | (max 0 (- x 5))) 1005 | (if (= y 0) 1006 | (min p-h (+ h 10)) 1007 | (max 0 (- y 10)))))) 1008 | 1009 | (defun posframe-mouse-banish-default (info) 1010 | "Banish mouse base on INFO. 1011 | 1012 | FIXME: This is a hacky fix for the mouse focus problem, which like: 1013 | https://github.com/tumashu/posframe/issues/4#issuecomment-357514918" 1014 | (let* ((parent-frame (plist-get info :parent-frame)) 1015 | (m-x (plist-get info :mouse-x)) 1016 | (m-y (plist-get info :mouse-y)) 1017 | (x (plist-get info :posframe-x)) 1018 | (y (plist-get info :posframe-y)) 1019 | (w (plist-get info :posframe-width)) 1020 | (h (plist-get info :posframe-height)) 1021 | (p-w (plist-get info :parent-frame-width)) 1022 | (p-h (plist-get info :parent-frame-height))) 1023 | (when (and m-x m-y 1024 | (>= m-x x) 1025 | (<= m-x (+ x w)) 1026 | (>= m-y y) 1027 | (<= m-y (+ y h))) 1028 | (set-mouse-pixel-position 1029 | parent-frame 1030 | (if (= x 0) 1031 | (min p-w (+ w 5)) 1032 | (max 0 (- x 5))) 1033 | (if (= y 0) 1034 | (min p-h (+ h 10)) 1035 | (max 0 (- y 10))))))) 1036 | 1037 | (defun posframe-refresh (buffer-or-name) 1038 | "Refresh posframe pertaining to BUFFER-OR-NAME. 1039 | 1040 | For example: 1041 | 1042 | (defvar buf \" *test*\") 1043 | (posframe-show buf) 1044 | 1045 | (with-current-buffer buf 1046 | (erase-buffer) 1047 | (insert \"ffffffffffffff\") 1048 | (posframe-refresh buf)) 1049 | 1050 | User can use posframe-show's :refresh argument, 1051 | to do similar job: 1052 | 1053 | (defvar buf \" *test*\") 1054 | (posframe-show buf :refresh 0.25) 1055 | 1056 | (with-current-buffer buf 1057 | (erase-buffer) 1058 | (insert \"ffffffffffffff\"))" 1059 | (dolist (frame (frame-list)) 1060 | (let ((buffer-info (frame-parameter frame 'posframe-buffer)) 1061 | (frame-resize-pixelwise t)) 1062 | (when (or (equal buffer-or-name (car buffer-info)) 1063 | (equal buffer-or-name (cdr buffer-info))) 1064 | (with-current-buffer buffer-or-name 1065 | (posframe--set-frame-size posframe--last-posframe-size)))))) 1066 | 1067 | ;;;###autoload 1068 | (defun posframe-hide-all () 1069 | "Hide all posframe frames." 1070 | (interactive) 1071 | (dolist (frame (frame-list)) 1072 | (when (frame-parameter frame 'posframe-buffer) 1073 | (posframe--make-frame-invisible frame)))) 1074 | 1075 | (defun posframe-hide (buffer-or-name) 1076 | "Hide posframe pertaining to BUFFER-OR-NAME. 1077 | BUFFER-OR-NAME can be a buffer or a buffer name." 1078 | ;; Make sure buffer-list-update-hook is nil when posframe-hide is 1079 | ;; called, otherwise: 1080 | ;; (add-hook 'buffer-list-update-hook #'posframe-hide) 1081 | ;; will lead to infinite recursion. 1082 | (when buffer-or-name 1083 | (let ((buffer-list-update-hook nil)) 1084 | (dolist (frame (frame-list)) 1085 | (let ((buffer-info (frame-parameter frame 'posframe-buffer))) 1086 | (when (or (equal buffer-or-name (car buffer-info)) 1087 | (equal buffer-or-name (cdr buffer-info))) 1088 | (posframe--make-frame-invisible frame))))))) 1089 | 1090 | (defun posframe-hidehandler-daemon () 1091 | "Run posframe hidehandler daemon." 1092 | (when (timerp posframe-hidehandler-timer) 1093 | (cancel-timer posframe-hidehandler-timer)) 1094 | (setq posframe-hidehandler-timer 1095 | (run-with-idle-timer 0.5 t #'posframe-hidehandler-daemon-function))) 1096 | 1097 | (defun posframe-hidehandler-daemon-function () 1098 | "Posframe hidehandler daemon function." 1099 | (ignore-errors 1100 | (dolist (frame (frame-list)) 1101 | (let ((hidehandler (frame-parameter frame 'posframe-hidehandler)) 1102 | (buffer (frame-parameter frame 'posframe-buffer)) 1103 | (parent-buffer (frame-parameter frame 'posframe-parent-buffer))) 1104 | (when (and hidehandler 1105 | (funcall hidehandler 1106 | (list 1107 | :posframe-buffer buffer 1108 | :posframe-parent-buffer parent-buffer))) 1109 | (posframe--make-frame-invisible frame)))))) 1110 | 1111 | (posframe-hidehandler-daemon) 1112 | 1113 | (defun posframe-hidehandler-when-buffer-switch (info) 1114 | "Posframe hidehandler function. 1115 | 1116 | This function let posframe hide when user switch buffer. 1117 | Note: This function is called in `post-command-hook'. 1118 | Argument INFO ." 1119 | (let ((parent-buffer (cdr (plist-get info :posframe-parent-buffer)))) 1120 | (and (buffer-live-p parent-buffer) 1121 | (not (equal parent-buffer (current-buffer)))))) 1122 | 1123 | ;;;###autoload 1124 | (defun posframe-delete-all () 1125 | "Delete all posframe frames and buffers." 1126 | (interactive) 1127 | (dolist (frame (frame-list)) 1128 | (when (frame-parameter frame 'posframe-buffer) 1129 | (let ((delete-frame-functions nil)) 1130 | (delete-frame frame)))) 1131 | (dolist (buffer (buffer-list)) 1132 | (with-current-buffer buffer 1133 | (when posframe--frame 1134 | (posframe--kill-buffer buffer))))) 1135 | 1136 | (defun posframe--kill-buffer (buffer-or-name) 1137 | "Kill posframe's buffer: BUFFER-OR-NAME. 1138 | BUFFER-OR-NAME can be a buffer or a buffer name." 1139 | (when (buffer-live-p (get-buffer buffer-or-name)) 1140 | (kill-buffer buffer-or-name))) 1141 | 1142 | (defun posframe-delete (buffer-or-name) 1143 | "Delete posframe pertaining to BUFFER-OR-NAME and kill the buffer. 1144 | BUFFER-OR-NAME can be a buffer or a buffer name. 1145 | 1146 | This function is not commonly used, for delete and recreate 1147 | posframe is very very slowly, `posframe-hide' is more useful." 1148 | (posframe-delete-frame buffer-or-name) 1149 | (posframe--kill-buffer buffer-or-name)) 1150 | 1151 | (defun posframe-funcall (buffer-or-name function &rest arguments) 1152 | "Select posframe of BUFFER-OR-NAME and call FUNCTION with ARGUMENTS. 1153 | BUFFER-OR-NAME can be a buffer or a buffer name." 1154 | (when (functionp function) 1155 | (when (get-buffer buffer-or-name) 1156 | (with-current-buffer buffer-or-name 1157 | (when (framep posframe--frame) 1158 | (with-selected-frame posframe--frame 1159 | (apply function arguments))))))) 1160 | 1161 | (defun posframe-poshandler-absolute-x-y (info) 1162 | "Posframe's position handler. 1163 | 1164 | This poshandler function deal with (integer . integer) style 1165 | position. 1166 | 1167 | The structure of INFO can be found in docstring of 1168 | `posframe-show'." 1169 | (let ((position (plist-get info :position)) 1170 | (x-pixel-offset (plist-get info :x-pixel-offset)) 1171 | (y-pixel-offset (plist-get info :y-pixel-offset))) 1172 | (cons (+ (car position) x-pixel-offset) 1173 | (+ (cdr position) y-pixel-offset)))) 1174 | 1175 | (defun posframe-poshandler-point-1 (info &optional font-height upward) 1176 | "The internal function used to deal with point-poshandler. 1177 | Argument INFO . 1178 | 1179 | Optional arguments: FONT-HEIGHT and UPWARD." 1180 | (let* ((x-pixel-offset (plist-get info :x-pixel-offset)) 1181 | (y-pixel-offset (plist-get info :y-pixel-offset)) 1182 | (posframe-width (plist-get info :posframe-width)) 1183 | (posframe-height (plist-get info :posframe-height)) 1184 | (window (plist-get info :parent-window)) 1185 | (xmax (plist-get info :parent-frame-width)) 1186 | (ymax (plist-get info :parent-frame-height)) 1187 | (position-info (plist-get info :position)) 1188 | (position-info 1189 | (if (integerp position-info) 1190 | (posn-at-point position-info window) 1191 | position-info)) 1192 | (header-line-height (plist-get info :header-line-height)) 1193 | (tab-line-height (plist-get info :tab-line-height)) 1194 | (x (+ (car (window-inside-pixel-edges window)) 1195 | (- (or (car (posn-x-y position-info)) 0) 1196 | (or (car (posn-object-x-y position-info)) 0)) 1197 | x-pixel-offset)) 1198 | (y-top (+ (cadr (window-pixel-edges window)) 1199 | tab-line-height 1200 | header-line-height 1201 | (- (or (cdr (posn-x-y position-info)) 0) 1202 | ;; Fix the conflict with flycheck 1203 | ;; http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html 1204 | (or (cdr (posn-object-x-y position-info)) 0)) 1205 | y-pixel-offset)) 1206 | (font-height (or font-height (plist-get info :font-height))) 1207 | (y-bottom (+ y-top font-height))) 1208 | (cons (max 0 (min x (- xmax (or posframe-width 0)))) 1209 | (max 0 (if (if upward 1210 | (> (- y-bottom (or posframe-height 0)) 0) 1211 | (> (+ y-bottom (or posframe-height 0)) ymax)) 1212 | (- y-top (or posframe-height 0)) 1213 | y-bottom))))) 1214 | 1215 | (defun posframe-poshandler-point-bottom-left-corner (info) 1216 | "Posframe's position handler. 1217 | 1218 | This poshandler function let top left corner of posframe align to 1219 | bottom left corner of point. 1220 | 1221 | The structure of INFO can be found in docstring of 1222 | `posframe-show'." 1223 | (posframe-poshandler-point-1 info)) 1224 | 1225 | (defun posframe-poshandler-point-window-center (info) 1226 | "Posframe's position handler. 1227 | 1228 | This poshandler function let center of posframe vertical align to 1229 | center of window and top edge of posframe horizontal align to 1230 | buttom edge of current point. 1231 | 1232 | The structure of INFO can be found in docstring of 1233 | `posframe-show'." 1234 | (let ((x (car (posframe-poshandler-window-top-center info))) 1235 | (y (cdr (posframe-poshandler-point-bottom-left-corner info)))) 1236 | (cons x y))) 1237 | 1238 | (defun posframe-poshandler-point-frame-center (info) 1239 | "Posframe's position handler. 1240 | 1241 | This poshandler function let center of posframe vertical align to 1242 | center of frame and top edge of posframe horizontal align to 1243 | buttom edge of current point. 1244 | 1245 | The structure of INFO can be found in docstring of 1246 | `posframe-show'." 1247 | (let ((x (car (posframe-poshandler-frame-top-center info))) 1248 | (y (cdr (posframe-poshandler-point-bottom-left-corner info)))) 1249 | (cons x y))) 1250 | 1251 | (defun posframe-poshandler-point-bottom-left-corner-upward (info) 1252 | "Posframe's position handler. 1253 | 1254 | This poshandler function let bottom left corner of posframe align 1255 | to bottom left corner of point. 1256 | 1257 | The structure of INFO can be found in docstring of 1258 | `posframe-show'." 1259 | (posframe-poshandler-point-1 info nil t)) 1260 | 1261 | (defun posframe-poshandler-point-top-left-corner (info) 1262 | "Posframe's position handler. 1263 | 1264 | This poshandler function let top left corner of posframe align to 1265 | top left corner of point. 1266 | 1267 | The structure of INFO can be found in docstring of 1268 | `posframe-show'." 1269 | (let ((font-height 0)) 1270 | (posframe-poshandler-point-1 info font-height))) 1271 | 1272 | (defun posframe-poshandler-frame-center (info) 1273 | "Posframe's position handler. 1274 | 1275 | This poshandler function let center of posframe align to center 1276 | of frame. 1277 | 1278 | The structure of INFO can be found in docstring of 1279 | `posframe-show'." 1280 | (cons (/ (- (plist-get info :parent-frame-width) 1281 | (plist-get info :posframe-width)) 1282 | 2) 1283 | (/ (- (plist-get info :parent-frame-height) 1284 | (plist-get info :posframe-height)) 1285 | 2))) 1286 | 1287 | (defun posframe-poshandler-frame-top-center (info) 1288 | "Posframe's position handler. 1289 | 1290 | This poshandler function let top edge center of posframe align 1291 | to top edge center of frame. 1292 | 1293 | The structure of INFO can be found in docstring of 1294 | `posframe-show'." 1295 | (cons (/ (- (plist-get info :parent-frame-width) 1296 | (plist-get info :posframe-width)) 1297 | 2) 1298 | 0)) 1299 | 1300 | (defun posframe-poshandler-frame-top-left-corner (_info) 1301 | "Posframe's position handler. 1302 | 1303 | This poshandler function let top left corner of posframe align to 1304 | top left corner of frame. 1305 | 1306 | The structure of INFO can be found in docstring of 1307 | `posframe-show'." 1308 | '(0 . 0)) 1309 | 1310 | (defun posframe-poshandler-frame-top-right-corner (_info) 1311 | "Posframe's position handler. 1312 | 1313 | This poshandler function let top right corner of posframe align to 1314 | top right corner of frame. 1315 | 1316 | The structure of INFO can be found in docstring of 1317 | `posframe-show'." 1318 | '(-1 . 0)) 1319 | 1320 | (defun posframe-poshandler-frame-top-left-or-right-other-corner (info) 1321 | "Posframe's position handler. 1322 | 1323 | This poshandler function let posframe align to top left or top right 1324 | corner of frame, based on whether current window is relatively at left 1325 | or right in the current frame. If window is at left, place posframe on 1326 | right, and vice versa. (This is calculated by whether current window 1327 | center is left or right to frame center.) 1328 | 1329 | The structure of INFO can be found in docstring of `posframe-show'." 1330 | (let ((window-left (plist-get info :parent-window-left)) 1331 | (window-width (plist-get info :parent-window-width)) 1332 | (frame-width (plist-get info :parent-frame-width))) 1333 | ;; when equal, put posframe on right because content in window tend to be on left 1334 | (if (<= (+ window-left (/ window-width 2)) 1335 | (/ frame-width 2)) 1336 | '(-1 . 0) 1337 | '(0 . 0)))) 1338 | 1339 | (defun posframe-poshandler-frame-bottom-left-corner (info) 1340 | "Posframe's position handler. 1341 | 1342 | This poshandler function let bottom left corner of posframe align 1343 | to buttom left corner of frame. 1344 | 1345 | The structure of INFO can be found in docstring of 1346 | `posframe-show'." 1347 | (cons 0 (- 0 1348 | (plist-get info :mode-line-height) 1349 | (plist-get info :minibuffer-height)))) 1350 | 1351 | (defun posframe-poshandler-frame-bottom-right-corner (info) 1352 | "Posframe's position handler. 1353 | 1354 | This poshandler function let bottom right corner of posframe 1355 | align to buttom right corner of frame. 1356 | 1357 | The structure of INFO can be found in docstring of 1358 | `posframe-show'." 1359 | (cons -1 (- 0 1360 | (plist-get info :mode-line-height) 1361 | (plist-get info :minibuffer-height)))) 1362 | 1363 | (defun posframe-poshandler-frame-bottom-center (info) 1364 | "Posframe's position handler. 1365 | 1366 | This poshandler function let bottom edge center of posframe align 1367 | to buttom edge center of frame. 1368 | 1369 | The structure of INFO can be found in docstring of 1370 | `posframe-show'." 1371 | (cons (/ (- (plist-get info :parent-frame-width) 1372 | (plist-get info :posframe-width)) 1373 | 2) 1374 | (- (plist-get info :parent-frame-height) 1375 | (plist-get info :posframe-height) 1376 | (plist-get info :mode-line-height) 1377 | (plist-get info :minibuffer-height)))) 1378 | 1379 | (defun posframe-poshandler-window-center (info) 1380 | "Posframe's position handler. 1381 | 1382 | This poshandler function let center of posframe align to center 1383 | of window. 1384 | 1385 | The structure of INFO can be found in docstring of 1386 | `posframe-show'." 1387 | (let* ((window-left (plist-get info :parent-window-left)) 1388 | (window-top (plist-get info :parent-window-top)) 1389 | (window-width (plist-get info :parent-window-width)) 1390 | (window-height (plist-get info :parent-window-height)) 1391 | (posframe-width (plist-get info :posframe-width)) 1392 | (posframe-height (plist-get info :posframe-height))) 1393 | (cons (max 0 (+ window-left (/ (- window-width posframe-width) 2))) 1394 | (max 0 (+ window-top (/ (- window-height posframe-height) 2)))))) 1395 | 1396 | (defun posframe-poshandler-window-top-left-corner (info) 1397 | "Posframe's position handler. 1398 | 1399 | This poshandler function let top left corner of posframe align to 1400 | top left corner of window. 1401 | 1402 | The structure of INFO can be found in docstring of 1403 | `posframe-show'." 1404 | (let* ((window-left (plist-get info :parent-window-left)) 1405 | (window-top (plist-get info :parent-window-top))) 1406 | (cons window-left 1407 | window-top))) 1408 | 1409 | (defun posframe-poshandler-window-top-right-corner (info) 1410 | "Posframe's position handler. 1411 | 1412 | This poshandler function let top right corner of posframe align to 1413 | top left right of window. 1414 | 1415 | The structure of INFO can be found in docstring of 1416 | `posframe-show'." 1417 | (let* ((window-left (plist-get info :parent-window-left)) 1418 | (window-top (plist-get info :parent-window-top)) 1419 | (window-width (plist-get info :parent-window-width)) 1420 | (posframe-width (plist-get info :posframe-width))) 1421 | (cons (+ window-left window-width 1422 | (- 0 posframe-width)) 1423 | window-top))) 1424 | 1425 | (defun posframe-poshandler-window-top-center (info) 1426 | "Posframe's position handler. 1427 | 1428 | This poshandler function let top edge center of posframe align to 1429 | top edge center of window. 1430 | 1431 | The structure of INFO can be found in docstring of 1432 | `posframe-show'." 1433 | (let* ((window-left (plist-get info :parent-window-left)) 1434 | (window-top (plist-get info :parent-window-top)) 1435 | (window-width (plist-get info :parent-window-width)) 1436 | (posframe-width (plist-get info :posframe-width))) 1437 | (cons (max 0 (+ window-left (/ (- window-width posframe-width) 2))) 1438 | window-top))) 1439 | 1440 | (defun posframe-poshandler-window-bottom-left-corner (info) 1441 | "Posframe's position handler. 1442 | 1443 | This poshandler function let bottom left corner of posframe align to 1444 | bottom left corner of window. 1445 | 1446 | The structure of INFO can be found in docstring of 1447 | `posframe-show'." 1448 | (let* ((window-left (plist-get info :parent-window-left)) 1449 | (window-top (plist-get info :parent-window-top)) 1450 | (window-height (plist-get info :parent-window-height)) 1451 | (posframe-height (plist-get info :posframe-height)) 1452 | (mode-line-height (plist-get info :mode-line-height))) 1453 | (cons window-left 1454 | (+ window-top window-height 1455 | (- 0 mode-line-height posframe-height))))) 1456 | 1457 | (defun posframe-poshandler-window-bottom-right-corner (info) 1458 | "Posframe's position handler. 1459 | 1460 | This poshandler function let bottom right corner of posframe 1461 | align to bottom right corner of window. 1462 | 1463 | The structure of INFO can be found in docstring of 1464 | `posframe-show'." 1465 | (let* ((window-left (plist-get info :parent-window-left)) 1466 | (window-top (plist-get info :parent-window-top)) 1467 | (window-width (plist-get info :parent-window-width)) 1468 | (window-height (plist-get info :parent-window-height)) 1469 | (posframe-width (plist-get info :posframe-width)) 1470 | (posframe-height (plist-get info :posframe-height)) 1471 | (mode-line-height (plist-get info :mode-line-height))) 1472 | (cons (+ window-left window-width 1473 | (- 0 posframe-width)) 1474 | (+ window-top window-height 1475 | (- 0 mode-line-height posframe-height))))) 1476 | 1477 | (defun posframe-poshandler-window-bottom-center (info) 1478 | "Posframe's position handler. 1479 | 1480 | This poshandler function let bottom edge center of posframe align 1481 | to bottom edge center of window. 1482 | 1483 | The structure of INFO can be found in docstring of 1484 | `posframe-show'." 1485 | (let* ((window-left (plist-get info :parent-window-left)) 1486 | (window-top (plist-get info :parent-window-top)) 1487 | (window-width (plist-get info :parent-window-width)) 1488 | (window-height (plist-get info :parent-window-height)) 1489 | (posframe-width (plist-get info :posframe-width)) 1490 | (posframe-height (plist-get info :posframe-height)) 1491 | (mode-line-height (plist-get info :mode-line-height))) 1492 | (cons (max 0 (+ window-left (/ (- window-width posframe-width) 2))) 1493 | (+ window-top window-height 1494 | (- 0 mode-line-height posframe-height))))) 1495 | 1496 | (defun posframe-refposhandler-xwininfo (&optional frame) 1497 | "Parent FRAME poshander function. 1498 | Get the position of parent frame (current frame) with the help of 1499 | xwininfo." 1500 | (when (executable-find "xwininfo") 1501 | (with-temp-buffer 1502 | (let ((case-fold-search nil)) 1503 | (call-process "xwininfo" nil t nil 1504 | "-display" (frame-parameter frame 'display) 1505 | "-id" (frame-parameter frame 'window-id)) 1506 | (goto-char (point-min)) 1507 | (search-forward "Absolute upper-left") 1508 | (let ((x (string-to-number 1509 | (buffer-substring-no-properties 1510 | (search-forward "X: ") 1511 | (line-end-position)))) 1512 | (y (string-to-number 1513 | (buffer-substring-no-properties 1514 | (search-forward "Y: ") 1515 | (line-end-position))))) 1516 | (cons x y)))))) 1517 | 1518 | (if (version< emacs-version "27.1") 1519 | (with-no-warnings 1520 | (add-hook 'focus-in-hook #'posframe--redirect-posframe-focus)) 1521 | (add-function :after after-focus-change-function #'posframe--redirect-posframe-focus)) 1522 | 1523 | (defun posframe--redirect-posframe-focus () 1524 | "Redirect focus from the posframe to the parent frame. 1525 | This prevents the posframe from catching keyboard input if the 1526 | window manager selects it." 1527 | (when (and (eq (selected-frame) posframe--frame) 1528 | ;; Do not redirect focus when posframe can accept focus. 1529 | ;; See posframe-show's accept-focus argument. 1530 | (not posframe--accept-focus)) 1531 | (redirect-frame-focus posframe--frame (frame-parent)))) 1532 | 1533 | (defun posframe-text-scale-factor-default (parent-text-scale-mode-amount) 1534 | "Return PARENT-TEXT-SCALE-MODE-AMOUNT or 0 if it is nil. 1535 | This ensures text scale factor is always a number for posframe display." 1536 | (or parent-text-scale-mode-amount 0)) 1537 | 1538 | (provide 'posframe) 1539 | 1540 | ;;; posframe.el ends here 1541 | --------------------------------------------------------------------------------