Mercurial > emacs
view lisp/play/life.el @ 31383:860d7ac182e3
(vc-rcs-show-log-entry): New function.
(vc-rcs-checkin, vc-rcs-checkout): Don't set all properties.
(vc-rcs-register): If there is no RCS subdir, ask the
user whether to create one.
(vc-rcs-state-heuristic): Use
file-ownership-preserved-p.
(vc-rcs-checkout): Remove the error-handling for missing-rcs.
(vc-rcs-state-heuristic): Don't use file-writable-p.
(vc-rcs-print-log): Insert in the current buffer.
(vc-rcs-diff): Insert in the current buffer and remove unused arg
CMP.
(vc-rcs-workfile-unchanged-p): Use vc-do-command
instead of vc-simple-command.
(vc-rcs-fetch-master-state): Removed check for unlocked-changes to
avoid doing a diff when opening a file.
(vc-rcs-state): Added check for unlocked-changes.
(vc-rcs-header): Escape Id.
(vc-rcs-workfile-unchanged-p): Remove optional arg VERSION.
(vc-rcs-state): Call vc-workfile-unchanged-p, not the RCS-specific
version.
(vc-rcs-state-heuristic): Use file-writable-p instead
of comparing userids.
(vc-rcs-fetch-master-state): Handle the case where rcs is missing.
Simplify the logic by eliminating unreachable code.
(vc-rcs-diff): Only pass `2' to vc-do-command if necessary and
just do a recursive call if we need to retry.
(vc-rcs-checkout): Handle the case where rcs is missing by making
the buffer read-write if requested and re-signalling the error.
(vc-rcs-find-most-recent-rev): New function. The code
derives from the old vc-parse-buffer but uses the revision number
rather than the date (much easier to compare robustly).
(vc-rcs-fetch-master-state): Use `with-temp-buffer'. Adapt to the
new vc-parse-buffer (and vc-rcs-find-most-recent-rev). Find the
locking-user more directly. Check strict locking and set
checkout-model appropriately.
(vc-rcs-parse-locks): Remove.
(vc-rcs-latest-on-branch-p): Use with-temp-buffer and adapt to the
new vc-parse-buffer (and vc-rcs-find-most-recent-rev).
(vc-rcs-system-release): Use with-current-buffer and
vc-parse-buffer.
(vc-rcs-register, vc-rcs-checkout): Use with-current-buffer.
Merge in code
from vc-rcs-hooks.el. Don't require 'vc anymore.
(vc-rcs-responsible-p): Use expand-file-name instead of concat and
file-directory-p instead of file-exists-p.
(vc-rcs-exists): Remove.
(vc-rcs-header): New var.
Update Copyright.
(vc-rcs-rename-file): New function.
(vc-rcs-diff): Remove unused `backend' variable.
(vc-rcs-clear-headers): New function; code moved here
from vc-clear-headers in vc.el.
(tail): Provide vc-rcs and remove vc-rcs-logentry-check.
(vc-rcs-register): Parse command output to find master
file name and workfile version.
(vc-rcs-checkout): Removed call to vc-file-clear-masterprops.
Require vc and vc-rcs-hooks.
(vc-rcs-trunk-p, vc-rcs-branch-part): Move to vc-rcs-hooks.
(vc-rcs-backend-release-p): Remove (use vc-rcs-release-p).
(vc-release-greater-or-equal-p): Move from vc.
(vc-rcs-trunk-p, vc-rcs-branch-p, vc-rcs-branch-part,
vc-rcs-minor-part, vc-rcs-previous-version): Remove duplicates.
(vc-rcs-checkout): Add a missing `new-version' argument in the
call to vc-rcs-latest-on-branch-p. Hopefully that was the right
one.
(vc-rcs-steal-lock): Renamed from `vc-rcs-steal'.
Updated everything to use `vc-checkout-model'.
(vc-rcs-backend-release-p): function added. other
stuff updated to reference this function instead of the old
`vc-backend-release-p'.
(vc-rcs-logentry-check): Function added.
(vc-rcs-checkin, vc-rcs-previous-version)
(vc-rcs-checkout): Name space cleaned up. No more revision number
crunching function names that are not prefixed with vc-rcs.
(vc-rcs-checkout-model): Function added. References to
`vc-checkout-model' replaced.
(vc-rcs-admin): Added the query-only option as
required by the vc.el file.
(vc-rcs-exists): Function added.
(vc-*-checkout):
Use with-temp-file instead of /bin/sh. Merged from mainline
(vc-rcs-latest-on-branch-p): Moved to vc-rcs-hooks.el.
(vc-rcs-latest-on-branch-p, vc-rcs-trunk-p)
(vc-rcs-branch-p, vc-rcs-branch-part, vc-rcs-minor-part)
(vc-rcs-previous-version): Functions added.
(vc-rcs-diff): Function added.
(vc-rcs-checkout) Bug (typo) found and fixed.
(vc-rcs-register-switches) Variable `vc-rcs-register-switches' added.
Require vc when compiling.
(vc-rcs-print-log, vc-rcs-assign-name, vc-rcs-merge)
(vc-rcs-check-headers, vc-rcs-steal, vc-rcs-uncheck, vc-rcs-revert)
(vc-rcs-checkin): New functions (code from vc.el).
(vc-rcs-previous-version, vc-rcs-system-release, vc-rcs-checkout):
Doc fix.
(vc-rcs-release): Deleted. (Duplicated vc-rcs-system-release).
(vc-rcs-trunk-p, vc-rcs-branch-p, vc-rcs-branch-part)
(vc-rcs-minor-part, vc-rcs-previous-version, vc-rcs-release)
(vc-rcs-release-p, vc-rcs-admin, vc-rcs-checkout): New functions
from vc.el.
(vc-rcs-system-release):
Renamed from vc-rcs-backend-release.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Mon, 04 Sep 2000 19:47:43 +0000 |
parents | acffd9b0ac6d |
children | 83e8e419d94d |
line wrap: on
line source
;;; life.el --- John Horton Conway's `Life' game for GNU Emacs ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Kyle Jones <kyleuunet.uu.net> ;; Keywords: games ;; 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 2, 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, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; A demonstrator for John Horton Conway's "Life" cellular automaton ;; in Emacs Lisp. Picks a random one of a set of interesting Life ;; patterns and evolves it according to the familiar rules. ;;; Code: (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. ;; ;; Don't change any of the life-* macro constants unless you thoroughly ;; understand the `life-grim-reaper' function. (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]")) (defmacro life-increment (variable) (list 'setq variable (list '1+ variable))) ;; 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) (defvar life-initialized nil "Non-nil if `life' has been run at least once.") ;;;###autoload (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 life-initialized (random t)) (setq life-initialized t) (or sleeptime (setq sleeptime 1)) (life-setup) (life-display-generation sleeptime) (catch 'life-exit (while t (let ((inhibit-quit t)) (life-grim-reaper) (life-expand-plane-if-needed) (life-increment-generation) (life-display-generation sleeptime))))) (defalias 'life-mode 'life) (put 'life-mode 'mode-class 'special) (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-char (point-min)) (while (re-search-forward (life-not-void-regexp) nil t) (replace-match (life-life-string) t t)) ;; center the pattern horizontally (goto-char (point-min)) (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-char (point-min)) (newline n) (goto-char (point-max)) (newline n) ;; pad lines out to fill-column (goto-char (point-min)) (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 (random (length life-patterns)))) (insert ?\n)) (defun life-increment-generation () (life-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. (set-match-data nil) (goto-char (point-min)) ;; 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)) (life-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-char (point-min)) (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-char (point-min)) (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-char (point-min)) ;; 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-char (point-min)) (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-char (point-max)) ;; 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-char (point-max)) (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) ;; Redisplay; if the user has hit a key, exit the loop. (or (eq t (sit-for sleeptime)) (throw 'life-exit nil))) (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") (provide 'life) ;;; life.el ends here