Mercurial > emacs
changeset 109200:141ddbd4a5e0
Merge from mainline.
| author | Katsumi Yamaoka <katsumi@flagship2> |
|---|---|
| date | Sat, 22 May 2010 03:32:53 +0000 |
| parents | d2833c80c27c (current diff) 4b1caf0bded6 (diff) |
| children | 0aaff477ec9f |
| files | |
| diffstat | 13 files changed, 586 insertions(+), 484 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Fri May 21 12:26:07 2010 +0000 +++ b/ChangeLog Sat May 22 03:32:53 2010 +0000 @@ -1,5 +1,7 @@ 2010-05-21 Glenn Morris <rgm@gnu.org> + * configure.in (MKDEPDIR): Parallel build tweak. + * configure.in (ns_frag): New output file. * configure.in (OLDXMENU): Set to "nothing" if !HAVE_X11 || USE_GTK.
--- a/configure.in Fri May 21 12:26:07 2010 +0000 +++ b/configure.in Sat May 22 03:32:53 2010 +0000 @@ -1376,7 +1376,10 @@ fi if test $ac_enable_autodepend = yes; then DEPFLAGS='-MMD -MF ${DEPDIR}/$*.d' - MKDEPDIR='test -d ${DEPDIR} || mkdir ${DEPDIR}' + ## In parallel builds, another make might create depdir between + ## the first test and mkdir, so stick another test on the end. + ## Or use mkinstalldirs? mkdir -p is not portable. + MKDEPDIR='test -d ${DEPDIR} || mkdir ${DEPDIR} || test -d ${DEPDIR}' deps_frag=autodeps.mk fi fi
--- a/lisp/ChangeLog Fri May 21 12:26:07 2010 +0000 +++ b/lisp/ChangeLog Sat May 22 03:32:53 2010 +0000 @@ -1,3 +1,33 @@ +2010-05-21 Juri Linkov <juri@jurta.org> + + * progmodes/grep.el (grep-read-files): Fix multi-pattern aliases. + Remove "all" from grep-files-aliases. Split grep-files-aliases by + whitespace, call wildcard-to-regexp on substrings and concat them + with "\\|". (Bug#6114) + +2010-05-21 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-engine.el (c-parse-state-get-strategy): Replace + parameter `here' with `here-' and `here-plus', which sandwich any + pertinent CPP construct. + (c-remove-stale-state-cache-backwards): Fix a bug which happens + when doing (c-parse-state) in a CPP construct: Exclude any "new" + CPP construct from taking part in the scanning. + +2010-05-21 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-do-copy-or-rename-file) + (tramp-handle-file-local-copy, tramp-maybe-open-connection): Tune + `with-progress-reporter' messages. + (tramp-handle-vc-registered): + * net/tramp-fish.el (tramp-fish-handle-file-local-copy) + (tramp-fish-handle-insert-file-contents) + (tramp-fish-maybe-open-connection): + * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): + * net/tramp-imap.el (tramp-imap-do-copy-or-rename-file) + (tramp-imap-handle-insert-file-contents) + (tramp-imap-handle-file-local-copy): Use `with-progress-reporter'. + 2010-05-21 Juanma Barranquero <lekktu@gmail.com> * add-log.el (change-log-font-lock-keywords):
--- a/lisp/net/tramp-fish.el Fri May 21 12:26:07 2010 +0000 +++ b/lisp/net/tramp-fish.el Sat May 22 03:32:53 2010 +0000 @@ -149,8 +149,11 @@ ;; parameter of `write-region'. Transfer of binary data fails due to ;; Emacs' process input/output handling. +;;; Code: -;;; Code: +(eval-when-compile + ;; Pacify byte-compiler. + (require 'cl)) (require 'tramp) (require 'tramp-cache) @@ -487,13 +490,13 @@ v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) - (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile) - (when (tramp-fish-retrieve-data v) - ;; Save file - (with-current-buffer (tramp-get-buffer v) - (write-region (point-min) (point-max) tmpfile)) - (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile) - tmpfile)))) + (with-progress-reporter + v 3 (format "Fetching %s to tmp file %s" filename tmpfile) + (when (tramp-fish-retrieve-data v) + ;; Save file + (with-current-buffer (tramp-get-buffer v) + (write-region (point-min) (point-max) tmpfile)) + tmpfile))))) ;; This function should return "foo/" for directories and "bar" for ;; files. @@ -591,17 +594,16 @@ (let ((point (point)) size) - (tramp-message v 4 "Fetching file %s..." filename) - (when (tramp-fish-retrieve-data v) - ;; Insert file - (insert - (with-current-buffer (tramp-get-buffer v) - (let ((beg (or beg (point-min))) - (end (min (or end (point-max)) (point-max)))) - (setq size (- end beg)) - (buffer-substring beg end)))) - (goto-char point)) - (tramp-message v 4 "Fetching file %s...done" filename) + (with-progress-reporter v 3 (format "Fetching file %s" filename) + (when (tramp-fish-retrieve-data v) + ;; Insert file + (insert + (with-current-buffer (tramp-get-buffer v) + (let ((beg (or beg (point-min))) + (end (min (or end (point-max)) (point-max)))) + (setq size (- end beg)) + (buffer-substring beg end)))) + (goto-char point))) (list (expand-file-name filename) size))))) @@ -1115,34 +1117,36 @@ (delete-process p)) (setenv "TERM" tramp-terminal-type) (setenv "PS1" tramp-initial-end-of-output) - (tramp-message - vec 3 "Opening connection for %s@%s using %s..." - tramp-current-user tramp-current-host tramp-current-method) + (with-progress-reporter + vec 3 + (format "Opening connection for %s@%s using %s" + tramp-current-user tramp-current-host tramp-current-method) - (let* ((process-connection-type tramp-process-connection-type) - (inhibit-eol-conversion nil) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) - ;; This must be done in order to avoid our file name handler. - (p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (start-process - (or (tramp-get-connection-property vec "process-name" nil) - (tramp-buffer-name vec)) - (tramp-get-connection-buffer vec) - "ssh" "-l" - (tramp-file-name-user vec) - (tramp-file-name-host vec))))) - (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) + (let* ((process-connection-type tramp-process-connection-type) + (inhibit-eol-conversion nil) + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) + ;; This must be done in order to avoid our file name handler. + (p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (start-process + (or (tramp-get-connection-property vec "process-name" nil) + (tramp-buffer-name vec)) + (tramp-get-connection-buffer vec) + "ssh" "-l" + (tramp-file-name-user vec) + (tramp-file-name-host vec))))) + (tramp-message + vec 6 "%s" (mapconcat 'identity (process-command p) " ")) - ;; Check whether process is alive. - (tramp-set-process-query-on-exit-flag p nil) + ;; Check whether process is alive. + (tramp-set-process-query-on-exit-flag p nil) - (tramp-process-actions p vec tramp-actions-before-shell 60) - (tramp-fish-send-command vec tramp-fish-start-fish-server-command) - (tramp-message - vec 3 - "Found remote shell prompt on `%s'" (tramp-file-name-host vec)))))) + (tramp-process-actions p vec tramp-actions-before-shell 60) + (tramp-fish-send-command vec tramp-fish-start-fish-server-command) + (tramp-message + vec 3 + "Found remote shell prompt on `%s'" (tramp-file-name-host vec))))))) (defun tramp-fish-send-command (vec command) "Send the COMMAND to connection VEC."
--- a/lisp/net/tramp-gvfs.el Fri May 21 12:26:07 2010 +0000 +++ b/lisp/net/tramp-gvfs.el Sat May 22 03:32:53 2010 +0000 @@ -1067,65 +1067,58 @@ (tramp-gvfs-object-path (tramp-make-tramp-file-name method user host "")))) - (if (zerop (length (tramp-file-name-user vec))) - (tramp-message - vec 3 "Opening connection for %s using %s..." host method) - (tramp-message - vec 3 "Opening connection for %s@%s using %s..." user host method)) + (with-progress-reporter + vec 3 + (if (zerop (length user)) + (format "Opening connection for %s using %s" host method) + (format "Opening connection for %s@%s using %s" user host method)) - ;; Enable auth-sorce and password-cache. - (tramp-set-connection-property vec "first-password-request" t) + ;; Enable auth-sorce and password-cache. + (tramp-set-connection-property vec "first-password-request" t) - ;; There will be a callback of "askPassword", when a password is - ;; needed. - (dbus-register-method - :session dbus-service-emacs object-path - tramp-gvfs-interface-mountoperation "askPassword" - 'tramp-gvfs-handler-askpassword) + ;; There will be a callback of "askPassword", when a password is + ;; needed. + (dbus-register-method + :session dbus-service-emacs object-path + tramp-gvfs-interface-mountoperation "askPassword" + 'tramp-gvfs-handler-askpassword) - ;; There could be a callback of "askQuestion", when adding fingerprint. - (dbus-register-method - :session dbus-service-emacs object-path - tramp-gvfs-interface-mountoperation "askQuestion" - 'tramp-gvfs-handler-askquestion) + ;; There could be a callback of "askQuestion", when adding fingerprint. + (dbus-register-method + :session dbus-service-emacs object-path + tramp-gvfs-interface-mountoperation "askQuestion" + 'tramp-gvfs-handler-askquestion) - ;; The call must be asynchronously, because of the "askPassword" - ;; or "askQuestion"callbacks. - (with-tramp-dbus-call-method vec nil - :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker - tramp-gvfs-interface-mounttracker "mountLocation" - `(:struct - ,(dbus-string-to-byte-array "/") - ,(tramp-gvfs-mount-spec vec)) - (dbus-get-unique-name :session) - :object-path object-path) + ;; The call must be asynchronously, because of the "askPassword" + ;; or "askQuestion"callbacks. + (with-tramp-dbus-call-method vec nil + :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker + tramp-gvfs-interface-mounttracker "mountLocation" + `(:struct + ,(dbus-string-to-byte-array "/") + ,(tramp-gvfs-mount-spec vec)) + (dbus-get-unique-name :session) + :object-path object-path) - ;; We must wait, until the mount is applied. This will be - ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint" - ;; file property. - (with-timeout - (60 - (if (zerop (length (tramp-file-name-user vec))) + ;; We must wait, until the mount is applied. This will be + ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint" + ;; file property. + (with-timeout + (60 + (if (zerop (length (tramp-file-name-user vec))) + (tramp-error + vec 'file-error + "Timeout reached mounting %s using %s" host method) (tramp-error vec 'file-error - "Timeout reached mounting %s using %s" host method) - (tramp-error - vec 'file-error - "Timeout reached mounting %s@%s using %s" user host method))) - (while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil)) - (read-event nil nil 0.1))) + "Timeout reached mounting %s@%s using %s" user host method))) + (while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil)) + (read-event nil nil 0.1))) - ;; We set the connection property "started" in order to put the - ;; remote location into the cache, which is helpful for further - ;; completion. - (tramp-set-connection-property vec "started" t) - - (if (zerop (length (tramp-file-name-user vec))) - (tramp-message - vec 3 "Opening connection for %s using %s...done" host method) - (tramp-message - vec 3 - "Opening connection for %s@%s using %s...done" user host method))))) + ;; We set the connection property "started" in order to put the + ;; remote location into the cache, which is helpful for further + ;; completion. + (tramp-set-connection-property vec "started" t))))) ;; D-Bus BLUEZ functions.
--- a/lisp/net/tramp-imap.el Fri May 21 12:26:07 2010 +0000 +++ b/lisp/net/tramp-imap.el Sat May 22 03:32:53 2010 +0000 @@ -241,32 +241,31 @@ (t2 (and (tramp-tramp-file-p newname) (tramp-imap-file-name-p newname)))) - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (with-parsed-tramp-file-name (if t1 filename newname) nil + (with-parsed-tramp-file-name (if t1 filename newname) nil + (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error - v 'file-already-exists "File %s already exists" newname))) + v 'file-already-exists "File %s already exists" newname)) - (with-parsed-tramp-file-name (if t1 filename newname) nil - (tramp-message v 0 "Transferring %s to %s..." filename newname)) + (with-progress-reporter + v 0 (format "%s %s to %s" + (if (eq op 'copy) "Copying" "Renaming") + filename newname) - ;; We just make a local copy of FILENAME, and write it then to - ;; NEWNAME. This must be optimized, when both files are located - ;; on the same IMAP server. - (with-temp-buffer - (if (and t1 t2) - ;; We don't encrypt. - (with-parsed-tramp-file-name newname nil - (insert (tramp-imap-get-file filename nil)) - (tramp-imap-put-file - v (current-buffer) - (tramp-imap-file-name-name v) - nil nil (nth 7 (file-attributes filename)))) - ;; One of them is not located on a IMAP mailbox. - (insert-file-contents filename) - (write-region (point-min) (point-max) newname))) - - (with-parsed-tramp-file-name (if t1 filename newname) nil - (tramp-message v 0 "Transferring %s to %s...done" filename newname)) + ;; We just make a local copy of FILENAME, and write it then to + ;; NEWNAME. This must be optimized, when both files are + ;; located on the same IMAP server. + (with-temp-buffer + (if (and t1 t2) + ;; We don't encrypt. + (with-parsed-tramp-file-name newname v1 + (insert (tramp-imap-get-file filename nil)) + (tramp-imap-put-file + v1 (current-buffer) + (tramp-imap-file-name-name v1) + nil nil (nth 7 (file-attributes filename)))) + ;; One of them is not located on a IMAP mailbox. + (insert-file-contents filename) + (write-region (point-min) (point-max) newname))))) (when (eq op 'rename) (tramp-compat-delete-file filename 'force)))) @@ -505,17 +504,16 @@ v 'file-error "File `%s' not found on remote host" filename) (let ((point (point)) size data) - (tramp-message v 4 "Fetching file %s..." filename) - (insert (tramp-imap-get-file filename t)) - (setq size (- (point) point)) + (with-progress-reporter v 3 (format "Fetching file %s" filename) + (insert (tramp-imap-get-file filename t)) + (setq size (- (point) point)) ;;; TODO: handle ranges. ;;; (let ((beg (or beg (point-min))) ;;; (end (min (or end (point-max)) (point-max)))) ;;; (setq size (- end beg)) ;;; (buffer-substring beg end)) - (goto-char point) - (tramp-message v 4 "Fetching file %s...done" filename) - (list (expand-file-name filename) size))))) + (goto-char point) + (list (expand-file-name filename) size)))))) (defun tramp-imap-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." @@ -588,12 +586,12 @@ v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) - (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile) - (with-temp-buffer - (insert-file-contents filename) - (write-region (point-min) (point-max) tmpfile) - (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile) - tmpfile)))) + (with-progress-reporter + v 3 (format "Fetching %s to tmp file %s" filename tmpfile) + (with-temp-buffer + (insert-file-contents filename) + (write-region (point-min) (point-max) tmpfile) + tmpfile))))) (defun tramp-imap-put-file (vec filename-or-buffer &optional subject inode encode size)
--- a/lisp/net/tramp.el Fri May 21 12:26:07 2010 +0000 +++ b/lisp/net/tramp.el Sat May 22 03:32:53 2010 +0000 @@ -3659,85 +3659,86 @@ (apply 'file-selinux-context (list filename)))) pr tm) - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (with-parsed-tramp-file-name (if t1 filename newname) nil + (with-parsed-tramp-file-name (if t1 filename newname) nil + (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error - v 'file-already-exists "File %s already exists" newname))) - - (with-parsed-tramp-file-name (if t1 filename newname) nil + v 'file-already-exists "File %s already exists" newname)) + (with-progress-reporter - v 0 (format "Transferring %s to %s" filename newname) - - (cond - ;; Both are Tramp files. - ((and t1 t2) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 - (cond - ;; Shortcut: if method, host, user are the same for both - ;; files, we invoke `cp' or `mv' on the remote host - ;; directly. - ((tramp-equal-remote filename newname) - (tramp-do-copy-or-rename-file-directly - op filename newname - ok-if-already-exists keep-date preserve-uid-gid)) - - ;; Try out-of-band operation. - ((tramp-method-out-of-band-p - v1 (nth 7 (file-attributes filename))) - (tramp-do-copy-or-rename-file-out-of-band - op filename newname keep-date)) - - ;; No shortcut was possible. So we copy the - ;; file first. If the operation was `rename', we go - ;; back and delete the original file (if the copy was - ;; successful). The approach is simple-minded: we - ;; create a new buffer, insert the contents of the - ;; source file into it, then write out the buffer to - ;; the target file. The advantage is that it doesn't - ;; matter which filename handlers are used for the - ;; source and target file. - (t - (tramp-do-copy-or-rename-file-via-buffer - op filename newname keep-date)))))) - - ;; One file is a Tramp file, the other one is local. - ((or t1 t2) - (cond - ;; Fast track on local machine. - ((tramp-local-host-p v) - (tramp-do-copy-or-rename-file-directly - op filename newname - ok-if-already-exists keep-date preserve-uid-gid)) - - ;; If the Tramp file has an out-of-band method, the corresponding - ;; copy-program can be invoked. - ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename))) - (tramp-do-copy-or-rename-file-out-of-band - op filename newname keep-date)) - - ;; Use the inline method via a Tramp buffer. - (t (tramp-do-copy-or-rename-file-via-buffer - op filename newname keep-date)))) - - (t - ;; One of them must be a Tramp file. - (error "Tramp implementation says this cannot happen"))) - - ;; Handle `preserve-selinux-context'. - (when context (apply 'set-file-selinux-context (list newname context))) - - ;; In case of `rename', we must flush the cache of the source file. - (when (and t1 (eq op 'rename)) - (with-parsed-tramp-file-name filename v1 - (tramp-flush-file-property v1 (file-name-directory localname)) - (tramp-flush-file-property v1 localname))) - - ;; When newname did exist, we have wrong cached values. - (when t2 - (with-parsed-tramp-file-name newname v2 - (tramp-flush-file-property v2 (file-name-directory localname)) - (tramp-flush-file-property v2 localname))))))) + v 0 (format "%s %s to %s" + (if (eq op 'copy) "Copying" "Renaming") + filename newname) + + (cond + ;; Both are Tramp files. + ((and t1 t2) + (with-parsed-tramp-file-name filename v1 + (with-parsed-tramp-file-name newname v2 + (cond + ;; Shortcut: if method, host, user are the same for + ;; both files, we invoke `cp' or `mv' on the remote + ;; host directly. + ((tramp-equal-remote filename newname) + (tramp-do-copy-or-rename-file-directly + op filename newname + ok-if-already-exists keep-date preserve-uid-gid)) + + ;; Try out-of-band operation. + ((tramp-method-out-of-band-p + v1 (nth 7 (file-attributes filename))) + (tramp-do-copy-or-rename-file-out-of-band + op filename newname keep-date)) + + ;; No shortcut was possible. So we copy the file + ;; first. If the operation was `rename', we go back + ;; and delete the original file (if the copy was + ;; successful). The approach is simple-minded: we + ;; create a new buffer, insert the contents of the + ;; source file into it, then write out the buffer to + ;; the target file. The advantage is that it doesn't + ;; matter which filename handlers are used for the + ;; source and target file. + (t + (tramp-do-copy-or-rename-file-via-buffer + op filename newname keep-date)))))) + + ;; One file is a Tramp file, the other one is local. + ((or t1 t2) + (cond + ;; Fast track on local machine. + ((tramp-local-host-p v) + (tramp-do-copy-or-rename-file-directly + op filename newname + ok-if-already-exists keep-date preserve-uid-gid)) + + ;; If the Tramp file has an out-of-band method, the + ;; corresponding copy-program can be invoked. + ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename))) + (tramp-do-copy-or-rename-file-out-of-band + op filename newname keep-date)) + + ;; Use the inline method via a Tramp buffer. + (t (tramp-do-copy-or-rename-file-via-buffer + op filename newname keep-date)))) + + (t + ;; One of them must be a Tramp file. + (error "Tramp implementation says this cannot happen"))) + + ;; Handle `preserve-selinux-context'. + (when context (apply 'set-file-selinux-context (list newname context))) + + ;; In case of `rename', we must flush the cache of the source file. + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename v1 + (tramp-flush-file-property v1 (file-name-directory localname)) + (tramp-flush-file-property v1 localname))) + + ;; When newname did exist, we have wrong cached values. + (when t2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-property v2 (file-name-directory localname)) + (tramp-flush-file-property v2 localname))))))) (defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date) "Use an Emacs buffer to copy or rename a file. @@ -4770,7 +4771,7 @@ (rem-enc (save-excursion (with-progress-reporter - v 5 (format "Encoding remote file %s" filename) + v 3 (format "Encoding remote file %s" filename) (tramp-barf-unless-okay v (format rem-enc (tramp-shell-quote-argument localname)) "Encoding remote file failed")) @@ -5341,46 +5342,50 @@ ;; any other remote command. (defun tramp-handle-vc-registered (file) "Like `vc-registered' for Tramp files." - (with-parsed-tramp-file-name file nil - - ;; There could be new files, created by the vc backend. We cannot - ;; reuse the old cache entries, therefore. - (let (tramp-vc-registered-file-names - (tramp-cache-inhibit-cache (current-time)) - (file-name-handler-alist - `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) - - ;; Here we collect only file names, which need an operation. - (tramp-run-real-handler 'vc-registered (list file)) - (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) - - ;; Send just one command, in order to fill the cache. - (when tramp-vc-registered-file-names - (tramp-maybe-send-script - v - (format tramp-vc-registered-read-file-names - (tramp-get-file-exists-command v) - (format "%s -r" (tramp-get-test-command v))) - "tramp_vc_registered_read_file_names") - - (dolist - (elt - (tramp-send-command-and-read - v - (format - "tramp_vc_registered_read_file_names %s" - (mapconcat 'tramp-shell-quote-argument - tramp-vc-registered-file-names - " ")))) - - (tramp-set-file-property v (car elt) (cadr elt) (cadr (cdr elt)))))) - - ;; Second run. Now all `file-exists-p' or `file-readable-p' calls - ;; shall be answered from the file cache. - ;; We unset `process-file-side-effects' in order to keep the cache - ;; when `process-file' calls appear. - (let (process-file-side-effects) - (tramp-run-real-handler 'vc-registered (list file))))) + (with-temp-message "" + (with-parsed-tramp-file-name file nil + (with-progress-reporter + v 3 (format "Checking `vc-registered' for %s" file) + + ;; There could be new files, created by the vc backend. We + ;; cannot reuse the old cache entries, therefore. + (let (tramp-vc-registered-file-names + (tramp-cache-inhibit-cache (current-time)) + (file-name-handler-alist + `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) + + ;; Here we collect only file names, which need an operation. + (tramp-run-real-handler 'vc-registered (list file)) + (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) + + ;; Send just one command, in order to fill the cache. + (when tramp-vc-registered-file-names + (tramp-maybe-send-script + v + (format tramp-vc-registered-read-file-names + (tramp-get-file-exists-command v) + (format "%s -r" (tramp-get-test-command v))) + "tramp_vc_registered_read_file_names") + + (dolist + (elt + (tramp-send-command-and-read + v + (format + "tramp_vc_registered_read_file_names %s" + (mapconcat 'tramp-shell-quote-argument + tramp-vc-registered-file-names + " ")))) + + (tramp-set-file-property + v (car elt) (cadr elt) (cadr (cdr elt)))))) + + ;; Second run. Now all `file-exists-p' or `file-readable-p' + ;; calls shall be answered from the file cache. We unset + ;; `process-file-side-effects' in order to keep the cache when + ;; `process-file' calls appear. + (let (process-file-side-effects) + (tramp-run-real-handler 'vc-registered (list file))))))) ;;;###autoload (progn (defun tramp-run-real-handler (operation args) @@ -7432,131 +7437,135 @@ ;; We call `tramp-get-buffer' in order to get a debug buffer for ;; messages from the beginning. (tramp-get-buffer vec) - (if (zerop (length (tramp-file-name-user vec))) + (with-progress-reporter + vec 3 + (if (zerop (length (tramp-file-name-user vec))) + (format "Opening connection for %s using %s" + (tramp-file-name-host vec) + (tramp-file-name-method vec)) + (format "Opening connection for %s@%s using %s" + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-method vec))) + + ;; Start new process. + (when (and p (processp p)) + (delete-process p)) + (setenv "TERM" tramp-terminal-type) + (setenv "LC_ALL" "C") + (setenv "PROMPT_COMMAND") + (setenv "PS1" tramp-initial-end-of-output) + (let* ((target-alist (tramp-compute-multi-hops vec)) + (process-connection-type tramp-process-connection-type) + (process-adaptive-read-buffering nil) + (coding-system-for-read nil) + ;; This must be done in order to avoid our file name handler. + (p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (start-process + (or process-name (tramp-buffer-name vec)) + (tramp-get-connection-buffer vec) + tramp-encoding-shell)))) + (tramp-message - vec 3 "Opening connection for %s using %s" - (tramp-file-name-host vec) - (tramp-file-name-method vec)) - (tramp-message - vec 3 "Opening connection for %s@%s using %s" - (tramp-file-name-user vec) - (tramp-file-name-host vec) - (tramp-file-name-method vec))) - - ;; Start new process. - (when (and p (processp p)) - (delete-process p)) - (setenv "TERM" tramp-terminal-type) - (setenv "LC_ALL" "C") - (setenv "PROMPT_COMMAND") - (setenv "PS1" tramp-initial-end-of-output) - (let* ((target-alist (tramp-compute-multi-hops vec)) - (process-connection-type tramp-process-connection-type) - (process-adaptive-read-buffering nil) - (coding-system-for-read nil) - ;; This must be done in order to avoid our file name handler. - (p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (start-process - (or process-name (tramp-buffer-name vec)) - (tramp-get-connection-buffer vec) - tramp-encoding-shell)))) - - (tramp-message - vec 6 "%s" (mapconcat 'identity (process-command p) " ")) - - ;; Check whether process is alive. - (tramp-set-process-query-on-exit-flag p nil) - (with-progress-reporter vec 3 "Waiting 60s for local shell to come up" + vec 6 "%s" (mapconcat 'identity (process-command p) " ")) + + ;; Check whether process is alive. + (tramp-set-process-query-on-exit-flag p nil) (tramp-barf-if-no-shell-prompt - p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)) - - ;; Now do all the connections as specified. - (while target-alist - (let* ((hop (car target-alist)) - (l-method (tramp-file-name-method hop)) - (l-user (tramp-file-name-user hop)) - (l-host (tramp-file-name-host hop)) - (l-port nil) - (login-program - (tramp-get-method-parameter l-method 'tramp-login-program)) - (login-args - (tramp-get-method-parameter l-method 'tramp-login-args)) - (async-args - (tramp-get-method-parameter l-method 'tramp-async-args)) - (gw-args - (tramp-get-method-parameter l-method 'tramp-gw-args)) - (gw (tramp-get-file-property hop "" "gateway" nil)) - (g-method (and gw (tramp-file-name-method gw))) - (g-user (and gw (tramp-file-name-user gw))) - (g-host (and gw (tramp-file-name-host gw))) - (command login-program) - ;; We don't create the temporary file. In fact, it - ;; is just a prefix for the ControlPath option of - ;; ssh; the real temporary file has another name, and - ;; it is created and protected by ssh. It is also - ;; removed by ssh, when the connection is closed. - (tmpfile - (tramp-set-connection-property - p "temp-file" - (make-temp-name - (expand-file-name - tramp-temp-name-prefix - (tramp-compat-temporary-file-directory))))) - spec) - - ;; Add arguments for asynchrononous processes. - (when (and process-name async-args) - (setq login-args (append login-args async-args))) - - ;; Add gateway arguments if necessary. - (when (and gw gw-args) - (setq login-args (append login-args gw-args))) - - ;; Check for port number. Until now, there's no need - ;; for handling like method, user, host. - (when (string-match tramp-host-with-port-regexp l-host) + p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell) + + ;; Now do all the connections as specified. + (while target-alist + (let* ((hop (car target-alist)) + (l-method (tramp-file-name-method hop)) + (l-user (tramp-file-name-user hop)) + (l-host (tramp-file-name-host hop)) + (l-port nil) + (login-program + (tramp-get-method-parameter + l-method 'tramp-login-program)) + (login-args + (tramp-get-method-parameter l-method 'tramp-login-args)) + (async-args + (tramp-get-method-parameter l-method 'tramp-async-args)) + (gw-args + (tramp-get-method-parameter l-method 'tramp-gw-args)) + (gw (tramp-get-file-property hop "" "gateway" nil)) + (g-method (and gw (tramp-file-name-method gw))) + (g-user (and gw (tramp-file-name-user gw))) + (g-host (and gw (tramp-file-name-host gw))) + (command login-program) + ;; We don't create the temporary file. In fact, + ;; it is just a prefix for the ControlPath option + ;; of ssh; the real temporary file has another + ;; name, and it is created and protected by ssh. + ;; It is also removed by ssh, when the connection + ;; is closed. + (tmpfile + (tramp-set-connection-property + p "temp-file" + (make-temp-name + (expand-file-name + tramp-temp-name-prefix + (tramp-compat-temporary-file-directory))))) + spec) + + ;; Add arguments for asynchrononous processes. + (when (and process-name async-args) + (setq login-args (append login-args async-args))) + + ;; Add gateway arguments if necessary. + (when (and gw gw-args) + (setq login-args (append login-args gw-args))) + + ;; Check for port number. Until now, there's no need + ;; for handling like method, user, host. + (when (string-match tramp-host-with-port-regexp l-host) (setq l-port (match-string 2 l-host) l-host (match-string 1 l-host))) - ;; Set variables for computing the prompt for reading - ;; password. They can also be derived from a gateway. - (setq tramp-current-method (or g-method l-method) - tramp-current-user (or g-user l-user) - tramp-current-host (or g-host l-host)) - - ;; Replace login-args place holders. - (setq - l-host (or l-host "") - l-user (or l-user "") - l-port (or l-port "") - spec (format-spec-make ?h l-host ?u l-user ?p l-port ?t tmpfile) - command - (concat - ;; We do not want to see the trailing local prompt in - ;; `start-file-process'. - (unless (memq system-type '(windows-nt)) "exec ") - command " " - (mapconcat - (lambda (x) - (setq x (mapcar (lambda (y) (format-spec y spec)) x)) - (unless (member "" x) (mapconcat 'identity x " "))) - login-args " ") - ;; Local shell could be a Windows COMSPEC. It doesn't - ;; know the ";" syntax, but we must exit always for - ;; `start-file-process'. "exec" does not work either. - (if (memq system-type '(windows-nt)) " && exit || exit"))) - - ;; Send the command. - (tramp-message vec 3 "Sending command `%s'" command) - (tramp-send-command vec command t t) - (tramp-process-actions p vec tramp-actions-before-shell 60) - (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host)) - ;; Next hop. - (setq target-alist (cdr target-alist))) - - ;; Make initial shell settings. - (tramp-open-connection-setup-interactive-shell p vec)))))) + ;; Set variables for computing the prompt for reading + ;; password. They can also be derived from a gateway. + (setq tramp-current-method (or g-method l-method) + tramp-current-user (or g-user l-user) + tramp-current-host (or g-host l-host)) + + ;; Replace login-args place holders. + (setq + l-host (or l-host "") + l-user (or l-user "") + l-port (or l-port "") + spec (format-spec-make + ?h l-host ?u l-user ?p l-port ?t tmpfile) + command + (concat + ;; We do not want to see the trailing local prompt in + ;; `start-file-process'. + (unless (memq system-type '(windows-nt)) "exec ") + command " " + (mapconcat + (lambda (x) + (setq x (mapcar (lambda (y) (format-spec y spec)) x)) + (unless (member "" x) (mapconcat 'identity x " "))) + login-args " ") + ;; Local shell could be a Windows COMSPEC. It + ;; doesn't know the ";" syntax, but we must exit + ;; always for `start-file-process'. "exec" does not + ;; work either. + (if (memq system-type '(windows-nt)) " && exit || exit"))) + + ;; Send the command. + (tramp-message vec 3 "Sending command `%s'" command) + (tramp-send-command vec command t t) + (tramp-process-actions p vec tramp-actions-before-shell 60) + (tramp-message + vec 3 "Found remote shell prompt on `%s'" l-host)) + ;; Next hop. + (setq target-alist (cdr target-alist))) + + ;; Make initial shell settings. + (tramp-open-connection-setup-interactive-shell p vec))))))) (defun tramp-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC.
--- a/lisp/progmodes/cc-engine.el Fri May 21 12:26:07 2010 +0000 +++ b/lisp/progmodes/cc-engine.el Sat May 22 03:32:53 2010 +0000 @@ -2245,50 +2245,50 @@ (setq cnt (1- cnt))))) (point))) -(defun c-state-balance-parens-backwards (here top) - ;; Return the position of the opening paren/brace/bracket before HERE which - ;; matches the outermost close p/b/b between HERE and TOP, like this: - ;; - ;; ...................................... - ;; | | - ;; ( [ ( ........... ) ( ) ] ) - ;; ^ ^ ^ - ;; | | | - ;; return HERE TOP +(defun c-state-balance-parens-backwards (here- here+ top) + ;; Return the position of the opening paren/brace/bracket before HERE- which + ;; matches the outermost close p/b/b between HERE+ and TOP. Except when + ;; there's a macro, HERE- and HERE+ are the same. Like this: + ;; + ;; ............................................ + ;; | | + ;; ( [ ( .........#macro.. ) ( ) ] ) + ;; ^ ^ ^ ^ + ;; | | | | + ;; return HERE- HERE+ TOP ;; ;; If there aren't enough opening paren/brace/brackets, return the position - ;; of the outermost one found, or HERE it there are none. If there are no - ;; closeing p/b/bs between HERE and TOP, return HERE. HERE and TOP must not - ;; be inside literals. Only the accessible portion of the buffer will be - ;; scanned. - - ;; PART 1: scan from `here' up to `top', accumulating ")"s which enclose - ;; `here'. Go round the next loop each time we pass over such a ")". These - ;; probably match "("s before `here'. + ;; of the outermost one found, or HERE- if there are none. If there are no + ;; closeing p/b/bs between HERE+ and TOP, return HERE-. HERE-/+ and TOP + ;; must not be inside literals. Only the accessible portion of the buffer + ;; will be scanned. + + ;; PART 1: scan from `here+' up to `top', accumulating ")"s which enclose + ;; `here'. Go round the next loop each time we pass over such a ")". These + ;; probably match "("s before `here-'. (let (pos pa ren+1 lonely-rens) (save-excursion (save-restriction (narrow-to-region (point-min) top) ; This can move point, sometimes. - (setq pos here) + (setq pos here+) (c-safe (while (setq ren+1 (scan-lists pos 1 1)) ; might signal (setq lonely-rens (cons ren+1 lonely-rens) pos ren+1))))) - ;; PART 2: Scan back before `here' searching for the "("s + ;; PART 2: Scan back before `here-' searching for the "("s ;; matching/mismatching the ")"s found above. We only need to direct the ;; caller to scan when we've encountered unmatched right parens. - (when lonely-rens - (setq pos here) - (c-safe - (while - (and lonely-rens ; actual values aren't used. - (setq pa (scan-lists pos -1 1))) - (setq pos pa) - (setq lonely-rens (cdr lonely-rens)))) ;) - ) - pos)) + (setq pos here-) + (when lonely-rens + (c-safe + (while + (and lonely-rens ; actual values aren't used. + (setq pa (scan-lists pos -1 1))) + (setq pos pa) + (setq lonely-rens (cdr lonely-rens))))) + pos)) (defun c-parse-state-get-strategy (here good-pos) ;; Determine the scanning strategy for adjusting `c-parse-state', attempting @@ -2746,6 +2746,7 @@ lit ; (START . END) of a literal containing some point. here-lit-start here-lit-end ; bounds of literal containing `here' ; or `here' itself. + here- here+ ; start/end of macro around HERE, or HERE (here-bol (c-point 'bol here)) (too-far-back (max (- here c-state-cache-too-far) 1))) @@ -2758,57 +2759,73 @@ ;; At this stage, (> pos here); ;; (< (c-state-cache-top-lparen) here) (or is nil). - ;; CASE 1: The top of the cache is a brace pair which now encloses `here'. - ;; As good-pos, return the address. of the "{". - (if (and (consp (car c-state-cache)) - (> (cdar c-state-cache) here)) - ;; Since we've no knowledge of what's inside these braces, we have no - ;; alternative but to direct the caller to scan the buffer from the - ;; opening brace. - (progn - (setq pos (caar c-state-cache)) - (setcar c-state-cache pos) - (list (1+ pos) pos t)) ; return value. We've just converted a brace - ; pair entry into a { entry, so the caller - ; needs to search for a brace pair before the - ; {. - - ;; ;; `here' might be inside a literal. Check for this. - (setq lit (c-state-literal-at here) - here-lit-start (or (car lit) here) - here-lit-end (or (cdr lit) here)) - - ;; `here' might be nested inside any depth of parens (or brackets but - ;; not braces). Scan backwards to find the outermost such opening - ;; paren, if there is one. This will be the scan position to return. - (save-restriction - (narrow-to-region cache-pos (point-max)) - (setq pos (c-state-balance-parens-backwards here-lit-end pos))) - - (if (< pos here-lit-start) - ;; CASE 2: Address of outermost ( or [ which now encloses `here', - ;; but didn't enclose the (previous) `c-state-cache-good-pos'. If - ;; there is a brace pair preceding this, it will already be in - ;; `c-state-cache', unless there was a brace pair after it, - ;; i.e. there'll only be one to scan for if we've just deleted one. - (list pos (and dropped-cons pos) t) ; Return value. - - ;; `here' isn't enclosed in a (previously unrecorded) bracket/paren. - ;; Further forward scanning isn't needed, but we still need to find a - ;; GOOD-POS. Step out of all enclosing "("s on HERE's line. + (cond + ((and (consp (car c-state-cache)) + (> (cdar c-state-cache) here)) + ;; CASE 1: The top of the cache is a brace pair which now encloses + ;; `here'. As good-pos, return the address. of the "{". Since we've no + ;; knowledge of what's inside these braces, we have no alternative but + ;; to direct the caller to scan the buffer from the opening brace. + (setq pos (caar c-state-cache)) + (setcar c-state-cache pos) + (list (1+ pos) pos t)) ; return value. We've just converted a brace pair + ; entry into a { entry, so the caller needs to + ; search for a brace pair before the {. + + ;; `here' might be inside a literal. Check for this. + ((progn + (setq lit (c-state-literal-at here) + here-lit-start (or (car lit) here) + here-lit-end (or (cdr lit) here)) + ;; Has `here' just "newly entered" a macro? + (save-excursion + (goto-char here-lit-start) + (if (and (c-beginning-of-macro) + (or (null c-state-old-cpp-beg) + (not (= (point) c-state-old-cpp-beg)))) + (progn + (setq here- (point)) + (c-end-of-macro) + (setq here+ (point))) + (setq here- here-lit-start + here+ here-lit-end))) + + ;; `here' might be nested inside any depth of parens (or brackets but + ;; not braces). Scan backwards to find the outermost such opening + ;; paren, if there is one. This will be the scan position to return. + (save-restriction + (narrow-to-region cache-pos (point-max)) + (setq pos (c-state-balance-parens-backwards here- here+ pos))) + nil)) ; for the cond + + ((< pos here-lit-start) + ;; CASE 2: Address of outermost ( or [ which now encloses `here', but + ;; didn't enclose the (previous) `c-state-cache-good-pos'. If there is + ;; a brace pair preceding this, it will already be in `c-state-cache', + ;; unless there was a brace pair after it, i.e. there'll only be one to + ;; scan for if we've just deleted one. + (list pos (and dropped-cons pos) t)) ; Return value. + + ;; `here' isn't enclosed in a (previously unrecorded) bracket/paren. + ;; Further forward scanning isn't needed, but we still need to find a + ;; GOOD-POS. Step out of all enclosing "("s on HERE's line. + ((progn (save-restriction (narrow-to-region here-bol (point-max)) (setq pos here-lit-start) (c-safe (while (setq pa (scan-lists pos -1 1)) (setq pos pa)))) ; might signal - (if (setq ren (c-safe-scan-lists pos -1 -1 too-far-back)) - ;; CASE 3: After a }/)/] before `here''s BOL. - (list (1+ ren) (and dropped-cons pos) nil) ; Return value - - ;; CASE 4; Best of a bad job: BOL before `here-bol', or beginning of - ;; literal containing it. - (setq good-pos (c-state-lit-beg (c-point 'bopl here-bol))) - (list good-pos (and dropped-cons good-pos) nil)))))) + nil)) ; for the cond + + ((setq ren (c-safe-scan-lists pos -1 -1 too-far-back)) + ;; CASE 3: After a }/)/] before `here''s BOL. + (list (1+ ren) (and dropped-cons pos) nil)) ; Return value + + (t + ;; CASE 4; Best of a bad job: BOL before `here-bol', or beginning of + ;; literal containing it. + (setq good-pos (c-state-lit-beg (c-point 'bopl here-bol))) + (list good-pos (and dropped-cons good-pos) nil))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- a/lisp/progmodes/grep.el Fri May 21 12:26:07 2010 +0000 +++ b/lisp/progmodes/grep.el Sat May 22 03:32:53 2010 +0000 @@ -781,12 +781,17 @@ (file-name-nondirectory bn))) (default-alias (and fn - (let ((aliases grep-files-aliases) + (let ((aliases (remove (assoc "all" grep-files-aliases) + grep-files-aliases)) alias) (while aliases (setq alias (car aliases) aliases (cdr aliases)) - (if (string-match (wildcard-to-regexp (cdr alias)) fn) + (if (string-match (mapconcat + 'wildcard-to-regexp + (split-string (cdr alias) nil t) + "\\|") + fn) (setq aliases nil) (setq alias nil))) (cdr alias))))
--- a/src/ChangeLog Fri May 21 12:26:07 2010 +0000 +++ b/src/ChangeLog Sat May 22 03:32:53 2010 +0000 @@ -1,3 +1,12 @@ +2010-05-21 Chong Yidong <cyd@stupidchicken.com> + + * xdisp.c (redisplay_internal): Clear caches even if redisplaying + just one window. + + * image.c (Vimage_cache_eviction_delay): Decrease to 300. + (clear_image_cache): If the number of cached images is unusually + large, decrease the cache eviction delay (Bug#6230). + 2010-05-21 Glenn Morris <rgm@gnu.org> * Makefile.in (${ns_appdir}, ${ns_appbindir}Emacs, ns-app):
--- a/src/Makefile.in Fri May 21 12:26:07 2010 +0000 +++ b/src/Makefile.in Sat May 22 03:32:53 2010 +0000 @@ -297,7 +297,6 @@ ## -MMD -MF ${DEPDIR}/$*.d if AUTO_DEPEND; else empty. DEPFLAGS=@DEPFLAGS@ ## test -d ${DEPDIR} || mkdir ${DEPDIR} (if AUTO_DEPEND); else ':'. -## FIXME This can fail in parallel builds. Use mkinstalldirs instead? MKDEPDIR=@MKDEPDIR@ # ========================== start of cpp stuff =======================
--- a/src/image.c Fri May 21 12:26:07 2010 +0000 +++ b/src/image.c Sat May 22 03:32:53 2010 +0000 @@ -1582,29 +1582,56 @@ { struct image_cache *c = FRAME_IMAGE_CACHE (f); - if (c && (!NILP (filter) || INTEGERP (Vimage_cache_eviction_delay))) - { - EMACS_TIME t; - unsigned long old; - int i, nfreed; - - EMACS_GET_TIME (t); - old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay); + if (c) + { + int i, nfreed = 0; /* Block input so that we won't be interrupted by a SIGIO while being in an inconsistent state. */ BLOCK_INPUT; - for (i = nfreed = 0; i < c->used; ++i) + if (!NILP (filter)) + { + /* Filter image cache. */ + for (i = 0; i < c->used; ++i) + { + struct image *img = c->images[i]; + if (img && (EQ (Qt, filter) + || !NILP (Fmember (filter, img->dependencies)))) + { + free_image (f, img); + ++nfreed; + } + } + } + else if (INTEGERP (Vimage_cache_eviction_delay)) { - struct image *img = c->images[i]; - if (img != NULL - && (NILP (filter) ? img->timestamp < old - : (EQ (Qt, filter) - || !NILP (Fmember (filter, img->dependencies))))) + /* Free cache based on timestamp. */ + EMACS_TIME t; + unsigned long old; + int delay, nimages = 0; + + for (i = 0; i < c->used; ++i) + if (c->images[i]) + nimages++; + + /* If the number of cached images has grown unusually large, + decrease the cache eviction delay (Bug#6230). */ + delay = XFASTINT (Vimage_cache_eviction_delay); + if (nimages > 40) + delay = max (1, 1600 * delay / (nimages*nimages)); + + EMACS_GET_TIME (t); + old = EMACS_SECS (t) - delay; + + for (i = 0; i < c->used; ++i) { - free_image (f, img); - ++nfreed; + struct image *img = c->images[i]; + if (img && img->timestamp < old) + { + free_image (f, img); + ++nfreed; + } } } @@ -8520,11 +8547,14 @@ Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS); DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay, - doc: /* Time after which cached images are removed from the cache. -When an image has not been displayed this many seconds, remove it -from the image cache. Value must be an integer or nil with nil -meaning don't clear the cache. */); - Vimage_cache_eviction_delay = make_number (30 * 60); + doc: /* Maximum time after which images are removed from the cache. +When an image has not been displayed this many seconds, Emacs +automatically removes it from the image cache. If the cache contains +a large number of images, the actual eviction time may be shorter. +The value can also be nil, meaning the cache is never cleared. + +The function `clear-image-cache' disregards this variable. */); + Vimage_cache_eviction_delay = make_number (300); } void
--- a/src/xdisp.c Fri May 21 12:26:07 2010 +0000 +++ b/src/xdisp.c Sat May 22 03:32:53 2010 +0000 @@ -12499,22 +12499,25 @@ if (windows_or_buffers_changed && !pause) goto retry; - /* Clear the face cache eventually. */ - if (consider_all_windows_p) - { - if (clear_face_cache_count > CLEAR_FACE_CACHE_COUNT) - { - clear_face_cache (0); - clear_face_cache_count = 0; - } -#ifdef HAVE_WINDOW_SYSTEM - if (clear_image_cache_count > CLEAR_IMAGE_CACHE_COUNT) - { - clear_image_caches (Qnil); - clear_image_cache_count = 0; - } + /* Clear the face and image caches. + + We used to do this only if consider_all_windows_p. But the cache + needs to be cleared if a timer creates images in the current + buffer (e.g. the test case in Bug#6230). */ + + if (clear_face_cache_count > CLEAR_FACE_CACHE_COUNT) + { + clear_face_cache (0); + clear_face_cache_count = 0; + } + +#ifdef HAVE_WINDOW_SYSTEM + if (clear_image_cache_count > CLEAR_IMAGE_CACHE_COUNT) + { + clear_image_caches (Qnil); + clear_image_cache_count = 0; + } #endif /* HAVE_WINDOW_SYSTEM */ - } end_of_redisplay: unbind_to (count, Qnil);