]> code.delx.au - gnu-emacs/blob - lisp/url/url-vars.el
Merge from emacs-23
[gnu-emacs] / lisp / url / url-vars.el
1 ;;; url-vars.el --- Variables for Uniform Resource Locator tool
2
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
5
6 ;; Keywords: comm, data, processes, hypermedia
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Code:
24
25 (require 'mm-util)
26
27 (defconst url-version "Emacs"
28 "Version number of URL package.")
29
30 (defgroup url nil
31 "Uniform Resource Locator tool."
32 :version "22.1"
33 :group 'comm)
34
35 (defgroup url-file nil
36 "URL storage."
37 :prefix "url-"
38 :group 'url)
39
40 (defgroup url-cache nil
41 "URL cache."
42 :prefix "url-"
43 :prefix "url-cache-"
44 :group 'url)
45
46 (defgroup url-mime nil
47 "MIME options of URL."
48 :prefix "url-"
49 :group 'url)
50
51 (defgroup url-hairy nil
52 "Hairy options of URL."
53 :prefix "url-"
54 :group 'url)
55
56
57 (defvar url-current-object nil
58 "A parsed representation of the current URL.")
59
60 (defvar url-current-mime-headers nil
61 "A parsed representation of the MIME headers for the current URL.")
62
63 (mapc 'make-variable-buffer-local
64 '(
65 url-current-object
66 url-current-referer
67 url-current-mime-headers
68 ))
69
70 (defcustom url-honor-refresh-requests t
71 "Whether to do automatic page reloads.
72 These are done at the request of the document author or the server via
73 the `Refresh' header in an HTTP response. If nil, no refresh
74 requests will be honored. If t, all refresh requests will be honored.
75 If non-nil and not t, the user will be asked for each refresh request."
76 :type '(choice (const :tag "off" nil)
77 (const :tag "on" t)
78 (const :tag "ask" 'ask))
79 :group 'url-hairy)
80
81 (defcustom url-automatic-caching nil
82 "If non-nil, all documents will be automatically cached to the local disk."
83 :type 'boolean
84 :group 'url-cache)
85
86 (defconst url-bug-address "bug-gnu-emacs@gnu.org"
87 "Where to send bug reports.")
88
89 (defcustom url-personal-mail-address nil
90 "Your full email address.
91 This is what is sent to HTTP servers as the FROM field in an HTTP
92 request."
93 :type '(choice (const :tag "Unspecified" nil) string)
94 :group 'url)
95
96 (defcustom url-directory-index-file "index.html"
97 "The filename to look for when indexing a directory.
98 If this file exists, and is readable, then it will be viewed instead of
99 using `dired' to view the directory."
100 :type 'string
101 :group 'url-file)
102
103 (defcustom url-privacy-level '(email)
104 "How private you want your requests to be.
105 HTTP has header fields for various information about the user, including
106 operating system information, email addresses, the last page you visited, etc.
107 This variable controls how much of this information is sent.
108
109 This should a symbol or a list.
110 Valid values if a symbol are:
111 none -- send all information
112 low -- don't send the last location
113 high -- don't send the email address or last location
114 paranoid -- don't send anything
115
116 If a list, this should be a list of symbols of what NOT to send.
117 Valid symbols are:
118 email -- the email address
119 os -- the operating system info
120 lastloc -- the last location
121 agent -- do not send the User-Agent string
122 cookies -- never accept HTTP cookies
123
124 Samples:
125
126 (setq url-privacy-level 'high)
127 (setq url-privacy-level '(email lastloc)) ;; equivalent to 'high
128 (setq url-privacy-level '(os))
129
130 ::NOTE::
131 This variable controls several other variables and is _NOT_ automatically
132 updated. Call the function `url-setup-privacy-info' after modifying this
133 variable."
134 :initialize 'custom-initialize-default
135 :set (lambda (sym val) (set-default sym val) (url-setup-privacy-info))
136 :type '(radio (const :tag "None (you believe in the basic goodness of humanity)"
137 :value none)
138 (const :tag "Low (do not reveal last location)"
139 :value low)
140 (const :tag "High (no email address or last location)"
141 :value high)
142 (const :tag "Paranoid (reveal nothing!)"
143 :value paranoid)
144 (checklist :tag "Custom"
145 (const :tag "Email address" :value email)
146 (const :tag "Operating system" :value os)
147 (const :tag "Last location" :value lastloc)
148 (const :tag "Browser identification" :value agent)
149 (const :tag "No cookies" :value cookie)))
150 :group 'url)
151
152 (defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.")
153
154 (defcustom url-uncompressor-alist '((".z" . "x-gzip")
155 (".gz" . "x-gzip")
156 (".uue" . "x-uuencoded")
157 (".hqx" . "x-hqx")
158 (".Z" . "x-compress")
159 (".bz2" . "x-bzip2"))
160 "An alist of file extensions and appropriate content-transfer-encodings."
161 :type '(repeat (cons :format "%v"
162 (string :tag "Extension")
163 (string :tag "Encoding")))
164 :group 'url-mime)
165
166 (defcustom url-mail-command 'compose-mail
167 "This function will be called whenever URL needs to send mail.
168 It should enter a mail-mode-like buffer in the current window.
169 The commands `mail-to' and `mail-subject' should still work in this
170 buffer, and it should use `mail-header-separator' if possible."
171 :type 'function
172 :group 'url)
173
174 (defcustom url-proxy-services nil
175 "An alist of schemes and proxy servers that gateway them.
176 Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up
177 from the ACCESS_proxy environment variables."
178 :type '(repeat (cons :format "%v"
179 (string :tag "Protocol")
180 (string :tag "Proxy")))
181 :group 'url)
182
183 (defcustom url-standalone-mode nil
184 "Rely solely on the cache?"
185 :type 'boolean
186 :group 'url-cache)
187
188 (defvar url-mime-separator-chars (mapcar 'identity
189 (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
190 "abcdefghijklmnopqrstuvwxyz"
191 "0123456789'()+_,-./=?"))
192 "Characters allowable in a MIME multipart separator.")
193
194 (defcustom url-bad-port-list
195 '("25" "119" "19")
196 "List of ports to warn the user about connecting to.
197 Defaults to just the mail, chargen, and NNTP ports so you cannot be
198 tricked into sending fake mail or forging messages by a malicious HTML
199 document."
200 :type '(repeat (string :tag "Port"))
201 :group 'url-hairy)
202
203 (defvar url-mime-content-type-charset-regexp
204 ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
205 "Regexp used in parsing `Content-Type' for a charset indication.")
206
207 (defvar url-request-data nil "Any data to send with the next request.")
208
209 (defvar url-request-extra-headers nil
210 "A list of extra headers to send with the next request.
211 Should be an assoc list of headers/contents.")
212
213 (defvar url-request-method nil "The method to use for the next request.")
214
215 ;; FIXME!! (RFC 2616 gives examples like `compress, gzip'.)
216 (defvar url-mime-encoding-string nil
217 "*String to send in the Accept-encoding: field in HTTP requests.")
218
219 ;; Perhaps the first few should actually be given decreasing `q's and
220 ;; the list should be trimmed significantly.
221 ;; Fixme: do something sane if we don't have `sort-coding-systems'
222 ;; (Emacs 20, XEmacs).
223 (defun url-mime-charset-string ()
224 "Generate a list of preferred MIME charsets for HTTP requests.
225 Generated according to current coding system priorities."
226 (if (fboundp 'sort-coding-systems)
227 (let ((ordered (sort-coding-systems
228 (let (accum)
229 (dolist (elt mm-mime-mule-charset-alist)
230 (if (mm-coding-system-p (car elt))
231 (push (car elt) accum)))
232 (nreverse accum)))))
233 (concat (format "%s;q=1, " (pop ordered))
234 (mapconcat 'symbol-name ordered ";q=0.5, ")
235 ";q=0.5"))))
236
237 (defvar url-mime-charset-string nil
238 "*String to send in the Accept-charset: field in HTTP requests.
239 The MIME charset corresponding to the most preferred coding system is
240 given priority 1 and the rest are given priority 0.5.")
241
242 (defun url-set-mime-charset-string ()
243 (setq url-mime-charset-string (url-mime-charset-string)))
244 ;; Regenerate if the language environment changes.
245 (add-hook 'set-language-environment-hook 'url-set-mime-charset-string)
246
247 ;; Fixme: set from the locale.
248 (defcustom url-mime-language-string nil
249 "String to send in the Accept-language: field in HTTP requests.
250
251 Specifies the preferred language when servers can serve documents in
252 several languages. Use RFC 1766 abbreviations, e.g.: `en' for
253 English, `de' for German. A comma-separated specifies descending
254 order of preference. The ordering can be made explicit using `q'
255 factors defined by HTTP, e.g. `de,en-gb;q=0.8,en;q=0.7'. `*' means
256 get the first available language (as opposed to the default)."
257 :type '(radio
258 (const :tag "None (get default language version)" :value nil)
259 (const :tag "Any (get first available language version)" :value "*")
260 (string :tag "Other"))
261 :group 'url-mime
262 :group 'i18n)
263
264 (defvar url-mime-accept-string nil
265 "String to send to the server in the Accept: field in HTTP requests.")
266
267 (defvar url-package-version nil
268 "Version number of package using URL.")
269
270 (defvar url-package-name nil "Name of package using URL.")
271
272 (defvar url-system-type nil
273 "What type of system we are on.")
274 (defvar url-os-type nil
275 "What OS we are on.")
276
277 (defcustom url-max-password-attempts 5
278 "Maximum number of times a password will be prompted for.
279 Applies when a protected document is denied by the server."
280 :type 'integer
281 :group 'url)
282
283 (defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
284 "Where temporary files go."
285 :type 'directory
286 :group 'url-file)
287 (make-obsolete-variable 'url-temporary-directory
288 'temporary-file-directory "23.1")
289
290 (defcustom url-show-status t
291 "Whether to show a running total of bytes transferred.
292 Can cause a large hit if using a remote X display over a slow link, or
293 a terminal with a slow modem."
294 :type 'boolean
295 :group 'url)
296
297 (defvar url-using-proxy nil
298 "Either nil or the fully qualified proxy URL in use, e.g.
299 http://www.example.com/")
300
301 (defcustom url-news-server nil
302 "The default news server from which to get newsgroups/articles.
303 Applies if no server is specified in the URL. Defaults to the
304 environment variable NNTPSERVER or \"news\" if NNTPSERVER is
305 undefined."
306 :type '(choice (const :tag "None" :value nil) string)
307 :group 'url)
308
309 (defvar url-nonrelative-link
310 "\\`\\([-a-zA-Z0-9+.]+:\\)"
311 "A regular expression that will match an absolute URL.")
312
313 (defcustom url-max-redirections 30
314 "The maximum number of redirection requests to honor in a HTTP connection.
315 A negative number means to honor an unlimited number of redirection requests."
316 :type 'integer
317 :group 'url)
318
319 (defcustom url-confirmation-func 'y-or-n-p
320 "What function to use for asking yes or no functions.
321 Possible values are `yes-or-no-p' or `y-or-n-p', or any function that
322 takes a single argument (the prompt), and returns t only if a positive
323 answer is given."
324 :type '(choice (const :tag "Short (y or n)" :value y-or-n-p)
325 (const :tag "Long (yes or no)" :value yes-or-no-p)
326 (function :tag "Other"))
327 :group 'url-hairy)
328
329 (defcustom url-gateway-method 'native
330 "The type of gateway support to use.
331 Should be a symbol specifying how to get a connection from the local machine.
332
333 Currently supported methods:
334 `telnet': Run telnet in a subprocess to connect;
335 `rlogin': Rlogin to another machine to connect;
336 `socks': Connect through a socks server;
337 `tls': Connect with TLS;
338 `ssl': Connect with SSL (deprecated, use `tls' instead);
339 `native': Connect directy."
340 :type '(radio (const :tag "Telnet to gateway host" :value telnet)
341 (const :tag "Rlogin to gateway host" :value rlogin)
342 (const :tag "Use SOCKS proxy" :value socks)
343 (const :tag "Use SSL/TLS for all connections" :value tls)
344 (const :tag "Use SSL for all connections (obsolete)" :value ssl)
345 (const :tag "Direct connection" :value native))
346 :group 'url-hairy)
347
348 (defvar url-setup-done nil "Has setup configuration been done?")
349
350 (defconst url-weekday-alist
351 '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3)
352 ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6)
353 ("Tues" . 2) ("Thurs" . 4)
354 ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
355 ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
356
357 (defconst url-monthabbrev-alist
358 '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
359 ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11)
360 ("Dec" . 12)))
361
362 (defvar url-lazy-message-time 0)
363
364 ;; Fixme: We may not be able to run SSL.
365 (defvar url-extensions-header "Security/Digest Security/SSL")
366
367 (defvar url-parse-syntax-table
368 (copy-syntax-table emacs-lisp-mode-syntax-table)
369 "*A syntax table for parsing URLs.")
370
371 (modify-syntax-entry ?' "\"" url-parse-syntax-table)
372 (modify-syntax-entry ?` "\"" url-parse-syntax-table)
373 (modify-syntax-entry ?< "(>" url-parse-syntax-table)
374 (modify-syntax-entry ?> ")<" url-parse-syntax-table)
375 (modify-syntax-entry ?/ " " url-parse-syntax-table)
376
377 (defvar url-load-hook nil
378 "*Hooks to be run after initializing the URL library.")
379
380 ;;; Make OS/2 happy - yeeks
381 ;; (defvar tcp-binary-process-input-services nil
382 ;; "*Make OS/2 happy with our CRLF pairs...")
383
384 (defconst url-working-buffer " *url-work")
385
386 (defvar url-gateway-unplugged nil
387 "Non-nil means don't open new network connections.
388 This should be set, e.g. by mail user agents rendering HTML to avoid
389 `bugs' which call home.")
390
391 (provide 'url-vars)
392
393 ;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49
394 ;;; url-vars.el ends here