Mercurial > emacs
comparison lisp/url/url.el @ 54832:8a894d554fb1
(url-retrieve): Use with-current-buffer.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Mon, 12 Apr 2004 20:50:16 +0000 (2004-04-12) |
parents | e8824c4f5f7e |
children | 01934125951e eb7e8d483840 |
comparison
equal
deleted
inserted
replaced
54831:ca18766bb266 | 54832:8a894d554fb1 |
---|---|
1 ;;; url.el --- Uniform Resource Locator retrieval tool | 1 ;;; url.el --- Uniform Resource Locator retrieval tool |
2 | |
3 ;; Copyright (c) 1996,97,98,99,2001,2004 Free Software Foundation, Inc. | |
4 ;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu> | |
5 | |
2 ;; Author: Bill Perry <wmperry@gnu.org> | 6 ;; Author: Bill Perry <wmperry@gnu.org> |
3 ;; Keywords: comm, data, processes, hypermedia | 7 ;; Keywords: comm, data, processes, hypermedia |
4 | 8 |
5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 9 ;; This file is part of GNU Emacs. |
6 ;;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu> | 10 ;; |
7 ;;; Copyright (c) 1996, 97, 98, 99, 2001 Free Software Foundation, Inc. | 11 ;; GNU Emacs is free software; you can redistribute it and/or modify |
8 ;;; | 12 ;; it under the terms of the GNU General Public License as published by |
9 ;;; This file is part of GNU Emacs. | 13 ;; the Free Software Foundation; either version 2, or (at your option) |
10 ;;; | 14 ;; any later version. |
11 ;;; GNU Emacs is free software; you can redistribute it and/or modify | 15 ;; |
12 ;;; it under the terms of the GNU General Public License as published by | 16 ;; GNU Emacs is distributed in the hope that it will be useful, |
13 ;;; the Free Software Foundation; either version 2, or (at your option) | 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
14 ;;; any later version. | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
15 ;;; | 19 ;; GNU General Public License for more details. |
16 ;;; GNU Emacs is distributed in the hope that it will be useful, | 20 ;; |
17 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 21 ;; You should have received a copy of the GNU General Public License |
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
19 ;;; GNU General Public License for more details. | 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
20 ;;; | 24 ;; Boston, MA 02111-1307, USA. |
21 ;;; You should have received a copy of the GNU General Public License | 25 |
22 ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 26 ;;; Commentary: |
23 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;;; Boston, MA 02111-1307, USA. | |
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
26 | 27 |
27 ;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes | 28 ;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes |
29 | |
30 ;;; Code: | |
28 | 31 |
29 (eval-when-compile (require 'cl)) | 32 (eval-when-compile (require 'cl)) |
30 ;; Don't require CL at runtime if we can avoid it (Emacs 21). | 33 ;; Don't require CL at runtime if we can avoid it (Emacs 21). |
31 ;; Otherwise we need it for hashing functions. `puthash' was never | 34 ;; Otherwise we need it for hashing functions. `puthash' was never |
32 ;; defined in the Emacs 20 cl.el for some reason. | 35 ;; defined in the Emacs 20 cl.el for some reason. |
166 loader 'url-proxy)) | 169 loader 'url-proxy)) |
167 (if asynch | 170 (if asynch |
168 (setq buffer (funcall loader url callback cbargs)) | 171 (setq buffer (funcall loader url callback cbargs)) |
169 (setq buffer (funcall loader url)) | 172 (setq buffer (funcall loader url)) |
170 (if buffer | 173 (if buffer |
171 (save-excursion | 174 (with-current-buffer buffer |
172 (set-buffer buffer) | |
173 (apply callback cbargs)))) | 175 (apply callback cbargs)))) |
174 (url-history-update-url url (current-time)) | 176 (url-history-update-url url (current-time)) |
175 buffer)) | 177 buffer)) |
176 | 178 |
177 (defun url-retrieve-synchronously (url) | 179 (defun url-retrieve-synchronously (url) |
194 ;; package. | 196 ;; package. |
195 nil | 197 nil |
196 (while (not retrieval-done) | 198 (while (not retrieval-done) |
197 (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" | 199 (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" |
198 retrieval-done asynch-buffer) | 200 retrieval-done asynch-buffer) |
199 ;; Quoth monnier: | 201 ;; Quoth Stef: |
200 ;; It turns out that the problem seems to be that the (sit-for | 202 ;; It turns out that the problem seems to be that the (sit-for |
201 ;; 0.1) below doesn't actually process the data: instead it | 203 ;; 0.1) below doesn't actually process the data: instead it |
202 ;; returns immediately because there is keyboard input | 204 ;; returns immediately because there is keyboard input |
203 ;; waiting, so we end up spinning endlessly waiting for the | 205 ;; waiting, so we end up spinning endlessly waiting for the |
204 ;; process to finish while not letting it finish. | 206 ;; process to finish while not letting it finish. |
254 ((fboundp 'warn) | 256 ((fboundp 'warn) |
255 (defun url-warn (class message &optional level) | 257 (defun url-warn (class message &optional level) |
256 (warn "(%s/%s) %s" class (or level 'warning) message))) | 258 (warn "(%s/%s) %s" class (or level 'warning) message))) |
257 (t | 259 (t |
258 (defun url-warn (class message &optional level) | 260 (defun url-warn (class message &optional level) |
259 (save-excursion | 261 (with-current-buffer (get-buffer-create "*URL-WARNINGS*") |
260 (set-buffer (get-buffer-create "*URL-WARNINGS*")) | |
261 (goto-char (point-max)) | 262 (goto-char (point-max)) |
262 (save-excursion | 263 (save-excursion |
263 (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) | 264 (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) |
264 (display-buffer (current-buffer)))))) | 265 (display-buffer (current-buffer)))))) |
265 | 266 |
266 (provide 'url) | 267 (provide 'url) |
267 | 268 |
268 ;;; arch-tag: bc182f1f-d187-4f10-b961-47af2066579a | 269 ;; arch-tag: bc182f1f-d187-4f10-b961-47af2066579a |
269 ;;; url.el ends here | 270 ;;; url.el ends here |