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