--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/games/mine.el	Mon Aug 13 09:13:56 2007 +0200
@@ -0,0 +1,1190 @@
+;;; mine.el --- Mine game for GNU Emacs
+
+;; Author:     Jacques Duthen <duthen@cegelec-red.fr>
+;; Keywords:   games
+;; Time-stamp: <97/01/20 14:37:36 duthen>
+;; Version:    1.17
+
+(defconst mine-version-number "1.17" "Emacs Mine version number.")
+(defconst mine-version (format "Emacs Mine v%s by Jacques Duthen © 1997"
+			       mine-version-number)
+  "Full Emacs Mine version number.")
+
+;; This file is not yet 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:
+
+;; The object of this classical game is to locate the hidden mines.
+;; To do this, you hit the squares on the game board that do not
+;; contain mines, and you mark the squares that do contain mines.
+
+;; The number of hidden mines remaining in the mine field is indicated
+;; inside the buffer.  Every time you mark a square as a mine, this
+;; number decreases by one, even if you incorrectly mark a square.
+
+;; To hit a square: Point to the square, and click the left button.
+;; If the square is a mine, you loose.
+;; If the square isn't a mine, a number appears, which represents
+;; the number of mines in the surrounding eight squares.
+
+;; To mark a square as a mine: Point to the square, and click
+;; the right button.
+
+;; To play Mine, compile it if you want, load it, and type `M-x mine'.
+
+;; To get help and doc, see the functions `mine' and `mine-help'
+;; (ie. type `?' in the *Mine* buffer or type `C-h f mine')
+
+;; This module has been developed and tested with GNU Emacs 19.31.1,
+;; but it should run with any GNU Emacs 19.* (at least with versions
+;; superior to 19.31). 
+
+;; This module has not been tested (yet) with XEmacs.  It may or may
+;; not run (can anybody tell me?).  
+
+;; Send any comment or bug report (do you expect to find any? ;-) to me:
+;; duthen@cegelec-red.fr (Jacques Duthen)
+
+;; Good luck.
+
+;; 1.17 Thanks to Vladimir Alexiev <vladimir@cs.ualberta.ca>.
+;; Fix bug: (void-function unless), add minimal support for xemacs.
+;; (mine-xemacs-p): Added.
+;; (event-point): New function.
+;; (mine-mouse-hit, mine-mouse-mark): Use (interactive "@e") and `event-point'
+;; (mine-init-mode-map): Support xemacs mouse binding.  
+;; (mine-make-face): Support xemacs get-face.  
+;; (mine-goto): Support `auto-show-make-point-visible' as well as
+;; `hscroll-point-visible'. 
+
+;; 1.16 Initial released version.
+
+;;; Code:
+
+(defvar mine-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
+
+;;; ================================================================
+;;; User Variables:
+
+;;; -1- size
+
+;;; The mine field is a rectangle (mine-xmax x mine-ymax), which is
+;;; duplicated to fill a bigger rectangle periodically tiled with the
+;;; smaller one, the period being (mine-xmax x mine-ymax).  
+
+(defvar mine-xmax 16 "*The logical width  of the mine field.")
+(defvar mine-ymax 24 "*The logical height of the mine field.")
+
+(defvar mine-mines-%  16
+  "*Percentage (between 0 and 100) of mines in the mine field.")
+
+(defvar mine-torus 't
+  "*Non-nil (the default) to play the game on a periodic board (a torus).")
+
+(defvar mine-nb-tiles-x 2
+  "*Number of duplications in the x direction, when `mine-torus' is non-nil.
+Indicate the number of times the original mine field is duplicated 
+in the x direction.
+It's better looking when it's an integer.  
+nil means fill exactly the whole window.
+0 means fill the whole window with the biggest integer that fits.
+a negative number means use exactly the opposite number.  If it's
+too big, the rows are truncated by emacs.  Automatic horizontal
+scrolling will occur if you move to an invisible point.
+a positive float means limit to the window width if needed.
+a positive integer means limit to the window width if needed,
+with the biggest possible integer value anyway.
+")
+
+(defvar mine-nb-tiles-y 2
+  "*Number of duplications in the y direction, when `mine-torus' is non-nil.
+Indicate the number of times the original mine field is duplicated 
+in the y direction.
+It's better looking when it's an integer.  
+nil means fill exactly the whole window.
+0 means fill the whole window with the biggest integer that fits.
+a negative number means use exactly the opposite number.  If it's
+too big, the rows will be simply scrolled up or down by emacs.
+a positive float means limit to the window height if needed.
+a positive integer means limit to the window height if needed,
+with the biggest possible integer value anyway.
+")
+
+;;; -2- square characters
+
+;;; All these characters may be changed but the first three ones
+;;; `unmarked' `marked' `zero' must differ from each other.
+
+(defvar mine-char-unmarked  ?-
+  "*Character for a square not yet marked nor hit.")
+(defvar mine-char-marked    ?@
+  "*Character for a square marked as containing a mine.")
+(defvar mine-char-zero      ?\ 
+  "*Character for a square hit with no adjacent mine.")
+
+(defvar mine-char-pad       ?\ 
+  "*Character to pad in the x direction or nil (not yet implemented).")
+(defvar mine-char-not-found ?o
+  "*Character for a square marked but with no mine.")
+(defvar mine-char-bogus     ?x
+  "*Character for a square not marked but with a mine.")
+
+;;; -3- colors
+
+(defvar mine-colorp (if window-system 't 'nil)
+  "*Non-nil means with colors.  Nil means in black and white.")
+
+(defvar mine-colors nil
+  "*Set this variable to override the colors defined by 
+`mine-default-colors' (use the same format).")
+
+(defconst mine-default-colors
+  '((mine-face-unmarked  . "LightBlue")
+    (mine-face-marked    . "Red")
+    (0 . nil)
+    (1 . "Cyan")
+    (2 . "Green")
+    (3 . "Yellow")
+    (4 . "Orange")
+    (5 . "OrangeRed")
+    (6 . "Red")
+    (7 . "Red")
+    (8 . "Red")
+    (mine-face-pad       . nil)
+    (mine-face-not-found . "Red")
+    (mine-face-bogus     . "Red")
+    )
+  "A-list of default colors for Mine faces.  Don't change its value.
+You can override these settings with `mine-colors' using the same format.")
+
+;;; -4- redisplay
+
+(defvar mine-level 2
+  "*Redisplay speed.  0 is the slowest redisplay, 5 is the fastest one.
+0 means redisplay when every single square changes.  
+1 means redisplay when one square and its periodic images change.  
+2 means redisplay every `mine-count1-max' change.  
+3 means redisplay every `mine-count1-max'*`mine-count2-max' change.  
+-1 or nil means redisplay only when all the changes are done.
+")
+
+(defvar mine-count1-max 16
+  "*See `mine-level'.  
+Redisplay when the number of empty squares which have changed
+is greater than `mine-count1-max'.
+8 means redisplay each time 8 squares have been changed.
+-1 means redisplay only when all the changes are done.")
+
+(defvar mine-count2-max  4
+  "*See `mine-level'.  
+Redisplay when the number of empty squares which have changed
+is greater than `mine-count1-max'.
+8 means redisplay each time 8 squares have been changed.
+-1 means redisplay only when all the changes are done.")
+
+(defvar mine-hscroll-step 4
+  "*Local value for `hscroll-step'")
+
+(defvar mine-mode-hook nil
+  "*Hook called by `mine-mode-hook'.")
+
+;;; ================================================================
+;;; Internal variables:
+
+(defvar mine-user-variables
+  '("Size"
+    mine-xmax mine-ymax mine-mines-%
+    mine-torus mine-nb-tiles-x mine-nb-tiles-y
+    "Square characters"
+    mine-char-unmarked mine-char-marked mine-char-zero
+    mine-char-pad mine-char-not-found mine-char-bogus
+    "Colors"
+    mine-colorp mine-colors
+    "Redisplay"
+    mine-level mine-count1-max mine-count2-max
+    "Scrolling"
+    mine-hscroll-step
+    "Hook"
+    mine-mode-hook))
+
+(defvar mine-user-commands
+  '("Help"
+    mine mine-help mine-help-bindings mine-help-variables
+    "Mouse control"
+    mine-mouse-hit mine-mouse-mark
+    "Move"
+    mine-left mine-right mine-up mine-down
+    mine-bol mine-eol mine-top mine-bottom
+    "Hit and mark"
+    mine-hit-curpoint mine-mark-curpoint
+    "Quit"
+    mine-quit))
+
+;; pad x factor == (if mine-char-pad 2 1)
+(defvar mine-padx*)
+
+(defvar mine-width)
+(defvar mine-height)
+
+;; (x y) of current point
+(defvar mine-x) ;; 1 <= mine-x <= mine-width
+(defvar mine-y) ;; 1 <= mine-y <= mine-height
+
+;; limits of the playable part of the board
+(defvar mine-point-min)
+(defvar mine-point-max)
+
+(defvar mine-point-remaining-mines)
+(defvar mine-point-mines-hit)
+
+(defvar mine-mode-map nil)
+
+(defvar mine-real-mines)
+
+(defvar mine-nb-remaining-mines)
+(defvar mine-nb-remaining-marks)
+(defvar mine-nb-mines-hit)
+
+(defvar mine-faces)
+
+;;; This variable is more special rather than global.
+(defvar mine-adjacent-points)
+
+(defvar mine-count1)
+(defvar mine-count2)
+
+;;; ================================================================
+;;; Macros (stolen from "cl.el" (soon in "subr.el" (thanks to rms)))
+
+(eval-when-compile
+(or (fboundp 'when)
+(defmacro when (cond &rest body)
+  "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
+  (list 'if cond (cons 'progn body)))))
+
+;;; ================================================================
+;;; User commands
+
+;;;###autoload
+(defun mine (num)
+  "Play Mine.  Optional prefix argument is the number of mines.
+
+To play Mine, type `\\[mine]' or `\\[universal-argument] NUM \\[mine]'.  
+
+An optional prefix argument specifies the number of mines to be hidden
+in the field.  If no prefix argument is given, a percentage
+`mine-mines-%' of the field will contain mines.
+
+What is Mine?\\<mine-mode-map>
+
+Mine is a classical game of hide and seek played on a rectangular grid
+containing `mine-xmax' by `mine-ymax' squares (the mine field).
+
+Your opponent (Emacs, in this case) has hidden several mines within
+this field.  The object of the game is to find every hidden mine.
+
+When you're sure a square does NOT contain a mine, you can hit it:
+move the mouse over the square and press `\\[mine-mouse-hit]' or 
+move the cursor with the usual keys and press `\\[mine-hit-curpoint]'.
+
+If the square is a mine, you loose.
+If the square isn't a mine, a number appears which represents
+the number of mines in the surrounding eight squares.  
+
+When you think a square DOES contain a mine, you can mark it:
+move the mouse over the square and press `\\[mine-mouse-mark]' or
+move the cursor with the usual keys and press `\\[mine-mark-curpoint]'.
+
+The number of hidden mines remaining in the mine field is indicated
+inside the buffer.  Every time you mark a square as a mine, this
+number decreases by one, even if you incorrectly mark a square.
+
+If `mine-torus' is non-nil (the default), the Mine game is played over
+a periodic field (like a torus).  Each mine is hidden periodically
+over the mine board `mine-nb-tiles-x' times in the x direction and
+`mine-nb-tiles-y' times in the y direction.
+
+If `mine-colorp' is non-nil (the default, if the system allows it),
+the game is displayed with colors.  The colors can be chosen with the
+variable `mine-colors'.
+
+If the redisplay is not fast enough, increase `mine-level'.  If you
+want to see a smoother (slower) redisplay, decrease `mine-level',
+`mine-count1-max' and `mine-count2-max'.
+
+You can get help on `mine-mode' and its key bindings by pressing `\\[mine-help]'
+while in the *Mine* buffer.
+"
+  (interactive "P")
+  (switch-to-buffer "*Mine*")
+  (mine-mode)
+  (setq buffer-read-only 't)
+  (buffer-disable-undo (current-buffer))
+  (setq mine-nb-remaining-mines
+	(or num (round (/ (* mine-xmax mine-ymax mine-mines-%) 100)))
+        mine-nb-remaining-marks mine-nb-remaining-mines)
+  (if (> mine-nb-remaining-mines (* mine-xmax mine-ymax))
+    (error "Too many mines: %d" mine-nb-remaining-mines))
+  (mine-init-faces)
+  (setq mine-real-mines (mine-init-mines mine-nb-remaining-mines))
+  (setq mine-nb-mines-hit 0)
+  (mine-init-board)
+  (mine-reset-counters)
+  (mine-update-remaining-mines)
+  (setq hscroll-step mine-hscroll-step)
+  ;; initial position
+  (setq mine-x 1)
+  (setq mine-y 1)
+  (mine-goto mine-x mine-y)
+)
+
+;; Mine mode is suitable only for specially formatted data.
+(put 'mine-mode 'mode-class 'special)
+
+(defun mine-mode ()
+  "Major mode for playing Mine.  To learn how to play Mine, see `mine'.
+
+If you have a mouse, you can do:\\<mine-mode-map>
+
+`\\[mine-mouse-hit]' -- hit point
+`\\[mine-mouse-mark]' -- mark or unmark a mine at point
+
+If you don't have a mouse, you can move the cursor over the mine
+field with the usual mnemonic keys and:
+
+`\\[mine-hit-curpoint]' -- hit point
+`\\[mine-mark-curpoint]' -- mark or unmark a mine at point
+
+`\\[mine-quit]' -- give up and see the hidden mines
+
+You can get help with:
+
+`\\[mine-help-variables]' -- get help on Mine variables
+`\\[mine-help-bindings]' -- get help on Mine bindings
+
+\\{mine-mode-map}
+"
+  (interactive)
+  (kill-all-local-variables)
+  (make-local-variable 'hscroll-step)
+  (use-local-map mine-mode-map)
+  (setq truncate-lines 't)
+  (setq major-mode 'mine-mode)
+  (setq mode-name "Mine")
+  (run-hooks 'mine-mode-hook)
+)
+
+;;;###autoload
+(defun mine-version ()
+  "Return string describing the current version of Mine.
+When called interactively, displays the version."
+  (interactive)
+  (if (interactive-p)
+      (message (mine-version))
+    mine-version))
+
+;;;###autoload
+(defun mine-help ()
+  "*Get help on `mine-mode'."
+  (interactive)
+  (save-excursion
+   (switch-to-buffer "*Mine*")
+   (mine-mode)
+   (describe-mode)))
+
+(defun mine-help-variables ()
+  "*Get help on Mine variables."
+  (interactive)
+  (save-excursion
+   (switch-to-buffer "*Mine*")
+   (mine-mode)
+   (apropos-symbols mine-user-variables 't)))
+
+(defun mine-help-bindings ()
+  "*Get help on Mine bindings."
+  (interactive)
+  (save-excursion
+   (switch-to-buffer "*Mine*")
+   (mine-mode)
+   (apropos-symbols mine-user-commands 't)))
+
+(defun mine-print-settings ()
+  "*Print the current Mine settings (value of all the user variables)."
+  (interactive)
+  (with-output-to-temp-buffer "*scratch*"
+    (mine-print-variables mine-user-variables)))
+
+;;; ================================================================
+;;; Click events - nop hit mark
+
+;;; [jack] The elisp manual says:
+;;; If you want to take action as soon as a button is pressed,
+;;; you need to handle "button-down" events.
+;;; The global map (cf. `mouse.el') has, by default, the binding:
+;;;	(define-key global-map [down-mouse-1] 'mouse-drag-region)
+;;; It seems that this function "eats" the final event [mouse-1].
+;;; So, we need a local binding for [down-mouse-1] which shadows
+;;; the global one and prevents `mouse-drag-region' from being called.
+;;; Hence, in `mine-init-mode-map' I use the following binding:
+;;;	(define-key mine-mode-map [down-mouse-1] 'mine-mouse-nop)
+;;; I found a better binding in "apropos.el"
+;;;	(define-key mine-mode-map [down-mouse-1] nil)
+;;; but, as it does not work, let's go back to nop...
+
+(or (fboundp 'event-point)
+    (defun event-point (event)
+      (posn-point (event-end event))))
+
+(defun mine-mouse-nop (event)
+  "Nop"
+  (interactive "e"))
+
+(defun mine-mouse-hit (event)
+  "Move point to the position clicked on with the mouse and hit this point."
+  (interactive "@e")
+  (if (mine-goto-point (event-point event))
+      (mine-hit-curpoint)
+    (mine-message 'mine-msg-click-precisely)))
+
+(defun mine-mouse-mark (event)
+  "Move point to the position clicked on with the mouse and mark or unmark
+this point."
+  (interactive "@e")
+  (if (mine-goto-point (event-point event))
+      (mine-mark-curpoint)
+    (mine-message 'mine-msg-click-precisely)))
+
+;;; ================================================================
+;;; Key events - hit mark quit
+
+(defun mine-hit-curpoint ()
+  "Hit point"
+  (interactive)
+  (mine-reset-counters)
+  (let ((c (following-char)))
+    (save-excursion
+      (cond
+	((eq c mine-char-marked)
+         (mine-message 'mine-msg-unmark-before-hit))
+	((not (eq c mine-char-unmarked))
+         (mine-message 'mine-msg-point-already-hit))
+	((mine-mine-at-point-p (point) 'slowp)
+	 (setq mine-nb-mines-hit (1+ mine-nb-mines-hit))
+	 (mine-update-mines-hit)
+         (mine-message 'mine-msg-loose)
+	 (mine-quit))
+	(t ;; the real job...
+	 (let* ((x.y (mine-top-left (mine-point-to-x.y (point))))
+		(pxy (cons (point) x.y))
+		(mine-adjacent-points (list pxy))) ; special variable
+	   (while mine-adjacent-points
+	     (setq pxy (car mine-adjacent-points)
+		   mine-adjacent-points (cdr mine-adjacent-points))
+	     (mine-deep-hit pxy))))))))
+
+(defun mine-mark-curpoint ()
+  "Mark or unmark current position"
+  (interactive)
+  (mine-reset-counters)
+  (let ((c (following-char)))
+    (save-excursion
+      (cond
+	((eq c mine-char-unmarked)
+	 (mine-mark-board (point))
+	 (setq mine-nb-remaining-marks
+	       (1- mine-nb-remaining-marks))
+	 (if (mine-mine-at-point-p (point) 'slowp)
+	     (setq mine-nb-remaining-mines
+		   (1- mine-nb-remaining-mines))))
+	((eq c mine-char-marked)
+	 (mine-unmark-board (point))
+	 (setq mine-nb-remaining-marks
+	       (1+ mine-nb-remaining-marks))
+	 (if (mine-mine-at-point-p (point) 'slowp)
+	     (setq mine-nb-remaining-mines
+		   (1+ mine-nb-remaining-mines))))
+	(t
+         (mine-message 'mine-msg-cannot-mark)))
+      (mine-update-remaining-mines))))
+
+(defun mine-quit ()
+  "*Display hidden and bogus mines."
+  (interactive)
+  (when (y-or-n-p "Do you want to see the remaining and bogus mines? ")
+    (mine-show-bogus-mines)))
+
+(defun mine-show-bogus-mines ()
+  (mine-reset-counters)
+  (let ((nrb 0) (nbb 0)
+        (x.y (cons nil nil))
+        (y 1) x
+        point c)
+    (while (<= y mine-ymax)
+      (setq x 1)
+      (setcdr x.y y)
+      (while (<= x mine-xmax)
+        (setq point (mine-xy-to-point x y)
+              c (char-after point))
+        (cond
+         ((eq c mine-char-unmarked)
+          (setcar x.y x)
+          (when (mine-mine-at-xy-p x.y)
+            (setq nrb (1+ nrb))
+            (mine-update-board point mine-char-not-found 'mine-face-not-found)))
+         ((eq c mine-char-marked)
+          (setcar x.y x)
+          (when (not (mine-mine-at-xy-p x.y))
+            (setq nbb (1+ nbb))
+            (mine-update-board point mine-char-bogus 'mine-face-bogus))))
+        (setq x (1+ x)))
+      (setq y (1+ y)))
+    (mine-update-bogus-mines nrb nbb)))
+
+;;; ================================================================
+;;; Key events - moves
+
+(defun mine-left ()
+  "Move left"
+  (interactive)
+  (setq mine-x (1- mine-x))
+  (when (<= mine-x 0)
+    (while (<= mine-x mine-width)
+      (setq mine-x (+ mine-x mine-xmax)))
+    (setq mine-x (- mine-x mine-xmax)))
+  (mine-goto mine-x mine-y))
+
+(defun mine-right ()
+  "Move right"
+  (interactive)
+  (setq mine-x (1+ mine-x))
+  (when (> mine-x mine-width)
+    (while (>= mine-x 0)
+      (setq mine-x (- mine-x mine-xmax)))
+    (setq mine-x (+ mine-x mine-xmax)))
+  (mine-goto mine-x mine-y))
+
+(defun mine-up ()
+  "Move up"
+  (interactive)
+  (setq mine-y (1- mine-y))
+  (when (<= mine-y 0)
+    (while (<= mine-y mine-height)
+      (setq mine-y (+ mine-y mine-ymax)))
+    (setq mine-y (- mine-y mine-ymax)))
+  (mine-goto mine-x mine-y))
+
+(defun mine-down ()
+  "Move down"
+  (interactive)
+  (setq mine-y (1+ mine-y))
+  (when (> mine-y mine-height)
+    (while (>= mine-y 0)
+      (setq mine-y (- mine-y mine-ymax)))
+    (setq mine-y (+ mine-y mine-ymax)))
+  (mine-goto mine-x mine-y))
+
+
+(defun mine-bol ()
+  "Move to the beginning of the row"
+  (interactive)
+  (setq mine-x 1)
+  (mine-goto mine-x mine-y))
+
+(defun mine-eol ()
+  "Move to the end of the row"
+  (interactive)
+  (setq mine-x mine-width)
+  (mine-goto mine-x mine-y))
+
+(defun mine-top ()
+  "Move to the top of the column"
+  (interactive)
+  (setq mine-y 1)
+  (mine-goto mine-x mine-y))
+
+(defun mine-bottom ()
+  "Move to the bottom of the column"
+  (interactive)
+  (setq mine-y mine-height)
+  (mine-goto mine-x mine-y))
+
+;;; ================================================================
+;;; Internal model functions
+
+(defun mine-init-mines (num-mines)
+  (random t)
+  (let ((mines (list)) (n num-mines) x y x.y)
+    (while (> n 0)
+      (setq n (1- n)
+            x (1+ (random mine-xmax))
+            y (1+ (random mine-ymax))
+            x.y (cons x y))
+      (while (mine-member x.y mines 'nil)
+	;; replace by the point to the right (or next row if eol)
+        (if (< x mine-xmax)
+	    (setcar x.y (setq x (1+ x)))
+          (setcar x.y (setq x 1))
+          (setcdr x.y (setq y (if (< y mine-ymax) (1+ y) 1)))))
+      (setq mines (cons x.y mines)))
+    mines))
+
+(defun mine-mine-at-point-p (point slowp)
+  (mine-member (mine-top-left (mine-point-to-x.y point))
+               mine-real-mines slowp))
+
+(defun mine-mine-at-xy-p (x.y)
+  (mine-member x.y mine-real-mines 'nil))
+
+;;; Returns non-nil if ELT is an element of LIST. 
+;;; Constant time execution if slowp is non-nil.
+(defun mine-member (x.y list slowp)
+  (let ((found 'nil))
+    (while (and list (or slowp (not found)))
+      (if (equal x.y (car list))
+        (setq found 't))
+      (setq list (cdr list)))
+    found))
+
+;;; ================================================================
+;;; Internal model & interface functions
+
+(defun mine-pxy (x y)
+  (cons (mine-xy-to-point x y) (cons x y)))
+
+;; pxy == (point . (x . y))
+;; with 1 <= {xy} <= mine-{xy}max
+(defun mine-deep-hit (pxy)
+  (interactive)
+  (let (point x.y c)
+    (setq point (car pxy)
+	  x.y   (cdr pxy)
+          c     (char-after point))
+    (cond
+     ((eq c mine-char-marked)) ;; free but marked (user bug)
+     ((not (eq c mine-char-unmarked))) ;; already done
+     ((mine-mine-at-xy-p x.y)
+      (error "Internal error: mine-deep-hit mine at %s" point))
+     (t ;; the real job...
+      (let* ((adjacent-points (mine-adjacent-points point x.y))
+             (nb-adjacent-mines (mine-nb-adjacent-mines adjacent-points)))
+        (mine-display-nb-adjacent-mines point nb-adjacent-mines)
+        (when (zerop nb-adjacent-mines)
+	  ;; Stack overflow: "Lisp nesting exceeds max-lisp-eval-depth"
+          ;;(mapc 'mine-deep-hit adjacent-points)
+	  (setq mine-adjacent-points
+		(nconc adjacent-points mine-adjacent-points))))))))
+
+;; return == ((point . (x . y))*)
+;; with 1 <= {xy} <= mine-{xy}max
+(defun mine-adjacent-points (point x.y)
+  (mine-random-permut
+   (if mine-torus
+     (mine-adjacent-points-on-torus point x.y)
+     (mine-adjacent-points-no-torus point x.y))))
+
+(defun mine-random-permut (l)
+  (let ((ll (nthcdr (random (length l)) l)))
+    (nconc ll l)
+    (prog1 (cdr ll) (setcdr ll ()))))
+
+(defun mine-adjacent-points-no-torus (point x.y)
+  (let ((x (car x.y)) (y (cdr x.y)) (points (list)) xx yy)
+    ;; left column
+    (when (not (= x 1))
+      (setq xx (1- x))
+      (when (not (= y 1))
+        (setq yy (1- y))
+        (setq points (cons (mine-pxy xx yy) points)))
+      (setq points (cons (mine-pxy xx y) points))
+      (when (not (= y mine-ymax))
+        (setq yy (1+ y))
+        (setq points (cons (mine-pxy xx yy) points))))
+    ;; middle column
+    (setq xx x)
+    (when (not (= y 1))
+      (setq yy (1- y))
+      (setq points (cons (mine-pxy xx yy) points)))
+    (when (not (= y mine-ymax))
+      (setq yy (1+ y))
+      (setq points (cons (mine-pxy xx yy) points)))
+    ;; right column
+    (when (not (= x mine-xmax))
+      (setq xx (1+ x))
+      (when (not (= y 1))
+        (setq yy (1- y))
+        (setq points (cons (mine-pxy xx yy) points)))
+      (setq points (cons (mine-pxy xx y) points))
+      (when (not (= y mine-ymax))
+        (setq yy (1+ y))
+        (setq points (cons (mine-pxy xx yy) points))))
+    (nreverse points)))
+
+(defun mine-adjacent-points-on-torus (point x.y)
+  (let ((x (car x.y)) (y (cdr x.y)) (points (list)) xx yy)
+    ;; left column
+    (setq xx (if (= x 1) mine-xmax (1- x)))
+    (setq yy (if (= y 1) mine-ymax (1- y)))
+    (setq points (cons (mine-pxy xx yy) points))
+    (setq points (cons (mine-pxy xx y) points))
+    (setq yy (if (= y mine-ymax) 1 (1+ y)))
+    (setq points (cons (mine-pxy xx yy) points))
+    ;; middle column
+    (setq xx x)
+    (setq yy (if (= y 1) mine-ymax (1- y)))
+    (setq points (cons (mine-pxy xx yy) points))
+    (setq yy (if (= y mine-ymax) 1 (1+ y)))
+    (setq points (cons (mine-pxy xx yy) points))
+    ;; right column
+    (setq xx (if (= x mine-xmax) 1 (1+ x)))
+    (setq yy (if (= y 1) mine-ymax (1- y)))
+    (setq points (cons (mine-pxy xx yy) points))
+    (setq points (cons (mine-pxy xx y) points))
+    (setq yy (if (= y mine-ymax) 1 (1+ y)))
+    (setq points (cons (mine-pxy xx yy) points))
+    (nreverse points)))
+
+;; l == ((p . (x . y))*)
+(defun mine-nb-adjacent-mines (l)
+  (let ((nb 0) pxy x.y)
+    (while l
+      (setq pxy (car l)  l (cdr l)  x.y (cdr pxy))
+      (if (mine-mine-at-xy-p x.y)
+          (setq nb (1+ nb))))
+    nb))
+
+;;; ================================================================
+;;; Mode map
+
+(defun mine-init-mode-map ()
+  (let ((map (make-keymap)) (gm global-map))
+    ;; All normally self-inserting keys (except digits) are undefined
+    (suppress-keymap map 'nil)
+    ;; Help
+    (define-key map "?"      'mine-help)
+    (define-key map "h"      'mine-help)
+    (define-key map "b"      'mine-help-bindings)
+    (define-key map "v"      'mine-help-variables)
+    (cond
+      (mine-xemacs-p
+       ;; Mouse control
+       (define-key map [mouse-1] 'mine-mouse-hit)
+       (define-key map [mouse-3] 'mine-mouse-mark)
+       ;; Mouse control to prevent problems
+       (define-key map [mouse-2] 'mine-mouse-nop))
+      (t
+       ;; Mouse control
+       (define-key map [mouse-1] 'mine-mouse-hit)
+       (define-key map [mouse-3] 'mine-mouse-mark)
+       ;; Mouse control to prevent problems
+       (define-key map [mouse-2] 'mine-mouse-nop)
+       (define-key map [down-mouse-1] 'mine-mouse-nop)
+       (define-key map [down-mouse-2] 'mine-mouse-nop)
+       (define-key map [down-mouse-3] 'mine-mouse-nop)
+       (define-key map [drag-mouse-1] 'mine-mouse-nop)
+       (define-key map [drag-mouse-2] 'mine-mouse-nop)
+       (define-key map [drag-mouse-3] 'mine-mouse-nop)
+       (define-key map [mouse-2] 'mine-mouse-nop)))
+    ;; Move
+    (substitute-key-definition 'backward-char 'mine-left  map gm)
+    (substitute-key-definition 'forward-char  'mine-right map gm)
+    (substitute-key-definition 'previous-line 'mine-up    map gm)
+    (substitute-key-definition 'next-line     'mine-down  map gm)
+
+    (substitute-key-definition 'beginning-of-line 'mine-bol map gm)
+    (substitute-key-definition 'backward-word     'mine-bol map gm)
+    (substitute-key-definition 'backward-sexp     'mine-bol map gm)
+    (substitute-key-definition 'end-of-line       'mine-eol map gm)
+    (substitute-key-definition 'forward-word      'mine-eol map gm)
+    (substitute-key-definition 'forward-sexp      'mine-eol map gm)
+    (define-key map "\M-p"   'mine-top)
+    (define-key map "\M-n"   'mine-bottom)
+    ;; Hit and mark
+    (define-key map " "      'mine-hit-curpoint)
+    (define-key map "\C-m"   'mine-mark-curpoint)
+    (define-key map [kp-enter] 'mine-mark-curpoint)
+    (define-key map "m"      'mine-mark-curpoint)
+    (define-key map "q"      'mine-quit)
+
+    (setq mine-mode-map map)))
+
+;;; ================================================================
+;;; Faces
+
+(defun mine-init-faces ()
+  (setq mine-faces (list))
+  (when mine-colorp
+    (let ((l (append mine-colors mine-default-colors))
+          key.col key col name)
+      (while l
+        (setq key.col (car l)
+              l (cdr l)
+              key (car key.col)
+              col (cdr key.col))
+        (when (null (assoc key mine-faces))
+          (setq name
+            (cond
+	      ((null key) nil)
+	      ((symbolp key) (mine-make-face key col))
+	      ((not (integerp key))
+	       (error "Key should be a symbol or a number: '%s'" key))
+	      ((or (< key 0) (> key 8))
+	       (error "Key should be a number between 0 and 8: '%s'" key))
+	      (t
+	       (setq name (intern (concat "mine-face-" key)))
+	       (mine-make-face name col))))
+          (setq mine-faces (cons (cons key name) mine-faces))))
+      (setq mine-faces (nreverse mine-faces)))))
+
+(defun mine-make-face (name col)
+  (or (if (fboundp 'internal-find-face)
+	  (internal-find-face name)
+	(find-face name))
+      (let ((face (make-face name)))
+	(unless (or (not mine-xemacs-p) col)
+	  (setq col (cdr (face-background 'default 'global))))
+	(set-face-background face col)
+	face))
+  name)
+
+(defun mine-get-face (key)
+  (cdr (assoc key mine-faces)))
+
+;;; ================================================================
+;;; Init board
+
+(defun mine-init-board ()
+  (setq mine-padx* (if mine-char-pad 2 1))
+  (if (not mine-torus)
+      (setq  mine-width  mine-xmax
+             mine-height mine-ymax)
+    (let (window-xmax window-nb-tiles-x window-xmax-int
+          window-ymax window-nb-tiles-y window-ymax-int)
+      (setq window-xmax       (/ (window-width) mine-padx*)
+            window-nb-tiles-x (/ window-xmax mine-xmax)
+            window-xmax-int   (* window-nb-tiles-x window-xmax))
+      (setq mine-width
+         (max mine-xmax ; at least mine-xmax
+            (cond
+             ((null mine-nb-tiles-x) window-xmax)
+             ((not (numberp mine-nb-tiles-x))
+              (error "mine-nb-tiles-x should be nil or a number: %s"
+                     mine-nb-tiles-x))
+             ((zerop mine-nb-tiles-x) window-xmax-int)
+             ((< mine-nb-tiles-x 0)
+              (floor (* mine-xmax (- mine-nb-tiles-x))))
+             ((floatp mine-nb-tiles-x)
+              (min window-xmax (floor (* mine-xmax mine-nb-tiles-x))))
+             (t (min window-xmax-int (* mine-xmax mine-nb-tiles-x))))))
+      (setq window-ymax (- (window-height) 5)
+            window-nb-tiles-y (/ window-ymax mine-ymax)
+            window-ymax-int (* window-nb-tiles-y window-ymax))
+      (setq mine-height
+         (max mine-ymax
+            (cond
+             ((null mine-nb-tiles-y) window-ymax)
+             ((not (numberp mine-nb-tiles-y))
+              (error "mine-nb-tiles-y should be nil or a number: %s"
+                     mine-nb-tiles-y))
+             ((zerop mine-nb-tiles-y) window-ymax-int)
+             ((< mine-nb-tiles-y 0)
+              (floor (* mine-ymax (- mine-nb-tiles-y))))
+             ((floatp mine-nb-tiles-y)
+              (min window-ymax (floor (* mine-ymax mine-nb-tiles-y))))
+             (t (min window-ymax-int (* mine-ymax mine-nb-tiles-y))))))))
+  (let ((buffer-read-only 'nil)
+	(face-unmarked (mine-get-face 'mine-face-unmarked))
+	(face-pad      (mine-get-face 'mine-face-pad))
+        row col)
+    (erase-buffer)
+    (mine-insert-copyright)
+    (mine-insert-remaining-mines)
+    (mine-insert-mines-hit)
+    (setq mine-point-min (point))
+    (setq row mine-height)
+    (while (>= (setq row (1- row)) 0)
+      (setq col (1- mine-width))
+      (insert mine-char-unmarked)
+      (when face-unmarked
+	(put-text-property (1- (point)) (point) 'face face-unmarked))
+      (while (>= (setq col (1- col)) 0)
+        (when mine-char-pad
+          (insert mine-char-pad)
+          (when face-pad
+            (put-text-property (1- (point)) (point) 'face face-pad)))
+        (insert mine-char-unmarked)
+	(when face-unmarked
+	  (put-text-property (1- (point)) (point) 'face face-unmarked)))
+      (insert ?\n))
+    (setq mine-point-max (1- (point)))
+    (mine-update-remaining-mines)
+    (mine-update-mines-hit)
+    (set-buffer-modified-p 'nil)))
+
+;;; ================================================================
+;;; Internal moves
+
+(defun mine-goto-point (point)
+  (let ((x.y (mine-point-to-x.y point)))
+    (setq mine-x (car x.y) mine-y (cdr x.y))
+    (mine-goto mine-x mine-y)
+    (= point (point))))
+
+(defun mine-goto (x y)
+  (goto-char (mine-xy-to-point x y))
+  (cond ((fboundp 'hscroll-point-visible)
+	 (hscroll-point-visible))
+	((fboundp 'auto-show-make-point-visible)
+	 (auto-show-make-point-visible))))
+
+;;; ================================================================
+;;; Conversions
+
+(defun mine-xy-to-point (x y)
+  ;; p = pmin + 2*w*(y-1) + 2*(x-1)
+  (+ mine-point-min
+     (* mine-padx* mine-width (1- y))
+     (* mine-padx* (1- x))))
+
+;;; Returns the topleft equivalent of point,
+;;; on the periodic board, ie. converts point to model coordinates.
+(defun mine-top-left (x.y)
+  (setcar x.y (1+ (mod (1- (car x.y)) mine-xmax)))
+  (setcdr x.y (1+ (mod (1- (cdr x.y)) mine-ymax)))
+  x.y)
+
+(defun mine-point-to-x.y (point)
+  (let (x y (p0 (- point mine-point-min)))
+    (cond
+     ((<= p0 0)
+      (setq x 1  y 1))
+     ((>= point mine-point-max)
+      (setq x mine-width  y mine-height))
+     (t
+      ;; p = pmin + 2*w*(y-1) + 2*(x-1)
+      ;; y = (p - pmin)/2w + 1
+      ;; x = (p - pmin - 2*w*(y-1)) / 2  +  1
+      (setq y (1+ (/ p0 mine-width mine-padx*))
+            x (1+ (/ (- p0 (* mine-padx* mine-width (1- y))) mine-padx*)))))
+    (cons x y)))
+
+;;; ================================================================
+;;; Screen display
+
+(defun mine-mark-board (point)
+  (mine-update-board point mine-char-marked 'mine-face-marked))
+
+(defun mine-unmark-board (point)
+  (mine-update-board point mine-char-unmarked 'mine-face-unmarked))
+
+(defun mine-display-nb-adjacent-mines (point nb)
+  (mine-update-board point
+     (if (zerop nb) mine-char-zero (+ ?0 nb))
+     nb))
+
+;; todo: enumerer tous les points periodiques
+(defun mine-update-board (point c key)
+  (let ((buffer-read-only 'nil)
+	(face (mine-get-face key))
+	(x.y (mine-top-left (mine-point-to-x.y point)))
+	x y)
+    (setq x (car x.y))
+    (while (<= x mine-width)
+      (setq y (cdr x.y))
+      (while (<= y mine-height)
+	(mine-update-point (mine-xy-to-point x y) c face)
+	(setq y (+ y mine-ymax)))
+      (setq x (+ x mine-xmax)))
+    (mine-reach-level 1) ; redisplay point and its periodic images
+    (set-buffer-modified-p 'nil)))
+
+(defun mine-update-point (point c face)
+  (goto-char point)
+  (delete-char 1)
+  (insert c)
+  (when face
+    (put-text-property point (point) 'face face))
+  (mine-reach-level 0)) ; redisplay point
+
+(defun mine-reach-level (level)
+  (cond
+    ((null mine-level)) ; no update at all
+    ((< mine-level 0))  ; no update at all
+    ((zerop mine-level) ; unconditional update
+     (sit-for 0))
+    ((zerop level))     ; wait for level 1
+    ((= level 1)
+     (cond
+       ((= mine-level level)
+	(sit-for 0))
+       ((= mine-count1 mine-count1-max)
+	(setq mine-count1 0)
+	(mine-reach-level (1+ level)))
+       (t (setq mine-count1 (1+ mine-count1)))))
+    ((= level 2)
+     (setq mine-count1 0)
+     (cond
+       ((= mine-level level)
+	(sit-for 0))
+       ((= mine-count2 mine-count2-max)
+	(setq mine-count2 0)
+	(mine-reach-level (1+ level)))
+       (t (setq mine-count2 (1+ mine-count2)))))
+    ((= level 3)
+     (setq mine-count1 0)
+     (setq mine-count2 0)
+     (cond
+       ((= mine-level level)
+	(sit-for 0))))))
+
+(defun mine-reset-counters ()
+  (setq mine-count1 0
+        mine-count2 0))
+
+;;; ================================================================
+;;; Messages - init board
+
+(defun mine-insert-copyright ()
+  (insert mine-version "\n\n"))
+
+(defun mine-insert-remaining-mines ()
+  (insert (format "%16s" "Remaining mines") ":")
+  (setq mine-point-remaining-mines (point))
+  (insert "   \n"))
+
+(defun mine-insert-mines-hit ()
+  (insert (format "%16s" "mines hit") ":")
+  (setq mine-point-mines-hit (point))
+  (insert "   \n\n"))
+
+;;; ================================================================
+;;; Messages - update board
+
+(defun mine-update-remaining-mines ()
+  (let ((buffer-read-only 'nil))
+    (save-excursion
+      (goto-char mine-point-remaining-mines)
+      (delete-char 3)
+      (insert (format "%3d" mine-nb-remaining-marks)))
+    (set-buffer-modified-p 'nil))
+  (sit-for 0)
+  (message "mines remaining to find...%d" mine-nb-remaining-marks)
+  (when (and (zerop mine-nb-remaining-mines)
+	     (zerop mine-nb-remaining-marks))
+    (mine-message 'mine-msg-win)))
+
+(defun mine-update-mines-hit ()
+  (let ((buffer-read-only 'nil))
+    (save-excursion
+      (goto-char mine-point-mines-hit)
+      (delete-char 3)
+      (insert (format "%3d" mine-nb-mines-hit)))
+    (set-buffer-modified-p 'nil)))
+
+(defun mine-update-bogus-mines (nrb nbb)
+  (let ((buffer-read-only 'nil)
+	(msg (format "There were %d remaining mines and %d bogus mines"
+		     nrb nbb)))
+    (save-excursion
+      (goto-char (point-max))
+      (insert "\n" msg))
+    (set-buffer-modified-p 'nil)
+    (message msg)))
+
+;;; ================================================================
+;;; Messages - write minibuffer
+
+(defun mine-message (msg)
+  (ding)
+  (cond
+   ((eq msg 'mine-msg-click-precisely)
+    (message "Please, click more precisely"))
+   ((eq msg 'mine-msg-unmark-before-hit)
+    (message "You must unmark point before hitting it."))
+   ((eq msg 'mine-msg-point-already-hit)
+    (message "Point has already been hit."))
+   ((eq msg 'mine-msg-cannot-mark)
+    (message "Can't (un)mark point..."))
+   ((eq msg 'mine-msg-loose)
+    (message "Sorry... There's a mine here...")
+    (sit-for 1)
+    (message "Sorry... There's a mine here... You lost!"))
+   ((eq msg 'mine-msg-win)
+    (message "Congratulations...")
+    (sit-for 1)
+    (message "Congratulations... You won!"))
+   (t
+    (message (format "%s" msg)))))
+
+(mine-init-mode-map)
+
+;;; ================================================================
+
+(defun mine-print-variables (l)
+  (let (var)
+    (princ "(setq ")
+    (while l
+      (setq var (car l) l (cdr l))
+      (cond
+	((stringp var) (princ (format ";; %s\n      " var)))
+	((not (symbolp var)) (error "Not a symbol: %s" var))
+	((not (boundp var))  (error "Unboundp symbol: %s" var))
+	(t (princ (format "%-20s'%s" var (symbol-value var)))
+	   (when l (princ "\n      ")))))
+    (princ "))\n")))
+
+;;; ================================================================
+
+;;(autoload 'apropos-print  "apropos")
+;;(autoload 'apropos-do-all "apropos")
+
+(if (not (boundp 'apropos-accumulator))
+    (load "apropos"))
+
+(if (boundp 'apropos-item)
+;; (Daniel.Pfeiffer's) old official version of apropos
+(defun apropos-symbols (l &optional do-all)
+  (let ((ll (list)))
+    (while l
+      (when (not (stringp (car l)))
+	(setq ll (cons (car l) ll)))
+      (setq l (cdr l)))
+    (setq apropos-accumulator (nreverse ll)))
+  (or do-all (setq do-all apropos-do-all))
+  (apropos-print
+   t
+   (lambda (p)
+     (let (doc symbol)
+       (while p
+         (setcar p
+                 (list ; (s f v p)
+                  (setq symbol (car p))
+                  (if (commandp symbol)
+                    (if (setq doc (documentation symbol t))
+                      (substring doc 0 (string-match "\n" doc))
+                      "(not documented)"))
+                  (and do-all
+                       (user-variable-p symbol)
+                       (if (setq doc (documentation-property
+                                      symbol 'variable-documentation t))
+                         (substring doc 0 (string-match "\n" doc))))))
+         (setq p (cdr p)))))
+   t)))
+
+(provide 'mine)
+
+;;; mine.el ends here