lisp/url/url-vars.el

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