Use with-demoted-errors now that it can format any error messages
[bpt/emacs.git] / lisp / play / bubbles.el
index f2b7294..ca7a401 100644 (file)
@@ -1,6 +1,6 @@
-;;; bubbles.el --- Puzzle game for Emacs
+;;; bubbles.el --- Puzzle game for Emacs -*- coding: utf-8 -*-
 
-;; Copyright (C) 2007-201 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
 
 ;; Author:      Ulf Jasper <ulf.jasper@web.de>
 ;; URL:         http://ulf.epplejasper.de/
@@ -33,7 +33,7 @@
 ;; Installation
 ;; ------------
 
-;; Add the following lines to your Emacs startup file (`~/.emacs').
+;; Add the following lines to your init file:
 ;; (add-to-list 'load-path "/path/to/bubbles/")
 ;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
 
@@ -55,7 +55,7 @@
 
 ;; 0.3 (2007-03-11)
 ;;     - Renamed shift modes and thus names of score files. All
-;;       highscores are lost, unless you rename the score files from
+;;       high scores are lost, unless you rename the score files from
 ;;       bubbles-shift-... to bubbles-...!
 ;;     - Bugfixes: Check for successful image creation.
 ;;                 Disable menus and counter when game is over.
@@ -82,7 +82,6 @@
 (defconst bubbles-version "0.5" "Version number of bubbles.el.")
 
 (require 'gamegrid)
-(eval-when-compile (require 'cl))       ; for 'case
 
 ;; User options
 
@@ -199,7 +198,7 @@ types are present."
   :group 'bubbles)
 
 (defcustom bubbles-chars
-  '(?+ ?O ?# ?X ?. ?* ?& ?§)
+  '(?+ ?O ?# ?X ?. ?* ?& ?§)
   "Characters used for bubbles.
 Note that the actual number of different bubbles is determined by
 the number of colors, see `bubbles-colors'."
@@ -718,58 +717,58 @@ static char * dot3d_xpm[] = {
 
 (defsubst bubbles--grid-width ()
   "Return the grid width for the current game theme."
-  (car (case bubbles-game-theme
-         (easy
+  (car (pcase bubbles-game-theme
+         (`easy
           bubbles--grid-small)
-         (medium
+         (`medium
           bubbles--grid-medium)
-         (difficult
+         (`difficult
           bubbles--grid-large)
-         (hard
+         (`hard
           bubbles--grid-huge)
-         (user-defined
+         (`user-defined
           bubbles-grid-size))))
 
 (defsubst bubbles--grid-height ()
   "Return the grid height for the current game theme."
-  (cdr (case bubbles-game-theme
-         (easy
+  (cdr (pcase bubbles-game-theme
+         (`easy
           bubbles--grid-small)
-         (medium
+         (`medium
           bubbles--grid-medium)
-         (difficult
+         (`difficult
           bubbles--grid-large)
-         (hard
+         (`hard
           bubbles--grid-huge)
-         (user-defined
+         (`user-defined
           bubbles-grid-size))))
 
 (defsubst bubbles--colors ()
   "Return the color list for the current game theme."
-  (case bubbles-game-theme
-    (easy
+  (pcase bubbles-game-theme
+    (`easy
      bubbles--colors-2)
-    (medium
+    (`medium
      bubbles--colors-3)
-    (difficult
+    (`difficult
      bubbles--colors-4)
-    (hard
+    (`hard
      bubbles--colors-5)
-    (user-defined
+    (`user-defined
      bubbles-colors)))
 
 (defsubst bubbles--shift-mode ()
   "Return the shift mode for the current game theme."
-  (case bubbles-game-theme
-    (easy
+  (pcase bubbles-game-theme
+    (`easy
      'default)
-    (medium
+    (`medium
      'default)
-    (difficult
+    (`difficult
      'always)
-    (hard
+    (`hard
      'always)
-    (user-defined
+    (`user-defined
      bubbles-shift-mode)))
 
 (defun bubbles-save-settings ()
@@ -1109,25 +1108,24 @@ Set `bubbles--col-offset' and `bubbles--row-offset'."
 Use optional parameter POS instead of point if given."
   (when bubbles--playing
     (unless pos (setq pos (point)))
-    (condition-case err
-        (let ((char (char-after pos))
-              (inhibit-read-only t)
-              (row (bubbles--row (point)))
-              (col (bubbles--col (point))))
-          (add-text-properties (point-min) (point-max)
-                               '(face default active nil))
-          (let ((count 0))
-            (when (and row col (not (eq char (bubbles--empty-char))))
-              (setq count (bubbles--mark-direct-neighbours row col char))
-              (unless (> count 1)
-                (add-text-properties (point-min) (point-max)
-                                     '(face default active nil))
-                (setq count 0)))
-            (bubbles--update-neighbourhood-score count))
-          (put-text-property (point-min) (point-max) 'pointer 'arrow)
-          (bubbles--update-faces-or-images)
-          (sit-for 0))
-      (error (message "Bubbles: Internal error %s" err)))))
+    (with-demoted-errors "Bubbles: Internal error %s"
+      (let ((char (char-after pos))
+            (inhibit-read-only t)
+            (row (bubbles--row (point)))
+            (col (bubbles--col (point))))
+        (add-text-properties (point-min) (point-max)
+                             '(face default active nil))
+        (let ((count 0))
+          (when (and row col (not (eq char (bubbles--empty-char))))
+            (setq count (bubbles--mark-direct-neighbours row col char))
+            (unless (> count 1)
+              (add-text-properties (point-min) (point-max)
+                                   '(face default active nil))
+              (setq count 0)))
+          (bubbles--update-neighbourhood-score count))
+        (put-text-property (point-min) (point-max) 'pointer 'arrow)
+        (bubbles--update-faces-or-images)
+        (sit-for 0)))))
 
 (defun bubbles--neighbourhood-available ()
   "Return t if another valid neighborhood is available."
@@ -1345,12 +1343,12 @@ Return t if new char is non-empty."
   "Prepare images for playing `bubbles'."
   (when (and (display-images-p)
              (not (eq bubbles-graphics-theme 'ascii)))
-    (let ((template (case bubbles-graphics-theme
-                      (circles bubbles--image-template-circle)
-                      (balls bubbles--image-template-ball)
-                      (squares bubbles--image-template-square)
-                      (diamonds bubbles--image-template-diamond)
-                      (emacs bubbles--image-template-emacs))))
+    (let ((template (pcase bubbles-graphics-theme
+                      (`circles bubbles--image-template-circle)
+                      (`balls bubbles--image-template-ball)
+                      (`squares bubbles--image-template-square)
+                      (`diamonds bubbles--image-template-diamond)
+                      (`emacs bubbles--image-template-emacs))))
       (setq bubbles--empty-image
             (create-image (replace-regexp-in-string
                            "^\"\\(.*\\)\t.*c .*\",$"