[PATCH] tetris.el customisable

[Mario Lang]

Hello.

I sent this patch originally to Gerd before the emacs 21 release. Pavel now
digged me out of that ...-xmail file and reminded me about it. It was kind of 
broken,
and regenerated it now for the current CVS. Here it is.
(BTW: I signed papers for that modification when I sent the original patch to 
Gerd).

Index: lisp/play/tetris.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/play/tetris.el,v
retrieving revision 1.4
diff -u -r1.4 tetris.el
--- lisp/play/tetris.el 25 Nov 2001 11:33:26 -0000      1.4
+++ lisp/play/tetris.el 21 Jan 2002 15:26:26 -0000
@@ -35,60 +35,108 @@
 
 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defvar tetris-use-glyphs t
-  "Non-nil means use glyphs when available.")
+(defgroup tetris nil
+  "Play a game of tetris."
+  :prefix "tetris-"
+  :group 'games)
+
+(defcustom tetris-use-glyphs t
+  "*Non-nil means use glyphs when available."
+  :group 'tetris
+  :type 'boolean)
+
+(defcustom tetris-use-color t
+  "*Non-nil means use color when available."
+  :group 'tetris
+  :type 'boolean)
+
+(defcustom tetris-draw-border-with-glyphs t
+  "*Non-nil means draw a border even when using glyphs."
+  :group 'tetris
+  :type 'boolean)
+
+(defcustom tetris-default-tick-period 0.3
+  "*The default time taken for a shape to drop one row."
+  :group 'tetris
+  :type 'number)
 
-(defvar tetris-use-color t
-  "Non-nil means use color when available.")
-
-(defvar tetris-draw-border-with-glyphs t
-  "Non-nil means draw a border even when using glyphs.")
-
-(defvar tetris-default-tick-period 0.3
-  "The default time taken for a shape to drop one row.")
-
-(defvar tetris-update-speed-function
+(defcustom tetris-update-speed-function
   'tetris-default-update-speed-function
   "Function run whenever the Tetris score changes
 Called with two arguments: (SHAPES ROWS)
 SHAPES is the number of shapes which have been dropped
 ROWS is the number of rows which have been completed
 
-If the return value is a number, it is used as the timer period.")
+If the return value is a number, it is used as the timer period."
+  :group 'tetris
+  :type 'function)
+
+(defcustom tetris-mode-hook nil
+  "Hook run upon starting Tetris."
+  :group 'tetris
+  :type 'hook)
 
-(defvar tetris-mode-hook nil
-  "Hook run upon starting Tetris.")
-
-(defvar tetris-tty-colors
+(defcustom tetris-tty-colors
   [nil "blue" "white" "yellow" "magenta" "cyan" "green" "red"]
   "Vector of colors of the various shapes in text mode
-Element 0 is ignored.")
+Element 0 is ignored."
+  :group 'tetris
+  :type (let ((names `("Shape 1" "Shape 2" "Shape 3"
+                      "Shape 4" "Shape 5" "Shape 6" "Shape 7"))
+             (result `(vector (const nil))))
+         (while names
+           (add-to-list 'result 
+                        (cons 'choice 
+                              (cons :tag 
+                                    (cons (car names) 
+                                          (mapcar (lambda (color)
+                                                    (list 'const color))
+                                                  (defined-colors)))))
+                        t)
+           (setq names (cdr names)))
+         result))
 
-(defvar tetris-x-colors
+(defcustom tetris-x-colors
   [nil [0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]]
   "Vector of colors of the various shapes
-Element 0 is ignored.")
-
-(defvar tetris-buffer-name "*Tetris*"
-  "Name used for Tetris buffer.")
-
-(defvar tetris-buffer-width 30
-  "Width of used portion of buffer.")
-
-(defvar tetris-buffer-height 22
-  "Height of used portion of buffer.")
-
-(defvar tetris-width 10
-  "Width of playing area.")
-
-(defvar tetris-height 20
-  "Height of playing area.")
-
-(defvar tetris-top-left-x 3
-  "X position of top left of playing area.")
-
-(defvar tetris-top-left-y 1
-  "Y position of top left of playing area.")
+Element 0 is ignored."
+  :group 'tetris
+  :type 'sexp)
+
+(defcustom tetris-buffer-name "*Tetris*"
+  "Name used for Tetris buffer."
+  :group 'tetris
+  :type 'string)
+
+(defcustom tetris-buffer-width 30
+  "Width of used portion of buffer."
+  :group 'tetris
+  :type 'number)
+
+(defcustom tetris-buffer-height 22
+  "Height of used portion of buffer."
+  :group 'tetris
+  :type 'number)
+
+(defcustom tetris-width 10
+  "Width of playing area."
+  :group 'tetris
+  :type 'number)
+
+(defcustom tetris-height 20
+  "Height of playing area."
+  :group 'tetris
+  :type 'number)
+
+(defcustom tetris-top-left-x 3
+  "X position of top left of playing area."
+  :group 'tetris
+  :type 'number)
+
+(defcustom tetris-top-left-y 1
+  "Y position of top left of playing area."
+  :group 'tetris
+  :type 'number)
 
 (defvar tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width)
   "X position of next shape.")
Index: lisp/cus-load.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/cus-load.el,v
retrieving revision 1.40
diff -u -r1.40 cus-load.el
--- lisp/cus-load.el    20 Jan 2002 16:02:31 -0000      1.40
+++ lisp/cus-load.el    21 Jan 2002 15:26:27 -0000
@@ -310,6 +310,7 @@
 (put 'ps-print-horizontal 'custom-loads '("ps-print"))
 (put 'woman 'custom-loads '("woman"))
 (put 'decipher 'custom-loads '("decipher"))
+(put 'tetris 'custom-loads '("tetris"))
 (put 'pcmpl-gnu 'custom-loads '("pcmpl-gnu"))
 (put 'ps-print-face 'custom-loads '("ps-print"))
 (put 'rmail-summary 'custom-loads '("rmail" "rmailsum"))
@@ -359,7 +360,7 @@
 (put 'gnus-article-mime 'custom-loads '("gnus-art" "mm-uu"))
 (put 'emulations 'custom-loads '("crisp" "tpu-edt" "vip" "viper"))
 (put 'compression 'custom-loads '("jka-compr"))
-(put 'games 'custom-loads '("5x5" "bruce" "decipher" "dunnet" "fortune" 
"gametree" "gomoku" "handwrite" "hanoi" "landmark" "mpuz" "pong" "solitaire" 
"spook" "yow"))
+(put 'games 'custom-loads '("5x5" "bruce" "decipher" "dunnet" "fortune" 
"gametree" "gomoku" "handwrite" "hanoi" "landmark" "mpuz" "pong" "solitaire" 
"spook" "tetris" "yow"))
 (put 'nnmail-retrieve 'custom-loads '("nnmail"))
 (put 'gnus-duplicate 'custom-loads '("gnus-dup"))
 (put 'find-function 'custom-loads '("find-func"))

-- 
CYa,
   Mario <address@hidden>
Homepage(s): http://delysid.org | http://piss.at/

You will lose an important tape file.