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