+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.
2000-08-30.
2002-01-08 Michael Kifer <kifer@cs.stonybrook.edu>
-
+
* ediff-hook.el: added an autoload cookie.
-
+
2002-01-08 Pavel Jan
\e,Bm
\e(Bk <Pavel@Janik.cz>
* net/eudcb-ph.el, net/ldap.el: New maintainer. New e-mail
(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
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.
(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
(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.
(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
* 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.
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.
* 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.
* 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>
* 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.
(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
* 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.
* 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.
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.
* 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.
;; 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:
(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
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
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."
(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)
;; input before zoning out.
(if (input-pending-p)
(discard-input))
- (funcall pgm)
+ (zone-call pgm)
(message "Zoning...sorry"))
(error
(while (not (input-pending-p))
(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)))
(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)))
(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 ()
(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)
(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 ()
(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))
;; 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))))
(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)))
(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)
(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)
(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)
(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))
-
- (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-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)))))
+
+
+;;;; 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
projects / emacs.git / commitdiff