Commit 30213927 authored by Glenn Morris's avatar Glenn Morris

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.
parent 170266d0
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.
......
......@@ -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
......
;;; 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'.
......
......@@ -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.
......
......@@ -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)
......
......@@ -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."
......
......@@ -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)
......
......@@ -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."
......
......@@ -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)
......
......@@ -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))
......
......@@ -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:
......
;;; 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:
......
;;; 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)
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment