aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuanma Barranquero2008-07-25 15:57:59 +0000
committerJuanma Barranquero2008-07-25 15:57:59 +0000
commitdedb7c74427d276cc79ee43588ffd5575702a066 (patch)
tree1429630bc0f19d0c62a9b0d7b4326e111a22742d
parentb2996e57831bdde76b61eae78ca97caf9c7dafdc (diff)
downloademacs-dedb7c74427d276cc79ee43588ffd5575702a066.tar.gz
emacs-dedb7c74427d276cc79ee43588ffd5575702a066.zip
* play/solitaire.el (solitaire-mode-map): Define within defvar.
(solitaire-mode): Define with `define-derived-mode'. (solitaire-insert-board, solitaire-right, solitaire-left, solitaire-up) (solitaire-down): Use "?\s" instead of "?\ "; use `when'. (solitaire-undo, solitaire-check): Use `when'. (solitaire-solve): Err out if the solitaire is already in progress. Use `when'.
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/play/solitaire.el165
2 files changed, 86 insertions, 88 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 89e61bbd084..de89e53327a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,13 @@
12008-07-25 Juanma Barranquero <lekktu@gmail.com> 12008-07-25 Juanma Barranquero <lekktu@gmail.com>
2 2
3 * play/solitaire.el (solitaire-mode-map): Define within defvar.
4 (solitaire-mode): Define with `define-derived-mode'.
5 (solitaire-insert-board, solitaire-right, solitaire-left, solitaire-up)
6 (solitaire-down): Use "?\s" instead of "?\ "; use `when'.
7 (solitaire-undo, solitaire-check): Use `when'.
8 (solitaire-solve): Err out if the solitaire is already in progress.
9 Use `when'.
10
3 * descr-text.el (describe-char): Don't overwrite local variable char 11 * descr-text.el (describe-char): Don't overwrite local variable char
4 when describing characters with display-table entries. Display font 12 when describing characters with display-table entries. Display font
5 backend when describing composed characters. Simplify: use `let' 13 backend when describing composed characters. Simplify: use `let'
@@ -11415,7 +11423,6 @@
11415 11423
11416 * diff-mode.el (diff-add-change-log-entries-other-window): Avoid the 11424 * diff-mode.el (diff-add-change-log-entries-other-window): Avoid the
11417 splitter in context hunks. 11425 splitter in context hunks.
11418
114192008-02-08 Kenichi Handa <handa@ni.aist.go.jp> 114262008-02-08 Kenichi Handa <handa@ni.aist.go.jp>
11420 11427
11421 * international/fontset.el (setup-default-fontset): Fix arabic otf 11428 * international/fontset.el (setup-default-fontset): Fix arabic otf
diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el
index c8c72d76f70..c6ee9b62c3c 100644
--- a/lisp/play/solitaire.el
+++ b/lisp/play/solitaire.el
@@ -37,75 +37,67 @@
37 :prefix "solitaire-" 37 :prefix "solitaire-"
38 :group 'games) 38 :group 'games)
39 39
40(defvar solitaire-mode-map nil
41 "Keymap for playing Solitaire.")
42
43(defcustom solitaire-mode-hook nil 40(defcustom solitaire-mode-hook nil
44 "Hook to run upon entry to Solitaire." 41 "Hook to run upon entry to Solitaire."
45 :type 'hook 42 :type 'hook
46 :group 'solitaire) 43 :group 'solitaire)
47 44
48(if solitaire-mode-map 45(defvar solitaire-mode-map
49 () 46 (let ((map (make-sparse-keymap)))
50 (setq solitaire-mode-map (make-sparse-keymap)) 47 (suppress-keymap map t)
51 (suppress-keymap solitaire-mode-map t) 48
52 (define-key solitaire-mode-map "\C-f" 'solitaire-right) 49 (define-key map "\C-f" 'solitaire-right)
53 (define-key solitaire-mode-map "\C-b" 'solitaire-left) 50 (define-key map "\C-b" 'solitaire-left)
54 (define-key solitaire-mode-map "\C-p" 'solitaire-up) 51 (define-key map "\C-p" 'solitaire-up)
55 (define-key solitaire-mode-map "\C-n" 'solitaire-down) 52 (define-key map "\C-n" 'solitaire-down)
56 (define-key solitaire-mode-map [return] 'solitaire-move) 53 (define-key map [return] 'solitaire-move)
57 (define-key solitaire-mode-map [remap undo] 'solitaire-undo) 54 (define-key map [remap undo] 'solitaire-undo)
58 (define-key solitaire-mode-map " " 'solitaire-do-check) 55 (define-key map " " 'solitaire-do-check)
59 (define-key solitaire-mode-map "q" 'quit-window) 56 (define-key map "q" 'quit-window)
60 57
61 (define-key solitaire-mode-map [right] 'solitaire-right) 58 (define-key map [right] 'solitaire-right)
62 (define-key solitaire-mode-map [left] 'solitaire-left) 59 (define-key map [left] 'solitaire-left)
63 (define-key solitaire-mode-map [up] 'solitaire-up) 60 (define-key map [up] 'solitaire-up)
64 (define-key solitaire-mode-map [down] 'solitaire-down) 61 (define-key map [down] 'solitaire-down)
65 62
66 (define-key solitaire-mode-map [S-right] 'solitaire-move-right) 63 (define-key map [S-right] 'solitaire-move-right)
67 (define-key solitaire-mode-map [S-left] 'solitaire-move-left) 64 (define-key map [S-left] 'solitaire-move-left)
68 (define-key solitaire-mode-map [S-up] 'solitaire-move-up) 65 (define-key map [S-up] 'solitaire-move-up)
69 (define-key solitaire-mode-map [S-down] 'solitaire-move-down) 66 (define-key map [S-down] 'solitaire-move-down)
70 67
71 (define-key solitaire-mode-map [kp-6] 'solitaire-right) 68 (define-key map [kp-6] 'solitaire-right)
72 (define-key solitaire-mode-map [kp-4] 'solitaire-left) 69 (define-key map [kp-4] 'solitaire-left)
73 (define-key solitaire-mode-map [kp-8] 'solitaire-up) 70 (define-key map [kp-8] 'solitaire-up)
74 (define-key solitaire-mode-map [kp-2] 'solitaire-down) 71 (define-key map [kp-2] 'solitaire-down)
75 (define-key solitaire-mode-map [kp-5] 'solitaire-center-point) 72 (define-key map [kp-5] 'solitaire-center-point)
76 73
77 (define-key solitaire-mode-map [S-kp-6] 'solitaire-move-right) 74 (define-key map [S-kp-6] 'solitaire-move-right)
78 (define-key solitaire-mode-map [S-kp-4] 'solitaire-move-left) 75 (define-key map [S-kp-4] 'solitaire-move-left)
79 (define-key solitaire-mode-map [S-kp-8] 'solitaire-move-up) 76 (define-key map [S-kp-8] 'solitaire-move-up)
80 (define-key solitaire-mode-map [S-kp-2] 'solitaire-move-down) 77 (define-key map [S-kp-2] 'solitaire-move-down)
81 78
82 (define-key solitaire-mode-map [kp-enter] 'solitaire-move) 79 (define-key map [kp-enter] 'solitaire-move)
83 (define-key solitaire-mode-map [kp-0] 'solitaire-undo) 80 (define-key map [kp-0] 'solitaire-undo)
84 81
85 ;; spoil it with s ;) 82 ;; spoil it with s ;)
86 (define-key solitaire-mode-map [?s] 'solitaire-solve) 83 (define-key map [?s] 'solitaire-solve)
87 84
88 ;; (define-key solitaire-mode-map [kp-0] 'solitaire-hint) - Not yet provided ;) 85 ;; (define-key map [kp-0] 'solitaire-hint) - Not yet provided ;)
89 ) 86 map)
87 "Keymap for playing Solitaire.")
90 88
91;; Solitaire mode is suitable only for specially formatted data. 89;; Solitaire mode is suitable only for specially formatted data.
92(put 'solitaire-mode 'mode-class 'special) 90(put 'solitaire-mode 'mode-class 'special)
93 91
94(defun solitaire-mode () 92(define-derived-mode solitaire-mode nil "Solitaire"
95 "Major mode for playing Solitaire. 93 "Major mode for playing Solitaire.
96To learn how to play Solitaire, see the documentation for function 94To learn how to play Solitaire, see the documentation for function
97`solitaire'. 95`solitaire'.
98\\<solitaire-mode-map> 96\\<solitaire-mode-map>
99The usual mnemonic keys move the cursor around the board; in addition, 97The usual mnemonic keys move the cursor around the board; in addition,
100\\[solitaire-move] is a prefix character for actually moving a stone on the board." 98\\[solitaire-move] is a prefix character for actually moving a stone on the board."
101 (interactive)
102 (kill-all-local-variables)
103 (use-local-map solitaire-mode-map)
104 (setq truncate-lines t) 99 (setq truncate-lines t)
105 (setq show-trailing-whitespace nil) 100 (setq show-trailing-whitespace nil))
106 (setq major-mode 'solitaire-mode)
107 (setq mode-name "Solitaire")
108 (run-mode-hooks 'solitaire-mode-hook))
109 101
110(defvar solitaire-stones 0 102(defvar solitaire-stones 0
111 "Counter for the stones that are still there.") 103 "Counter for the stones that are still there.")
@@ -235,14 +227,13 @@ Pick your favourite shortcuts:
235 (t ""))) 227 (t "")))
236 (vsep (cond ((> h 17) "\n\n") 228 (vsep (cond ((> h 17) "\n\n")
237 (t "\n"))) 229 (t "\n")))
238 (indent (make-string (/ (- w 7 (* 6 (length hsep))) 2) ?\ ))) 230 (indent (make-string (/ (- w 7 (* 6 (length hsep))) 2) ?\s)))
239 (erase-buffer) 231 (erase-buffer)
240 (insert (make-string (/ (- h 7 (if (> h 12) 3 0) 232 (insert (make-string (/ (- h 7 (if (> h 12) 3 0)
241 (* 6 (1- (length vsep)))) 2) ?\n)) 233 (* 6 (1- (length vsep)))) 2) ?\n))
242 (if (or (string= vsep "\n\n") (> h 12)) 234 (when (or (string= vsep "\n\n") (> h 12))
243 (progn 235 (insert (format "%sLe Solitaire\n" indent))
244 (insert (format "%sLe Solitaire\n" indent)) 236 (insert (format "%s============\n\n" indent)))
245 (insert (format "%s============\n\n" indent))))
246 (insert indent) 237 (insert indent)
247 (setq solitaire-start (point)) 238 (setq solitaire-start (point))
248 (setq solitaire-start-x (current-column)) 239 (setq solitaire-start-x (current-column))
@@ -258,30 +249,29 @@ Pick your favourite shortcuts:
258 (insert (format "%s %s %so%so%so%s %s " indent hsep hsep hsep hsep hsep hsep)) 249 (insert (format "%s %s %so%so%so%s %s " indent hsep hsep hsep hsep hsep hsep))
259 (setq solitaire-end (point)) 250 (setq solitaire-end (point))
260 (setq solitaire-end-x (current-column)) 251 (setq solitaire-end-x (current-column))
261 (setq solitaire-end-y (solitaire-current-line)) 252 (setq solitaire-end-y (solitaire-current-line))))
262 ))
263 253
264(defun solitaire-right () 254(defun solitaire-right ()
265 (interactive) 255 (interactive)
266 (let ((start (point))) 256 (let ((start (point)))
267 (forward-char) 257 (forward-char)
268 (while (= ?\ (following-char)) 258 (while (= ?\s (following-char))
269 (forward-char)) 259 (forward-char))
270 (if (or (= 0 (following-char)) 260 (when (or (= 0 (following-char))
271 (= ?\ (following-char)) 261 (= ?\s (following-char))
272 (= ?\n (following-char))) 262 (= ?\n (following-char)))
273 (goto-char start)))) 263 (goto-char start))))
274 264
275(defun solitaire-left () 265(defun solitaire-left ()
276 (interactive) 266 (interactive)
277 (let ((start (point))) 267 (let ((start (point)))
278 (backward-char) 268 (backward-char)
279 (while (= ?\ (following-char)) 269 (while (= ?\s (following-char))
280 (backward-char)) 270 (backward-char))
281 (if (or (= 0 (preceding-char)) 271 (when (or (= 0 (preceding-char))
282 (= ?\ (following-char)) 272 (= ?\s (following-char))
283 (= ?\n (following-char))) 273 (= ?\n (following-char)))
284 (goto-char start)))) 274 (goto-char start))))
285 275
286(defun solitaire-up () 276(defun solitaire-up ()
287 (interactive) 277 (interactive)
@@ -293,12 +283,11 @@ Pick your favourite shortcuts:
293 (forward-line -1) 283 (forward-line -1)
294 (move-to-column c) 284 (move-to-column c)
295 (not (bolp)))) 285 (not (bolp))))
296 (if (or (= 0 (preceding-char)) 286 (when (or (= 0 (preceding-char))
297 (= ?\ (following-char)) 287 (= ?\s (following-char))
298 (= ?\= (following-char)) 288 (= ?\= (following-char))
299 (= ?\n (following-char))) 289 (= ?\n (following-char)))
300 (goto-char start) 290 (goto-char start))))
301 )))
302 291
303(defun solitaire-down () 292(defun solitaire-down ()
304 (interactive) 293 (interactive)
@@ -310,10 +299,10 @@ Pick your favourite shortcuts:
310 (forward-line 1) 299 (forward-line 1)
311 (move-to-column c) 300 (move-to-column c)
312 (not (eolp)))) 301 (not (eolp))))
313 (if (or (= 0 (following-char)) 302 (when (or (= 0 (following-char))
314 (= ?\ (following-char)) 303 (= ?\s (following-char))
315 (= ?\n (following-char))) 304 (= ?\n (following-char)))
316 (goto-char start)))) 305 (goto-char start))))
317 306
318(defun solitaire-center-point () 307(defun solitaire-center-point ()
319 (interactive) 308 (interactive)
@@ -386,7 +375,7 @@ which a stone will be taken away) and target."
386 (setq count (1+ count)))) 375 (setq count (1+ count))))
387 count))) 376 count)))
388 (solitaire-build-modeline) 377 (solitaire-build-modeline)
389 (if solitaire-auto-eval (solitaire-do-check))) 378 (when solitaire-auto-eval (solitaire-do-check)))
390 379
391(defun solitaire-check () 380(defun solitaire-check ()
392 (save-excursion 381 (save-excursion
@@ -401,8 +390,8 @@ which a stone will be taken away) and target."
401 (<= (solitaire-current-line) solitaire-end-y) 390 (<= (solitaire-current-line) solitaire-end-y)
402 (mapc 391 (mapc
403 (lambda (movesymbol) 392 (lambda (movesymbol)
404 (if (listp (solitaire-possible-move movesymbol)) 393 (when (listp (solitaire-possible-move movesymbol))
405 (setq count (1+ count)))) 394 (setq count (1+ count))))
406 solitaire-valid-directions))) 395 solitaire-valid-directions)))
407 count)))) 396 count))))
408 397
@@ -430,6 +419,8 @@ Seen in info on text lines."
430 "Spoil Solitaire by solving the game for you - nearly ... 419 "Spoil Solitaire by solving the game for you - nearly ...
431... stops with five stones left ;)" 420... stops with five stones left ;)"
432 (interactive) 421 (interactive)
422 (when (< solitaire-stones 32)
423 (error "Cannot solve game in progress"))
433 (let ((allmoves [up up S-down up left left S-right up up left S-down 424 (let ((allmoves [up up S-down up left left S-right up up left S-down
434 up up right right S-left down down down S-up up 425 up up right right S-left down down down S-up up
435 S-down down down down S-up left left down 426 S-down down down down S-up left left down
@@ -446,11 +437,11 @@ Seen in info on text lines."
446 (solitaire-auto-eval nil)) 437 (solitaire-auto-eval nil))
447 (solitaire-center-point) 438 (solitaire-center-point)
448 (mapc (lambda (op) 439 (mapc (lambda (op)
449 (if (memq op '(S-left S-right S-up S-down)) 440 (when (memq op '(S-left S-right S-up S-down))
450 (sit-for 0.2)) 441 (sit-for 0.2))
451 (execute-kbd-macro (vector op)) 442 (execute-kbd-macro (vector op))
452 (if (memq op '(S-left S-right S-up S-down)) 443 (when (memq op '(S-left S-right S-up S-down))
453 (sit-for 0.4))) 444 (sit-for 0.4)))
454 allmoves)) 445 allmoves))
455 (solitaire-do-check)) 446 (solitaire-do-check))
456 447