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

@@ -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
 

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,39 +223,20 @@ 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
+  (run-hooks 'zone-start-hook)
-    (let ((f (selected-frame))
+  (let* ((start-time (current-time))
-          (outbuf (get-buffer-create "*zone*"))
+         (zone-again nil)
-          (text (buffer-substring (window-start) (window-end nil t)))
+         (src-winbuf (zone--choose-window-and-buffer))
-          (wp (1+ (- (window-point)
+         (src-win  (car src-winbuf))
-                     (window-start)))))
+         (src-buf  (cdr src-winbuf))
-      (put 'zone 'orig-buffer (current-buffer))
+         (src-frm  (window-frame src-win)))
-      (switch-to-buffer outbuf)
+    (setq zone-frame-configuration-alist nil)
-      (setq mode-name "Zone")
+    (unwind-protect
-      (erase-buffer)
+        (progn
-      (setq buffer-undo-list t
+          (zone--save-frame-configuration src-frm)
-            truncate-lines t
+          (zone--build-zone-buffer src-win src-buf)
-            tab-width (zone-orig tab-width)
+          (zone--prepare-frames src-frm)
-            line-spacing (zone-orig line-spacing))
+          (condition-case zone-err
-      (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)
@@ -165,18 +248,205 @@ run a specific program.  The program must be a member of
                     (discard-input))
                 (zone-call pgm)
                 (message "Zoning...sorry"))
+
             (error
-           (funcall restore)
+             (message "%s error: %S" (or pgm 'zone) zone-err)
-           (while (not (input-pending-p))
+             (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-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)))
+        (sit-for 3)))))
-          (quit
-           (funcall restore)
-           (ding)
-           (message "Zoning...sorry")))
-        (when restore (funcall restore))))))
 
 ;;;; 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 ()