lisp/url/url-vars.el

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