54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
1 ;;; url-util.el --- Miscellaneous helper routines for URL library
|
54935
|
2
|
64748
|
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004,
|
75347
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
54935
|
5
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
6 ;; Author: Bill Perry <wmperry@gnu.org>
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
7 ;; Keywords: comm, data, processes
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
8
|
54935
|
9 ;; This file is part of GNU Emacs.
|
|
10 ;;
|
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
78222
|
13 ;; the Free Software Foundation; either version 3, or (at your option)
|
54935
|
14 ;; any later version.
|
|
15 ;;
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20 ;;
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64084
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
24 ;; Boston, MA 02110-1301, USA.
|
54935
|
25
|
|
26 ;;; Commentary:
|
|
27
|
|
28 ;;; Code:
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
29
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
30 (require 'url-parse)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
31 (autoload 'timezone-parse-date "timezone")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
32 (autoload 'timezone-make-date-arpa-standard "timezone")
|
54803
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
33 (autoload 'mail-header-extract "mailheader")
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
34
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
35 (defvar url-parse-args-syntax-table
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
36 (copy-syntax-table emacs-lisp-mode-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
37 "A syntax table for parsing sgml attributes.")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
38
|
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 (modify-syntax-entry ?{ "(" url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
42 (modify-syntax-entry ?} ")" url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
43
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
44 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
45 (defcustom url-debug nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
46 "*What types of debug messages from the URL library to show.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
47 Debug messages are logged to the *URL-DEBUG* buffer.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
48
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
49 If t, all messages will be logged.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
50 If a number, all messages will be logged, as well shown via `message'.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
51 If a list, it is a list of the types of messages to be logged."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
52 :type '(choice (const :tag "none" nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
53 (const :tag "all" t)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
54 (checklist :tag "custom"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
55 (const :tag "HTTP" :value http)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
56 (const :tag "DAV" :value dav)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
57 (const :tag "General" :value retrieval)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
58 (const :tag "Filename handlers" :value handlers)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
59 (symbol :tag "Other")))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
60 :group 'url-hairy)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
61
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
62 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
63 (defun url-debug (tag &rest args)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
64 (if quit-flag
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
65 (error "Interrupted!"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
66 (if (or (eq url-debug t)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
67 (numberp url-debug)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
68 (and (listp url-debug) (memq tag url-debug)))
|
54935
|
69 (with-current-buffer (get-buffer-create "*URL-DEBUG*")
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
70 (goto-char (point-max))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
71 (insert (symbol-name tag) " -> " (apply 'format args) "\n")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
72 (if (numberp url-debug)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
73 (apply 'message args)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
74
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
75 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
76 (defun url-parse-args (str &optional nodowncase)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
77 ;; Return an assoc list of attribute/value pairs from an RFC822-type string
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
78 (let (
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
79 name ; From name=
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
80 value ; its value
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
81 results ; Assoc list of results
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
82 name-pos ; Start of XXXX= position
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
83 val-pos ; Start of value position
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
84 st
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
85 nd
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
86 )
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
87 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
88 (save-restriction
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
89 (set-buffer (get-buffer-create " *urlparse-temp*"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
90 (set-syntax-table url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
91 (erase-buffer)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
92 (insert str)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
93 (setq st (point-min)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
94 nd (point-max))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
95 (set-syntax-table url-parse-args-syntax-table)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
96 (narrow-to-region st nd)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
97 (goto-char (point-min))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
98 (while (not (eobp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
99 (skip-chars-forward "; \n\t")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
100 (setq name-pos (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
101 (skip-chars-forward "^ \n\t=;")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
102 (if (not nodowncase)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
103 (downcase-region name-pos (point)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
104 (setq name (buffer-substring name-pos (point)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
105 (skip-chars-forward " \t\n")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
106 (if (/= (or (char-after (point)) 0) ?=) ; There is no value
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
107 (setq value nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
108 (skip-chars-forward " \t\n=")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
109 (setq val-pos (point)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
110 value
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
111 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
112 ((or (= (or (char-after val-pos) 0) ?\")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
113 (= (or (char-after val-pos) 0) ?'))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
114 (buffer-substring (1+ val-pos)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
115 (condition-case ()
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
116 (prog2
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
117 (forward-sexp 1)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
118 (1- (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
119 (skip-chars-forward "\""))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
120 (error
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
121 (skip-chars-forward "^ \t\n")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
122 (point)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
123 (t
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
124 (buffer-substring val-pos
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
125 (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
126 (skip-chars-forward "^;")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
127 (skip-chars-backward " \t")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
128 (point)))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
129 (setq results (cons (cons name value) results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
130 (skip-chars-forward "; \n\t"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
131 results))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
132
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
133 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
134 (defun url-insert-entities-in-string (string)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
135 "Convert HTML markup-start characters to entity references in STRING.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
136 Also replaces the \" character, so that the result may be safely used as
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
137 an attribute value in a tag. Returns a new string with the result of the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
138 conversion. Replaces these characters as follows:
|
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 \" ==> ""
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
143 (if (string-match "[&<>\"]" string)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
144 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
145 (set-buffer (get-buffer-create " *entity*"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
146 (erase-buffer)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
147 (buffer-disable-undo (current-buffer))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
148 (insert string)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
149 (goto-char (point-min))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
150 (while (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
151 (skip-chars-forward "^&<>\"")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
152 (not (eobp)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
153 (insert (cdr (assq (char-after (point))
|
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 (?> . ">")))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
158 (delete-char 1))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
159 (buffer-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
160 string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
161
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
162 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
163 (defun url-normalize-url (url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
164 "Return a 'normalized' version of URL.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
165 Strips out default port numbers, etc."
|
72218
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
166 (let (type data retval)
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
167 (setq data (url-generic-parse-url url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
168 type (url-type data))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
169 (if (member type '("www" "about" "mailto" "info"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
170 (setq retval url)
|
83823
dd2bcc6758a0
* url-parse.el (url): Use defstruct rather than macros. Update all callers.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
171 (setf (url-target data) nil)
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
172 (setq retval (url-recreate-url data)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
173 retval))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
174
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
175 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
176 (defun url-lazy-message (&rest args)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
177 "Just like `message', but is a no-op if called more than once a second.
|
54935
|
178 Will not do anything if `url-show-status' is nil."
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
179 (if (or (null url-show-status)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
180 (active-minibuffer-window)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
181 (= url-lazy-message-time
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
182 (setq url-lazy-message-time (nth 1 (current-time)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
183 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
184 (apply 'message args)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
185
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
186 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
187 (defun url-get-normalized-date (&optional specified-time)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
188 "Return a 'real' date string that most HTTP servers can understand."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
189 (require 'timezone)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
190 (let* ((raw (if specified-time (current-time-string specified-time)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
191 (current-time-string)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
192 (gmt (timezone-make-date-arpa-standard raw
|
78850
|
193 (current-time-zone)
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
194 "GMT"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
195 (parsed (timezone-parse-date gmt))
|
57513
6052b6df37c1
(url-get-normalized-date): Use url-weekday-alist and url-monthabbrev-alist.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
196 (day (cdr-safe (assoc (substring raw 0 3) url-weekday-alist)))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
197 (year nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
198 (month (car
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
199 (rassoc
|
62400
|
200 (string-to-number (aref parsed 1)) url-monthabbrev-alist)))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
201 )
|
57513
6052b6df37c1
(url-get-normalized-date): Use url-weekday-alist and url-monthabbrev-alist.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
202 (setq day (or (car-safe (rassoc day url-weekday-alist))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
203 (substring raw 0 3))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
204 year (aref parsed 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
205 ;; This is needed for plexus servers, or the server will hang trying to
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
206 ;; parse the if-modified-since header. Hopefully, I can take this out
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
207 ;; soon.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
208 (if (and year (> (length year) 2))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
209 (setq year (substring year -2 nil)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
210
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
211 (concat day ", " (aref parsed 2) "-" month "-" year " "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
212 (aref parsed 3) " " (or (aref parsed 4)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
213 (concat "[" (nth 1 (current-time-zone))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
214 "]")))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
215
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
216 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
217 (defun url-eat-trailing-space (x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
218 "Remove spaces/tabs at the end of a string."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
219 (let ((y (1- (length x)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
220 (skip-chars (list ? ?\t ?\n)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
221 (while (and (>= y 0) (memq (aref x y) skip-chars))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
222 (setq y (1- y)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
223 (substring x 0 (1+ y))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
224
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
225 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
226 (defun url-strip-leading-spaces (x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
227 "Remove spaces at the front of a string."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
228 (let ((y (1- (length x)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
229 (z 0)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
230 (skip-chars (list ? ?\t ?\n)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
231 (while (and (<= z y) (memq (aref x z) skip-chars))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
232 (setq z (1+ z)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
233 (substring x z nil)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
234
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
235 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
236 (defun url-pretty-length (n)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
237 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
238 ((< n 1024)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
239 (format "%d bytes" n))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
240 ((< n (* 1024 1024))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
241 (format "%dk" (/ n 1024.0)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
242 (t
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
243 (format "%2.2fM" (/ n (* 1024 1024.0))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
244
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
245 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
246 (defun url-display-percentage (fmt perc &rest args)
|
74135
e125bce98ce9
(url-display-percentage): Only show a message if `url-show-status' is non-nil.
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
247 (when url-show-status
|
e125bce98ce9
(url-display-percentage): Only show a message if `url-show-status' is non-nil.
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
248 (if (null fmt)
|
e125bce98ce9
(url-display-percentage): Only show a message if `url-show-status' is non-nil.
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
249 (if (fboundp 'clear-progress-display)
|
e125bce98ce9
(url-display-percentage): Only show a message if `url-show-status' is non-nil.
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
250 (clear-progress-display))
|
e125bce98ce9
(url-display-percentage): Only show a message if `url-show-status' is non-nil.
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
251 (if (and (fboundp 'progress-display) perc)
|
e125bce98ce9
(url-display-percentage): Only show a message if `url-show-status' is non-nil.
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
252 (apply 'progress-display fmt perc args)
|
e125bce98ce9
(url-display-percentage): Only show a message if `url-show-status' is non-nil.
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
253 (apply 'message fmt args)))))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
254
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
255 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
256 (defun url-percentage (x y)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
257 (if (fboundp 'float)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
258 (round (* 100 (/ x (float y))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
259 (/ (* x 100) y)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
260
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
261 ;;;###autoload
|
79064
|
262 (defun url-file-directory (file)
|
|
263 "Return the directory part of FILE, for a URL."
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
264 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
265 ((null file) "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
266 ((string-match (eval-when-compile (regexp-quote "?")) file)
|
79064
|
267 (file-name-directory (substring file 0 (match-beginning 0))))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
268 (t (file-name-directory file))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
269
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
270 ;;;###autoload
|
79064
|
271 (defun url-file-nondirectory (file)
|
|
272 "Return the nondirectory part of FILE, for a URL."
|
|
273 (cond
|
|
274 ((null file) "")
|
|
275 ((string-match (eval-when-compile (regexp-quote "?")) file)
|
|
276 (file-name-nondirectory (substring file 0 (match-beginning 0))))
|
|
277 (t (file-name-nondirectory file))))
|
|
278
|
|
279 ;;;###autoload
|
65312
|
280 (defun url-parse-query-string (query &optional downcase allow-newlines)
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
281 (let (retval pairs cur key val)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
282 (setq pairs (split-string query "&"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
283 (while pairs
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
284 (setq cur (car pairs)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
285 pairs (cdr pairs))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
286 (if (not (string-match "=" cur))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
287 nil ; Grace
|
65312
|
288 (setq key (url-unhex-string (substring cur 0 (match-beginning 0))
|
|
289 allow-newlines))
|
|
290 (setq val (url-unhex-string (substring cur (match-end 0) nil)
|
|
291 allow-newlines))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
292 (if downcase
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
293 (setq key (downcase key)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
294 (setq cur (assoc key retval))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
295 (if cur
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
296 (setcdr cur (cons val (cdr cur)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
297 (setq retval (cons (list key val) retval)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
298 retval))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
299
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
300 (defun url-unhex (x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
301 (if (> x ?9)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
302 (if (>= x ?a)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
303 (+ 10 (- x ?a))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
304 (+ 10 (- x ?A)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
305 (- x ?0)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
306
|
54803
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
307 ;; Fixme: Is this definition better, and does it ever matter?
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
308
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
309 ;; (defun url-unhex-string (str &optional allow-newlines)
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
310 ;; "Remove %XX, embedded spaces, etc in a url.
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
311 ;; If optional second argument ALLOW-NEWLINES is non-nil, then allow the
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
312 ;; decoding of carriage returns and line feeds in the string, which is normally
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
313 ;; forbidden in URL encoding."
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
314 ;; (setq str (or str ""))
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
315 ;; (setq str (replace-regexp-in-string "%[[:xdigit:]]\\{2\\}"
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
316 ;; (lambda (match)
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
317 ;; (string (string-to-number
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
318 ;; (substring match 1) 16)))
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
319 ;; str t t))
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
320 ;; (if allow-newlines
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
321 ;; (replace-regexp-in-string "[\n\r]" (lambda (match)
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
322 ;; (format "%%%.2X" (aref match 0)))
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
323 ;; str t t)
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
324 ;; str))
|
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
325
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
326 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
327 (defun url-unhex-string (str &optional allow-newlines)
|
54803
a78c94aa182d
(url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
328 "Remove %XX embedded spaces, etc in a url.
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
329 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
330 decoding of carriage returns and line feeds in the string, which is normally
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
331 forbidden in URL encoding."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
332 (setq str (or str ""))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
333 (let ((tmp "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
334 (case-fold-search t))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
335 (while (string-match "%[0-9a-f][0-9a-f]" str)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
336 (let* ((start (match-beginning 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
337 (ch1 (url-unhex (elt str (+ start 1))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
338 (code (+ (* 16 ch1)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
339 (url-unhex (elt str (+ start 2))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
340 (setq tmp (concat
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
341 tmp (substring str 0 start)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
342 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
343 (allow-newlines
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
344 (char-to-string code))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
345 ((or (= code ?\n) (= code ?\r))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
346 " ")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
347 (t (char-to-string code))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
348 str (substring str (match-end 0)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
349 (setq tmp (concat tmp str))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
350 tmp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
351
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
352 (defconst url-unreserved-chars
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
353 '(
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
354 ?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
|
355 ?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
|
356 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
357 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
358 "A list of characters that are _NOT_ reserved in the URL spec.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
359 This is taken from RFC 2396.")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
360
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
361 ;;;###autoload
|
72196
|
362 (defun url-hexify-string (string)
|
|
363 "Return a new string that is STRING URI-encoded.
|
|
364 First, STRING is converted to utf-8, if necessary. Then, for each
|
|
365 character in the utf-8 string, those found in `url-unreserved-chars'
|
|
366 are left as-is, all others are represented as a three-character
|
|
367 string: \"%\" followed by two lowercase hex digits."
|
72218
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
368 ;; To go faster and avoid a lot of consing, we could do:
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
369 ;;
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
370 ;; (defconst url-hexify-table
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
371 ;; (let ((map (make-vector 256 nil)))
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
372 ;; (dotimes (byte 256) (aset map byte
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
373 ;; (if (memq byte url-unreserved-chars)
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
374 ;; (char-to-string byte)
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
375 ;; (format "%%%02x" byte))))
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
376 ;; map))
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
377 ;;
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
378 ;; (mapconcat (curry 'aref url-hexify-table) ...)
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
379 (mapconcat (lambda (byte)
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
380 (if (memq byte url-unreserved-chars)
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
381 (char-to-string byte)
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
382 (format "%%%02x" byte)))
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
383 (if (multibyte-string-p string)
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
384 (encode-coding-string string 'utf-8)
|
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
385 string)
|
72196
|
386 ""))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
387
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
388 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
389 (defun url-file-extension (fname &optional x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
390 "Return the filename extension of FNAME.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
391 If optional variable X is t,
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
392 then return the basename of the file with the extension stripped off."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
393 (if (and fname
|
79064
|
394 (setq fname (url-file-nondirectory fname))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
395 (string-match "\\.[^./]+$" fname))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
396 (if x (substring fname 0 (match-beginning 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
397 (substring fname (match-beginning 0) nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
398 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
399 ;; If fname has no extension, and x then return fname itself instead of
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
400 ;; nothing. When caching it allows the correct .hdr file to be produced
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
401 ;; for filenames without extension.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
402 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
403 (if x
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
404 fname
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
405 "")))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
406
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
407 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
408 (defun url-truncate-url-for-viewing (url &optional width)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
409 "Return a shortened version of URL that is WIDTH characters or less wide.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
410 WIDTH defaults to the current frame width."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
411 (let* ((fr-width (or width (frame-width)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
412 (str-width (length url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
413 (fname nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
414 (modified 0)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
415 (urlobj nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
416 ;; The first thing that can go are the search strings
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
417 (if (and (>= str-width fr-width)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
418 (string-match "?" url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
419 (setq url (concat (substring url 0 (match-beginning 0)) "?...")
|
72218
23d71f51857b
(url-hexify-string): Only utf-8 encode if it's a multibyte string.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
420 str-width (length url)))
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
421 (if (< str-width fr-width)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
422 nil ; Hey, we are done!
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
423 (setq urlobj (url-generic-parse-url url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
424 fname (url-filename urlobj)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
425 fr-width (- fr-width 4))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
426 (while (and (>= str-width fr-width)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
427 (string-match "/" fname))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
428 (setq fname (substring fname (match-end 0) nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
429 modified (1+ modified))
|
83823
dd2bcc6758a0
* url-parse.el (url): Use defstruct rather than macros. Update all callers.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
430 (setf (url-filename urlobj) fname)
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
431 (setq url (url-recreate-url urlobj)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
432 str-width (length url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
433 (if (> modified 1)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
434 (setq fname (concat "/.../" fname))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
435 (setq fname (concat "/" fname)))
|
83823
dd2bcc6758a0
* url-parse.el (url): Use defstruct rather than macros. Update all callers.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
436 (setf (url-filename urlobj) fname)
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
437 (setq url (url-recreate-url urlobj)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
438 url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
439
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
440 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
441 (defun url-view-url (&optional no-show)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
442 "View the current document's URL.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
443 Optional argument NO-SHOW means just return the URL, don't show it in
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
444 the minibuffer.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
445
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
446 This uses `url-current-object', set locally to the buffer."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
447 (interactive)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
448 (if (not url-current-object)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
449 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
450 (if no-show
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
451 (url-recreate-url url-current-object)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
452 (message "%s" (url-recreate-url url-current-object)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
453
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
454 (eval-and-compile
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
455 (defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
456 "Valid characters in a URL")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
457 )
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
458
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
459 (defun url-get-url-at-point (&optional pt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
460 "Get the URL closest to point, but don't change position.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
461 Has a preference for looking backward when not directly on a symbol."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
462 ;; Not at all perfect - point must be right in the name.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
463 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
464 (if pt (goto-char pt))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
465 (let (start url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
466 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
467 ;; first see if you're just past a filename
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
468 (if (not (eobp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
469 (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
470 (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
471 (skip-chars-backward " \n\t\r({[]})")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
472 (if (not (bobp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
473 (backward-char 1)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
474 (if (and (char-after (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
475 (string-match (eval-when-compile
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
476 (concat "[" url-get-url-filename-chars "]"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
477 (char-to-string (char-after (point)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
478 (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
479 (skip-chars-backward url-get-url-filename-chars)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
480 (setq start (point))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
481 (skip-chars-forward url-get-url-filename-chars))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
482 (setq start (point)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
483 (setq url (buffer-substring-no-properties start (point))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
484 (if (and url (string-match "^(.*)\\.?$" url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
485 (setq url (match-string 1 url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
486 (if (and url (string-match "^URL:" url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
487 (setq url (substring url 4 nil)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
488 (if (and url (string-match "\\.$" url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
489 (setq url (substring url 0 -1)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
490 (if (and url (string-match "^www\\." url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
491 (setq url (concat "http://" url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
492 (if (and url (not (string-match url-nonrelative-link url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
493 (setq url nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
494 url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
495
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
496 (defun url-generate-unique-filename (&optional fmt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
497 "Generate a unique filename in `url-temporary-directory'."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
498 (if (not fmt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
499 (let ((base (format "url-tmp.%d" (user-real-uid)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
500 (fname "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
501 (x 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
502 (setq fname (format "%s%d" base x))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
503 (while (file-exists-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
504 (expand-file-name fname url-temporary-directory))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
505 (setq x (1+ x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
506 fname (concat base (int-to-string x))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
507 (expand-file-name fname url-temporary-directory))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
508 (let ((base (concat "url" (int-to-string (user-real-uid))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
509 (fname "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
510 (x 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
511 (setq fname (format fmt (concat base (int-to-string x))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
512 (while (file-exists-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
513 (expand-file-name fname url-temporary-directory))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
514 (setq x (1+ x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
515 fname (format fmt (concat base (int-to-string x)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
516 (expand-file-name fname url-temporary-directory))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
517
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
518 (defun url-extract-mime-headers ()
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
519 "Set `url-current-mime-headers' in current buffer."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
520 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
521 (goto-char (point-min))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
522 (unless url-current-mime-headers
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
523 (set (make-local-variable 'url-current-mime-headers)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
524 (mail-header-extract)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
525
|
87256
|
526 (defun url-make-private-file (file)
|
|
527 "Make FILE only readable and writable by the current user.
|
|
528 Creates FILE and its parent directories if they do not exist."
|
|
529 (let ((dir (file-name-directory file)))
|
|
530 (when dir
|
|
531 ;; For historical reasons.
|
|
532 (make-directory dir t)))
|
|
533 ;; Based on doc-view-make-safe-dir.
|
|
534 (condition-case nil
|
|
535 (let ((umask (default-file-modes)))
|
|
536 (unwind-protect
|
|
537 (progn
|
|
538 (set-default-file-modes #o0600)
|
|
539 (with-temp-buffer
|
|
540 (write-region (point-min) (point-max)
|
|
541 file nil 'silent nil 'excl)))
|
|
542 (set-default-file-modes umask)))
|
|
543 (file-already-exists
|
|
544 (if (file-symlink-p file)
|
|
545 (error "Danger: `%s' is a symbolic link" file))
|
|
546 (set-file-modes file #o0600))))
|
|
547
|
54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
548 (provide 'url-util)
|
54699
|
549
|
54935
|
550 ;; arch-tag: 24352abc-5a5a-412e-90cd-313b26bed5c9
|
|
551 ;;; url-util.el ends here
|