diff options
| author | Juanma Barranquero | 2008-07-25 15:57:59 +0000 |
|---|---|---|
| committer | Juanma Barranquero | 2008-07-25 15:57:59 +0000 |
| commit | dedb7c74427d276cc79ee43588ffd5575702a066 (patch) | |
| tree | 1429630bc0f19d0c62a9b0d7b4326e111a22742d | |
| parent | b2996e57831bdde76b61eae78ca97caf9c7dafdc (diff) | |
| download | emacs-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/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/play/solitaire.el | 165 |
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 @@ | |||
| 1 | 2008-07-25 Juanma Barranquero <lekktu@gmail.com> | 1 | 2008-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 | |||
| 11419 | 2008-02-08 Kenichi Handa <handa@ni.aist.go.jp> | 11426 | 2008-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. |
| 96 | To learn how to play Solitaire, see the documentation for function | 94 | To learn how to play Solitaire, see the documentation for function |
| 97 | `solitaire'. | 95 | `solitaire'. |
| 98 | \\<solitaire-mode-map> | 96 | \\<solitaire-mode-map> |
| 99 | The usual mnemonic keys move the cursor around the board; in addition, | 97 | The 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 | ||