Mercurial > emacs
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 |