aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog32
-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/progmodes/octave.el3
-rw-r--r--lisp/progmodes/ruby-mode.el1
-rw-r--r--lisp/reveal.el41
-rw-r--r--lisp/saveplace.el8
-rw-r--r--lisp/shell.el21
-rw-r--r--lisp/term/pc-win.el9
-rw-r--r--lisp/vc/vc-bzr.el7
-rw-r--r--lisp/vc/vc-git.el4
-rw-r--r--lisp/w32-common-fns.el5
18 files changed, 161 insertions, 146 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7984dc214c4..beeb53d5c31 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,35 @@
12013-09-12 Glenn Morris <rgm@gnu.org>
2
3 * vc/vc-bzr.el (vc-exec-after): Remove unused declaration.
4 (vc-compilation-mode): Declare.
5 (vc-bzr-pull): Require vc-dispatcher.
6 * vc/vc-git.el (vc-compilation-mode): Declare.
7 (vc-git-pull): Require vc-dispatcher.
8
9 * progmodes/ruby-mode.el (ruby-syntax-propertize-function): Declare.
10
11 * progmodes/octave.el (help-button-action): Declare.
12
13 * shell.el (shell-directory-tracker): Output error as a message
14 rather than just returning it as a string.
15 (shell-process-pushd): Remove useless use of message.
16
17 * dframe.el (dframe-timer-fn):
18 * files.el (dir-locals-read-from-file):
19 * mpc.el (mpc--status-timer-run, mpc--status-idle-timer-run)
20 (mpc-format):
21 * reveal.el (reveal-post-command):
22 * saveplace.el (load-save-place-alist-from-file):
23 * shell.el (shell-resync-dirs):
24 * w32-common-fns.el (x-get-selection-value):
25 * emacs-lisp/copyright.el (copyright-find-copyright):
26 * emacs-lisp/eldoc.el (eldoc-print-current-symbol-info):
27 * emulation/tpu-edt.el (tpu-copy-keyfile):
28 * play/bubbles.el (bubbles--mark-neighbourhood):
29 * progmodes/executable.el
30 (executable-make-buffer-file-executable-if-script-p):
31 * term/pc-win.el (x-get-selection-value): Use with-demoted-errors.
32
12013-09-12 Stefan Monnier <monnier@iro.umontreal.ca> 332013-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
2 34
3 Cleanup Eshell to rely less on dynamic scoping. 35 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."
758Evaluates all cached timer functions in sequence." 758Evaluates all cached timer functions in sequence."
759 (let ((l dframe-client-functions)) 759 (let ((l dframe-client-functions))
760 (while (and l (sit-for 0)) 760 (while (and l (sit-for 0))
761 (condition-case er 761 (with-demoted-errors "DFRAME TIMER ERROR: %S"
762 (funcall (car l)) 762 (funcall (car l)))
763 (error (message "DFRAME TIMER ERROR: %S" er)))
764 (setq l (cdr l))))) 763 (setq l (cdr l)))))
765 764
766;;; Menu hacking for mouse-3 765;;; 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 @@
1;;; copyright.el --- update the copyright notice in current buffer 1;;; copyright.el --- update the copyright notice in current buffer
2 2
3;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation, 3;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation, Inc.
4;; Inc.
5 4
6;; Author: Daniel Pfeiffer <occitan@esperanto.org> 5;; Author: Daniel Pfeiffer <occitan@esperanto.org>
7;; Keywords: maint, tools 6;; Keywords: maint, tools
@@ -145,18 +144,17 @@ The header must match `copyright-regexp' and `copyright-names-regexp', if set.
145This function sets the match-data that `copyright-update-year' uses." 144This function sets the match-data that `copyright-update-year' uses."
146 (widen) 145 (widen)
147 (goto-char (copyright-start-point)) 146 (goto-char (copyright-start-point))
148 (condition-case err 147 ;; In case the regexp is rejected. This is useful because
149 ;; (1) Need the extra \\( \\) around copyright-regexp because we 148 ;; copyright-update is typically called from before-save-hook where
150 ;; goto (match-end 1) below. See note (2) below. 149 ;; such an error is very inconvenient for the user.
151 (copyright-re-search (concat "\\(" copyright-regexp 150 (with-demoted-errors "Can't update copyright: %s"
152 "\\)\\([ \t]*\n\\)?.*\\(?:" 151 ;; (1) Need the extra \\( \\) around copyright-regexp because we
153 copyright-names-regexp "\\)") 152 ;; goto (match-end 1) below. See note (2) below.
154 (copyright-limit) 153 (copyright-re-search (concat "\\(" copyright-regexp
155 t) 154 "\\)\\([ \t]*\n\\)?.*\\(?:"
156 ;; In case the regexp is rejected. This is useful because 155 copyright-names-regexp "\\)")
157 ;; copyright-update is typically called from before-save-hook where 156 (copyright-limit)
158 ;; such an error is very inconvenient for the user. 157 t)))
159 (error (message "Can't update copyright: %s" err) nil)))
160 158
161(defun copyright-find-end () 159(defun copyright-find-end ()
162 "Possibly adjust the search performed by `copyright-find-copyright'. 160 "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
309Emacs Lisp mode) that support ElDoc.") 309Emacs Lisp mode) that support ElDoc.")
310 310
311(defun eldoc-print-current-symbol-info () 311(defun eldoc-print-current-symbol-info ()
312 (condition-case err 312 ;; This is run from post-command-hook or some idle timer thing,
313 (and (or (eldoc-display-message-p) eldoc-post-insert-mode) 313 ;; so we need to be careful that errors aren't ignored.
314 (if eldoc-documentation-function 314 (with-demoted-errors "eldoc error: %s"
315 (eldoc-message (funcall eldoc-documentation-function)) 315 (and (or (eldoc-display-message-p) eldoc-post-insert-mode)
316 (let* ((current-symbol (eldoc-current-symbol)) 316 (if eldoc-documentation-function
317 (current-fnsym (eldoc-fnsym-in-current-sexp)) 317 (eldoc-message (funcall eldoc-documentation-function))
318 (doc (cond 318 (let* ((current-symbol (eldoc-current-symbol))
319 ((null current-fnsym) 319 (current-fnsym (eldoc-fnsym-in-current-sexp))
320 nil) 320 (doc (cond
321 ((eq current-symbol (car current-fnsym)) 321 ((null current-fnsym)
322 (or (apply 'eldoc-get-fnsym-args-string 322 nil)
323 current-fnsym) 323 ((eq current-symbol (car current-fnsym))
324 (eldoc-get-var-docstring current-symbol))) 324 (or (apply 'eldoc-get-fnsym-args-string
325 (t 325 current-fnsym)
326 (or (eldoc-get-var-docstring current-symbol) 326 (eldoc-get-var-docstring current-symbol)))
327 (apply 'eldoc-get-fnsym-args-string 327 (t
328 current-fnsym)))))) 328 (or (eldoc-get-var-docstring current-symbol)
329 (eldoc-message doc)))) 329 (apply 'eldoc-get-fnsym-args-string
330 ;; This is run from post-command-hook or some idle timer thing, 330 current-fnsym))))))
331 ;; so we need to be careful that errors aren't ignored. 331 (eldoc-message doc))))))
332 (error (message "eldoc error: %s" err))))
333 332
334(defun eldoc-get-fnsym-args-string (sym &optional index) 333(defun eldoc-get-fnsym-args-string (sym &optional index)
335 "Return a string containing the parameter list of the function SYM. 334 "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
2374 (goto-char (point-min)) 2374 (goto-char (point-min))
2375 (beep) 2375 (beep)
2376 (and (tpu-y-or-n-p "Copy key definitions to the new file now? ") 2376 (and (tpu-y-or-n-p "Copy key definitions to the new file now? ")
2377 (condition-case conditions 2377 (with-demoted-errors "Sorry, couldn't copy - %s."
2378 (copy-file oldname newname) 2378 (copy-file oldname newname)))
2379 (error (message "Sorry, couldn't copy - %s." (cdr conditions)))))
2380 (kill-buffer "*TPU-Notice*"))) 2379 (kill-buffer "*TPU-Notice*")))
2381 2380
2382(defvar tpu-edt-old-global-values nil) 2381(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.
3637The new class name is the same as the directory in which FILE 3637The new class name is the same as the directory in which FILE
3638is found. Returns the new class name." 3638is found. Returns the new class name."
3639 (with-temp-buffer 3639 (with-temp-buffer
3640 ;; This is with-demoted-errors, but we want to mention dir-locals 3640 (with-demoted-errors "Error reading dir-locals: %S"
3641 ;; in any error message. 3641 (insert-file-contents file)
3642 (condition-case err 3642 (unless (zerop (buffer-size))
3643 (progn 3643 (let* ((dir-name (file-name-directory file))
3644 (insert-file-contents file) 3644 (class-name (intern dir-name))
3645 (unless (zerop (buffer-size)) 3645 (variables (let ((read-circle nil))
3646 (let* ((dir-name (file-name-directory file)) 3646 (read (current-buffer)))))
3647 (class-name (intern dir-name)) 3647 (dir-locals-set-class-variables class-name variables)
3648 (variables (let ((read-circle nil)) 3648 (dir-locals-set-directory-class dir-name class-name
3649 (read (current-buffer))))) 3649 (nth 5 (file-attributes file)))
3650 (dir-locals-set-class-variables class-name variables) 3650 class-name)))))
3651 (dir-locals-set-directory-class dir-name class-name
3652 (nth 5 (file-attributes file)))
3653 class-name)))
3654 (error (message "Error reading dir-locals: %S" err) nil))))
3655 3651
3656(defcustom enable-remote-dir-locals nil 3652(defcustom enable-remote-dir-locals nil
3657 "Non-nil means dir-local variables will be applied to remote files." 3653 "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.")
491 (cancel-timer mpc--status-timer) 491 (cancel-timer mpc--status-timer)
492 (setq mpc--status-timer nil))) 492 (setq mpc--status-timer nil)))
493(defun mpc--status-timer-run () 493(defun mpc--status-timer-run ()
494 (condition-case err 494 (with-demoted-errors "MPC: %s"
495 (when (process-get (mpc-proc) 'ready) 495 (when (process-get (mpc-proc) 'ready)
496 (with-local-quit (mpc-status-refresh))) 496 (with-local-quit (mpc-status-refresh)))))
497 (error (message "MPC: %s" err))))
498 497
499(defvar mpc--status-idle-timer nil) 498(defvar mpc--status-idle-timer nil)
500(defun mpc--status-idle-timer-start () 499(defun mpc--status-idle-timer-start ()
@@ -520,9 +519,8 @@ to call FUN for any change whatsoever.")
520 (run-with-idle-timer 10 t 'mpc--status-idle-timer-run)))) 519 (run-with-idle-timer 10 t 'mpc--status-idle-timer-run))))
521(defun mpc--status-idle-timer-run () 520(defun mpc--status-idle-timer-run ()
522 (when (process-get (mpc-proc) 'ready) 521 (when (process-get (mpc-proc) 'ready)
523 (condition-case err 522 (with-demoted-errors "MPC: %s"
524 (with-local-quit (mpc-status-refresh)) 523 (with-local-quit (mpc-status-refresh))))
525 (error (message "MPC: %s" err))))
526 (mpc--status-timer-start)) 524 (mpc--status-timer-start))
527 525
528(defun mpc--status-timers-refresh () 526(defun mpc--status-timers-refresh ()
@@ -999,9 +997,8 @@ If PLAYLIST is t or nil or missing, use the main playlist."
999 (`Cover 997 (`Cover
1000 (let* ((dir (file-name-directory (cdr (assq 'file info)))) 998 (let* ((dir (file-name-directory (cdr (assq 'file info))))
1001 (cover (concat dir "cover.jpg")) 999 (cover (concat dir "cover.jpg"))
1002 (file (condition-case err 1000 (file (with-demoted-errors "MPC: %s"
1003 (mpc-file-local-copy cover) 1001 (mpc-file-local-copy cover)))
1004 (error (message "MPC: %s" err))))
1005 image) 1002 image)
1006 ;; (debug) 1003 ;; (debug)
1007 (push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred) 1004 (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'."
1108Use optional parameter POS instead of point if given." 1108Use optional parameter POS instead of point if given."
1109 (when bubbles--playing 1109 (when bubbles--playing
1110 (unless pos (setq pos (point))) 1110 (unless pos (setq pos (point)))
1111 (condition-case err 1111 (with-demoted-errors "Bubbles: Internal error %s"
1112 (let ((char (char-after pos)) 1112 (let ((char (char-after pos))
1113 (inhibit-read-only t) 1113 (inhibit-read-only t)
1114 (row (bubbles--row (point))) 1114 (row (bubbles--row (point)))
1115 (col (bubbles--col (point)))) 1115 (col (bubbles--col (point))))
1116 (add-text-properties (point-min) (point-max) 1116 (add-text-properties (point-min) (point-max)
1117 '(face default active nil)) 1117 '(face default active nil))
1118 (let ((count 0)) 1118 (let ((count 0))
1119 (when (and row col (not (eq char (bubbles--empty-char)))) 1119 (when (and row col (not (eq char (bubbles--empty-char))))
1120 (setq count (bubbles--mark-direct-neighbours row col char)) 1120 (setq count (bubbles--mark-direct-neighbours row col char))
1121 (unless (> count 1) 1121 (unless (> count 1)
1122 (add-text-properties (point-min) (point-max) 1122 (add-text-properties (point-min) (point-max)
1123 '(face default active nil)) 1123 '(face default active nil))
1124 (setq count 0))) 1124 (setq count 0)))
1125 (bubbles--update-neighbourhood-score count)) 1125 (bubbles--update-neighbourhood-score count))
1126 (put-text-property (point-min) (point-max) 'pointer 'arrow) 1126 (put-text-property (point-min) (point-max) 'pointer 'arrow)
1127 (bubbles--update-faces-or-images) 1127 (bubbles--update-faces-or-images)
1128 (sit-for 0)) 1128 (sit-for 0)))))
1129 (error (message "Bubbles: Internal error %s" err)))))
1130 1129
1131(defun bubbles--neighbourhood-available () 1130(defun bubbles--neighbourhood-available ()
1132 "Return t if another valid neighborhood is available." 1131 "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."
269 (save-restriction 269 (save-restriction
270 (widen) 270 (widen)
271 (string= "#!" (buffer-substring (point-min) (+ 2 (point-min))))) 271 (string= "#!" (buffer-substring (point-min) (+ 2 (point-min)))))
272 (condition-case nil 272 ;; Eg file-modes can return nil (bug#9879). It should not,
273 (let* ((current-mode (file-modes (buffer-file-name))) 273 ;; in this context, but we should handle it all the same.
274 (add-mode (logand ?\111 (default-file-modes)))) 274 (with-demoted-errors "Unable to make file executable: %s"
275 (or (/= (logand ?\111 current-mode) 0) 275 (let* ((current-mode (file-modes (buffer-file-name)))
276 (zerop add-mode) 276 (add-mode (logand ?\111 (default-file-modes))))
277 (set-file-modes (buffer-file-name) 277 (or (/= (logand ?\111 current-mode) 0)
278 (logior current-mode add-mode)))) 278 (zerop add-mode)
279 ;; Eg file-modes can return nil (bug#9879). It should not, 279 (set-file-modes (buffer-file-name)
280 ;; in this context, but we should handle it all the same. 280 (logior current-mode add-mode)))))))
281 (error (message "Unable to make file executable")))))
282 281
283(provide 'executable) 282(provide 'executable)
284 283
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index de1c26a7fa7..f20a57940be 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1581,6 +1581,9 @@ code line."
1581 :group 'octave 1581 :group 'octave
1582 :version "24.4") 1582 :version "24.4")
1583 1583
1584;; Used in a mode derived from help-mode.
1585(declare-function help-button-action "help-mode" (button))
1586
1584(define-button-type 'octave-help-file 1587(define-button-type 'octave-help-file
1585 'follow-link t 1588 'follow-link t
1586 'action #'help-button-action 1589 'action #'help-button-action
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 0f868255589..902616e3023 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1377,6 +1377,7 @@ If the result is do-end block, it will always be multiline."
1377;; Unusual code layout confuses the byte-compiler. 1377;; Unusual code layout confuses the byte-compiler.
1378(declare-function ruby-syntax-propertize-expansion "ruby-mode" ()) 1378(declare-function ruby-syntax-propertize-expansion "ruby-mode" ())
1379(declare-function ruby-syntax-expansion-allowed-p "ruby-mode" (parse-state)) 1379(declare-function ruby-syntax-expansion-allowed-p "ruby-mode" (parse-state))
1380(declare-function ruby-syntax-propertize-function "ruby-mode" (start end))
1380 1381
1381(if (eval-when-compile (fboundp #'syntax-propertize-rules)) 1382(if (eval-when-compile (fboundp #'syntax-propertize-rules))
1382 ;; New code that works independently from font-lock. 1383 ;; New code that works independently from font-lock.
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).")
72 ;; - we only refresh spots in the current window. 72 ;; - we only refresh spots in the current window.
73 ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ? 73 ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ?
74 (with-local-quit 74 (with-local-quit
75 (condition-case err 75 (with-demoted-errors "Reveal: %s"
76 (let ((old-ols 76 (let ((old-ols
77 (delq nil 77 (delq nil
78 (mapcar 78 (mapcar
79 (lambda (x) 79 (lambda (x)
80 ;; We refresh any spot in the current window as well 80 ;; We refresh any spot in the current window as well
81 ;; as any spots associated with a dead window or 81 ;; as any spots associated with a dead window or
82 ;; a window which does not show this buffer any more. 82 ;; a window which does not show this buffer any more.
83 (cond 83 (cond
84 ((eq (car x) (selected-window)) (cdr x)) 84 ((eq (car x) (selected-window)) (cdr x))
85 ((not (and (window-live-p (car x)) 85 ((not (and (window-live-p (car x))
86 (eq (window-buffer (car x)) (current-buffer)))) 86 (eq (window-buffer (car x)) (current-buffer))))
87 ;; Adopt this since it's owned by a window that's 87 ;; Adopt this since it's owned by a window that's
88 ;; either not live or at least not showing this 88 ;; either not live or at least not showing this
89 ;; buffer any more. 89 ;; buffer any more.
90 (setcar x (selected-window)) 90 (setcar x (selected-window))
91 (cdr x)))) 91 (cdr x))))
92 reveal-open-spots)))) 92 reveal-open-spots))))
93 (setq old-ols (reveal-open-new-overlays old-ols)) 93 (setq old-ols (reveal-open-new-overlays old-ols))
94 (reveal-close-old-overlays old-ols)) 94 (reveal-close-old-overlays old-ols)))))
95 (error (message "Reveal: %s" err)))))
96 95
97(defun reveal-open-new-overlays (old-ols) 96(defun reveal-open-new-overlays (old-ols)
98 (let ((repeat t)) 97 (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'."
255 (insert-file-contents file) 255 (insert-file-contents file)
256 (goto-char (point-min)) 256 (goto-char (point-min))
257 (setq save-place-alist 257 (setq save-place-alist
258 ;; This is with-demoted-errors, but we want to 258 (with-demoted-errors "Error reading save-place-file: %S"
259 ;; mention save-place in any error message.
260 (condition-case err
261 (car (read-from-string 259 (car (read-from-string
262 (buffer-substring (point-min) (point-max)))) 260 (buffer-substring (point-min) (point-max))))))
263 (error (message "Error reading save-place-file: %S" err)
264 nil)))
265 261
266 ;; If there is a limit, and we're over it, then we'll 262 ;; If there is a limit, and we're over it, then we'll
267 ;; have to truncate the end of the list: 263 ;; have to truncate the end of the list:
diff --git a/lisp/shell.el b/lisp/shell.el
index 3ca2564b65c..2047543f288 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1,7 +1,6 @@
1;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*- 1;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1988, 1993-1997, 2000-2013 Free Software Foundation, 3;; Copyright (C) 1988, 1993-1997, 2000-2013 Free Software Foundation, Inc.
4;; Inc.
5 4
6;; Author: Olin Shivers <shivers@cs.cmu.edu> 5;; Author: Olin Shivers <shivers@cs.cmu.edu>
7;; Simon Marshall <simon@gnu.org> 6;; Simon Marshall <simon@gnu.org>
@@ -792,7 +791,7 @@ and `shell-pushd-dunique' control the behavior of the relevant command.
792Environment variables are expanded, see function `substitute-in-file-name'." 791Environment variables are expanded, see function `substitute-in-file-name'."
793 (if shell-dirtrackp 792 (if shell-dirtrackp
794 ;; We fail gracefully if we think the command will fail in the shell. 793 ;; We fail gracefully if we think the command will fail in the shell.
795 (condition-case nil 794 (with-demoted-errors "Couldn't cd: %s"
796 (let ((start (progn (string-match 795 (let ((start (progn (string-match
797 (concat "^" shell-command-separator-regexp) 796 (concat "^" shell-command-separator-regexp)
798 str) ; skip whitespace 797 str) ; skip whitespace
@@ -825,8 +824,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
825 (setq start (progn (string-match shell-command-separator-regexp 824 (setq start (progn (string-match shell-command-separator-regexp
826 str end) 825 str end)
827 ;; skip again 826 ;; skip again
828 (match-end 0))))) 827 (match-end 0))))))))
829 (error "Couldn't cd"))))
830 828
831(defun shell-unquote-argument (string) 829(defun shell-unquote-argument (string)
832 "Remove all kinds of shell quoting from STRING." 830 "Remove all kinds of shell quoting from STRING."
@@ -908,7 +906,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
908 (cond ((> num (length shell-dirstack)) 906 (cond ((> num (length shell-dirstack))
909 (message "Directory stack not that deep.")) 907 (message "Directory stack not that deep."))
910 ((= num 0) 908 ((= num 0)
911 (error (message "Couldn't cd"))) 909 (error "Couldn't cd"))
912 (shell-pushd-dextract 910 (shell-pushd-dextract
913 (let ((dir (nth (1- num) shell-dirstack))) 911 (let ((dir (nth (1- num) shell-dirstack)))
914 (shell-process-popd arg) 912 (shell-process-popd arg)
@@ -1015,12 +1013,11 @@ command again."
1015 ds)) 1013 ds))
1016 (setq i (match-end 0))) 1014 (setq i (match-end 0)))
1017 (let ((ds (nreverse ds))) 1015 (let ((ds (nreverse ds)))
1018 (condition-case nil 1016 (with-demoted-errors "Couldn't cd: %s"
1019 (progn (shell-cd (car ds)) 1017 (shell-cd (car ds))
1020 (setq shell-dirstack (cdr ds) 1018 (setq shell-dirstack (cdr ds)
1021 shell-last-dir (car shell-dirstack)) 1019 shell-last-dir (car shell-dirstack))
1022 (shell-dirstack-message)) 1020 (shell-dirstack-message)))))
1023 (error (message "Couldn't cd"))))))
1024 (if started-at-pmark (goto-char (marker-position pmark))))) 1021 (if started-at-pmark (goto-char (marker-position pmark)))))
1025 1022
1026;; For your typing convenience: 1023;; 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 @@
1;;; pc-win.el --- setup support for `PC windows' (whatever that is) 1;;; pc-win.el --- setup support for `PC windows' (whatever that is)
2 2
3;; Copyright (C) 1994, 1996-1997, 1999, 2001-2013 Free Software 3;; Copyright (C) 1994, 1996-1997, 1999, 2001-2013
4;; Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: Morten Welinder <terra@diku.dk> 6;; Author: Morten Welinder <terra@diku.dk>
7;; Maintainer: FSF 7;; Maintainer: FSF
@@ -238,9 +238,8 @@ is not used)."
238 (if x-select-enable-clipboard 238 (if x-select-enable-clipboard
239 (let (text) 239 (let (text)
240 ;; Don't die if x-get-selection signals an error. 240 ;; Don't die if x-get-selection signals an error.
241 (condition-case c 241 (with-demoted-errors "w16-get-clipboard-data:%s"
242 (setq text (w16-get-clipboard-data)) 242 (setq text (w16-get-clipboard-data)))
243 (error (message "w16-get-clipboard-data:%s" c)))
244 (if (string= text "") (setq text nil)) 243 (if (string= text "") (setq text nil))
245 (cond 244 (cond
246 ((not text) nil) 245 ((not text) nil)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 5f5416dc2ff..3b8643e22f4 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -320,11 +320,9 @@ in the repository root directory of FILE."
320 ("^Using saved parent location: \\(.+\\)" 1 nil nil 0)) 320 ("^Using saved parent location: \\(.+\\)" 1 nil nil 0))
321 "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.") 321 "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
322 322
323;; Follows vc-bzr-(async-)command, which uses vc-do-(async-)command 323;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
324;; from vc-dispatcher.
325(declare-function vc-exec-after "vc-dispatcher" (code))
326;; Follows vc-exec-after.
327(declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) 324(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
325(declare-function vc-compilation-mode "vc-dispatcher" (backend))
328 326
329(defun vc-bzr-pull (prompt) 327(defun vc-bzr-pull (prompt)
330 "Pull changes into the current Bzr branch. 328 "Pull changes into the current Bzr branch.
@@ -354,6 +352,7 @@ prompt for the Bzr command to run."
354 (setq vc-bzr-program (car args) 352 (setq vc-bzr-program (car args)
355 command (cadr args) 353 command (cadr args)
356 args (cddr args))) 354 args (cddr args)))
355 (require 'vc-dispatcher)
357 (let ((buf (apply 'vc-bzr-async-command command args))) 356 (let ((buf (apply 'vc-bzr-async-command command args)))
358 (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr))) 357 (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
359 (vc-set-async-update buf)))) 358 (vc-set-async-update buf))))
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index a4ce3a2c46c..e730db17526 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -706,6 +706,9 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
706 '(("^ \\(.+\\) |" 1 nil nil 0)) 706 '(("^ \\(.+\\) |" 1 nil nil 0))
707 "Value of `compilation-error-regexp-alist' in *vc-git* buffers.") 707 "Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
708 708
709;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
710(declare-function vc-compilation-mode "vc-dispatcher" (backend))
711
709(defun vc-git-pull (prompt) 712(defun vc-git-pull (prompt)
710 "Pull changes into the current Git branch. 713 "Pull changes into the current Git branch.
711Normally, this runs \"git pull\". If PROMPT is non-nil, prompt 714Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
@@ -725,6 +728,7 @@ for the Git command to run."
725 (setq git-program (car args) 728 (setq git-program (car args)
726 command (cadr args) 729 command (cadr args)
727 args (cddr args))) 730 args (cddr args)))
731 (require 'vc-dispatcher)
728 (apply 'vc-do-async-command buffer root git-program command args) 732 (apply 'vc-do-async-command buffer root git-program command args)
729 (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git))) 733 (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
730 (vc-set-async-update buffer))) 734 (vc-set-async-update buffer)))
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."
107 (if x-select-enable-clipboard 107 (if x-select-enable-clipboard
108 (let (text) 108 (let (text)
109 ;; Don't die if x-get-selection signals an error. 109 ;; Don't die if x-get-selection signals an error.
110 (condition-case c 110 (with-demoted-errors "w32-get-clipboard-data:%s"
111 (setq text (w32-get-clipboard-data)) 111 (setq text (w32-get-clipboard-data)))
112 (error (message "w32-get-clipboard-data:%s" c)))
113 (if (string= text "") (setq text nil)) 112 (if (string= text "") (setq text nil))
114 (cond 113 (cond
115 ((not text) nil) 114 ((not text) nil)