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