summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lisp/mail/mailalias.el157
-rw-r--r--lisp/play/hanoi.el192
-rw-r--r--lisp/play/life.el276
3 files changed, 625 insertions, 0 deletions
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
new file mode 100644
index 00000000000..7fc41289a15
--- /dev/null
+++ b/lisp/mail/mailalias.el
@@ -0,0 +1,157 @@
+;; Expand mailing address aliases defined in ~/.mailrc.
+;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; Called from sendmail-send-it, or similar functions,
+;; only if some mail aliases are defined.
+(defun expand-mail-aliases (beg end &optional exclude)
+ "Expand all mail aliases in suitable header fields found between BEG and END.
+Suitable header fields are To, Cc and Bcc. Optional 2nd arg EXCLUDE may be a
+regular expression defining text to be removed from alias expansions."
+ (if (eq mail-aliases t)
+ (progn (setq mail-aliases nil) (build-mail-aliases)))
+ (goto-char beg)
+ (setq end (set-marker (make-marker) end))
+ (let ((case-fold-search nil))
+ (while (let ((case-fold-search t))
+ (re-search-forward "^\\(to\\|cc\\|bcc\\):" end t))
+ (skip-chars-forward " \t")
+ (let ((beg1 (point))
+ end1 pos epos seplen
+ ;; DISABLED-ALIASES records aliases temporarily disabled
+ ;; while we scan text that resulted from expanding those aliases.
+ ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
+ ;; is where to reenable the alias (expressed as number of chars
+ ;; counting from END1).
+ (disabled-aliases nil))
+ (re-search-forward "^[^ \t]" end 'move)
+ (beginning-of-line)
+ (skip-chars-backward " \t\n")
+ (setq end1 (point-marker))
+ (goto-char beg1)
+ (while (< (point) end1)
+ (setq pos (point))
+ ;; Reenable any aliases which were disabled for ranges
+ ;; that we have passed out of.
+ (while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases)))))
+ (setq disabled-aliases (cdr disabled-aliases)))
+ ;; EPOS gets position of end of next name;
+ ;; SEPLEN gets length of whitespace&separator that follows it.
+ (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
+ (setq epos (match-beginning 0)
+ seplen (- (point) epos))
+ (setq epos (marker-position end1) seplen 0))
+ (let (translation
+ (string (buffer-substring pos epos)))
+ (if (and (not (assoc string disabled-aliases))
+ (setq translation
+ (cdr (assoc string mail-aliases))))
+ (progn
+ ;; This name is an alias. Disable it.
+ (setq disabled-aliases (cons (cons string (- end1 epos))
+ disabled-aliases))
+ ;; Replace the alias with its expansion
+ ;; then rescan the expansion for more aliases.
+ (goto-char pos)
+ (insert translation)
+ (if exclude
+ (let ((regexp
+ (concat "\\b\\(" exclude "\\)\\b"))
+ (end (point-marker)))
+ (goto-char pos)
+ (while (re-search-forward regexp end t)
+ (replace-match ""))
+ (goto-char end)))
+ (delete-region (point) (+ (point) (- epos pos)))
+ (goto-char pos))
+ ;; Name is not an alias. Skip to start of next name.
+ (goto-char epos)
+ (forward-char seplen))))
+ (set-marker end1 nil)))
+ (set-marker end nil)))
+
+;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
+(defun build-mail-aliases (&optional file)
+ "Read mail aliases from ~/.mailrc and set mail-aliases."
+ (setq file (expand-file-name (or file "~/.mailrc")))
+ (let ((buffer nil)
+ (obuf (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq buffer (generate-new-buffer "mailrc"))
+ (buffer-disable-undo buffer)
+ (set-buffer buffer)
+ (cond ((get-file-buffer file)
+ (insert (save-excursion
+ (set-buffer (get-file-buffer file))
+ (buffer-substring (point-min) (point-max)))))
+ ((not (file-exists-p file)))
+ (t (insert-file-contents file)))
+ ;; Don't lose if no final newline.
+ (goto-char (point-max))
+ (or (eq (preceding-char) ?\n) (newline))
+ (goto-char (point-min))
+ ;; handle "\\\n" continuation lines
+ (while (not (eobp))
+ (end-of-line)
+ (if (= (preceding-char) ?\\)
+ (progn (delete-char -1) (delete-char 1) (insert ?\ ))
+ (forward-char 1)))
+ (goto-char (point-min))
+ (while (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t)
+ (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t))
+ (re-search-forward "[^ \t]+")
+ (let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
+ (start (progn (skip-chars-forward " \t") (point))))
+ (end-of-line)
+ (define-mail-alias
+ name
+ (buffer-substring start (point)))))
+ mail-aliases)
+ (if buffer (kill-buffer buffer))
+ (set-buffer obuf))))
+
+;; Always autoloadable in case the user wants to define aliases
+;; interactively or in .emacs.
+(defun define-mail-alias (name definition)
+ "Define NAME as a mail-alias that translates to DEFINITION.
+This means that sending a message to NAME will actually send to DEFINITION.
+DEFINITION can be one or more mail addresses separated by commas."
+ (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
+ ;; Read the defaults first, if we have not done so.
+ (if (eq mail-aliases t)
+ (progn
+ (setq mail-aliases nil)
+ (if (file-exists-p "~/.mailrc")
+ (build-mail-aliases))))
+ (let (tem)
+ ;; ~/.mailrc contains addresses separated by spaces.
+ ;; mailers should expect addresses separated by commas.
+ (while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
+ (if (= (match-end 0) (length definition))
+ (setq definition (substring definition 0 (1+ tem)))
+ (setq definition (concat (substring definition
+ 0 (1+ tem))
+ ", "
+ (substring definition (match-end 0))))
+ (setq tem (+ 3 tem))))
+ (setq tem (assoc name mail-aliases))
+ (if tem
+ (rplacd tem definition)
+ (setq mail-aliases (cons (cons name definition) mail-aliases)))))
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
new file mode 100644
index 00000000000..8884f6cb37b
--- /dev/null
+++ b/lisp/play/hanoi.el
@@ -0,0 +1,192 @@
+;
+; hanoi - towers of hanoi in GNUmacs
+;
+; Author (a) 1985, Damon Anton Permezel
+;
+
+;;;
+;;; hanoi-topos - direct cursor addressing
+;;;
+(defun hanoi-topos (row col)
+ (goto-line row)
+ (beginning-of-line)
+ (forward-char col))
+
+;;;
+;;; hanoi - user callable Towers of Hanoi
+;;;
+(defun hanoi (nrings)
+ "Towers of Hanoi diversion. Argument is number of rings."
+ (interactive
+ (list (if (null current-prefix-arg)
+ 3
+ (prefix-numeric-value current-prefix-arg))))
+ (if (<= nrings 0) (error "Negative number of rings"))
+ (let (pole-spacing
+ floor-row
+ fly-row
+ (window-height (window-height (selected-window)))
+ (window-width (window-width (selected-window))))
+ (let ((h (+ nrings 2))
+ (w (+ (* (1- nrings) 6) 2 5)))
+ (if (not (and (>= window-width h)
+ (> window-width w)))
+ (progn
+ (delete-other-windows)
+ (if (not (and (>= (setq window-height
+ (window-height (selected-window))) h)
+ (> (setq window-width
+ (window-width (selected-window))) w)))
+ (error "Screen is too small (need at least %dx%d)" w h))))
+ (setq pole-spacing (/ window-width 6))
+ (if (not (zerop (logand pole-spacing 1)))
+ ;; must be even
+ (setq pole-spacing (1+ pole-spacing)))
+ (setq floor-row (if (> (- window-height 3) h)
+ (- window-height 3) window-height)))
+ (let ((fly-row (- floor-row nrings 1))
+ ;; pole: column . fill height
+ (pole-1 (cons pole-spacing floor-row))
+ (pole-2 (cons (* 3 pole-spacing) floor-row))
+ (pole-3 (cons (* 5 pole-spacing) floor-row))
+ (rings (make-vector nrings nil)))
+ ;; construct the ring list
+ (let ((i 0))
+ (while (< i nrings)
+ ;; ring: [pole-number string empty-string]
+ (aset rings i (vector nil
+ (make-string (+ i i 3) (+ ?0 i))
+ (make-string (+ i i 3) ?\ )))
+ (setq i (1+ i))))
+ ;;
+ ;; init the screen
+ ;;
+ (switch-to-buffer "*Hanoi*")
+ (setq buffer-read-only nil)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (let ((i 0))
+ (while (< i floor-row)
+ (setq i (1+ i))
+ (insert-char ?\ (1- window-width))
+ (insert ?\n)))
+ (insert-char ?= (1- window-width))
+
+ (let ((n 1))
+ (while (< n 6)
+ (hanoi-topos fly-row (* n pole-spacing))
+ (setq n (+ n 2))
+ (let ((i fly-row))
+ (while (< i floor-row)
+ (setq i (1+ i))
+ (next-line 1)
+ (insert ?\|)
+ (delete-char 1)
+ (backward-char 1)))))
+ ;(sit-for 0)
+ ;;
+ ;; now draw the rings in their initial positions
+ ;;
+ (let ((i 0)
+ ring)
+ (while (< i nrings)
+ (setq ring (aref rings (- nrings 1 i)))
+ (aset ring 0 (- floor-row i))
+ (hanoi-topos (cdr pole-1)
+ (- (car pole-1) (- nrings i)))
+ (hanoi-draw-ring ring t nil)
+ (setcdr pole-1 (1- (cdr pole-1)))
+ (setq i (1+ i))))
+ (setq buffer-read-only t)
+ (sit-for 0)
+ ;;
+ ;; do it!
+ ;;
+ (hanoi0 (1- nrings) pole-1 pole-2 pole-3)
+ (goto-char (point-min))
+ (message "Done")
+ (setq buffer-read-only t)
+ (set-buffer-modified-p (buffer-modified-p))
+ (sit-for 0))))
+
+;;;
+;;; hanoi0 - work horse of hanoi
+;;;
+(defun hanoi0 (n from to work)
+ (cond ((input-pending-p)
+ (signal 'quit (list "I can tell you've had enough")))
+ ((< n 0))
+ (t
+ (hanoi0 (1- n) from work to)
+ (hanoi-move-ring n from to)
+ (hanoi0 (1- n) work to from))))
+
+;;;
+;;; hanoi-move-ring - move ring 'n' from 'from' to 'to'
+;;;
+;;;
+(defun hanoi-move-ring (n from to)
+ (let ((ring (aref rings n)) ; ring <- ring: (ring# . row)
+ (buffer-read-only nil))
+ (let ((row (aref ring 0)) ; row <- row ring is on
+ (col (- (car from) n 1)) ; col <- left edge of ring
+ (dst-col (- (car to) n 1)) ; dst-col <- dest col for left edge
+ (dst-row (cdr to))) ; dst-row <- dest row for ring
+ (hanoi-topos row col)
+ (while (> row fly-row) ; move up to the fly row
+ (hanoi-draw-ring ring nil t) ; blank out ring
+ (previous-line 1) ; move up a line
+ (hanoi-draw-ring ring t nil) ; redraw
+ (sit-for 0)
+ (setq row (1- row)))
+ (setcdr from (1+ (cdr from))) ; adjust top row
+ ;;
+ ;; fly the ring over to the right pole
+ ;;
+ (while (not (equal dst-col col))
+ (cond ((> dst-col col) ; dst-col > col: right shift
+ (end-of-line 1)
+ (delete-backward-char 2)
+ (beginning-of-line 1)
+ (insert ?\ ?\ )
+ (sit-for 0)
+ (setq col (1+ (1+ col))))
+ ((< dst-col col) ; dst-col < col: left shift
+ (beginning-of-line 1)
+ (delete-char 2)
+ (end-of-line 1)
+ (insert ?\ ?\ )
+ (sit-for 0)
+ (setq col (1- (1- col))))))
+ ;;
+ ;; let the ring float down
+ ;;
+ (hanoi-topos fly-row dst-col)
+ (while (< row dst-row) ; move down to the dest row
+ (hanoi-draw-ring ring nil (> row fly-row)) ; blank out ring
+ (next-line 1) ; move down a line
+ (hanoi-draw-ring ring t nil) ; redraw ring
+ (sit-for 0)
+ (setq row (1+ row)))
+ (aset ring 0 dst-row)
+ (setcdr to (1- (cdr to)))))) ; adjust top row
+
+;;;
+;;; draw-ring - draw the ring at point, leave point unchanged
+;;;
+;;; Input:
+;;; ring
+;;; f1 - flag: t -> draw, nil -> erase
+;;; f2 - flag: t -> erasing and need to draw ?\|
+;;;
+(defun hanoi-draw-ring (ring f1 f2)
+ (save-excursion
+ (let* ((string (if f1 (aref ring 1) (aref ring 2)))
+ (len (length string)))
+ (delete-char len)
+ (insert string)
+ (if f2
+ (progn
+ (backward-char (/ (+ len 1) 2))
+ (delete-char 1) (insert ?\|))))))
+
diff --git a/lisp/play/life.el b/lisp/play/life.el
new file mode 100644
index 00000000000..e216dbf0b4e
--- /dev/null
+++ b/lisp/play/life.el
@@ -0,0 +1,276 @@
+;; Conway's `Life' for GNU Emacs
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+;; Contributed by Kyle Jones, talos!kjones@uunet.uu.net
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(provide 'life)
+
+(defconst life-patterns
+ [("@@@" " @@" "@@@")
+ ("@@@ @@@" "@@ @@ " "@@@ @@@")
+ ("@@@ @@@" "@@ @@" "@@@ @@@")
+ ("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@")
+ ("@@@@@@@@@@")
+ (" @@@@@@@@@@ "
+ " @@@@@@@@@@ "
+ " @@@@@@@@@@ "
+ "@@@@@@@@@@ "
+ "@@@@@@@@@@ ")
+ ("@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@")
+ ("@ @" "@ @" "@ @"
+ "@ @" "@ @" "@ @"
+ "@ @" "@ @" "@ @"
+ "@ @" "@ @" "@ @"
+ "@ @" "@ @" "@ @")
+ ("@@ " " @@ " " @@ "
+ " @@ " " @@ " " @@ "
+ " @@ " " @@ " " @@ "
+ " @@ " " @@ " " @@ "
+ " @@ " " @@ " " @@ "
+ " @@")
+ ("@@@@@@@@@" "@ @ @" "@ @@@@@ @" "@ @ @ @" "@@@ @@@"
+ "@ @ @ @" "@ @@@@@ @" "@ @ @" "@@@@@@@@@")]
+ "Vector of rectangles containing some Life startup patterns.")
+
+;; Macros are used macros for manifest constants instead of variables
+;; because the compiler will convert them to constants, which should
+;; eval faster than symbols.
+;;
+;; The (require) wrapping forces the compiler to eval these macros at
+;; compile time. This would not be necessary if we did not use macros
+;; inside of macros, which the compiler doesn't seem to check for.
+;;
+;; Don't change any of the life-* macro constants unless you thoroughly
+;; understand the `life-grim-reaper' function.
+(require
+ (progn
+ (defmacro life-life-char () ?@)
+ (defmacro life-death-char () (1+ (life-life-char)))
+ (defmacro life-birth-char () 3)
+ (defmacro life-void-char () ?\ )
+
+ (defmacro life-life-string () (char-to-string (life-life-char)))
+ (defmacro life-death-string () (char-to-string (life-death-char)))
+ (defmacro life-birth-string () (char-to-string (life-birth-char)))
+ (defmacro life-void-string () (char-to-string (life-void-char)))
+ (defmacro life-not-void-regexp () (concat "[^" (life-void-string) "\n]"))
+
+ ;; try to optimize the (goto-char (point-min)) & (goto-char (point-max))
+ ;; idioms. This depends on goto-char's not griping if we underrshoot
+ ;; or overshoot beginning or end of buffer.
+ (defmacro goto-beginning-of-buffer () '(goto-char 1))
+ (defmacro maxint () (lsh (lsh (lognot 0) 1) -1))
+ (defmacro goto-end-of-buffer () '(goto-char (maxint)))
+
+ (defmacro increment (variable) (list 'setq variable (list '1+ variable)))
+ 'life))
+
+;; list of numbers that tell how many characters to move to get to
+;; each of a cell's eight neighbors.
+(defconst life-neighbor-deltas nil)
+
+;; window display always starts here. Easier to deal with than
+;; (scroll-up) and (scroll-down) when trying to center the display.
+(defconst life-window-start nil)
+
+;; For mode line
+(defconst life-current-generation nil)
+;; Sadly, mode-line-format won't display numbers.
+(defconst life-generation-string nil)
+
+(defun abs (n) (if (< n 0) (- n) n))
+
+(defun life (&optional sleeptime)
+ "Run Conway's Life simulation.
+The starting pattern is randomly selected. Prefix arg (optional first arg
+non-nil from a program) is the number of seconds to sleep between
+generations (this defaults to 1)."
+ (interactive "p")
+ (or sleeptime (setq sleeptime 1))
+ (life-setup)
+ (life-display-generation sleeptime)
+ (while t
+ (let ((inhibit-quit t))
+ (life-grim-reaper)
+ (life-expand-plane-if-needed)
+ (life-increment-generation)
+ (life-display-generation sleeptime))))
+
+(fset 'life-mode 'life)
+(put 'life-mode 'mode-class 'special)
+
+(random t)
+
+(defun life-setup ()
+ (let (n)
+ (switch-to-buffer (get-buffer-create "*Life*") t)
+ (erase-buffer)
+ (kill-all-local-variables)
+ (setq case-fold-search nil
+ mode-name "Life"
+ major-mode 'life-mode
+ truncate-lines t
+ life-current-generation 0
+ life-generation-string "0"
+ mode-line-buffer-identification '("Life: generation "
+ life-generation-string)
+ fill-column (1- (window-width))
+ life-window-start 1)
+ (buffer-disable-undo (current-buffer))
+ ;; stuff in the random pattern
+ (life-insert-random-pattern)
+ ;; make sure (life-life-char) is used throughout
+ (goto-beginning-of-buffer)
+ (while (re-search-forward (life-not-void-regexp) nil t)
+ (replace-match (life-life-string) t t))
+ ;; center the pattern horizontally
+ (goto-beginning-of-buffer)
+ (setq n (/ (- fill-column (save-excursion (end-of-line) (point))) 2))
+ (while (not (eobp))
+ (indent-to n)
+ (forward-line))
+ ;; center the pattern vertically
+ (setq n (/ (- (1- (window-height))
+ (count-lines (point-min) (point-max)))
+ 2))
+ (goto-beginning-of-buffer)
+ (newline n)
+ (goto-end-of-buffer)
+ (newline n)
+ ;; pad lines out to fill-column
+ (goto-beginning-of-buffer)
+ (while (not (eobp))
+ (end-of-line)
+ (indent-to fill-column)
+ (move-to-column fill-column)
+ (delete-region (point) (progn (end-of-line) (point)))
+ (forward-line))
+ ;; expand tabs to spaces
+ (untabify (point-min) (point-max))
+ ;; before starting be sure the automaton has room to grow
+ (life-expand-plane-if-needed)
+ ;; compute initial neighbor deltas
+ (life-compute-neighbor-deltas)))
+
+(defun life-compute-neighbor-deltas ()
+ (setq life-neighbor-deltas
+ (list -1 (- fill-column)
+ (- (1+ fill-column)) (- (+ 2 fill-column))
+ 1 fill-column (1+ fill-column)
+ (+ 2 fill-column))))
+
+(defun life-insert-random-pattern ()
+ (insert-rectangle
+ (elt life-patterns (% (abs (random)) (length life-patterns))))
+ (insert ?\n))
+
+(defun life-increment-generation ()
+ (increment life-current-generation)
+ (setq life-generation-string (int-to-string life-current-generation)))
+
+(defun life-grim-reaper ()
+ ;; Clear the match information. Later we check to see if it
+ ;; is still clear, if so then all the cells have died.
+ (store-match-data nil)
+ (goto-beginning-of-buffer)
+ ;; For speed declare all local variable outside the loop.
+ (let (point char pivot living-neighbors list)
+ (while (search-forward (life-life-string) nil t)
+ (setq list life-neighbor-deltas
+ living-neighbors 0
+ pivot (1- (point)))
+ (while list
+ (setq point (+ pivot (car list))
+ char (char-after point))
+ (cond ((eq char (life-void-char))
+ (subst-char-in-region point (1+ point)
+ (life-void-char) 1 t))
+ ((< char 3)
+ (subst-char-in-region point (1+ point) char (1+ char) t))
+ ((< char 9)
+ (subst-char-in-region point (1+ point) char 9 t))
+ ((>= char (life-life-char))
+ (increment living-neighbors)))
+ (setq list (cdr list)))
+ (if (memq living-neighbors '(2 3))
+ ()
+ (subst-char-in-region pivot (1+ pivot)
+ (life-life-char) (life-death-char) t))))
+ (if (null (match-beginning 0))
+ (life-extinct-quit))
+ (subst-char-in-region 1 (point-max) 9 (life-void-char) t)
+ (subst-char-in-region 1 (point-max) 1 (life-void-char) t)
+ (subst-char-in-region 1 (point-max) 2 (life-void-char) t)
+ (subst-char-in-region 1 (point-max) (life-birth-char) (life-life-char) t)
+ (subst-char-in-region 1 (point-max) (life-death-char) (life-void-char) t))
+
+(defun life-expand-plane-if-needed ()
+ (catch 'done
+ (goto-beginning-of-buffer)
+ (while (not (eobp))
+ ;; check for life at beginning or end of line. If found at
+ ;; either end, expand at both ends,
+ (cond ((or (eq (following-char) (life-life-char))
+ (eq (progn (end-of-line) (preceding-char)) (life-life-char)))
+ (goto-beginning-of-buffer)
+ (while (not (eobp))
+ (insert (life-void-char))
+ (end-of-line)
+ (insert (life-void-char))
+ (forward-char))
+ (setq fill-column (+ 2 fill-column))
+ (scroll-left 1)
+ (life-compute-neighbor-deltas)
+ (throw 'done t)))
+ (forward-line)))
+ (goto-beginning-of-buffer)
+ ;; check for life within the first two lines of the buffer.
+ ;; If present insert two lifeless lines at the beginning..
+ (cond ((search-forward (life-life-string)
+ (+ (point) fill-column fill-column 2) t)
+ (goto-beginning-of-buffer)
+ (insert-char (life-void-char) fill-column)
+ (insert ?\n)
+ (insert-char (life-void-char) fill-column)
+ (insert ?\n)
+ (setq life-window-start (+ life-window-start fill-column 1))))
+ (goto-end-of-buffer)
+ ;; check for life within the last two lines of the buffer.
+ ;; If present insert two lifeless lines at the end.
+ (cond ((search-backward (life-life-string)
+ (- (point) fill-column fill-column 2) t)
+ (goto-end-of-buffer)
+ (insert-char (life-void-char) fill-column)
+ (insert ?\n)
+ (insert-char (life-void-char) fill-column)
+ (insert ?\n)
+ (setq life-window-start (+ life-window-start fill-column 1)))))
+
+(defun life-display-generation (sleeptime)
+ (goto-char life-window-start)
+ (recenter 0)
+ (sit-for sleeptime))
+
+(defun life-extinct-quit ()
+ (life-display-generation 0)
+ (signal 'life-extinct nil))
+
+(put 'life-extinct 'error-conditions '(life-extinct quit))
+(put 'life-extinct 'error-message "All life has perished")
+
+