comparison lisp/url/url-util.el @ 54935:efddc239393d

(url-debug): Use with-current-buffer.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Fri, 16 Apr 2004 22:05:32 +0000
parents a78c94aa182d
children 01934125951e 625059157bad
comparison
equal deleted inserted replaced
54934:2fc584798d79 54935:efddc239393d
1 ;;; url-util.el --- Miscellaneous helper routines for URL library 1 ;;; url-util.el --- Miscellaneous helper routines for URL library
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 7 ;; Keywords: comm, data, processes
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, 27
24 ;;; Boston, MA 02111-1307, USA. 28 ;;; Code:
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 29
27 (require 'url-parse) 30 (require 'url-parse)
28 (autoload 'timezone-parse-date "timezone") 31 (autoload 'timezone-parse-date "timezone")
29 (autoload 'timezone-make-date-arpa-standard "timezone") 32 (autoload 'timezone-make-date-arpa-standard "timezone")
30 (autoload 'mail-header-extract "mailheader") 33 (autoload 'mail-header-extract "mailheader")
61 (if quit-flag 64 (if quit-flag
62 (error "Interrupted!")) 65 (error "Interrupted!"))
63 (if (or (eq url-debug t) 66 (if (or (eq url-debug t)
64 (numberp url-debug) 67 (numberp url-debug)
65 (and (listp url-debug) (memq tag url-debug))) 68 (and (listp url-debug) (memq tag url-debug)))
66 (save-excursion 69 (with-current-buffer (get-buffer-create "*URL-DEBUG*")
67 (set-buffer (get-buffer-create "*URL-DEBUG*"))
68 (goto-char (point-max)) 70 (goto-char (point-max))
69 (insert (symbol-name tag) " -> " (apply 'format args) "\n") 71 (insert (symbol-name tag) " -> " (apply 'format args) "\n")
70 (if (numberp url-debug) 72 (if (numberp url-debug)
71 (apply 'message args))))) 73 (apply 'message args)))))
72 74
171 retval)) 173 retval))
172 174
173 ;;;###autoload 175 ;;;###autoload
174 (defun url-lazy-message (&rest args) 176 (defun url-lazy-message (&rest args)
175 "Just like `message', but is a no-op if called more than once a second. 177 "Just like `message', but is a no-op if called more than once a second.
176 Will not do anything if url-show-status is nil." 178 Will not do anything if `url-show-status' is nil."
177 (if (or (null url-show-status) 179 (if (or (null url-show-status)
178 (active-minibuffer-window) 180 (active-minibuffer-window)
179 (= url-lazy-message-time 181 (= url-lazy-message-time
180 (setq url-lazy-message-time (nth 1 (current-time))))) 182 (setq url-lazy-message-time (nth 1 (current-time)))))
181 nil 183 nil
500 (set (make-local-variable 'url-current-mime-headers) 502 (set (make-local-variable 'url-current-mime-headers)
501 (mail-header-extract))))) 503 (mail-header-extract)))))
502 504
503 (provide 'url-util) 505 (provide 'url-util)
504 506
505 ;;; arch-tag: 24352abc-5a5a-412e-90cd-313b26bed5c9 507 ;; arch-tag: 24352abc-5a5a-412e-90cd-313b26bed5c9
508 ;;; url-util.el ends here