Use with-demoted-errors now that it can format any error messages

* dframe.el (dframe-timer-fn):
* files.el (dir-locals-read-from-file):
* mpc.el (mpc--status-timer-run, mpc--status-idle-timer-run, mpc-format):
* reveal.el (reveal-post-command):
* saveplace.el (load-save-place-alist-from-file):
* shell.el (shell-resync-dirs):
* w32-common-fns.el (x-get-selection-value):
* emacs-lisp/copyright.el (copyright-find-copyright):
* emacs-lisp/eldoc.el (eldoc-print-current-symbol-info):
* emulation/tpu-edt.el (tpu-copy-keyfile):
* play/bubbles.el (bubbles--mark-neighbourhood):
* progmodes/executable.el (executable-make-buffer-file-executable-if-script-p):
* term/pc-win.el (x-get-selection-value): Use with-demoted-errors.

14 files changed, 133 insertions, 138 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7984dc214c..d5b6b09aab 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,21 @@
+2013-09-12  Glenn Morris  <rgm@gnu.org>
+
+	* dframe.el (dframe-timer-fn):
+	* files.el (dir-locals-read-from-file):
+	* mpc.el (mpc--status-timer-run, mpc--status-idle-timer-run)
+	(mpc-format):
+	* reveal.el (reveal-post-command):
+	* saveplace.el (load-save-place-alist-from-file):
+	* shell.el (shell-resync-dirs):
+	* w32-common-fns.el (x-get-selection-value):
+	* emacs-lisp/copyright.el (copyright-find-copyright):
+	* emacs-lisp/eldoc.el (eldoc-print-current-symbol-info):
+	* emulation/tpu-edt.el (tpu-copy-keyfile):
+	* play/bubbles.el (bubbles--mark-neighbourhood):
+	* progmodes/executable.el
+	(executable-make-buffer-file-executable-if-script-p):
+	* term/pc-win.el (x-get-selection-value): Use with-demoted-errors.
+
 2013-09-12  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	Cleanup Eshell to rely less on dynamic scoping.
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 66967075e3..3ef30d055b 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -758,9 +758,8 @@ who requested the timer.  NULL-ON-ERROR is ignored."
 Evaluates all cached timer functions in sequence."
   (let ((l dframe-client-functions))
     (while (and l (sit-for 0))
-      (condition-case er
-	  (funcall (car l))
-	(error (message "DFRAME TIMER ERROR: %S" er)))
+      (with-demoted-errors "DFRAME TIMER ERROR: %S"
+	(funcall (car l)))
       (setq l (cdr l)))))
 
 ;;; Menu hacking for mouse-3
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index b3fc6fb887..2b2189e70e 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -1,7 +1,6 @@
 ;;; copyright.el --- update the copyright notice in current buffer
 
-;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation, Inc.
 
 ;; Author: Daniel Pfeiffer <occitan@esperanto.org>
 ;; Keywords: maint, tools
@@ -145,18 +144,17 @@ The header must match `copyright-regexp' and `copyright-names-regexp', if set.
 This function sets the match-data that `copyright-update-year' uses."
   (widen)
   (goto-char (copyright-start-point))
-  (condition-case err
-      ;; (1) Need the extra \\( \\) around copyright-regexp because we
-      ;; goto (match-end 1) below. See note (2) below.
-      (copyright-re-search (concat "\\(" copyright-regexp
-				   "\\)\\([ \t]*\n\\)?.*\\(?:"
-				   copyright-names-regexp "\\)")
-			   (copyright-limit)
-			   t)
-    ;; In case the regexp is rejected.  This is useful because
-    ;; copyright-update is typically called from before-save-hook where
-    ;; such an error is very inconvenient for the user.
-    (error (message "Can't update copyright: %s" err) nil)))
+  ;; In case the regexp is rejected.  This is useful because
+  ;; copyright-update is typically called from before-save-hook where
+  ;; such an error is very inconvenient for the user.
+  (with-demoted-errors "Can't update copyright: %s"
+    ;; (1) Need the extra \\( \\) around copyright-regexp because we
+    ;; goto (match-end 1) below. See note (2) below.
+    (copyright-re-search (concat "\\(" copyright-regexp
+				 "\\)\\([ \t]*\n\\)?.*\\(?:"
+				 copyright-names-regexp "\\)")
+			 (copyright-limit)
+			 t)))
 
 (defun copyright-find-end ()
   "Possibly adjust the search performed by `copyright-find-copyright'.
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 9b9fd32594..250f93800e 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -309,27 +309,26 @@ This variable is expected to be made buffer-local by modes (other than
 Emacs Lisp mode) that support ElDoc.")
 
 (defun eldoc-print-current-symbol-info ()
-  (condition-case err
-      (and (or (eldoc-display-message-p) eldoc-post-insert-mode)
-	   (if eldoc-documentation-function
-	       (eldoc-message (funcall eldoc-documentation-function))
-	     (let* ((current-symbol (eldoc-current-symbol))
-		    (current-fnsym  (eldoc-fnsym-in-current-sexp))
-		    (doc (cond
-			  ((null current-fnsym)
-			   nil)
-			  ((eq current-symbol (car current-fnsym))
-			   (or (apply 'eldoc-get-fnsym-args-string
-				      current-fnsym)
-			       (eldoc-get-var-docstring current-symbol)))
-			  (t
-			   (or (eldoc-get-var-docstring current-symbol)
-			       (apply 'eldoc-get-fnsym-args-string
-				      current-fnsym))))))
-	       (eldoc-message doc))))
-    ;; This is run from post-command-hook or some idle timer thing,
-    ;; so we need to be careful that errors aren't ignored.
-    (error (message "eldoc error: %s" err))))
+  ;; This is run from post-command-hook or some idle timer thing,
+  ;; so we need to be careful that errors aren't ignored.
+  (with-demoted-errors "eldoc error: %s"
+    (and (or (eldoc-display-message-p) eldoc-post-insert-mode)
+	 (if eldoc-documentation-function
+	     (eldoc-message (funcall eldoc-documentation-function))
+	   (let* ((current-symbol (eldoc-current-symbol))
+		  (current-fnsym  (eldoc-fnsym-in-current-sexp))
+		  (doc (cond
+			((null current-fnsym)
+			 nil)
+			((eq current-symbol (car current-fnsym))
+			 (or (apply 'eldoc-get-fnsym-args-string
+				    current-fnsym)
+			     (eldoc-get-var-docstring current-symbol)))
+			(t
+			 (or (eldoc-get-var-docstring current-symbol)
+			     (apply 'eldoc-get-fnsym-args-string
+				    current-fnsym))))))
+	     (eldoc-message doc))))))
 
 (defun eldoc-get-fnsym-args-string (sym &optional index)
   "Return a string containing the parameter list of the function SYM.
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
index 1ec0ecc943..e2fcf2eae4 100644
--- a/lisp/emulation/tpu-edt.el
+++ b/lisp/emulation/tpu-edt.el
@@ -2374,9 +2374,8 @@ If FILE is nil, try to load a default file.  The default file names are
     (goto-char (point-min))
     (beep)
     (and (tpu-y-or-n-p "Copy key definitions to the new file now? ")
-	 (condition-case conditions
-             (copy-file oldname newname)
-	   (error (message "Sorry, couldn't copy - %s." (cdr conditions)))))
+	 (with-demoted-errors "Sorry, couldn't copy - %s."
+           (copy-file oldname newname)))
     (kill-buffer "*TPU-Notice*")))
 
 (defvar tpu-edt-old-global-values nil)
diff --git a/lisp/files.el b/lisp/files.el
index 85bbc8596b..ca55c64669 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3637,21 +3637,17 @@ FILE is the name of the file holding the variables to apply.
 The new class name is the same as the directory in which FILE
 is found.  Returns the new class name."
   (with-temp-buffer
-    ;; This is with-demoted-errors, but we want to mention dir-locals
-    ;; in any error message.
-    (condition-case err
-        (progn
-          (insert-file-contents file)
-          (unless (zerop (buffer-size))
-            (let* ((dir-name (file-name-directory file))
-                   (class-name (intern dir-name))
-                   (variables (let ((read-circle nil))
-                                (read (current-buffer)))))
-              (dir-locals-set-class-variables class-name variables)
-              (dir-locals-set-directory-class dir-name class-name
-                                              (nth 5 (file-attributes file)))
-              class-name)))
-      (error (message "Error reading dir-locals: %S" err) nil))))
+    (with-demoted-errors "Error reading dir-locals: %S"
+      (insert-file-contents file)
+      (unless (zerop (buffer-size))
+        (let* ((dir-name (file-name-directory file))
+               (class-name (intern dir-name))
+               (variables (let ((read-circle nil))
+                            (read (current-buffer)))))
+          (dir-locals-set-class-variables class-name variables)
+          (dir-locals-set-directory-class dir-name class-name
+                                          (nth 5 (file-attributes file)))
+          class-name)))))
 
 (defcustom enable-remote-dir-locals nil
   "Non-nil means dir-local variables will be applied to remote files."
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 825eb3c05d..bd61c26124 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -491,10 +491,9 @@ to call FUN for any change whatsoever.")
     (cancel-timer mpc--status-timer)
     (setq mpc--status-timer nil)))
 (defun mpc--status-timer-run ()
-    (condition-case err
-      (when (process-get (mpc-proc) 'ready)
-        (with-local-quit (mpc-status-refresh)))
-    (error (message "MPC: %s" err))))
+  (with-demoted-errors "MPC: %s"
+    (when (process-get (mpc-proc) 'ready)
+      (with-local-quit (mpc-status-refresh)))))
 
 (defvar mpc--status-idle-timer nil)
 (defun mpc--status-idle-timer-start ()
@@ -520,9 +519,8 @@ to call FUN for any change whatsoever.")
           (run-with-idle-timer 10 t 'mpc--status-idle-timer-run))))
 (defun mpc--status-idle-timer-run ()
   (when (process-get (mpc-proc) 'ready)
-    (condition-case err
-        (with-local-quit (mpc-status-refresh))
-      (error (message "MPC: %s" err))))
+    (with-demoted-errors "MPC: %s"
+        (with-local-quit (mpc-status-refresh))))
   (mpc--status-timer-start))
 
 (defun mpc--status-timers-refresh ()
@@ -999,9 +997,8 @@ If PLAYLIST is t or nil or missing, use the main playlist."
                     (`Cover
                      (let* ((dir (file-name-directory (cdr (assq 'file info))))
                             (cover (concat dir "cover.jpg"))
-                            (file (condition-case err
-                                      (mpc-file-local-copy cover)
-                                    (error (message "MPC: %s" err))))
+                            (file (with-demoted-errors "MPC: %s"
+                                    (mpc-file-local-copy cover)))
                             image)
                        ;; (debug)
                        (push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred)
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 665e98a69b..ca7a401379 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -1108,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."
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index a305393c7d..7b08df8b85 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -269,16 +269,15 @@ file modes."
        (save-restriction
 	 (widen)
 	 (string= "#!" (buffer-substring (point-min) (+ 2 (point-min)))))
-       (condition-case nil
-           (let* ((current-mode (file-modes (buffer-file-name)))
-                  (add-mode (logand ?\111 (default-file-modes))))
-             (or (/= (logand ?\111 current-mode) 0)
-                 (zerop add-mode)
-                 (set-file-modes (buffer-file-name)
-                                 (logior current-mode add-mode))))
-         ;; Eg file-modes can return nil (bug#9879).  It should not,
-         ;; in this context, but we should handle it all the same.
-         (error (message "Unable to make file executable")))))
+       ;; Eg file-modes can return nil (bug#9879).  It should not,
+       ;; in this context, but we should handle it all the same.
+       (with-demoted-errors "Unable to make file executable: %s"
+         (let* ((current-mode (file-modes (buffer-file-name)))
+                (add-mode (logand ?\111 (default-file-modes))))
+           (or (/= (logand ?\111 current-mode) 0)
+               (zerop add-mode)
+               (set-file-modes (buffer-file-name)
+                               (logior current-mode add-mode)))))))
 
 (provide 'executable)
 
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 92c1178041..6740f7e923 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -72,27 +72,26 @@ Each element has the form (WINDOW . OVERLAY).")
   ;; - we only refresh spots in the current window.
   ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ?
   (with-local-quit
-    (condition-case err
-        (let ((old-ols
-               (delq nil
-                     (mapcar
-                      (lambda (x)
-                        ;; We refresh any spot in the current window as well
-                        ;; as any spots associated with a dead window or
-                        ;; a window which does not show this buffer any more.
-                        (cond
-                         ((eq (car x) (selected-window)) (cdr x))
-                         ((not (and (window-live-p (car x))
-                                    (eq (window-buffer (car x)) (current-buffer))))
-                          ;; Adopt this since it's owned by a window that's
-                          ;; either not live or at least not showing this
-                          ;; buffer any more.
-                          (setcar x (selected-window))
-                          (cdr x))))
-                      reveal-open-spots))))
-          (setq old-ols (reveal-open-new-overlays old-ols))
-          (reveal-close-old-overlays old-ols))
-      (error (message "Reveal: %s" err)))))
+    (with-demoted-errors "Reveal: %s"
+      (let ((old-ols
+             (delq nil
+                   (mapcar
+                    (lambda (x)
+                      ;; We refresh any spot in the current window as well
+                      ;; as any spots associated with a dead window or
+                      ;; a window which does not show this buffer any more.
+                      (cond
+                       ((eq (car x) (selected-window)) (cdr x))
+                       ((not (and (window-live-p (car x))
+                                  (eq (window-buffer (car x)) (current-buffer))))
+                        ;; Adopt this since it's owned by a window that's
+                        ;; either not live or at least not showing this
+                        ;; buffer any more.
+                        (setcar x (selected-window))
+                        (cdr x))))
+                    reveal-open-spots))))
+        (setq old-ols (reveal-open-new-overlays old-ols))
+        (reveal-close-old-overlays old-ols)))))
 
 (defun reveal-open-new-overlays (old-ols)
   (let ((repeat t))
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index e9dc12b00f..e070a7da48 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -255,13 +255,9 @@ may have changed\) back to `save-place-alist'."
                 (insert-file-contents file)
                 (goto-char (point-min))
                 (setq save-place-alist
-                      ;; This is with-demoted-errors, but we want to
-                      ;; mention save-place in any error message.
-                      (condition-case err
+                      (with-demoted-errors "Error reading save-place-file: %S"
                         (car (read-from-string
-                              (buffer-substring (point-min) (point-max))))
-                        (error (message "Error reading save-place-file: %S" err)
-                               nil)))
+                              (buffer-substring (point-min) (point-max))))))
 
                 ;; If there is a limit, and we're over it, then we'll
                 ;; have to truncate the end of the list:
diff --git a/lisp/shell.el b/lisp/shell.el
index 3ca2564b65..387d1057bd 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1,7 +1,6 @@
 ;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*-
 
-;; Copyright (C) 1988, 1993-1997, 2000-2013 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1988, 1993-1997, 2000-2013 Free Software Foundation, Inc.
 
 ;; Author: Olin Shivers <shivers@cs.cmu.edu>
 ;;	Simon Marshall <simon@gnu.org>
@@ -1015,12 +1014,11 @@ command again."
 			 ds))
 	  (setq i (match-end 0)))
 	(let ((ds (nreverse ds)))
-	  (condition-case nil
-	      (progn (shell-cd (car ds))
-		     (setq shell-dirstack (cdr ds)
-			   shell-last-dir (car shell-dirstack))
-		     (shell-dirstack-message))
-	    (error (message "Couldn't cd"))))))
+	  (with-demoted-errors "Couldn't cd: %s"
+	    (shell-cd (car ds))
+	    (setq shell-dirstack (cdr ds)
+		  shell-last-dir (car shell-dirstack))
+	    (shell-dirstack-message)))))
     (if started-at-pmark (goto-char (marker-position pmark)))))
 
 ;; For your typing convenience:
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 96831cea9a..e5229bd3f0 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -1,7 +1,7 @@
 ;;; pc-win.el --- setup support for `PC windows' (whatever that is)
 
-;; Copyright (C) 1994, 1996-1997, 1999, 2001-2013 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1994, 1996-1997, 1999, 2001-2013
+;;   Free Software Foundation, Inc.
 
 ;; Author: Morten Welinder <terra@diku.dk>
 ;; Maintainer: FSF
@@ -238,9 +238,8 @@ is not used)."
   (if x-select-enable-clipboard
       (let (text)
 	;; Don't die if x-get-selection signals an error.
-	(condition-case c
-	    (setq text (w16-get-clipboard-data))
-	  (error (message "w16-get-clipboard-data:%s" c)))
+	(with-demoted-errors "w16-get-clipboard-data:%s"
+          (setq text (w16-get-clipboard-data)))
 	(if (string= text "") (setq text nil))
 	(cond
 	 ((not text) nil)
diff --git a/lisp/w32-common-fns.el b/lisp/w32-common-fns.el
index 9f3501a01d..5d8d717186 100644
--- a/lisp/w32-common-fns.el
+++ b/lisp/w32-common-fns.el
@@ -107,9 +107,8 @@ Consult the selection.  Treat empty strings as if they were unset."
   (if x-select-enable-clipboard
       (let (text)
 	;; Don't die if x-get-selection signals an error.
-	(condition-case c
-	    (setq text (w32-get-clipboard-data))
-	  (error (message "w32-get-clipboard-data:%s" c)))
+	(with-demoted-errors "w32-get-clipboard-data:%s"
+	  (setq text (w32-get-clipboard-data)))
 	(if (string= text "") (setq text nil))
 	(cond
 	 ((not text) nil)