mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Zone multi-window and -frame support

Browse source 
* 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.
This commit is contained in:
Michael R. Mauger 2025-11-09 19:40:48 -05:00
parent d2bc774ec9
commit 04520bfd7e
2 changed files with 415 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

86
etc/NEWS
View file

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

386
lisp/play/zone.el
View file

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