From 04520bfd7ef593b77a7fe84ab1f4f4353365b717 Mon Sep 17 00:00:00 2001 From: "Michael R. Mauger" Date: Sun, 9 Nov 2025 19:40:48 -0500 Subject: [PATCH] Zone multi-window and -frame support * lisp/play/zone.el: Multi-window and -frame support. (zone): New group. (zone-buffer-name): New constant. (zone-add-program, zone-remove-program): New functions. * : User configuration (zone-all-frames, zone-all-windows-in-frame) (zone-delete-other-windows): New boolean options. (zone-time-elapsed-while-zoning): New var. (zone-start-hook, zone-finish-hook): New hooks. * : Preserve frame configuration (zone-frame-configuration-alist): New Alist of cursor type and window configuration per frame. (zone--save-frame-configuration) (zone--restore-frame-configuration) (zone--restore-all-frame-configuration): New internal functions to restore windows and frames. * : Rewrite/modularization of zone logic (zone): Refactor function. (zone--buffer-empty-p, zone--buffer-encrypted-p): New functions. (zone--choose-window-and-buffer): New function. (zone-ignored-buffers, zone--buffer-zoneable-p): New var and function. (zone--build-zone-buffer): New function to create zone buffer. (zone--prepare-frames): New function to configure multi-frames and -windows. (zone--apologize-seconds, zone--apologize-for-failing): New var and function when zone fails. --- etc/NEWS | 86 +++++++++++ lisp/play/zone.el | 386 +++++++++++++++++++++++++++++++++++++++------- 2 files changed, 415 insertions(+), 57 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 3b66f4baff2..7168cc5bb92 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3007,6 +3007,92 @@ CPerl mode creates imenu entries for ":writer" generated accessors and recognizes the new functions "all" and "any". See https://perldoc.perl.org/5.42.0/perldelta for details. +** Zone +Zone can scramble multiple windows across multiple frames; it may also +reorganize frames to be a single window. As before, when a key or mouse +event occurs, all of the frames and windows are restored to their +original state. This is controlled by three new customization flags +which control the use of frames and windows beyond the currently active +ones. It is identifies suitable buffers for zoning out so that +potentially important buffer contents are not exposed. + +When a zone program encounters an error, it will apologize for a minute +and then start a new round of zoning. Previously, it just kept +apologizing. Finally, zone does not pollute the *Messages* buffer with +extraneous messages. + +**** New function 'zone-add-program' +This function accepts a symbol, whose name starts with "zone-pgm-", that +runs a zone program when 'zone' is invoked. It adds the program to the +'zone-programs' vector if it is not already present.'' + +**** New functipon 'zone-remove-program' +This function removes a program from the 'zone-programs' vector. If the +parameter is a symbol, and the symbol is present in the vector, it is +removed. If the parameter is a string, it is a regular expression that +will remove any programs whose name matches the parameter pattern. + +*** Multi-window and -frame customization options +Prior to this update, zone would only (safely) scramble the contents of +the current window on the current frame. Now, with the use of these +three options, it is possible to scramble to contents of all windows +across all frames. It is also possible to make frames single window +displays while zoning. But when zoning is interrupted by a key- or +mouse-press, the original window layout across all frames is restored. + +**** New user option 'zone-delete-other-windows' +When non-nil, the frame is made into a single full frame window to hold +the zoned buffer. If all frames were to be used (`zone-all-frames' set +to non-nil), then all frames are converted to single window frames. + +**** New user option 'zone-all-frames' +When non-nil, zone will appear on all visible frames. While the buffer +scrambling will appear on each frame, it will be the same buffer so they +will all behave the same way. + +**** New user option 'zone-all-windows-in-frame' +When non-nil, the zoned buffer will be mapped to all of the windows +present on the frame. If the option is nil, then only the selected +window will show the zoned buffer. Note, however, that each window +holding the zoned buffer is showing the same zoned buffer. + +*** Selecting source buffers suitable for zoning +When the idle timer, or the user, invokes `zone', the current buffer may +not be appropriate as the source of the zone buffer. For example, +encrypted buffers, empty buffers, or specialized buffers like +`*Messages*' probably shouldn't have their content splashed across zoned +windows. So the selection of a suitable buffer for zoning can be controlled with a variable that identifies buffers with concerns. + +**** New variable 'zone-ignored-buffers' +The variable is a list of criteria for excluding a buffer from +consideration as the source of zoning. The list has entries that are +tested against each buffer until a suitable one is found. The criteria +can be a symbol that ends in `-mode' which excludes buffers that are in +a mode derived from the specified mode. It may also be a function-bound +symbol or lambda expression that is called with a buffer that returns a +non-nil value if it should not be the zone source. Finally, an entry +can also be a regular expression string that must not match the buffer's +name. + +Initially, the list excludes buffers in a special-mode, in an +image-mode, contains an encrypted file, is an empty buffer, is a hidden +buffer, or is the `*scratch*' buffer. If it cannot locate any +acceptable buffers, it will begrudgingly use the scratch buffer. + +*** Zone hooks +Hooks have been added to notify programs of the start and end of zone activity. For example, you may want to credit time spent zoning as a Pomodoro break. + +**** New hook 'zone-start-hook' +This hook contains functions that are invoked when zoning is about to begin. + +**** New hook 'zone-finish-hook' +This hook contains functions that are invoked when zoning has finished. + +**** New variable 'zone-time-elapsed-while-zoning' +This is the elapsed time between the start and finish hooks. So this +represents how long Emacs was zoning. Zone calculates this so that the +finish hook can communicate this to other modes if necessary. + * New Modes and Packages in Emacs 31.1 diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 5f817c10371..0d33a9783d6 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -36,6 +36,14 @@ ;;; Code: +(defgroup zone nil + "Zone related settings." + :prefix "zone-" + :group 'play) + +(defconst zone-buffer-name "*zone*" + "Name of the zone buffer that holds zoned text.") + (defvar zone-timer nil "The timer we use to decide when to zone out, or nil if none.") @@ -71,11 +79,32 @@ If nil, don't interrupt for about 1^26 seconds.") zone-pgm-random-life ]) +(defun zone-add-program (pgm) + "Add a zone program PGM to `zone-programs'." + (unless (seq-contains-p zone-programs pgm #'eq) + (setq zone-programs (vconcat zone-programs (list pgm))))) + +(defun zone-remove-program (pgm) + "Remove a zone program PGM from `zone-programs'. +If PGM is a symbol, remove it from the `zone-programs'; if it is a +string, assume it is a regular expression that will remove programs +whose name matches the pattern." + (setq zone-programs + (vector (seq-remove + (lambda (v) + (cond + ((symbolp pgm) (eq pgm v)) + ((stringp pgm) (string-match-p pgm (symbol-name v))) + (t nil))) + zone-programs)))) + (defmacro zone-orig (&rest body) + "Perform BODY in the original source buffer of the zone buffer." `(with-current-buffer (get 'zone 'orig-buffer) ,@body)) (defmacro zone-hiding-mode-line (&rest body) + "Perform BODY without a window mode line." ;; This formerly worked by temporarily altering face `mode-line', ;; which did not even work right, it seems. `(let (mode-line-format) @@ -102,6 +131,79 @@ If the element is a function or a list of a function and a number, (t (error "Bad `zone-call' elem: %S" elem)))) program)))) +;;;; Customization flags to control what is zoned + +(defcustom zone-all-frames nil + "When non-nil, zone in all open frames. +Displays the `*zone*' buffer in all windows in all frames." + :type 'boolean) + +(defcustom zone-all-windows-in-frame nil + "When non-nil, zone in all windows in the current frame." + :type 'boolean) + +(defcustom zone-delete-other-windows nil + "When non-nil, make the frame a single window before zoning. +The original windows and their content will be restored when zoning +completes." + :type 'boolean) + +;;;; Hooks to detect the start and finish of zone activity + +(defvar zone-time-elapsed-while-zoning nil + "In the `zone-finish-hook', will report the time spent zoning.") + +(defvar zone-start-hook nil + "Hook at the start of zoning.") + +(defvar zone-finish-hook nil + "Hook at the finish of Zoning. +When this is invoked, `zone-time-elapsed-while-zoning' will be properly set.") + +;;;; Save frame configuration so it can be restored when we finish zoning + +(defvar zone-frame-configuration-alist nil + "An Alist of frames and their cursor and window configuration. + +Before zone starts using a frame, it saves the configuration before it +touches anything. At the end of zoning, the frame configuration is +restored. + +The Alist key is the frame object, then value is the cons cell +containing the window configuration and cursor type.") + +(defun zone--save-frame-configuration (frm &optional reset) + "Save the frame FRM's configuration. + +When RESET is non-nil, the `zone-frame-configuration-alist' will contain +this frame only, otherwise the frame's configuration will be appended to +the Alist." + (when reset + (setq zone-frame-configuration-alist nil)) + (when (frame-visible-p frm) + (push (cons frm + (cons + (current-window-configuration frm) + (frame-parameter frm 'cursor-type))) + zone-frame-configuration-alist))) + +(defun zone--restore-frame-configuration (frm) + "Restore the frame FRM's configuration from the Alist." + (when-let* ((config (alist-get frm zone-frame-configuration-alist))) + (with-selected-frame frm + (set-window-configuration (car config)) + (modify-frame-parameters frm (list (cons 'cursor-type (cdr config))))))) + +(defun zone--restore-all-frame-configurations () + "Restore all of the saved frame configurations." + (mapc #'zone--restore-frame-configuration + (mapcar #'car zone-frame-configuration-alist)) + (setq zone-frame-configuration-alist nil) + (when (get-buffer zone-buffer-name) + (kill-buffer zone-buffer-name))) + +;;;; Here we zone... + ;;;###autoload (defun zone (&optional pgm) "Zone out, completely. @@ -121,62 +223,230 @@ run a specific program. The program must be a member of (list (intern (concat "zone-pgm-" choice)))))) (unless pgm (setq pgm (aref zone-programs (random (length zone-programs))))) - (save-window-excursion - (let ((f (selected-frame)) - (outbuf (get-buffer-create "*zone*")) - (text (buffer-substring (window-start) (window-end nil t))) - (wp (1+ (- (window-point) - (window-start))))) - (put 'zone 'orig-buffer (current-buffer)) - (switch-to-buffer outbuf) - (setq mode-name "Zone") + (run-hooks 'zone-start-hook) + (let* ((start-time (current-time)) + (zone-again nil) + (src-winbuf (zone--choose-window-and-buffer)) + (src-win (car src-winbuf)) + (src-buf (cdr src-winbuf)) + (src-frm (window-frame src-win))) + (setq zone-frame-configuration-alist nil) + (unwind-protect + (progn + (zone--save-frame-configuration src-frm) + (zone--build-zone-buffer src-win src-buf) + (zone--prepare-frames src-frm) + (condition-case zone-err + (progn + (message "Zoning... (%s)" pgm) + (garbage-collect) + ;; If some input is pending, zone says "sorry", which + ;; isn't nice; this might happen e.g. when they invoke the + ;; game by clicking the menu bar. So discard any pending + ;; input before zoning out. + (if (input-pending-p) + (discard-input)) + (zone-call pgm) + (message "Zoning...sorry")) + + (error + (message "%s error: %S" (or pgm 'zone) zone-err) + (zone--apologize-for-failing pgm) + (setq zone-again t)) + + (quit + (ding) + (message "Zoning...sorry")))) + (zone--restore-all-frame-configurations)) + (when (and zone-again + (not (input-pending-p))) + (zone)) + (setq zone-time-elapsed-while-zoning (time-since start-time))) + (run-hooks 'zone-finish-hook)) + +;;;; Identify the current window and the best buffer to use as zone source + +(defun zone--buffer-empty-p (buffer) + "Is BUFFER empty?" + (zerop (buffer-size buffer))) + +(defun zone--buffer-encrypted-p (buffer) + "Is BUFFER encrypted with `epa'?" + (require 'epa-hook) + (when-let* ((name (buffer-file-name buffer))) + (epa-file-name-p name))) + +(defun zone--choose-window-and-buffer () + "Choose the current window and an acceptable buffer. +Check each buffer to determine whether it is suitable for zoning, +starting with the buffer in the current window. For example, encrypted +files, certain source modules, or command sessions may be inappropriate +if they might expose privileged or secret information." + (cons + (selected-window) + (or (seq-find #'zone--buffer-zoneable-p + (buffer-list (selected-frame))) + ;; only create *scratch* if we need one as fall back + (get-scratch-buffer-create)))) + +(defvar zone-ignored-buffers + '( "\\`\s" ;; Hidden buffers + zone--buffer-empty-p ;; Empty buffers (not very interesting) + special-mode ;; Special/internal buffers + image-mode ;; image buffers + authinfo-mode ;; encrypted buffers + zone--buffer-encrpted-p + "\\`\\*scratch\\*\\'" ;; zone will fallback to scratch , but + ;; ignore it in the first pass + ) + "Buffers that satisfy any of these rules are ignored as a zone buffer. +Each entry in the list must be one of the following: + ++ MODE: all derived modes of the MODE are considered unacceptable, ++ REGEXP: a buffer name that matches the REGEXP is not acceptable, and ++ PRED: a buffer that satisfies the PRED, such that it returns a non-nil + value when invoked as a function with the buffer supplied as a + parameter, is considered not acceptable.") + +(defun zone--buffer-zoneable-p (buffer) + "Is BUFFER suitable for zoning? +For example, buffers containing passwords, critical source files, and +command line transcripts might not be appropriate for a zone buffer. + +To be acceptable, the buffer must NOT satisfy any of the entries on +`zone-ignored-buffers'." + (not (any + (lambda (ign) + (cond + ((stringp ign) + (string-match-p ign (buffer-name buffer))) + ((and (symbolp ign) + (string-suffix-p "-mode" (symbol-name ign))) + (with-current-buffer buffer + (derived-mode-p ign))) + ((functionp ign) + (funcall ign buffer)))) + zone-ignored-buffers))) + +;;;; Prepare the *zone* buffer with a copy of the source buffer + +(defun zone--build-zone-buffer (win buf) + "Construct the *zone* buffer in window WIN, based on buffer BUF. +Remove other windows if `zone-delete-other-windows' is non-nil. The +selected buffer is then placed in the window. If only a portion of the +buffer is visible, try to recenter it to expose more." + ;; Make us single window if desired + (when zone-delete-other-windows + (delete-other-windows win)) + ;; Switch in the source buffer into the window + (unless (eq (current-buffer) buf) + (set-window-buffer win buf nil)) + ;; Try to scroll the buffer into the window + (unless (< (window-end) (point-max)) + (let ((scroll-margin 0)) + (recenter -1))) + (redisplay) + ;; Create the zone buffer and populate it + (let* ((win-end (window-end win t)) + (win-beg (window-start)) + (win-pt (window-point)) + (new-pt (1+ (- win-pt win-beg))) + (win-ht (line-pixel-height))) + (with-current-buffer (get-buffer-create zone-buffer-name) + (put 'zone 'orig-buffer buf) (erase-buffer) - (setq buffer-undo-list t - truncate-lines t - tab-width (zone-orig tab-width) - line-spacing (zone-orig line-spacing)) - (insert text) - (untabify (point-min) (point-max)) - (set-window-start (selected-window) (point-min)) - (set-window-point (selected-window) wp) - (sit-for 0.500) - (let ((ct (and f (frame-parameter f 'cursor-type))) - (show-trailing-whitespace nil) - restore) - (when ct - (modify-frame-parameters f '((cursor-type . (bar . 0))))) - ;; Make `restore' a self-disabling one-shot thunk. - (setq restore - (lambda () - (when ct - (modify-frame-parameters - f (list (cons 'cursor-type ct)))) - (kill-buffer outbuf) - (setq restore nil))) - (condition-case nil - (progn - (message "Zoning... (%s)" pgm) - (garbage-collect) - ;; If some input is pending, zone says "sorry", which - ;; isn't nice; this might happen e.g. when they invoke the - ;; game by clicking the menu bar. So discard any pending - ;; input before zoning out. - (if (input-pending-p) - (discard-input)) - (zone-call pgm) - (message "Zoning...sorry")) - (error - (funcall restore) - (while (not (input-pending-p)) - (message "We were zoning when we wrote %s..." pgm) - (sit-for 3) - (message "...here's hoping we didn't hose your buffer!") - (sit-for 3))) - (quit - (funcall restore) - (ding) - (message "Zoning...sorry"))) - (when restore (funcall restore)))))) + (setq-local mode-name "Zone" + buffer-undo-list t + truncate-lines t + scroll-margin 0 + scroll-conservatively 1000 + scroll-up-aggressively 0 + scroll-down-aggressively 0 + show-trailing-whitespace nil + tab-width (buffer-local-value 'tab-width buf) + line-spacing (buffer-local-value 'line-spacing buf)) + ;; Grab the visible portion of the source buffer + (insert-buffer-substring buf win-beg win-end) + ;; Remove read-only property so zone can play with all of it + (let ((inhibit-read-only t) + (beg (point-min)) + (end (point-max))) + (remove-text-properties beg end '(read-only nil)) + ;; Adjust line height with the settings from the original buffer + (add-text-properties beg end `(line-height ,win-ht)) + ;; Get rid of tab characters and position the window + (untabify beg end))) + ;; Move the zone buffer to the window + (set-window-buffer win zone-buffer-name nil) + ;; Position the zone buffer in the window + ;; Position point and then fix the top. + ;; These with scroll settings above fix + ;; the content boundaries in the window + (set-window-point win new-pt) + (set-window-start win (point-min)) + (redisplay))) + +;;;; Configure frames and windows based on customization flags + +(defun zone--prepare-frames (prim-frm) + "Reorganize frames and their windows to show the zone out. +This is based on the settings of three customization flags: ++ `zone-all-frames', ++ `zone-all-windows-in-frame', and ++ `zone-delete-other-windows' + +These have been partially performed on the primary frame PRIM-FRM. +Based on the settings, the other frames may be similarly adjusted." + (let* ((z (get-buffer zone-buffer-name)) + (prim-win (frame-selected-window prim-frm)) + (f prim-frm) + (no-cursor '((cursor-type . (bar . 0)))) + w1) + ;; Handle the primary frame + (select-frame f t) + (setq w1 (frame-selected-window f)) + ;; Put zone in current or every window + (dolist (w (if zone-all-windows-in-frame + (window-list f 'no-minibuf w1) + (list w1))) + (set-window-buffer w z nil)) + (modify-frame-parameters f no-cursor) + ;; Handle the remaining frames + (dolist (f (visible-frame-list)) + (unless (eq f prim-frm) + (select-frame f t) + (setq w1 (frame-selected-window f)) + ;; Single window frame + (when zone-delete-other-windows + (delete-other-windows)) + ;; Put zone in current or every window + (dolist (w (if zone-all-windows-in-frame + (window-list f 'no-minibuf w1) + (list w1))) + (set-window-buffer w z nil)) + (modify-frame-parameters f no-cursor) + (set-frame-selected-window f w1 t))) + (select-frame prim-frm) + (set-frame-selected-window prim-frm prim-win t))) + +;;;; If the zone program fails, apologize and try again + +(defvar zone-apologize-seconds 60 ;; 1 minute + "Number of seconds to apologize for failing. +This value is broken into 6 second cycles to allow for two messages +displayed for 3 seconds each in every cycle.") + +(defun zone--apologize-for-failing (pgm) + "Apologize for PGM failing for a minute." + (let ((cycle 0) + (n-cycles (floor zone-apologize-seconds 6))) + (while (and (not (input-pending-p)) + (<= (incf cycle) n-cycles)) + (let ((message-log-max (= cycle 1))) ;; Log message first time only + (message "We were zoning when we wrote %s..." pgm) + (sit-for 3) + (message "...here's hoping we didn't hose your buffer!") + (sit-for 3))))) ;;;; Zone when idle, or not. @@ -598,7 +868,8 @@ run a specific program. The program must be a member of lines (cons (buffer-substring p (point)) lines)))) (sit-for 5) (zone-hiding-mode-line - (let ((msg "Zoning... (zone-pgm-stress)")) + (let ((message-log-max nil) + (msg "Zoning... (zone-pgm-stress)")) (while (not (string= msg "")) (message (setq msg (substring msg 1))) (sit-for 0.05))) @@ -609,7 +880,8 @@ run a specific program. The program must be a member of (delete-region (point) (line-beginning-position 2)) (goto-char (point-min)) (insert (seq-random-elt lines))) - (message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr")) + (let ((message-log-max nil)) + (message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))) (sit-for 0.1))))) (defun zone-pgm-stress-destress ()