[Emacs-diffs] trunk r114226: Use with-demoted-errors now that it can format any error messages

[Glenn Morris]

------------------------------------------------------------
revno: 114226
revision-id: address@hidden
parent: address@hidden
committer: Glenn Morris <address@hidden>
branch nick: trunk
timestamp: Wed 2013-09-11 22:32:57 -0700
message:
  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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/dframe.el                 dframe.el-20091113204419-o5vbwnq5f7feedwu-3871
  lisp/emacs-lisp/copyright.el   
copyright.el-20091113204419-o5vbwnq5f7feedwu-245
  lisp/emacs-lisp/eldoc.el       eldoc.el-20091113204419-o5vbwnq5f7feedwu-952
  lisp/emulation/tpu-edt.el      tpuedt.el-20091113204419-o5vbwnq5f7feedwu-617
  lisp/files.el                  files.el-20091113204419-o5vbwnq5f7feedwu-265
  lisp/mpc.el                    mpc.el-20091201190351-ubdosyf8lle4bzd3-10
  lisp/play/bubbles.el           bubbles.el-20091113204419-o5vbwnq5f7feedwu-5217
  lisp/progmodes/executable.el   
executable.el-20091113204419-o5vbwnq5f7feedwu-891
  lisp/reveal.el                 reveal.el-20091113204419-o5vbwnq5f7feedwu-2355
  lisp/saveplace.el              
saveplace.el-20091113204419-o5vbwnq5f7feedwu-622
  lisp/shell.el                  shell.el-20091113204419-o5vbwnq5f7feedwu-150
  lisp/term/pc-win.el            pcwin.el-20091113204419-o5vbwnq5f7feedwu-795
  lisp/w32-common-fns.el         
w32commonfns.el-20120917115700-3at3xhn4to67xnca-4

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-09-12 05:20:07 +0000
+++ b/lisp/ChangeLog    2013-09-12 05:32:57 +0000
@@ -1,3 +1,21 @@
+2013-09-12  Glenn Morris  <address@hidden>
+
+       * 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  <address@hidden>
 
        Cleanup Eshell to rely less on dynamic scoping.

=== modified file 'lisp/dframe.el'
--- a/lisp/dframe.el    2013-08-29 19:55:58 +0000
+++ b/lisp/dframe.el    2013-09-12 05:32:57 +0000
@@ -758,9 +758,8 @@
 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

=== modified file 'lisp/emacs-lisp/copyright.el'
--- a/lisp/emacs-lisp/copyright.el      2013-01-01 09:11:05 +0000
+++ b/lisp/emacs-lisp/copyright.el      2013-09-12 05:32:57 +0000
@@ -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 <address@hidden>
 ;; Keywords: maint, tools
@@ -145,18 +144,17 @@
 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'.

=== modified file 'lisp/emacs-lisp/eldoc.el'
--- a/lisp/emacs-lisp/eldoc.el  2013-08-29 19:55:58 +0000
+++ b/lisp/emacs-lisp/eldoc.el  2013-09-12 05:32:57 +0000
@@ -309,27 +309,26 @@
 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.

=== modified file 'lisp/emulation/tpu-edt.el'
--- a/lisp/emulation/tpu-edt.el 2013-05-15 23:55:41 +0000
+++ b/lisp/emulation/tpu-edt.el 2013-09-12 05:32:57 +0000
@@ -2374,9 +2374,8 @@
     (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)

=== modified file 'lisp/files.el'
--- a/lisp/files.el     2013-09-11 12:36:59 +0000
+++ b/lisp/files.el     2013-09-12 05:32:57 +0000
@@ -3637,21 +3637,17 @@
 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."

=== modified file 'lisp/mpc.el'
--- a/lisp/mpc.el       2013-08-09 21:22:44 +0000
+++ b/lisp/mpc.el       2013-09-12 05:32:57 +0000
@@ -491,10 +491,9 @@
     (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 @@
           (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 @@
                     (`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)

=== modified file 'lisp/play/bubbles.el'
--- a/lisp/play/bubbles.el      2013-03-05 17:13:01 +0000
+++ b/lisp/play/bubbles.el      2013-09-12 05:32:57 +0000
@@ -1108,25 +1108,24 @@
 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."

=== modified file 'lisp/progmodes/executable.el'
--- a/lisp/progmodes/executable.el      2013-01-01 09:11:05 +0000
+++ b/lisp/progmodes/executable.el      2013-09-12 05:32:57 +0000
@@ -269,16 +269,15 @@
        (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)
 

=== modified file 'lisp/reveal.el'
--- a/lisp/reveal.el    2013-01-01 09:11:05 +0000
+++ b/lisp/reveal.el    2013-09-12 05:32:57 +0000
@@ -72,27 +72,26 @@
   ;; - 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))

=== modified file 'lisp/saveplace.el'
--- a/lisp/saveplace.el 2013-09-08 23:15:17 +0000
+++ b/lisp/saveplace.el 2013-09-12 05:32:57 +0000
@@ -255,13 +255,9 @@
                 (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:

=== modified file 'lisp/shell.el'
--- a/lisp/shell.el     2013-08-05 14:26:57 +0000
+++ b/lisp/shell.el     2013-09-12 05:32:57 +0000
@@ -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 <address@hidden>
 ;;     Simon Marshall <address@hidden>
@@ -1015,12 +1014,11 @@
                         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:

=== modified file 'lisp/term/pc-win.el'
--- a/lisp/term/pc-win.el       2013-08-08 23:59:14 +0000
+++ b/lisp/term/pc-win.el       2013-09-12 05:32:57 +0000
@@ -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 <address@hidden>
 ;; Maintainer: FSF
@@ -238,9 +238,8 @@
   (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)

=== modified file 'lisp/w32-common-fns.el'
--- a/lisp/w32-common-fns.el    2013-01-01 09:11:05 +0000
+++ b/lisp/w32-common-fns.el    2013-09-12 05:32:57 +0000
@@ -107,9 +107,8 @@
   (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)