lisp/url/url-vars.el

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