54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
1 ;;; url-util.el --- Miscellaneous helper routines for URL library
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
2 ;; Author: Bill Perry <wmperry@gnu.org>
|
54699
|
3 ;; Created: $Date: 2004/04/04 01:21:46 $
|
|
4 ;; Version: $Revision: 1.1.1.1 $
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
5 ;; Keywords: comm, data, processes
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
6
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
9 ;;; Copyright (c) 1996, 97, 98, 99, 2001 Free Software Foundation, Inc.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
10 ;;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
11 ;;; This file is part of GNU Emacs.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
12 ;;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
14 ;;; it under the terms of the GNU General Public License as published by
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
15 ;;; the Free Software Foundation; either version 2, or (at your option)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
16 ;;; any later version.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
17 ;;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
21 ;;; GNU General Public License for more details.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
22 ;;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
23 ;;; You should have received a copy of the GNU General Public License
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
26 ;;; Boston, MA 02111-1307, USA.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
28
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
29 (require 'url-parse)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
30 (autoload 'timezone-parse-date "timezone")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
31 (autoload 'timezone-make-date-arpa-standard "timezone")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
32
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
33 (defvar url-parse-args-syntax-table
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
34 (copy-syntax-table emacs-lisp-mode-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
35 "A syntax table for parsing sgml attributes.")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
36
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
37 (modify-syntax-entry ?' "\"" url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
38 (modify-syntax-entry ?` "\"" url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
39 (modify-syntax-entry ?{ "(" url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
40 (modify-syntax-entry ?} ")" url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
41
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
42 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
43 (defcustom url-debug nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
44 "*What types of debug messages from the URL library to show.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
45 Debug messages are logged to the *URL-DEBUG* buffer.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
46
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
47 If t, all messages will be logged.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
48 If a number, all messages will be logged, as well shown via `message'.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
49 If a list, it is a list of the types of messages to be logged."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
50 :type '(choice (const :tag "none" nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
51 (const :tag "all" t)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
52 (checklist :tag "custom"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
53 (const :tag "HTTP" :value http)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
54 (const :tag "DAV" :value dav)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
55 (const :tag "General" :value retrieval)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
56 (const :tag "Filename handlers" :value handlers)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
57 (symbol :tag "Other")))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
58 :group 'url-hairy)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
59
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
60 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
61 (defun url-debug (tag &rest args)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
62 (if quit-flag
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
63 (error "Interrupted!"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
64 (if (or (eq url-debug t)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
65 (numberp url-debug)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
66 (and (listp url-debug) (memq tag url-debug)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
67 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
68 (set-buffer (get-buffer-create "*URL-DEBUG*"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
69 (goto-char (point-max))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
70 (insert (symbol-name tag) " -> " (apply 'format args) "\n")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
71 (if (numberp url-debug)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
72 (apply 'message args)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
73
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
74 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
75 (defun url-parse-args (str &optional nodowncase)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
76 ;; Return an assoc list of attribute/value pairs from an RFC822-type string
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
77 (let (
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
78 name ; From name=
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
79 value ; its value
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
80 results ; Assoc list of results
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
81 name-pos ; Start of XXXX= position
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
82 val-pos ; Start of value position
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
83 st
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
84 nd
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
85 )
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
86 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
87 (save-restriction
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
88 (set-buffer (get-buffer-create " *urlparse-temp*"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
89 (set-syntax-table url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
90 (erase-buffer)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
91 (insert str)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
92 (setq st (point-min)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
93 nd (point-max))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
94 (set-syntax-table url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
95 (narrow-to-region st nd)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
96 (goto-char (point-min))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
97 (while (not (eobp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
98 (skip-chars-forward "; \n\t")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
99 (setq name-pos (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
100 (skip-chars-forward "^ \n\t=;")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
101 (if (not nodowncase)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
102 (downcase-region name-pos (point)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
103 (setq name (buffer-substring name-pos (point)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
104 (skip-chars-forward " \t\n")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
105 (if (/= (or (char-after (point)) 0) ?=) ; There is no value
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
106 (setq value nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
107 (skip-chars-forward " \t\n=")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
108 (setq val-pos (point)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
109 value
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
110 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
111 ((or (= (or (char-after val-pos) 0) ?\")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
112 (= (or (char-after val-pos) 0) ?'))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
113 (buffer-substring (1+ val-pos)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
114 (condition-case ()
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
115 (prog2
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
116 (forward-sexp 1)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
117 (1- (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
118 (skip-chars-forward "\""))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
119 (error
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
120 (skip-chars-forward "^ \t\n")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
121 (point)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
122 (t
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
123 (buffer-substring val-pos
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
124 (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
125 (skip-chars-forward "^;")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
126 (skip-chars-backward " \t")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
127 (point)))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
128 (setq results (cons (cons name value) results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
129 (skip-chars-forward "; \n\t"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
130 results))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
131
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
132 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
133 (defun url-insert-entities-in-string (string)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
134 "Convert HTML markup-start characters to entity references in STRING.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
135 Also replaces the \" character, so that the result may be safely used as
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
136 an attribute value in a tag. Returns a new string with the result of the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
137 conversion. Replaces these characters as follows:
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
138 & ==> &
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
139 < ==> <
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
140 > ==> >
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
141 \" ==> ""
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
142 (if (string-match "[&<>\"]" string)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
143 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
144 (set-buffer (get-buffer-create " *entity*"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
145 (erase-buffer)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
146 (buffer-disable-undo (current-buffer))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
147 (insert string)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
148 (goto-char (point-min))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
149 (while (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
150 (skip-chars-forward "^&<>\"")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
151 (not (eobp)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
152 (insert (cdr (assq (char-after (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
153 '((?\" . """)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
154 (?& . "&")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
155 (?< . "<")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
156 (?> . ">")))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
157 (delete-char 1))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
158 (buffer-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
159 string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
160
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
161 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
162 (defun url-normalize-url (url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
163 "Return a 'normalized' version of URL.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
164 Strips out default port numbers, etc."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
165 (let (type data grok retval)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
166 (setq data (url-generic-parse-url url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
167 type (url-type data))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
168 (if (member type '("www" "about" "mailto" "info"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
169 (setq retval url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
170 (url-set-target data nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
171 (setq retval (url-recreate-url data)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
172 retval))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
173
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
174 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
175 (defun url-lazy-message (&rest args)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
176 "Just like `message', but is a no-op if called more than once a second.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
177 Will not do anything if url-show-status is nil."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
178 (if (or (null url-show-status)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
179 (active-minibuffer-window)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
180 (= url-lazy-message-time
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
181 (setq url-lazy-message-time (nth 1 (current-time)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
182 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
183 (apply 'message args)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
184
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
185 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
186 (defun url-get-normalized-date (&optional specified-time)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
187 "Return a 'real' date string that most HTTP servers can understand."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
188 (require 'timezone)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
189 (let* ((raw (if specified-time (current-time-string specified-time)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
190 (current-time-string)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
191 (gmt (timezone-make-date-arpa-standard raw
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
192 (nth 1 (current-time-zone))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
193 "GMT"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
194 (parsed (timezone-parse-date gmt))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
195 (day (cdr-safe (assoc (substring raw 0 3) weekday-alist)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
196 (year nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
197 (month (car
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
198 (rassoc
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
199 (string-to-int (aref parsed 1)) monthabbrev-alist)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
200 )
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
201 (setq day (or (car-safe (rassoc day weekday-alist))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
202 (substring raw 0 3))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
203 year (aref parsed 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
204 ;; This is needed for plexus servers, or the server will hang trying to
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
205 ;; parse the if-modified-since header. Hopefully, I can take this out
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
206 ;; soon.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
207 (if (and year (> (length year) 2))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
208 (setq year (substring year -2 nil)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
209
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
210 (concat day ", " (aref parsed 2) "-" month "-" year " "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
211 (aref parsed 3) " " (or (aref parsed 4)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
212 (concat "[" (nth 1 (current-time-zone))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
213 "]")))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
214
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
215 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
216 (defun url-eat-trailing-space (x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
217 "Remove spaces/tabs at the end of a string."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
218 (let ((y (1- (length x)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
219 (skip-chars (list ? ?\t ?\n)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
220 (while (and (>= y 0) (memq (aref x y) skip-chars))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
221 (setq y (1- y)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
222 (substring x 0 (1+ y))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
223
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
224 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
225 (defun url-strip-leading-spaces (x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
226 "Remove spaces at the front of a string."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
227 (let ((y (1- (length x)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
228 (z 0)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
229 (skip-chars (list ? ?\t ?\n)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
230 (while (and (<= z y) (memq (aref x z) skip-chars))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
231 (setq z (1+ z)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
232 (substring x z nil)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
233
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
234 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
235 (defun url-pretty-length (n)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
236 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
237 ((< n 1024)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
238 (format "%d bytes" n))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
239 ((< n (* 1024 1024))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
240 (format "%dk" (/ n 1024.0)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
241 (t
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
242 (format "%2.2fM" (/ n (* 1024 1024.0))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
243
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
244 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
245 (defun url-display-percentage (fmt perc &rest args)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
246 (if (null fmt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
247 (if (fboundp 'clear-progress-display)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
248 (clear-progress-display))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
249 (if (and (fboundp 'progress-display) perc)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
250 (apply 'progress-display fmt perc args)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
251 (apply 'message fmt args))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
252
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
253 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
254 (defun url-percentage (x y)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
255 (if (fboundp 'float)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
256 (round (* 100 (/ x (float y))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
257 (/ (* x 100) y)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
258
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
259 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
260 (defun url-basepath (file &optional x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
261 "Return the base pathname of FILE, or the actual filename if X is true."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
262 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
263 ((null file) "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
264 ((string-match (eval-when-compile (regexp-quote "?")) file)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
265 (if x
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
266 (file-name-nondirectory (substring file 0 (match-beginning 0)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
267 (file-name-directory (substring file 0 (match-beginning 0)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
268 (x (file-name-nondirectory file))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
269 (t (file-name-directory file))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
270
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
271 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
272 (defun url-parse-query-string (query &optional downcase)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
273 (let (retval pairs cur key val)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
274 (setq pairs (split-string query "&"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
275 (while pairs
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
276 (setq cur (car pairs)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
277 pairs (cdr pairs))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
278 (if (not (string-match "=" cur))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
279 nil ; Grace
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
280 (setq key (url-unhex-string (substring cur 0 (match-beginning 0)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
281 val (url-unhex-string (substring cur (match-end 0) nil)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
282 (if downcase
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
283 (setq key (downcase key)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
284 (setq cur (assoc key retval))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
285 (if cur
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
286 (setcdr cur (cons val (cdr cur)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
287 (setq retval (cons (list key val) retval)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
288 retval))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
289
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
290 (defun url-unhex (x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
291 (if (> x ?9)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
292 (if (>= x ?a)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
293 (+ 10 (- x ?a))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
294 (+ 10 (- x ?A)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
295 (- x ?0)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
296
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
297 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
298 (defun url-unhex-string (str &optional allow-newlines)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
299 "Remove %XXX embedded spaces, etc in a url.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
300 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
301 decoding of carriage returns and line feeds in the string, which is normally
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
302 forbidden in URL encoding."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
303 (setq str (or str ""))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
304 (let ((tmp "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
305 (case-fold-search t))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
306 (while (string-match "%[0-9a-f][0-9a-f]" str)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
307 (let* ((start (match-beginning 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
308 (ch1 (url-unhex (elt str (+ start 1))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
309 (code (+ (* 16 ch1)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
310 (url-unhex (elt str (+ start 2))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
311 (setq tmp (concat
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
312 tmp (substring str 0 start)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
313 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
314 (allow-newlines
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
315 (char-to-string code))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
316 ((or (= code ?\n) (= code ?\r))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
317 " ")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
318 (t (char-to-string code))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
319 str (substring str (match-end 0)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
320 (setq tmp (concat tmp str))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
321 tmp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
322
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
323 (defconst url-unreserved-chars
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
324 '(
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
325 ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
326 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
327 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
328 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
329 "A list of characters that are _NOT_ reserved in the URL spec.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
330 This is taken from RFC 2396.")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
331
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
332 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
333 (defun url-hexify-string (str)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
334 "Escape characters in a string."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
335 (mapconcat
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
336 (lambda (char)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
337 ;; Fixme: use a char table instead.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
338 (if (not (memq char url-unreserved-chars))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
339 (if (< char 16)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
340 (format "%%0%X" char)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
341 (if (> char 255)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
342 (error "Hexifying multibyte character %s" str))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
343 (format "%%%X" char))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
344 (char-to-string char)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
345 str ""))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
346
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
347 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
348 (defun url-file-extension (fname &optional x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
349 "Return the filename extension of FNAME.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
350 If optional variable X is t,
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
351 then return the basename of the file with the extension stripped off."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
352 (if (and fname
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
353 (setq fname (url-basepath fname t))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
354 (string-match "\\.[^./]+$" fname))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
355 (if x (substring fname 0 (match-beginning 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
356 (substring fname (match-beginning 0) nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
357 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
358 ;; If fname has no extension, and x then return fname itself instead of
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
359 ;; nothing. When caching it allows the correct .hdr file to be produced
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
360 ;; for filenames without extension.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
361 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
362 (if x
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
363 fname
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
364 "")))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
365
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
366 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
367 (defun url-truncate-url-for-viewing (url &optional width)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
368 "Return a shortened version of URL that is WIDTH characters or less wide.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
369 WIDTH defaults to the current frame width."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
370 (let* ((fr-width (or width (frame-width)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
371 (str-width (length url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
372 (tail (file-name-nondirectory url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
373 (fname nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
374 (modified 0)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
375 (urlobj nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
376 ;; The first thing that can go are the search strings
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
377 (if (and (>= str-width fr-width)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
378 (string-match "?" url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
379 (setq url (concat (substring url 0 (match-beginning 0)) "?...")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
380 str-width (length url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
381 tail (file-name-nondirectory url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
382 (if (< str-width fr-width)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
383 nil ; Hey, we are done!
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
384 (setq urlobj (url-generic-parse-url url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
385 fname (url-filename urlobj)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
386 fr-width (- fr-width 4))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
387 (while (and (>= str-width fr-width)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
388 (string-match "/" fname))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
389 (setq fname (substring fname (match-end 0) nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
390 modified (1+ modified))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
391 (url-set-filename urlobj fname)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
392 (setq url (url-recreate-url urlobj)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
393 str-width (length url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
394 (if (> modified 1)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
395 (setq fname (concat "/.../" fname))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
396 (setq fname (concat "/" fname)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
397 (url-set-filename urlobj fname)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
398 (setq url (url-recreate-url urlobj)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
399 url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
400
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
401 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
402 (defun url-view-url (&optional no-show)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
403 "View the current document's URL.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
404 Optional argument NO-SHOW means just return the URL, don't show it in
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
405 the minibuffer.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
406
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
407 This uses `url-current-object', set locally to the buffer."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
408 (interactive)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
409 (if (not url-current-object)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
410 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
411 (if no-show
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
412 (url-recreate-url url-current-object)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
413 (message "%s" (url-recreate-url url-current-object)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
414
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
415 (eval-and-compile
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
416 (defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
417 "Valid characters in a URL")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
418 )
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
419
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
420 (defun url-get-url-at-point (&optional pt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
421 "Get the URL closest to point, but don't change position.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
422 Has a preference for looking backward when not directly on a symbol."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
423 ;; Not at all perfect - point must be right in the name.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
424 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
425 (if pt (goto-char pt))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
426 (let (start url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
427 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
428 ;; first see if you're just past a filename
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
429 (if (not (eobp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
430 (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
431 (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
432 (skip-chars-backward " \n\t\r({[]})")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
433 (if (not (bobp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
434 (backward-char 1)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
435 (if (and (char-after (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
436 (string-match (eval-when-compile
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
437 (concat "[" url-get-url-filename-chars "]"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
438 (char-to-string (char-after (point)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
439 (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
440 (skip-chars-backward url-get-url-filename-chars)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
441 (setq start (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
442 (skip-chars-forward url-get-url-filename-chars))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
443 (setq start (point)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
444 (setq url (buffer-substring-no-properties start (point))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
445 (if (and url (string-match "^(.*)\\.?$" url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
446 (setq url (match-string 1 url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
447 (if (and url (string-match "^URL:" url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
448 (setq url (substring url 4 nil)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
449 (if (and url (string-match "\\.$" url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
450 (setq url (substring url 0 -1)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
451 (if (and url (string-match "^www\\." url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
452 (setq url (concat "http://" url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
453 (if (and url (not (string-match url-nonrelative-link url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
454 (setq url nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
455 url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
456
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
457 (defun url-generate-unique-filename (&optional fmt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
458 "Generate a unique filename in `url-temporary-directory'."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
459 (if (not fmt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
460 (let ((base (format "url-tmp.%d" (user-real-uid)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
461 (fname "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
462 (x 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
463 (setq fname (format "%s%d" base x))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
464 (while (file-exists-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
465 (expand-file-name fname url-temporary-directory))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
466 (setq x (1+ x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
467 fname (concat base (int-to-string x))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
468 (expand-file-name fname url-temporary-directory))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
469 (let ((base (concat "url" (int-to-string (user-real-uid))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
470 (fname "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
471 (x 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
472 (setq fname (format fmt (concat base (int-to-string x))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
473 (while (file-exists-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
474 (expand-file-name fname url-temporary-directory))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
475 (setq x (1+ x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
476 fname (format fmt (concat base (int-to-string x)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
477 (expand-file-name fname url-temporary-directory))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
478
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
479 (defun url-extract-mime-headers ()
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
480 "Set `url-current-mime-headers' in current buffer."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
481 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
482 (goto-char (point-min))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
483 (unless url-current-mime-headers
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
484 (set (make-local-variable 'url-current-mime-headers)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
485 (mail-header-extract)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
486
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
487 (provide 'url-util)
|
54699
|
488
|
|
489 ;;; arch-tag: 24352abc-5a5a-412e-90cd-313b26bed5c9
|