summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog18
-rw-r--r--lisp/dframe.el5
-rw-r--r--lisp/emacs-lisp/copyright.el26
-rw-r--r--lisp/emacs-lisp/eldoc.el41
-rw-r--r--lisp/emulation/tpu-edt.el5
-rw-r--r--lisp/files.el26
-rw-r--r--lisp/mpc.el17
-rw-r--r--lisp/play/bubbles.el37
-rw-r--r--lisp/progmodes/executable.el19
-rw-r--r--lisp/reveal.el41
-rw-r--r--lisp/saveplace.el8
-rw-r--r--lisp/shell.el14
-rw-r--r--lisp/term/pc-win.el9
-rw-r--r--lisp/w32-common-fns.el5
14 files changed, 133 insertions, 138 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7984dc214c4..d5b6b09aab7 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 66967075e34..3ef30d055b6 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 b3fc6fb887a..2b2189e70e3 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 9b9fd325941..250f93800ec 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 1ec0ecc943c..e2fcf2eae41 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 85bbc8596be..ca55c646699 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 825eb3c05d4..bd61c261246 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 665e98a69b2..ca7a4013796 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 a305393c7d8..7b08df8b85f 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 92c1178041c..6740f7e923f 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 e9dc12b00fe..e070a7da489 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 3ca2564b65c..387d1057bd4 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 96831cea9a6..e5229bd3f0a 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 9f3501a01d7..5d8d7171860 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)