(zone-timeout): New var.
(zone-hiding-modeline): New macro. (zone-call): New func. (zone): Init `modeline-hidden-level' symbol property. Use `zone-call' instead of `funcall'. (zone-pgm-whack-chars): Use `make-string' (bug introduced in 2001-10-26T20:11:25Z!monnier@iro.umontreal.ca). (zone-pgm-stress): Use `zone-hiding-modeline'. (zone-pgm-stress-destress): New zone program.
This commit is contained in:
Thien-Thi Nguyen
parent
33f1148dad
commit
df9d055ed4
2 changed files with 214 additions and 145 deletions
101
lisp/ChangeLog
101
lisp/ChangeLog
|
|
@ -1,12 +1,27 @@
|
|||
2002-01-10 Thien-Thi Nguyen <ttn@giblet.glug.org>
|
||||
|
||||
* play/zone.el (zone-timeout): New var.
|
||||
(zone-hiding-modeline): New macro.
|
||||
(zone-call): New func.
|
||||
|
||||
(zone): Init `modeline-hidden-level' symbol property.
|
||||
Use `zone-call' instead of `funcall'.
|
||||
|
||||
(zone-pgm-whack-chars): Use `make-string' (fix bug introduced in 2001-10-26T20:11:25Z!monnier@iro.umontreal.ca).
|
||||
|
||||
(zone-pgm-stress): Use `zone-hiding-modeline'.
|
||||
|
||||
(zone-pgm-stress-destress): New zone program.
|
||||
|
||||
2002-01-10 Eli Zaretskii <eliz@is.elta.co.il>
|
||||
|
||||
* faces.el (minibuffer-prompt): Special face definition for MS-DOS.
|
||||
|
||||
2002-01-09 Michael Kifer <kifer@cs.stonybrook.edu>
|
||||
|
||||
|
||||
* viper.el (viper-set-hooks): zap viper-unfriendly bindings in
|
||||
flyspell-mouse-map.
|
||||
|
||||
|
||||
2002-01-08 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* emacs-lisp/regexp-opt.el (regexp-opt): Bind max-specpdl-size.
|
||||
|
|
@ -42,9 +57,9 @@
|
|||
2000-08-30.
|
||||
|
||||
2002-01-08 Michael Kifer <kifer@cs.stonybrook.edu>
|
||||
|
||||
|
||||
* ediff-hook.el: added an autoload cookie.
|
||||
|
||||
|
||||
2002-01-08 Pavel Jan,Bm(Bk <Pavel@Janik.cz>
|
||||
|
||||
* net/eudcb-ph.el, net/ldap.el: New maintainer. New e-mail
|
||||
|
|
@ -56,37 +71,37 @@
|
|||
(occur-mode-map): Bind `o' to that.
|
||||
|
||||
2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
|
||||
|
||||
|
||||
* viper-init.el (viper-cond-compile-for-xemacs-or-emacs):
|
||||
new macro that replaces viper-emacs-p and viper-xemacs-p in many
|
||||
cases. Used to reduce the number of warnings.
|
||||
|
||||
|
||||
* viper-cmd.el: use viper-cond-compile-for-xemacs-or-emacs.
|
||||
(viper-standard-value): moved here from viper.el.
|
||||
(viper-set-unread-command-events): moved to viper-util.el
|
||||
(viper-check-minibuffer-overlay): make sure
|
||||
viper-minibuffer-overlay is moved to cover the entire input field.
|
||||
|
||||
|
||||
* viper-util.el: use viper-cond-compile-for-xemacs-or-emacs.
|
||||
(viper-read-key-sequence, viper-set-unread-command-events,
|
||||
viper-char-symbol-sequence-p, viper-char-array-p): moved here.
|
||||
|
||||
|
||||
* viper-ex.el: use viper-cond-compile-for-xemacs-or-emacs.
|
||||
|
||||
|
||||
* viper-keym.el: use viper-cond-compile-for-xemacs-or-emacs.
|
||||
|
||||
|
||||
* viper-mous.el: use viper-cond-compile-for-xemacs-or-emacs.
|
||||
|
||||
|
||||
* viper-macs.el (viper-char-array-p, viper-char-symbol-sequence-p,
|
||||
viper-event-vector-p): moved to viper-util.el
|
||||
|
||||
|
||||
* viper.el (viper-standard-value): moved to viper-cmd.el.
|
||||
Use viper-cond-compile-for-xemacs-or-emacs.
|
||||
|
||||
* ediff-help.el: use ediff-cond-compile-for-xemacs-or-emacs.
|
||||
|
||||
|
||||
* ediff-hook.el: use ediff-cond-compile-for-xemacs-or-emacs.
|
||||
|
||||
|
||||
* ediff-init.el (ediff-cond-compile-for-xemacs-or-emacs): new
|
||||
macro designed to be used in many places where ediff-emacs-p or
|
||||
ediff-xemacs-p was previously used. Reduces the number of
|
||||
|
|
@ -98,11 +113,11 @@
|
|||
ediff-whitespace-diff-region-p, ediff-get-region-contents):
|
||||
moved to ediff-util.el.
|
||||
(ediff-event-key): moved here.
|
||||
|
||||
|
||||
* ediff-merge.el: got rid of unreferenced variables.
|
||||
|
||||
|
||||
* ediff-mult.el: use ediff-cond-compile-for-xemacs-or-emacs.
|
||||
|
||||
|
||||
* ediff-util.el: use ediff-cond-compile-for-xemacs-or-emacs.
|
||||
(ediff-cleanup-mess): improved the way windows are set up after
|
||||
quitting ediff.
|
||||
|
|
@ -126,11 +141,11 @@
|
|||
(ediff-arrange-autosave-in-merge-jobs): check if the merge file
|
||||
is visited by another buffer and ask to save/delete that buffer.
|
||||
(ediff-verify-file-merge-buffer): new function to do the above.
|
||||
|
||||
|
||||
* ediff-vers.el: load ediff-init.el at compile time.
|
||||
|
||||
|
||||
* ediff-wind.el: use ediff-cond-compile-for-xemacs-or-emacs.
|
||||
|
||||
|
||||
* ediff.el (ediff-windows, ediff-regions-wordwise,
|
||||
ediff-regions-linewise): use indirect buffers to improve
|
||||
robustness and make it possible to compare regions of the same
|
||||
|
|
@ -140,7 +155,7 @@
|
|||
(ediff-files-internal): refuse to compare identical files.
|
||||
(ediff-regions-internal): get rid of the warning about comparing
|
||||
regions of the same buffer.
|
||||
|
||||
|
||||
* ediff-diff.el (ediff-convert-fine-diffs-to-overlays): moved here.
|
||||
Plus the following fixes courtesy of Dave Love:
|
||||
Doc fixes.
|
||||
|
|
@ -150,7 +165,7 @@
|
|||
(ediff-copy-to-buffer): Use insert-buffer-substring rather than
|
||||
consing buffer contents.
|
||||
(ediff-goto-word): Move syntax table setting outside loop.
|
||||
|
||||
|
||||
2002-01-07 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* dired.el (dired-copy-filename-as-kill): Call kill-append
|
||||
|
|
@ -223,8 +238,8 @@
|
|||
|
||||
* enriched.el (enriched-make-annotation): Doc fix.
|
||||
|
||||
* format.el (format-replace-strings, format-subtract-regions)
|
||||
(format-annotate-region, format-annotate-location)
|
||||
* format.el (format-replace-strings, format-subtract-regions)
|
||||
(format-annotate-region, format-annotate-location)
|
||||
(format-annotate-atomic-property-change)
|
||||
(format-annotate-single-property-change): Doc fixes.
|
||||
|
||||
|
|
@ -292,7 +307,7 @@
|
|||
2002-01-02 Chris Hanson <cph@aarau.ai.mit.edu>
|
||||
|
||||
* xscheme.el: Eleven years of updates on a private copy.
|
||||
|
||||
|
||||
Extensive changes to support multiple xscheme buffers:
|
||||
(run-scheme): Break up into new functions to facilitate starting
|
||||
processes in other buffers.
|
||||
|
|
@ -415,11 +430,11 @@
|
|||
* comint.el, cus-edit.el, diff-mode.el, enriched.el, font-lock.el:
|
||||
* generic-x.el, info.el, log-view.el, pcvs-info.el, speedbar.el:
|
||||
* wid-edit.el, woman.el, calendar/calendar.el, textmodes/flyspell.el:
|
||||
* emulation/viper-init.el, eshell/em-ls.el, progmodes/antlr-mode.el:
|
||||
* emulation/viper-init.el, eshell/em-ls.el, progmodes/antlr-mode.el:
|
||||
* progmodes/cperl-mode.el, progmodes/idlwave.el:
|
||||
* progmodes/sh-script.el, progmodes/vhdl-mode.el:
|
||||
Adapt face definitions to use :weight and :slant.
|
||||
|
||||
|
||||
* ps-print.el (ps-font-lock-face-attributes): Use :weight and :slant.
|
||||
|
||||
* cus-edit.el (custom-face-edit-fix-value): Delete `assert' call.
|
||||
|
|
@ -454,7 +469,7 @@
|
|||
|
||||
* replace.el (query-replace-read-args): Immediate error if read-only.
|
||||
|
||||
* textmodes/makeinfo.el (makeinfo-compilation-sentinel):
|
||||
* textmodes/makeinfo.el (makeinfo-compilation-sentinel):
|
||||
Display the output buffer in a more intelligent way.
|
||||
|
||||
2001-12-30 Eli Zaretskii <eliz@is.elta.co.il>
|
||||
|
|
@ -493,8 +508,8 @@
|
|||
* international/iso-transl.el (iso-transl-char-map) Eliminate the
|
||||
alias symbols--put the translated sequences here directly.
|
||||
|
||||
* progmodes/cc-mode.el (c-mode-abbrev-table)
|
||||
(c++-mode-abbrev-table, objc-mode-abbrev-table)
|
||||
* progmodes/cc-mode.el (c-mode-abbrev-table)
|
||||
(c++-mode-abbrev-table, objc-mode-abbrev-table)
|
||||
(java-mode-abbrev-table, pike-mode-abbrev-table):
|
||||
Mark all the predefined abbrevs as "system" abbrevs.
|
||||
|
||||
|
|
@ -616,29 +631,29 @@
|
|||
(occur-mode-map): Bind C-o to it.
|
||||
|
||||
2001-12-24 Michael Kifer <kifer@cs.sunysb.edu>
|
||||
|
||||
|
||||
* viper-cmd.el (viper-change-state): Got rid of make-local-hook.
|
||||
(viper-special-read-and-insert-char): Make C-m work right in the r
|
||||
comand.
|
||||
(viper-buffer-search-enable): Fixed format string.
|
||||
|
||||
|
||||
* viper-ex.el (ex-token-alist): Use ex-set-visited-file-name
|
||||
instead of viper-info-on-file.
|
||||
(ex-set-visited-file-name): New function.
|
||||
|
||||
|
||||
* viper.el (viper-emacs-state-mode-list): Added mail-mode.
|
||||
|
||||
|
||||
* ediff-mult.el (ediff-meta-mark-equal-files): Added optional
|
||||
action argument.
|
||||
|
||||
|
||||
* ediff-init.el: Fixed some doc strings.
|
||||
|
||||
|
||||
* ediff-util.el (ediff-after-quit-hook-internal): New variable.
|
||||
Got rid of make-local-hook.
|
||||
|
||||
|
||||
* ediff-wind.el (ediff-setup-control-frame): Got rid of
|
||||
make-local-hook.
|
||||
|
||||
|
||||
2001-12-23 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* term/x-win.el (x-handle-geometry): Put height and width
|
||||
|
|
@ -681,7 +696,7 @@
|
|||
|
||||
* time.el (display-time-load-average-threshold): New variable.
|
||||
(display-time-update): Use it.
|
||||
|
||||
|
||||
These changes allow cycling through past 1, 5 and 15 minutes
|
||||
load-average displayed in the mode-line.
|
||||
|
||||
|
|
@ -725,7 +740,7 @@
|
|||
|
||||
* net/ange-ftp.el (ange-ftp-file-modtime): Use save-match-data.
|
||||
|
||||
* emacs-lisp/easy-mmode.el (define-minor-mode):
|
||||
* emacs-lisp/easy-mmode.el (define-minor-mode):
|
||||
Make no arg by default in an interactive call,
|
||||
so that repeating the command toggles again.
|
||||
|
||||
|
|
@ -847,9 +862,9 @@
|
|||
|
||||
2001-12-19 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* international/mule-cmds.el (describe-language-environment):
|
||||
* international/mule-cmds.el (describe-language-environment):
|
||||
Fix calls to help-xref-button.
|
||||
|
||||
|
||||
2001-12-19 Miles Bader <miles@gnu.org>
|
||||
|
||||
* international/fontset.el: Require `ind-util' when compiling.
|
||||
|
|
@ -967,7 +982,7 @@
|
|||
|
||||
* startup.el (command-line-1): Display startup screen
|
||||
even if there are command line args.
|
||||
Add a note about how to go to editing your files.
|
||||
Add a note about how to go to editing your files.
|
||||
(fancy-splash-head): Add a note about how to go to your files.
|
||||
(fancy-splash-outer-buffer): New variable.
|
||||
(fancy-splash-screens): Bind variable fancy-splash-outer-buffer.
|
||||
|
|
|
|||
|
|
@ -30,13 +30,13 @@
|
|||
;; If it eventually irritates you, try M-x zone-leave-me-alone.
|
||||
|
||||
;; Bored by the zone pyrotechnics? Write your own! Add it to
|
||||
;; `zone-programs'.
|
||||
;; `zone-programs'. See `zone-call' for higher-ordered zoning.
|
||||
|
||||
;; WARNING: Not appropriate for Emacs sessions over modems or
|
||||
;; computers as slow as mine.
|
||||
|
||||
;; THANKS: Christopher Mayer, Scott Flinchbaugh, Rachel Kalmar,
|
||||
;; Max Froumentin.
|
||||
;; Max Froumentin.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -47,6 +47,10 @@
|
|||
(defvar zone-idle 20
|
||||
"*Seconds to idle before zoning out.")
|
||||
|
||||
(defvar zone-timeout nil
|
||||
"*Seconds to timeout the zoning.
|
||||
If nil, don't interrupt for about 1^26 seconds.")
|
||||
|
||||
;; Vector of functions that zone out. `zone' will execute one of
|
||||
;; these functions, randomly chosen. The chosen function is invoked
|
||||
;; in the *zone* buffer, which contains the text of the selected
|
||||
|
|
@ -57,7 +61,7 @@
|
|||
zone-pgm-jitter
|
||||
zone-pgm-putz-with-case
|
||||
zone-pgm-dissolve
|
||||
;; zone-pgm-explode
|
||||
;; zone-pgm-explode
|
||||
zone-pgm-whack-chars
|
||||
zone-pgm-rotate
|
||||
zone-pgm-rotate-LR-lockstep
|
||||
|
|
@ -70,12 +74,60 @@
|
|||
zone-pgm-martini-swan-dive
|
||||
zone-pgm-paragraph-spaz
|
||||
zone-pgm-stress
|
||||
zone-pgm-stress-destress
|
||||
])
|
||||
|
||||
(defmacro zone-orig (&rest body)
|
||||
`(with-current-buffer (get 'zone 'orig-buffer)
|
||||
,@body))
|
||||
|
||||
(defmacro zone-hiding-modeline (&rest body)
|
||||
`(let (bg mode-line-fg mode-line-bg mode-line-box)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(when (and (= 0 (get 'zone 'modeline-hidden-level))
|
||||
(display-color-p))
|
||||
(setq bg (face-background 'default)
|
||||
mode-line-box (face-attribute 'mode-line :box)
|
||||
mode-line-fg (face-attribute 'mode-line :foreground)
|
||||
mode-line-bg (face-attribute 'mode-line :background))
|
||||
(set-face-attribute 'mode-line nil
|
||||
:foreground bg
|
||||
:background bg
|
||||
:box nil))
|
||||
(put 'zone 'modeline-hidden-level
|
||||
(1+ (get 'zone 'modeline-hidden-level)))
|
||||
,@body)
|
||||
(put 'zone 'modeline-hidden-level
|
||||
(1- (get 'zone 'modeline-hidden-level)))
|
||||
(when (and (> 1 (get 'zone 'modeline-hidden-level))
|
||||
mode-line-fg)
|
||||
(set-face-attribute 'mode-line nil
|
||||
:foreground mode-line-fg
|
||||
:background mode-line-bg
|
||||
:box mode-line-box)))))
|
||||
|
||||
(defun zone-call (program &optional timeout)
|
||||
"Call PROGRAM in a zoned way.
|
||||
If PROGRAM is a function, call it, interrupting after the amount
|
||||
of time in seconds specified by optional arg TIMEOUT, or `zone-timeout'
|
||||
if unspecified, q.v.
|
||||
PROGRAM can also be a list of elements, which are interpreted like so:
|
||||
If the element is a function or a list of a function and a number,
|
||||
apply `zone-call' recursively."
|
||||
(cond ((functionp program)
|
||||
(with-timeout ((or timeout zone-timeout (ash 1 26)))
|
||||
(funcall program)))
|
||||
((listp program)
|
||||
(mapcar (lambda (elem)
|
||||
(cond ((functionp elem) (zone-call elem))
|
||||
((and (listp elem)
|
||||
(functionp (car elem))
|
||||
(numberp (cadr elem)))
|
||||
(apply 'zone-call elem))
|
||||
(t (error "bad `zone-call' elem:" elem))))
|
||||
program))))
|
||||
|
||||
;;;###autoload
|
||||
(defun zone ()
|
||||
"Zone out, completely."
|
||||
|
|
@ -89,6 +141,7 @@
|
|||
(wp (1+ (- (window-point (selected-window))
|
||||
(window-start)))))
|
||||
(put 'zone 'orig-buffer (current-buffer))
|
||||
(put 'zone 'modeline-hidden-level 0)
|
||||
(set-buffer outbuf)
|
||||
(setq mode-name "Zone")
|
||||
(erase-buffer)
|
||||
|
|
@ -112,7 +165,7 @@
|
|||
;; input before zoning out.
|
||||
(if (input-pending-p)
|
||||
(discard-input))
|
||||
(funcall pgm)
|
||||
(zone-call pgm)
|
||||
(message "Zoning...sorry"))
|
||||
(error
|
||||
(while (not (input-pending-p))
|
||||
|
|
@ -149,10 +202,10 @@
|
|||
|
||||
(defun zone-shift-up ()
|
||||
(let* ((b (point))
|
||||
(e (progn
|
||||
(end-of-line)
|
||||
(if (looking-at "\n") (1+ (point)) (point))))
|
||||
(s (buffer-substring b e)))
|
||||
(e (progn
|
||||
(end-of-line)
|
||||
(if (looking-at "\n") (1+ (point)) (point))))
|
||||
(s (buffer-substring b e)))
|
||||
(delete-region b e)
|
||||
(goto-char (point-max))
|
||||
(insert s)))
|
||||
|
|
@ -162,10 +215,10 @@
|
|||
(forward-line -1)
|
||||
(beginning-of-line)
|
||||
(let* ((b (point))
|
||||
(e (progn
|
||||
(end-of-line)
|
||||
(if (looking-at "\n") (1+ (point)) (point))))
|
||||
(s (buffer-substring b e)))
|
||||
(e (progn
|
||||
(end-of-line)
|
||||
(if (looking-at "\n") (1+ (point)) (point))))
|
||||
(s (buffer-substring b e)))
|
||||
(delete-region b e)
|
||||
(goto-char (point-min))
|
||||
(insert s)))
|
||||
|
|
@ -173,20 +226,20 @@
|
|||
(defun zone-shift-left ()
|
||||
(while (not (eobp))
|
||||
(or (eolp)
|
||||
(let ((c (following-char)))
|
||||
(delete-char 1)
|
||||
(end-of-line)
|
||||
(insert c)))
|
||||
(let ((c (following-char)))
|
||||
(delete-char 1)
|
||||
(end-of-line)
|
||||
(insert c)))
|
||||
(forward-line 1)))
|
||||
|
||||
(defun zone-shift-right ()
|
||||
(while (not (eobp))
|
||||
(end-of-line)
|
||||
(or (bolp)
|
||||
(let ((c (preceding-char)))
|
||||
(delete-backward-char 1)
|
||||
(beginning-of-line)
|
||||
(insert c)))
|
||||
(let ((c (preceding-char)))
|
||||
(delete-backward-char 1)
|
||||
(beginning-of-line)
|
||||
(insert c)))
|
||||
(forward-line 1)))
|
||||
|
||||
(defun zone-pgm-jitter ()
|
||||
|
|
@ -216,14 +269,14 @@
|
|||
(let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl))))
|
||||
(while (not (input-pending-p))
|
||||
(let ((i 48))
|
||||
(while (< i 122)
|
||||
(aset tbl i (+ 48 (random (- 123 48))))
|
||||
(setq i (1+ i)))
|
||||
(translate-region (point-min) (point-max) tbl)
|
||||
(sit-for 0 2)))))
|
||||
(while (< i 122)
|
||||
(aset tbl i (+ 48 (random (- 123 48))))
|
||||
(setq i (1+ i)))
|
||||
(translate-region (point-min) (point-max) tbl)
|
||||
(sit-for 0 2)))))
|
||||
|
||||
(put 'zone-pgm-whack-chars 'wc-tbl
|
||||
(let ((tbl (make-vector 128 ?x))
|
||||
(let ((tbl (make-string 128 ?x))
|
||||
(i 0))
|
||||
(while (< i 128)
|
||||
(aset tbl i i)
|
||||
|
|
@ -237,17 +290,17 @@
|
|||
(while working
|
||||
(setq working nil)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (looking-at "[^(){}\n\t ]")
|
||||
(let ((n (random 5)))
|
||||
(if (not (= n 0))
|
||||
(progn
|
||||
(setq working t)
|
||||
(forward-char 1))
|
||||
(delete-char 1)
|
||||
(insert " ")))
|
||||
(forward-char 1))))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (looking-at "[^(){}\n\t ]")
|
||||
(let ((n (random 5)))
|
||||
(if (not (= n 0))
|
||||
(progn
|
||||
(setq working t)
|
||||
(forward-char 1))
|
||||
(delete-char 1)
|
||||
(insert " ")))
|
||||
(forward-char 1))))
|
||||
(sit-for 0 2))))
|
||||
|
||||
(defun zone-pgm-dissolve ()
|
||||
|
|
@ -261,14 +314,14 @@
|
|||
(let ((i 0))
|
||||
(while (< i 20)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (looking-at "[^*\n\t ]")
|
||||
(let ((n (random 5)))
|
||||
(if (not (= n 0))
|
||||
(forward-char 1))
|
||||
(insert " ")))
|
||||
(forward-char 1)))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (looking-at "[^*\n\t ]")
|
||||
(let ((n (random 5)))
|
||||
(if (not (= n 0))
|
||||
(forward-char 1))
|
||||
(insert " ")))
|
||||
(forward-char 1)))
|
||||
(setq i (1+ i))
|
||||
(sit-for 0 2)))
|
||||
(zone-pgm-jitter))
|
||||
|
|
@ -285,25 +338,25 @@
|
|||
;; less interesting effect than you might imagine.
|
||||
(defun zone-pgm-2nd-putz-with-case ()
|
||||
(let ((tbl (make-string 128 ?x))
|
||||
(i 0))
|
||||
(i 0))
|
||||
(while (< i 128)
|
||||
(aset tbl i i)
|
||||
(setq i (1+ i)))
|
||||
(while (not (input-pending-p))
|
||||
(setq i ?a)
|
||||
(while (<= i ?z)
|
||||
(aset tbl i
|
||||
(if (zerop (random 5))
|
||||
(upcase i)
|
||||
(downcase i)))
|
||||
(setq i (+ i (1+ (random 5)))))
|
||||
(aset tbl i
|
||||
(if (zerop (random 5))
|
||||
(upcase i)
|
||||
(downcase i)))
|
||||
(setq i (+ i (1+ (random 5)))))
|
||||
(setq i ?A)
|
||||
(while (<= i ?z)
|
||||
(aset tbl i
|
||||
(if (zerop (random 5))
|
||||
(downcase i)
|
||||
(upcase i)))
|
||||
(setq i (+ i (1+ (random 5)))))
|
||||
(aset tbl i
|
||||
(if (zerop (random 5))
|
||||
(downcase i)
|
||||
(upcase i)))
|
||||
(setq i (+ i (1+ (random 5)))))
|
||||
(translate-region (point-min) (point-max) tbl)
|
||||
(sit-for 0 2))))
|
||||
|
||||
|
|
@ -311,18 +364,18 @@
|
|||
(goto-char (point-min))
|
||||
(while (not (input-pending-p))
|
||||
(let ((np (+ 2 (random 5)))
|
||||
(pm (point-max)))
|
||||
(pm (point-max)))
|
||||
(while (< np pm)
|
||||
(goto-char np)
|
||||
(goto-char np)
|
||||
(let ((prec (preceding-char))
|
||||
(props (text-properties-at (1- (point)))))
|
||||
(insert (if (zerop (random 2))
|
||||
(upcase prec)
|
||||
(downcase prec)))
|
||||
(set-text-properties (1- (point)) (point) props))
|
||||
(backward-char 2)
|
||||
(delete-char 1)
|
||||
(setq np (+ np (1+ (random 5))))))
|
||||
(backward-char 2)
|
||||
(delete-char 1)
|
||||
(setq np (+ np (1+ (random 5))))))
|
||||
(goto-char (point-min))
|
||||
(sit-for 0 2)))
|
||||
|
||||
|
|
@ -334,9 +387,9 @@
|
|||
(save-excursion
|
||||
(goto-char (window-start))
|
||||
(while (< (point) (window-end))
|
||||
(when (looking-at "[\t ]*\\([^\n]+\\)")
|
||||
(setq ret (cons (cons (match-beginning 1) (match-end 1)) ret)))
|
||||
(forward-line 1)))
|
||||
(when (looking-at "[\t ]*\\([^\n]+\\)")
|
||||
(setq ret (cons (cons (match-beginning 1) (match-end 1)) ret)))
|
||||
(forward-line 1)))
|
||||
ret))
|
||||
|
||||
(defun zone-pgm-rotate (&optional random-style)
|
||||
|
|
@ -413,7 +466,7 @@
|
|||
(defun zone-fall-through-ws (c col wend)
|
||||
(let ((fall-p nil) ; todo: move outward
|
||||
(wait 0.15)
|
||||
(o (point)) ; for terminals w/o cursor hiding
|
||||
(o (point)) ; for terminals w/o cursor hiding
|
||||
(p (point)))
|
||||
(while (progn
|
||||
(forward-line 1)
|
||||
|
|
@ -447,15 +500,14 @@
|
|||
(delete-char (- ww cc))))
|
||||
(unless (eobp)
|
||||
(forward-char 1)))
|
||||
;; what the hell is going on here?
|
||||
;; pad ws past bottom of screen
|
||||
(let ((nl (- wh (count-lines (point-min) (point)))))
|
||||
(when (> nl 0)
|
||||
(let ((line (concat (make-string (1- ww) ? ) "\n")))
|
||||
(do ((i 0 (1+ i)))
|
||||
((= i nl))
|
||||
(insert line)))))
|
||||
;;
|
||||
(catch 'done ;; ugh
|
||||
(catch 'done
|
||||
(while (not (input-pending-p))
|
||||
(goto-char (point-min))
|
||||
(sit-for 0)
|
||||
|
|
@ -526,48 +578,50 @@
|
|||
|
||||
(defun zone-pgm-stress ()
|
||||
(goto-char (point-min))
|
||||
(let (lines bg mode-line-fg mode-line-bg mode-line-box)
|
||||
(let (lines)
|
||||
(while (< (point) (point-max))
|
||||
(let ((p (point)))
|
||||
(forward-line 1)
|
||||
(setq lines (cons (buffer-substring p (point)) lines))))
|
||||
(sit-for 5)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(when (display-color-p)
|
||||
(setq bg (face-background 'default)
|
||||
mode-line-box (face-attribute 'mode-line :box)
|
||||
mode-line-fg (face-attribute 'mode-line :foreground)
|
||||
mode-line-bg (face-attribute 'mode-line :background))
|
||||
(set-face-attribute 'mode-line nil
|
||||
:foreground bg
|
||||
:background bg
|
||||
:box nil))
|
||||
(zone-hiding-modeline
|
||||
(let ((msg "Zoning... (zone-pgm-stress)"))
|
||||
(while (not (string= msg ""))
|
||||
(message (setq msg (substring msg 1)))
|
||||
(sit-for 0.05)))
|
||||
(while (not (input-pending-p))
|
||||
(when (< 50 (random 100))
|
||||
(goto-char (point-max))
|
||||
(forward-line -1)
|
||||
(let ((kill-whole-line t))
|
||||
(kill-line))
|
||||
(goto-char (point-min))
|
||||
(insert (nth (random (length lines)) lines)))
|
||||
(message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))
|
||||
(sit-for 0.1)))))
|
||||
|
||||
(let ((msg "Zoning... (zone-pgm-stress)"))
|
||||
(while (not (string= msg ""))
|
||||
(message (setq msg (substring msg 1)))
|
||||
(sit-for 0.05)))
|
||||
|
||||
(while (not (input-pending-p))
|
||||
(when (< 50 (random 100))
|
||||
(goto-char (point-max))
|
||||
(forward-line -1)
|
||||
(unless (eobp)
|
||||
(let ((kill-whole-line t))
|
||||
(kill-line)))
|
||||
(goto-char (point-min))
|
||||
(when lines
|
||||
(insert (nth (random (1- (length lines))) lines))))
|
||||
(message (concat (make-string (random (- (frame-width) 5)) ? )
|
||||
"grrr"))
|
||||
(sit-for 0.1)))
|
||||
(when mode-line-fg
|
||||
(set-face-attribute 'mode-line nil
|
||||
:foreground mode-line-fg
|
||||
:background mode-line-bg
|
||||
:box mode-line-box)))))
|
||||
;;;; zone-pgm-stress-destress
|
||||
|
||||
(defun zone-pgm-stress-destress ()
|
||||
(zone-call 'zone-pgm-stress 25)
|
||||
(zone-hiding-modeline
|
||||
(sit-for 3)
|
||||
(erase-buffer)
|
||||
(sit-for 3)
|
||||
(insert-buffer "*Messages*")
|
||||
(message "")
|
||||
(goto-char (point-max))
|
||||
(recenter -1)
|
||||
(sit-for 3)
|
||||
(delete-region (point-min) (window-start))
|
||||
(message "hey why stress out anyway?")
|
||||
(zone-call '((zone-pgm-rotate 30)
|
||||
(zone-pgm-whack-chars 10)
|
||||
zone-pgm-drip))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;
|
||||
(provide 'zone)
|
||||
|
||||
;;; zone.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue