popon.el (27377B)
1 ;;; popon.el --- "Pop" floating text "on" a window -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2022 Akib Azmain Turja. 4 5 ;; Author: Akib Azmain Turja <akib@disroot.org> 6 ;; Created: 2022-04-11 7 ;; Version: 0.13 8 ;; Package-Requires: ((emacs "25.1")) 9 ;; Keywords: lisp extensions frames 10 ;; Homepage: https://codeberg.org/akib/emacs-popon 11 12 ;; This file is not part of GNU Emacs. 13 14 ;; This file 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, or (at your option) 17 ;; any later version. 18 19 ;; This program 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 ;; For a full copy of the GNU General Public License 25 ;; see <https://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 29 ;; Popon allows you to pop text on a window, what we call a popon. 30 ;; Popons are window-local and sticky, they don't move while 31 ;; scrolling, and they even don't go away when switching buffer, but 32 ;; you can bind a popon to a specific buffer to only show on that 33 ;; buffer. 34 35 ;; If some popons are annoying you and you can't kill them, do M-x 36 ;; popon-kill-all to kill all popons. 37 38 ;;; Code: 39 40 (require 'subr-x) 41 (require 'cl-lib) 42 43 (defun popon--render-lines (framebuffer x y lines width) 44 "Place LINES on top of FRAMEBUFFER. 45 46 Place LINES on top of text at line X and column Y on FRAMEBUFFER and 47 return FRAMEBUFFER. LINES is a list of list as string. FRAMEBUFFER 48 is a list, each element is of form: (LINE MODIFIED EXTENDED 49 OTHERS...), where LINE is as string, MODIFIED is t when LINE is 50 modified and EXTENDED is t when the line has been extended. OTHERS is 51 not modified in any way. Each line in LINES is assumed to occupy 52 WIDTH character. FRAMEBUFFER and LINES shouldn\\='t contain newlines. 53 Example: 54 55 \(`popon--render-lines' 56 \\='((\"GNU Emacs is “free software”; this means\" nil nil) 57 (\"that everyone is free to use it and free\" nil nil) 58 (\"to redistribute it under certain\" nil nil) 59 (\"conditions. GNU Emacs is not in the\" nil nil) 60 (\"public domain; it is copyrighted and\" nil nil) 61 (\"there are restrictions on its\" nil nil) 62 (\"distribution, but these restrictions are\" nil nil) 63 (\"designed to permit everything that a\" nil nil foo) 64 (\"good cooperating citizen would want to\" nil nil bar) 65 (\"do. What is not allowed is to try to\" nil nil) 66 (\"prevent others from further sharing any\" nil nil) 67 (\"version of GNU Emacs that they might get\" nil nil) 68 (\"from you. The precise conditions are\" nil nil) 69 (\"found in the GNU General Public License\" nil nil) 70 (\"that comes with Emacs and also appears\" nil nil) 71 (\"in this manual(1). See Copying.\" t nil)) 72 11 1 \\='(\"+--^^^^^^^^^^^^^-------------------------+\" 73 \"|Free software is a type of software that|\" 74 \"|respects user freedom. Think free as in|\" 75 \"|free speech, not as in free beer. |\" 76 \"+----------------------------------------+\") 77 42) 78 => ((\"GNU Emacs is “free software”; this means\" nil nil) 79 (\"that everyo+--^^^^^^^^^^^^^-------------------------+\" t t) 80 (\"to redistri|Free software is a type of software that|\" t t) 81 (\"conditions.|respects user freedom. Think free as in|\" t t) 82 (\"public doma|free speech, not as in free beer. |\" t t) 83 (\"there are r+----------------------------------------+\" t t) 84 (\"distribution, but these restrictions are\" nil nil) 85 (\"designed to permit everything that a\" nil nil foo) 86 (\"good cooperating citizen would want to\" nil nil bar) 87 (\"do. What is not allowed is to try to\" nil nil) 88 (\"prevent others from further sharing any\" nil nil) 89 (\"version of GNU Emacs that they might get\" nil nil) 90 (\"from you. The precise conditions are\" nil nil) 91 (\"found in the GNU General Public License\" nil nil) 92 (\"that comes with Emacs and also appears\" nil nil) 93 (\"in this manual(1). See Copying.\" t nil))" 94 (let ((tab-size tab-width) 95 ;; The text might have `read-only' property. 96 (inhibit-read-only t)) 97 (with-temp-buffer 98 (setq-local tab-width tab-size) ; Preseve tab width. 99 (dotimes (i (length lines)) 100 (when (< (+ y i) (length framebuffer)) 101 (erase-buffer) 102 (insert (car (nth (+ y i) framebuffer))) 103 (goto-char (point-min)) 104 (let ((end (line-end-position))) 105 (move-to-column x t) 106 (let ((mark (point))) 107 (move-to-column (+ x width) t) 108 (setf (car (nth (+ y i) framebuffer)) 109 (concat (buffer-substring (point-min) mark) 110 (nth i lines) 111 (buffer-substring (point) (point-max)))) 112 (setf (cadr (nth (+ y i) framebuffer)) t) 113 (when (< end (point-max)) 114 (setf (cadr (cdr (nth (+ y i) framebuffer))) t)))))))) 115 framebuffer) 116 117 ;;;###autoload 118 (defun poponp (object) 119 "Return t if OBJECT is a popon." 120 (and (listp object) 121 (eq (car-safe object) 'popon))) 122 123 ;;;###autoload 124 (defun popon-live-p (object) 125 "Return t if OBJECT is a popon and not killed." 126 (and (poponp object) 127 (plist-get (cdr object) :live) 128 (and (plist-get (cdr object) :window) 129 (window-live-p (plist-get (cdr object) :window))) 130 (or (not (plist-get (cdr object) :buffer)) 131 (buffer-live-p (plist-get (cdr object) :buffer))) 132 t)) 133 134 ;;;###autoload 135 (defun popon-get (popon prop) 136 "Get the PROP property of popon POPON." 137 (plist-get (plist-get (cdr popon) :plist) prop)) 138 139 ;;;###autoload 140 (defun popon-put (popon prop value) 141 "Set the PROP property of popon POPON to VALUE." 142 (setcdr popon 143 (plist-put (cdr popon) :plist 144 (plist-put (plist-get (cdr popon) :plist) 145 prop value)))) 146 147 ;;;###autoload 148 (defun popon-properties (popon) 149 "Return a copy the property list of popon POPON." 150 (copy-sequence (plist-get (cdr popon) :plist))) 151 152 ;;;###autoload 153 (defun popon-position (popon) 154 "Return the position of popon POPON as a cons (X, Y). 155 156 When popon POPON is killed, return nil." 157 (when (popon-live-p popon) 158 (cons (plist-get (cdr popon) :x) 159 (plist-get (cdr popon) :y)))) 160 161 ;;;###autoload 162 (defun popon-size (popon) 163 "Return the size of popon POPON as a cons (WIDTH . HEIGHT). 164 165 When popon POPON is killed, return nil." 166 (when (popon-live-p popon) 167 (cons (plist-get (cdr popon) :width) 168 (length (plist-get (cdr popon) :lines))))) 169 170 ;;;###autoload 171 (defun popon-window (popon) 172 "Return the window popon POPON belongs to. 173 174 Return nil if popon POPON is killed." 175 (when (popon-live-p popon) 176 (plist-get (cdr popon) :window))) 177 178 ;;;###autoload 179 (defun popon-buffer (popon) 180 "Return the buffer popon POPON belongs to. 181 182 Return nil if popon POPON is killed." 183 (when (popon-live-p popon) 184 (plist-get (cdr popon) :buffer))) 185 186 ;;;###autaload 187 (defun popon-priority (popon) 188 "Return the priority of popon POPON. 189 190 Return nil if popon POPON is killed." 191 (when (popon-live-p popon) 192 (plist-get (cdr popon) :priority))) 193 194 ;;;###autoload 195 (defun popon-text (popon) 196 "Return the text popon POPON is displaying. 197 198 POPON may be a killed popon. Return nil if POPON isn't a popon at 199 all." 200 (when (poponp popon) 201 (mapconcat #'identity (plist-get (cdr popon) :lines) "\n"))) 202 203 (defun popon--render (popon framebuffer offset) 204 "Render POPON in FRAMEBUFFER at vertical offset OFFSET." 205 (popon--render-lines framebuffer 206 (+ (plist-get (cdr popon) :x) offset) 207 (plist-get (cdr popon) :y) 208 (plist-get (cdr popon) :lines) 209 (plist-get (cdr popon) :width))) 210 211 ;;;###autoload 212 (defun popon-create (text pos &optional window buffer priority) 213 "Create a popon showing TEXT at POS of WINDOW. 214 215 Display popon only if WINDOW is displaying BUFFER. 216 217 POS is a cons (X, Y), where X is column and Y is line in WINDOW. TEXT 218 should be a string or a cons cell of form (STR . WIDTH). When TEXT is 219 a string, each line of it should be of same length (i.e `string-width' 220 should return the same length for every line). When TEXT is a cons 221 cell, STR is used as the text to display and each line of it should be 222 of visual length width. 223 224 PRIORITY is a number (integer or float) between -100 and 100. Popons 225 with larger priority values are rendered first." 226 (when (not (or (consp text) (stringp text))) 227 (signal 'wrong-type-argument 228 `((or (consp text) (stringp text)) ,text))) 229 (when (not (consp pos)) 230 (signal 'wrong-type-argument `(consp ,pos))) 231 (when (and window (not (windowp window))) 232 (signal 'wrong-type-argument `(windowp ,window))) 233 (when (and buffer (not (bufferp buffer))) 234 (signal 'wrong-type-argument `(bufferp ,buffer))) 235 (when (and priority (not (numberp priority))) 236 (signal 'wrong-type-argument `(numberp ,priority))) 237 (let* ((lines (split-string (if (consp text) (car text) text) "\n")) 238 (popon `(popon :live t 239 :x ,(car pos) 240 :y ,(cdr pos) 241 :lines ,lines 242 :width ,(or (and (consp text) (cdr text)) 243 (string-width (car lines))) 244 :window ,(or window (selected-window)) 245 :buffer ,buffer 246 :priority ,(or priority 0) 247 :plist nil))) 248 (push popon (window-parameter window 'popon-list)) 249 (popon-update) 250 popon)) 251 252 ;;;###autoload 253 (defun popon-kill (popon) 254 "Kill popon POPON. 255 256 Do nothing if POPON isn't a live popon. Return nil." 257 (when (popon-live-p popon) 258 (let ((window (popon-window popon))) 259 (setf (window-parameter window 'popon-list) 260 (delete popon (window-parameter window 'popon-list)))) 261 (setcdr popon (plist-put (cdr popon) :live nil)) 262 (popon-update) 263 nil)) 264 265 (defvar-local popon--line-beginnings nil 266 "List of line beginning of current buffer. 267 268 The value is of form (TICK . LINE-BEGINNINGS), where LINE-BEGINNINGS 269 is the sorted list of beginning of lines and TICK is the value of tick 270 counter when LINE-BEGINNINGS was calculated.") 271 272 (defun popon--buffer-visible-substring (start end) 273 "Return the visible contents of part of the current buffer. 274 275 Take the `invisible' text property into account. 276 277 START and END specifies which part to return. They can be in any 278 order." 279 (when (> start end) 280 (let ((tmp end)) 281 (setq end start) 282 (setq start tmp))) 283 (let ((str "")) 284 (save-excursion 285 (goto-char start) 286 (while (< (point) end) 287 (let ((prop (get-char-property (point) 'invisible)) 288 (next-change (next-single-char-property-change 289 (point) 'invisible nil end))) 290 (cond 291 ((null prop) 292 (setq str (concat str (buffer-substring 293 (point) next-change)))) 294 ((and (consp buffer-invisibility-spec) 295 (member (cons prop t) buffer-invisibility-spec)) 296 (setq str 297 (concat str (apply #'propertize "..." 'invisible nil 298 (text-properties-at (point))))))) 299 (goto-char next-change)))) 300 str)) 301 302 (defun popon--make-framebuffer () 303 "Create a framebuffer for current window and buffer." 304 (let ((framebuffer nil) 305 (line-boundaries 306 (let ((pair popon--line-beginnings) 307 (boundaries nil)) 308 (when (eq (car pair) (buffer-modified-tick)) 309 (setq pair (cdr pair)) 310 (while pair 311 (when (and (integerp (car pair)) 312 (integerp (cadr pair))) 313 (push (cons (car pair) (cadr pair)) boundaries)) 314 (setq pair (cdr pair)))) 315 boundaries))) 316 (save-excursion 317 (goto-char (window-start)) 318 (let ((mark (point)) 319 (point-to-line nil) 320 (next-invisible 321 (if (get-char-property (point) 'invisible) 322 (point) 323 (next-single-char-property-change 324 (point) 'invisible nil (window-end))))) 325 (dotimes (i (floor (window-screen-lines))) 326 (if-let ((next (alist-get (point) line-boundaries))) 327 (goto-char next) 328 (if truncate-lines 329 (forward-line 1) 330 (vertical-motion 1)) 331 (when (< next-invisible (point)) 332 (let ((next-visible 333 (let ((pos next-invisible)) 334 (while (get-char-property pos 'invisible) 335 (setq pos (next-single-char-property-change 336 pos 'invisible nil (window-end)))) 337 pos))) 338 (setq next-invisible (next-single-char-property-change 339 next-visible 'invisible nil 340 (window-end))) 341 (while (> next-visible (point)) 342 (if truncate-lines 343 (forward-line 1) 344 (vertical-motion 1)))))) 345 (let ((line (alist-get mark point-to-line))) 346 (unless line 347 (setq line i) 348 (setf (alist-get mark point-to-line) line)) 349 (let* ((str (popon--buffer-visible-substring 350 mark (point))) 351 (disp-str (if (>= emacs-major-version 26) 352 (string-trim-right str "\n") 353 (let ((i (string-match-p 354 (concat "\\(?:\n\\)\\'") 355 str))) 356 (if i (substring str 0 i) str))))) 357 (unless (string-empty-p disp-str) 358 (let ((prefix 359 (if (and (> mark (point-min)) 360 (= (char-before mark) ?\n)) 361 (or (get-text-property 0 'line-prefix 362 disp-str) 363 line-prefix) 364 (or (get-text-property 0 'wrap-prefix 365 disp-str) 366 wrap-prefix)))) 367 (when (stringp prefix) 368 (setq disp-str 369 (propertize (concat prefix disp-str) 370 ;; Set these to empty strings to 371 ;; avoid using the buffer-local 372 ;; variables. 373 'line-prefix "" 374 'wrap-prefix ""))))) 375 (push (list disp-str nil nil line mark 376 (if (equal str disp-str) 377 (point) 378 (1- (point)))) 379 framebuffer))) 380 (push (cons mark (point)) line-boundaries) 381 (setq mark (point))))) 382 (let ((line-beginnings nil)) 383 (dolist (pair (sort (delete-dups line-boundaries) 384 #'car-less-than-car)) 385 (unless (eq (car line-beginnings) (car pair)) 386 (when (car line-beginnings) 387 (push nil line-beginnings)) 388 (push (car pair) line-beginnings)) 389 (push (cdr pair) line-beginnings)) 390 (push nil line-beginnings) 391 (setq popon--line-beginnings (cons (buffer-modified-tick) 392 (nreverse line-beginnings)))) 393 (nreverse framebuffer))) 394 395 (defun popon--make-overlays (framebuffer) 396 "Make overlays to display FRAMEBUFFER on window." 397 (let ((line-map nil)) 398 (let ((i 0) 399 (lines-left framebuffer)) 400 (while lines-left 401 (let ((line (pop lines-left))) 402 (when (nth 1 line) 403 (when (and (< (point-min) (nth 4 line) (point-max)) 404 (not (eq (char-before (nth 4 line)) ?\n))) 405 ;; Let's assume that the last glyph of a wrapped 406 ;; line is a invisible space. Then we can replace 407 ;; it with a newline, instead of inserting. 408 (let ((ov (make-overlay (1- (nth 4 line)) 409 (nth 4 line)))) 410 (push ov (window-parameter nil 'popon-overlays)) 411 (overlay-put ov 'window (selected-window)) 412 (overlay-put ov 'display (copy-sequence 413 '(space :width (0)))) 414 (overlay-put ov 'after-string 415 (propertize "\n" 416 'line-prefix "" 417 'wrap-prefix "")))) 418 (let* ((key (cons (nth 4 line) (nth 5 line))) 419 (pair (assoc key line-map))) 420 (unless pair 421 (setq pair (list key nil nil)) 422 (push pair line-map)) 423 (setf (cadr pair) (or (cadr pair) (nth 2 line))) 424 (push (cons (- i (nth 3 line)) (car line)) 425 (cadr (cdr pair)))))) 426 (setq i (1+ i)))) 427 (dolist (block line-map) 428 (let ((ov (make-overlay (caar block) (cdar block)))) 429 (push ov (window-parameter nil 'popon-overlays)) 430 (overlay-put ov 'window (selected-window)) 431 (overlay-put ov 'line-prefix "") 432 (overlay-put ov 'wrap-prefix "") 433 (overlay-put ov 'display (copy-sequence '(space :width (0)))) 434 (overlay-put 435 ov 'before-string 436 (let ((text "") 437 (current-offset 0)) 438 (when (and (= (caar block) (cdar block) (point-max)) 439 (not (equal (buffer-substring-no-properties 440 (1- (caar block)) (caar block)) 441 "\n"))) 442 (setq text "\n")) 443 (dolist (line (sort (cadr (cdr block)) 444 #'car-less-than-car)) 445 (setq text (concat text 446 (make-string (- (car line) 447 current-offset) 448 ?\n) 449 (cdr line))) 450 (setq current-offset (car line))) 451 (add-face-text-property 0 (length text) 'default 'append 452 text) 453 454 ;; Pay attention to the `font-lock-face' property. 455 (when font-lock-mode 456 (let ((pos 0)) 457 (while (< pos (length text)) 458 (let ((next-pos (or (next-single-property-change 459 pos 'font-lock-face text) 460 (length text)))) 461 (when-let ((face (get-pos-property 462 pos 'font-lock-face text))) 463 (add-face-text-property pos next-pos face nil 464 text)) 465 (setq pos next-pos))))) 466 text))) 467 (when (and (cadr block) 468 (< (cdar block) (point-max)) 469 (not (let* ((extend-attr 470 (lambda (face) 471 (if (facep face) 472 (when (>= emacs-major-version 27) 473 (face-attribute face :extend)) 474 (if-let (val (plist-member 475 face :extend)) 476 (cadr val) 477 'unspecified)))) 478 (extend 'unspecified)) 479 (let ((faceprop (get-char-property 480 (cdar block) 'face))) 481 (catch 'done 482 (if (face-list-p faceprop) 483 (dolist (face faceprop) 484 (setq extend (funcall extend-attr 485 face)) 486 (when (booleanp extend) 487 (throw 'done extend))) 488 (setq extend (funcall extend-attr 489 faceprop)) 490 (when (booleanp extend) 491 (throw 'done extend))) 492 (funcall extend-attr 'default)))))) 493 (let ((ov (make-overlay (cdar block) (1+ (cdar block))))) 494 (push ov (window-parameter nil 'popon-overlays)) 495 (overlay-put ov 'window (selected-window)) 496 (overlay-put ov 'face 'default)))))) 497 498 (defun popon--redisplay-1 (force) 499 "Redisplay popon overlays. 500 501 When FORCE is non-nil, update all overlays." 502 (let ((popon-available-p nil) 503 (any-popon-visible-p nil)) 504 (dolist (frame (frame-list)) 505 (dolist (window (window-list frame)) 506 (set-window-parameter 507 window 'popon-list 508 (cl-remove-if-not #'popon-live-p 509 (window-parameter window 'popon-list))) 510 (when (window-parameter window 'popon-list) 511 (setq popon-available-p t)) 512 (let ((popons 513 (cl-remove-if-not 514 (lambda (popon) 515 (and (or (null (popon-buffer popon)) 516 (eq (popon-buffer popon) (window-buffer))) 517 (< (cdr (popon-position popon)) 518 (with-selected-window window 519 (floor (window-screen-lines)))) 520 (< (car (popon-position popon)) 521 (- (window-width window) 522 (if (fboundp 'line-number-display-width) 523 (with-selected-window window 524 (line-number-display-width)) 525 0) 526 (if (display-graphic-p) 527 (let ((fringes (window-fringes 528 window))) 529 (/ (+ (car fringes) (cadr fringes)) 530 (frame-char-width frame))) 531 (if (zerop (window-hscroll)) 0 1)))))) 532 (copy-sequence (window-parameter 533 window 'popon-list))))) 534 (when (or force 535 (not 536 (and 537 (eq (window-parameter 538 window 'popon-window-start) 539 (window-start window)) 540 (eq (window-parameter 541 window 'popon-window-hscroll) 542 (window-hscroll window)) 543 (eq (window-parameter 544 window 'popon-window-buffer) 545 (window-buffer window)) 546 (null (cl-set-exclusive-or 547 popons 548 (window-parameter 549 window 'popon-visible-popons)))))) 550 (while (window-parameter window 'popon-overlays) 551 (delete-overlay 552 (pop (window-parameter window 'popon-overlays)))) 553 (when popons 554 (setq popons (sort popons (lambda (a b) 555 (< (popon-priority a) 556 (popon-priority b))))) 557 (with-selected-window window 558 (let* ((framebuffer (popon--make-framebuffer))) 559 (dolist (popon popons) 560 (popon--render popon framebuffer 561 (window-hscroll))) 562 (popon--make-overlays framebuffer)))) 563 (set-window-parameter window 'popon-visible-popons popons) 564 (set-window-parameter window 'popon-window-start 565 (window-start window)) 566 (set-window-parameter window 'popon-window-hscroll 567 (window-hscroll window)) 568 (set-window-parameter window 'popon-window-buffer 569 (window-buffer window)))) 570 (when (window-parameter window 'popon-visible-popons) 571 (setq any-popon-visible-p t)))) 572 (if any-popon-visible-p 573 (add-hook 'pre-redisplay-functions #'popon--pre-redisplay) 574 (remove-hook 'pre-redisplay-functions #'popon--pre-redisplay)) 575 (if popon-available-p 576 (add-hook 'window-configuration-change-hook #'popon-update) 577 (remove-hook 'window-configuration-change-hook 578 #'popon-update)))) 579 580 ;;;###autoload 581 (defun popon-redisplay () 582 "Redisplay popon overlays." 583 (popon--redisplay-1 t)) 584 585 ;;;###autoload 586 (defun popon-update () 587 "Update popons if needed." 588 (popon--redisplay-1 nil)) 589 590 (defun popon--pre-redisplay (_) 591 "Update popons." 592 (popon-update)) 593 594 ;;;###autoload 595 (defun popon-x-y-at-posn (posn) 596 "Return the (X, Y) coodinate at position POSN as a cons. 597 598 Return nil if a popon can't be shown at position POSN. 599 600 NOTE: This uses `posn-at-point', which is slow. So try to minimize 601 calls to this function." 602 (when (and posn (posn-point posn)) 603 (let* ((window-start-x-y 604 (if (>= emacs-major-version 29) 605 (posn-col-row (posn-at-point (window-start)) 606 'use-window) 607 (posn-col-row (posn-at-point (window-start))))) 608 (point-x-y 609 (if (>= emacs-major-version 29) 610 (posn-col-row posn 'use-window) 611 (posn-col-row posn))) 612 (x-y (cons (if (and (or (not truncate-lines) word-wrap) 613 (if truncate-partial-width-windows 614 (>= (window-total-width) 615 truncate-partial-width-windows) 616 t)) 617 (- (car point-x-y) (car window-start-x-y)) 618 (- (save-excursion 619 (goto-char (posn-point posn)) 620 (current-column)) 621 (window-hscroll))) 622 (- (cdr point-x-y) (cdr window-start-x-y))))) 623 (when (and (>= (car x-y) 0) 624 (>= (cdr x-y) 0)) 625 x-y)))) 626 627 ;;;###autoload 628 (defun popon-x-y-at-pos (point) 629 "Return the (X, Y) coodinate of POINT in selected window as a cons. 630 631 Return nil if POINT is not in visible text area. 632 633 NOTE: This uses `posn-at-point', which is slow. So try to minimize 634 calls to this function." 635 (popon-x-y-at-posn (posn-at-point point))) 636 637 ;;;###autoload 638 (defun popon-kill-all () 639 "Kill all popons." 640 (interactive) 641 (dolist (frame (frame-list)) 642 (dolist (window (window-list frame)) 643 (while (window-parameter window 'popon-list) 644 (popon-kill (pop (window-parameter window 'popon-list))))))) 645 646 (provide 'popon) 647 ;;; popon.el ends here