diff options
Diffstat (limited to 'lisp/url')
| -rw-r--r-- | lisp/url/ChangeLog | 112 | ||||
| -rw-r--r-- | lisp/url/url-about.el | 2 | ||||
| -rw-r--r-- | lisp/url/url-auth.el | 2 | ||||
| -rw-r--r-- | lisp/url/url-cookie.el | 99 | ||||
| -rw-r--r-- | lisp/url/url-dav.el | 32 | ||||
| -rw-r--r-- | lisp/url/url-expand.el | 23 | ||||
| -rw-r--r-- | lisp/url/url-file.el | 33 | ||||
| -rw-r--r-- | lisp/url/url-handlers.el | 5 | ||||
| -rw-r--r-- | lisp/url/url-history.el | 20 | ||||
| -rw-r--r-- | lisp/url/url-http.el | 2 | ||||
| -rw-r--r-- | lisp/url/url-imap.el | 4 | ||||
| -rw-r--r-- | lisp/url/url-irc.el | 4 | ||||
| -rw-r--r-- | lisp/url/url-mailto.el | 4 | ||||
| -rw-r--r-- | lisp/url/url-methods.el | 14 | ||||
| -rw-r--r-- | lisp/url/url-news.el | 4 | ||||
| -rw-r--r-- | lisp/url/url-parse.el | 74 | ||||
| -rw-r--r-- | lisp/url/url-privacy.el | 7 | ||||
| -rw-r--r-- | lisp/url/url-util.el | 6 | ||||
| -rw-r--r-- | lisp/url/url-vars.el | 17 | ||||
| -rw-r--r-- | lisp/url/url.el | 16 |
20 files changed, 256 insertions, 224 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 040a6a46d81..3890daabf46 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -4,28 +4,83 @@ 2007-12-11 Glenn Morris <rgm@gnu.org> + * url.el (url-configuration-directory): Make it a defcustom. + * url-util.el (url-make-private-file): New function. * url-cookie.el (url-cookie-write-file): * url-history.el (url-history-save-history): Use url-make-private-file and with-temp-buffer. +2007-12-06 Glenn Morris <rgm@gnu.org> + + * url-file.el, url-mailto.el: Remove directory part from filenames + in function declarations. + 2007-12-02 Glenn Morris <rgm@gnu.org> - * url-news.el (nntp-open-tls-stream, nntp-open-ssl-stream): + * url-about.el, url-handlers.el: Don't require cl when compiling. + + * url-dav.el (url-dav-delete-directory): Fix message typo. + + * url-history.el (top-level): Don't require cl when compiling. + (url-history-setup-save-timer, url-history-save-history): + Use condition-case rather than ignore-errors. + + * url-imap.el (top-level): Don't require cl when compiling. + (url-imap): Use signal rather than check-type. + + * url-news.el (top-level): Don't require cl when compiling. + (gnus-group-buffer): Define for compiler. + (url-news-fetch-message-id): Don't use `declare'. + (nntp-open-tls-stream, nntp-open-ssl-stream): No need to define for compiler. (url-snews): Use nntp-open-tls-stream unless ssl is requested. Correct quoting of nntp-open-connection-function value. +2007-12-01 Glenn Morris <rgm@gnu.org> + + * url-handlers.el (top-level): Always require url-parse, not just + when compiling. + +2007-11-30 Glenn Morris <rgm@gnu.org> + + * url-cookie.el (url-cookie-p): Declare as a function. + +2007-11-29 Glenn Morris <rgm@gnu.org> + + * url-file.el (url-file-build-filename, url-file): Wrap uses of + efs in (featurep 'xemacs) test. + + * url-irc.el (zenirc, zenirc-send-line): Declare as functions. + 2007-11-28 Diane Murray <disumu@x3y2z1.net> * url-dired.el: Don't require w3-fetch and w3-open-local. (url-dired-find-file): Use `find-file'. Doc fix. (url-dired-find-file-mouse, url-dired-minor-mode): Doc fix. +2007-11-24 Glenn Morris <rgm@gnu.org> + + * url-privacy.el (url-device-type): Fix typo. + +2007-11-20 Dan Nicolaescu <dann@ics.uci.edu> + + * url-mailto.el (mail-send-and-exit): + * url-http.el (url-dav-file-attributes): + * url-file.el (ange-ftp-set-passwd, ange-ftp-copy-file-internal) + (url-generate-unique-filename): Declare as functions. + + * url-privacy.el (url-device-type): Define unconditionally. + 2007-11-15 Richard Stallman <rms@gnu.org> * url.el (url-retrieve-synchronously): Call delete-process. +2007-10-31 Juanma Barranquero <lekktu@gmail.com> + + * url-vars.el (url-vars-unload-hook): Remove function and variable. + Hooks are automatically removed by `unload-feature'. + 2007-10-13 Richard Stallman <rms@gnu.org> * url-util.el (url-basepath): Function deleted. @@ -50,6 +105,11 @@ (url-set-host, url-set-port, url-set-filename, url-set-target) (url-set-attributes, url-set-full): Change macros to defuns. +2007-09-26 Juanma Barranquero <lekktu@gmail.com> + + * url-dav.el (top): + * url-vars.el (top): Use `mapc' rather than `mapcar'. + 2007-09-22 Diane Murray <disumu@x3y2z1.net> * url-misc.el (url-generic-emulator-loader): Send the port as a @@ -57,8 +117,7 @@ 2007-09-21 Diane Murray <disumu@x3y2z1.net> - * url-news.el (url-news-fetch-newsgroup): Fix formatting of Gnus - method. + * url-news.el (url-news-fetch-newsgroup): Fix formatting of Gnus method. * url-util.el (url-get-normalized-date): Pass full timezone information to timezone-make-date-arpa-standard, since zone name @@ -71,6 +130,22 @@ `current-buffer', so that the correct buffer is killed if `url-retrieve-synchronously' gets redirected to a new URL. +2007-08-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-parse.el (url): Use defstruct rather than macros. + (url-generic-parse-url): + * url-util.el (url-normalize-url, url-truncate-url-for-viewing): + * url-methods.el (url-scheme-register-proxy): + * url-mailto.el (url-mailto): + * url-file.el (url-file-build-filename): + * url-expand.el (url-identity-expander, url-default-expander): + Update all callers. + +2007-08-09 Edward O'Connor <hober0@gmail.com> (tiny change) + + * url-auth.el (url-basic-auth): When prompting for username + and password, default to the username and password in the URL. + 2007-08-08 Glenn Morris <rgm@gnu.org> * url-auth.el, url-cache.el, url-dav.el, url-file.el, vc-dav.el: @@ -80,11 +155,26 @@ * Relicense all FSF files to GPLv3 or later. +2007-06-12 Tom Tromey <tromey@redhat.com> + + * url.el (url-configuration-directory): Use user-emacs-directory. + +2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-cookie.el (url-cookie-name, url-cookie-value) + (url-cookie-expires, url-cookie-localpart, url-cookie-domain) + (url-cookie-secure, url-cookie-set-name, url-cookie-set-value) + (url-cookie-set-expires, url-cookie-set-localpart) + (url-cookie-set-domain, url-cookie-set-secure) + (url-cookie-retrieve-arg, url-cookie-create, url-cookie-p): Remove. + (url-cookie): New struct. + (url-cookie-store): Use setf instead of url-cookie-set-*. + 2007-05-29 Chong Yidong <cyd@stupidchicken.com> * url-mailto.el (url-mailto): Insert body after mail-header-separator if present, so that it is before signature. - Bug reported by Leo <sdl.web@gmail.com>. + Suggested by Leo <sdl.web@gmail.com>. 2007-04-15 Chong Yidong <cyd@stupidchicken.com> @@ -1227,7 +1317,7 @@ * lisp/url-about.el (url-about): New loader scheme to handle about:foo URLs. Automatically tries to find a `url-about-foo' function to display the actual data. - (url-about-protocols): Implement about:protocols + (url-about-protocols): Implement about:protocols. * lisp/url-http.el (url-http): Make sure that we signal an error when we cannot open a network connection for whatever reason. @@ -1574,11 +1664,11 @@ 2001-01-03 Sam Steingold <sds@gnu.org> * lisp/url-http.el (url-http-wait-for-headers-change-function): - set `url-http-end-of-headers' to 0 for HTTP 0.9 + set `url-http-end-of-headers' to 0 for HTTP 0.9. 2001-01-02 Sam Steingold <sds@gnu.org> - * lisp/url-auth.el (provide): `url-auth', not `urlauth' + * lisp/url-auth.el (provide): `url-auth', not `urlauth'. 2000-12-22 Dave Love <fx@gnu.org> @@ -1666,7 +1756,7 @@ IRC URL so people don't think I'm crazy. * configure.in: Checks to make sure that Gnus was found, since we - HAVE to have it now. Removed conditional compilation of url-cid.el + HAVE to have it now. Removed conditional compilation of url-cid.el. 1999-12-16 Eric Marsden <emarsden@mail.dotcom.fr> @@ -1750,7 +1840,7 @@ 1999-12-06 William M. Perry <wmperry@aventail.com> * lisp/mule-sysdp.el (mule-code-convert-region): Deal with Mule - 4.1 gracefully + 4.1 gracefully. * lisp/url-news.el: Reimplemented news and nntp URL support. No longer bothers to check for outdated Gnus versions, since this @@ -1776,7 +1866,7 @@ as well as efs. (url-file): Add default content-type of application/octet-stream if none known. - (url-file): Correct bad call to url-host-is-local-p + (url-file): Correct bad call to url-host-is-local-p. * lisp/url-handlers.el (url-insert-file-contents): Emacs doesn't like buffer-substring with nil arguments. @@ -1792,7 +1882,7 @@ (url-scheme-get-property): Use it when we load a URL scheme for the first time. - * lisp/url-util.el (url-get-url-at-point): Re-integrated + * lisp/url-util.el (url-get-url-at-point): Re-integrated. 1999-12-04 William M. Perry <wmperry@aventail.com> diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el index a64d0a5f045..d8db9ea8a53 100644 --- a/lisp/url/url-about.el +++ b/lisp/url/url-about.el @@ -26,8 +26,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) (require 'url-util) (require 'url-parse) diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 10b968a68d8..ea96bb08129 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -318,5 +318,5 @@ RATING a rating between 1 and 10 of the strength of the authentication. (provide 'url-auth) -;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91 +;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91 ;;; url-auth.el ends here diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index c7a3e7da4c5..7db8e0a307a 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -33,51 +33,6 @@ ;; See http://home.netscape.com/newsref/std/cookie_spec.html for the ;; 'open standard' defining this crap. -;; -;; A cookie is stored internally as a vector of 7 slots -;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ] - -(defsubst url-cookie-name (cookie) (aref cookie 1)) -(defsubst url-cookie-value (cookie) (aref cookie 2)) -(defsubst url-cookie-expires (cookie) (aref cookie 3)) -(defsubst url-cookie-localpart (cookie) (aref cookie 4)) -(defsubst url-cookie-domain (cookie) (aref cookie 5)) -(defsubst url-cookie-secure (cookie) (aref cookie 6)) - -(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val)) -(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val)) -(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val)) -(defsubst url-cookie-set-localpart (cookie val) (aset cookie 4 val)) -(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val)) -(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val)) -(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args))) - -(defsubst url-cookie-create (&rest args) - "Create a cookie vector object from keyword-value pairs ARGS. -The keywords allowed are - :name NAME - :value VALUE - :expires TIME - :localpart LOCALPAR - :domain DOMAIN - :secure ??? -Could someone fill in more information?" - (let ((retval (make-vector 7 nil))) - (aset retval 0 'cookie) - (url-cookie-set-name retval (url-cookie-retrieve-arg :name args)) - (url-cookie-set-value retval (url-cookie-retrieve-arg :value args)) - (url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args)) - (url-cookie-set-localpart retval (url-cookie-retrieve-arg :localpart args)) - (url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args)) - (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args)) - retval)) - -(defun url-cookie-p (obj) - "Return non-nil if OBJ is a cookie vector object. -These objects represent cookies in the URL package. -A cookie vector object is a vector of 7 slots: - [cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE]." - (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie))) (defgroup url-cookie nil "URL cookies." @@ -85,6 +40,20 @@ A cookie vector object is a vector of 7 slots: :prefix "url-cookie-" :group 'url) +;; A cookie is stored internally as a vector of 7 slots +;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ] + +(defstruct (url-cookie + (:constructor url-cookie-create) + (:copier nil) + ;; For compatibility with a previous version which did not use + ;; defstruct, and also in order to make sure that the printed + ;; representation does not depend on CL internals, we use an + ;; explicitly managed tag. + (:type vector)) + (tag 'cookie :read-only t) + name value expires localpart domain secure) + (defvar url-cookie-storage nil "Where cookies are stored.") (defvar url-cookie-secure-storage nil "Where secure cookies are stored.") (defcustom url-cookie-file nil @@ -118,6 +87,8 @@ telling Microsoft that." ;; (message "Could not load cookie file %s" fname) ))) +(declare-function url-cookie-p "url-cookie" t t) ; defstruct + (defun url-cookie-clean-up (&optional secure) (let* ( (var (if secure 'url-cookie-secure-storage 'url-cookie-storage)) @@ -156,23 +127,23 @@ telling Microsoft that." nil) (error t)) (message "Error accessing cookie file `%s'" fname) - (url-cookie-clean-up) - (url-cookie-clean-up t) - (with-temp-buffer - (insert ";; Emacs-W3 HTTP cookies file\n" - ";; Automatically generated file!!! DO NOT EDIT!!!\n\n" - "(setq url-cookie-storage\n '") - (pp url-cookie-storage (current-buffer)) - (insert ")\n(setq url-cookie-secure-storage\n '") - (pp url-cookie-secure-storage (current-buffer)) - (insert ")\n") - (insert " \n;; Local Variables:\n" - ";; version-control: never\n" - ";; no-byte-compile: t\n" - ";; End:\n") - (set (make-local-variable 'version-control) 'never) - (write-file fname)) - (setq url-cookies-changed-since-last-save nil)))) + (url-cookie-clean-up) + (url-cookie-clean-up t) + (with-temp-buffer + (insert ";; Emacs-W3 HTTP cookies file\n" + ";; Automatically generated file!!! DO NOT EDIT!!!\n\n" + "(setq url-cookie-storage\n '") + (pp url-cookie-storage (current-buffer)) + (insert ")\n(setq url-cookie-secure-storage\n '") + (pp url-cookie-secure-storage (current-buffer)) + (insert ")\n") + (insert " \n;; Local Variables:\n" + ";; version-control: never\n" + ";; no-byte-compile: t\n" + ";; End:\n") + (set (make-local-variable 'version-control) 'never) + (write-file fname)) + (setq url-cookies-changed-since-last-save nil)))) (defun url-cookie-store (name value &optional expires domain localpart secure) "Store a netscape-style cookie." @@ -196,8 +167,8 @@ telling Microsoft that." (if (and (equal localpart (url-cookie-localpart cur)) (equal name (url-cookie-name cur))) (progn - (url-cookie-set-expires cur expires) - (url-cookie-set-value cur value) + (setf (url-cookie-expires cur) expires) + (setf (url-cookie-value cur) value) (setq tmp t)))) (if (not tmp) ;; New cookie diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index f1f62fd4bdc..b8e7b526265 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -194,7 +194,7 @@ (while children (setq node (car children) node-type (intern - (or + (or (cdr-safe (assq url-dav-datatype-attribute (xml-node-attributes node))) "unknown")) @@ -746,7 +746,7 @@ files in the collection as well." (setq status (plist-get (cdr result) 'DAV:status)) (if (not (url-dav-http-success-p status)) (signal 'file-error (list "Removing directory" - "Errror removing" + "Error removing" (car result) status)))) props)) nil) @@ -864,7 +864,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. (exists-p (url-http-file-exists-p newname))) (if (and exists-p - (or + (or (null overwrite) (and (numberp overwrite) (not (yes-or-no-p @@ -933,19 +933,19 @@ Returns nil if DIR contains no name starting with FILE." (defun url-dav-register-handler (op) (put op 'url-file-handlers (intern-soft (format "url-dav-%s" op)))) -(mapcar 'url-dav-register-handler - ;; These handlers are disabled because they incorrectly presume that - ;; the URL specifies an HTTP location and thus break FTP URLs. - '(;; file-name-all-completions - ;; file-name-completion - ;; rename-file - ;; make-directory - ;; file-directory-p - ;; directory-files - ;; delete-file - ;; delete-directory - ;; file-attributes - )) +(mapc 'url-dav-register-handler + ;; These handlers are disabled because they incorrectly presume that + ;; the URL specifies an HTTP location and thus break FTP URLs. + '(;; file-name-all-completions + ;; file-name-completion + ;; rename-file + ;; make-directory + ;; file-directory-p + ;; directory-files + ;; delete-file + ;; delete-directory + ;; file-attributes + )) ;;; Version Control backend cruft diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index f3d84c6a1dd..545388ffa83 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -106,24 +106,24 @@ path components followed by `..' are removed, along with the `..' itself." (url-recreate-url urlobj))))) (defun url-identity-expander (urlobj defobj) - (url-set-type urlobj (or (url-type urlobj) (url-type defobj)))) + (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj)))) (defun url-default-expander (urlobj defobj) ;; The default expansion routine - urlobj is modified by side effect! (if (url-type urlobj) ;; Well, they told us the scheme, let's just go with it. nil - (url-set-type urlobj (or (url-type urlobj) (url-type defobj))) - (url-set-port urlobj (or (url-port urlobj) - (and (string= (url-type urlobj) - (url-type defobj)) - (url-port defobj)))) + (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj))) + (setf (url-port urlobj) (or (url-port urlobj) + (and (string= (url-type urlobj) + (url-type defobj)) + (url-port defobj)))) (if (not (string= "file" (url-type urlobj))) - (url-set-host urlobj (or (url-host urlobj) (url-host defobj)))) + (setf (url-host urlobj) (or (url-host urlobj) (url-host defobj)))) (if (string= "ftp" (url-type urlobj)) - (url-set-user urlobj (or (url-user urlobj) (url-user defobj)))) + (setf (url-user urlobj) (or (url-user urlobj) (url-user defobj)))) (if (string= (url-filename urlobj) "") - (url-set-filename urlobj "/")) + (setf (url-filename urlobj) "/")) (if (string-match "^/" (url-filename urlobj)) nil (let ((query nil) @@ -137,9 +137,10 @@ path components followed by `..' are removed, along with the `..' itself." (setq file (url-expander-remove-relative-links (expand-file-name file (url-file-directory (url-filename defobj))))) - (url-set-filename urlobj (if query (concat file sepchar query) file)))))) + (setf (url-filename urlobj) + (if query (concat file sepchar query) file)))))) (provide 'url-expand) -;;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a +;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a ;;; url-expand.el ends here diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 68127df6b72..cc8a654947a 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -86,6 +86,12 @@ to them." (error nil))) (apply func args)))) +(declare-function ange-ftp-set-passwd "ange-ftp" (host user passwd)) +(declare-function ange-ftp-copy-file-internal "ange-ftp" + (filename newname ok-if-already-exists + keep-date &optional msg cont nowait)) +(declare-function url-generate-unique-filename "url-util" (&optional fmt)) + (defun url-file-build-filename (url) (if (not (vectorp url)) (setq url (url-generic-parse-url url))) @@ -113,8 +119,9 @@ to them." (cond ((featurep 'ange-ftp) (ange-ftp-set-passwd host user pass)) - ((or (featurep 'efs) (featurep 'efs-auto)) - (efs-set-passwd host user pass)) + ((when (featurep 'xemacs) + (or (featurep 'efs) (featurep 'efs-auto) + (efs-set-passwd host user pass)))) (t nil))) @@ -127,10 +134,11 @@ to them." ;; straighten it out for us? ;; (if (and (file-directory-p filename) ;; (not (string-match (format "%c$" directory-sep-char) filename))) - ;; (url-set-filename url (format "%s%c" filename directory-sep-char))) + ;; (setf (url-filename url) + ;; (format "%s%c" filename directory-sep-char))) (if (and (file-directory-p filename) (not (string-match "/\\'" filename))) - (url-set-filename url (format "%s/" filename))) + (setf (url-filename url) (format "%s/" filename))) ;; If it is a directory, look for an index file first. @@ -207,14 +215,15 @@ to them." new (current-buffer) callback cbargs) t) - (autoload 'efs-copy-file-internal "efs") - (efs-copy-file-internal filename (efs-ftp-path filename) - new (efs-ftp-path new) - t nil 0 - (list 'url-file-asynch-callback - new (current-buffer) - callback cbargs) - 0 nil)))))) + (when (featurep 'xemacs) + (autoload 'efs-copy-file-internal "efs") + (efs-copy-file-internal filename (efs-ftp-path filename) + new (efs-ftp-path new) + t nil 0 + (list 'url-file-asynch-callback + new (current-buffer) + callback cbargs) + 0 nil))))))) buffer)) (defmacro url-file-create-wrapper (method args) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 8dd9792f467..869132df93f 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -27,7 +27,7 @@ ;;; Code: ;; (require 'url) -(eval-when-compile (require 'url-parse)) +(require 'url-parse) ;; (require 'url-util) (eval-when-compile (require 'mm-decode)) ;; (require 'mailcap) @@ -41,9 +41,6 @@ (autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") (autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") -(eval-when-compile - (require 'cl)) - ;; Implementation status ;; --------------------- ;; Function Status diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el index 66b41ddaccc..6650ae74756 100644 --- a/lisp/url/url-history.el +++ b/lisp/url/url-history.el @@ -28,7 +28,6 @@ ;; This can get a recursive require. ;;(require 'url) -(eval-when-compile (require 'cl)) (require 'url-parse) (autoload 'url-do-setup "url") @@ -83,8 +82,9 @@ to run the `url-history-setup-save-timer' function manually." (defun url-history-setup-save-timer () "Reset the history list timer." (interactive) - (ignore-errors - (cancel-timer url-history-timer)) + (condition-case nil + (cancel-timer url-history-timer) + (error nil)) (setq url-history-timer nil) (if (and (eq url-history-track t) url-history-save-interval) (setq url-history-timer (run-at-time url-history-save-interval @@ -146,13 +146,13 @@ user for what type to save as." ;; We used to add this in the file, but it just makes the code ;; more complex with no benefit. Worse: it makes it harder to ;; preserve preexisting history when loading the history file. - ;; (goto-char (point-min)) - ;; (insert (format - ;; "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" - ;; (/ count 4))) - ;; (goto-char (point-max)) - (insert "\n") - (write-file fname))) + ;; (goto-char (point-min)) + ;; (insert (format + ;; "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" + ;; (/ count 4))) + ;; (goto-char (point-max)) + (insert "\n") + (write-file fname))) (setq url-history-changed-since-last-save nil)))) (defun url-have-visited-url (url) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 955eac0f995..7b29eba05ef 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1269,6 +1269,8 @@ CBARGS as the arguments." nil nil nil) ;whether gid would change ; inode ; device. (kill-buffer buffer))))) +(declare-function url-dav-file-attributes (url &optional id-format)) + ;;;###autoload (defun url-http-file-attributes (url &optional id-format) (if (url-dav-supported-p url) diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el index 5e5957ba818..e267c52c012 100644 --- a/lisp/url/url-imap.el +++ b/lisp/url/url-imap.el @@ -32,7 +32,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'url-util) (require 'url-parse) (require 'nnimap) @@ -53,7 +52,8 @@ (nnimap-authenticator ,authenticator))))) (defun url-imap (url) - (check-type url vector "Need a pre-parsed URL.") + (unless (vectorp url) + (signal 'wrong-type-error (list "Need a pre-parsed URL." url))) (save-excursion (set-buffer (generate-new-buffer " *url-imap*")) (mm-disable-multibyte) diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 7297e75496e..759ea91914f 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -47,6 +47,10 @@ PASSWORD - What password to use" (function :tag "Other")) :group 'url) +;; External. +(declare-function zenirc "ext:zenirc" (&optional prefix)) +(declare-function zenirc-send-line "ext:zenirc" ()) + (defun url-irc-zenirc (host port channel user password) (let ((zenirc-buffer-name (if (and user host port) (format "%s@%s:%d" user host port) diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index df5e19d092a..26c2cdc2592 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el @@ -60,13 +60,15 @@ (save-excursion (insert "\n")))))) +(declare-function mail-send-and-exit "sendmail") + ;;;###autoload (defun url-mailto (url) "Handle the mailto: URL syntax." (if (url-user url) ;; malformed mailto URL (mailto://wmperry@gnu.org) instead of ;; mailto:wmperry@gnu.org - (url-set-filename url (concat (url-user url) "@" (url-filename url)))) + (setf (url-filename url) (concat (url-user url) "@" (url-filename url)))) (setq url (url-filename url)) (let (to args source-url subject func headers-start) (if (string-match (regexp-quote "?") url) diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el index 4b732a7f67e..3c8ba222211 100644 --- a/lisp/url/url-methods.el +++ b/lisp/url/url-methods.el @@ -89,19 +89,19 @@ ;; First check if its something like hostname:port ((string-match "^\\([^:]+\\):\\([0-9]+\\)$" env-proxy) (setq urlobj (url-generic-parse-url nil)) ; Get a blank object - (url-set-type urlobj "http") - (url-set-host urlobj (match-string 1 env-proxy)) - (url-set-port urlobj (string-to-number (match-string 2 env-proxy)))) + (setf (url-type urlobj) "http") + (setf (url-host urlobj) (match-string 1 env-proxy)) + (setf (url-port urlobj) (string-to-number (match-string 2 env-proxy)))) ;; Then check if its a fully specified URL ((string-match url-nonrelative-link env-proxy) (setq urlobj (url-generic-parse-url env-proxy)) - (url-set-type urlobj "http") - (url-set-target urlobj nil)) + (setf (url-type urlobj) "http") + (setf (url-target urlobj) nil)) ;; Finally, fall back on the assumption that its just a hostname (t (setq urlobj (url-generic-parse-url nil)) ; Get a blank object - (url-set-type urlobj "http") - (url-set-host urlobj env-proxy))) + (setf (url-type urlobj) "http") + (setf (url-host urlobj) env-proxy))) (if (and (not cur-proxy) urlobj) (progn diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 0efc2b0d03a..6fb559ca06a 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el @@ -30,7 +30,6 @@ (require 'nntp) (autoload 'url-warn "url") (autoload 'gnus-group-read-ephemeral-group "gnus-group") -(eval-when-compile (require 'cl)) (defgroup url-news nil "News related options." @@ -83,8 +82,9 @@ ))) buf)) +(defvar gnus-group-buffer) + (defun url-news-fetch-newsgroup (newsgroup host) - (declare (special gnus-group-buffer)) (if (string-match "^/+" newsgroup) (setq newsgroup (substring newsgroup (match-end 0)))) (if (string-match "/+$" newsgroup) diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index d45a028cc03..f47ff9a37c3 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -27,64 +27,24 @@ ;;; Code: (require 'url-vars) +(eval-when-compile (require 'cl)) (autoload 'url-scheme-get-property "url-methods") -(defun url-type (urlobj) - (aref urlobj 0)) +(defstruct (url + (:constructor nil) + (:constructor url-parse-make-urlobj + (&optional type user password host portspec filename + target attributes fullness)) + (:copier nil)) + type user password host portspec filename target attributes fullness) -(defun url-user (urlobj) - (aref urlobj 1)) - -(defun url-password (urlobj) - (aref urlobj 2)) - -(defun url-host (urlobj) - (aref urlobj 3)) - -(defun url-port (urlobj) - (or (aref urlobj 4) +(defsubst url-port (urlobj) + (or (url-portspec urlobj) (if (url-fullness urlobj) - (url-scheme-get-property (url-type urlobj) 'default-port)))) - -(defun url-filename (urlobj) - (aref urlobj 5)) - -(defun url-target (urlobj) - (aref urlobj 6)) - -(defun url-attributes (urlobj) - (aref urlobj 7)) - -(defun url-fullness (urlobj) - (aref urlobj 8)) - -(defun url-set-type (urlobj type) - (aset urlobj 0 type)) - -(defun url-set-user (urlobj user) - (aset urlobj 1 user)) - -(defun url-set-password (urlobj pass) - (aset urlobj 2 pass)) - -(defun url-set-host (urlobj host) - (aset urlobj 3 host)) - -(defun url-set-port (urlobj port) - (aset urlobj 4 port)) - -(defun url-set-filename (urlobj file) - (aset urlobj 5 file)) - -(defun url-set-target (urlobj targ) - (aset urlobj 6 targ)) - -(defun url-set-attributes (urlobj targ) - (aset urlobj 7 targ)) + (url-scheme-get-property (url-type urlobj) 'default-port)))) -(defun url-set-full (urlobj val) - (aset urlobj 8 val)) +(defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,port)) ;;;###autoload (defun url-recreate-url (urlobj) @@ -123,17 +83,14 @@ Format is: ;; See RFC 3986. (cond ((null url) - (make-vector 9 nil)) + (url-parse-make-urlobj)) ((or (not (string-match url-nonrelative-link url)) (= ?/ (string-to-char url))) ;; This isn't correct, as a relative URL can be a fragment link ;; (e.g. "#foo") and many other things (see section 4.2). ;; However, let's not fix something that isn't broken, especially ;; when close to a release. - (let ((retval (make-vector 9 nil))) - (url-set-filename retval url) - (url-set-full retval nil) - retval)) + (url-parse-make-urlobj nil nil nil nil nil url)) (t (with-temp-buffer (set-syntax-table url-parse-syntax-table) @@ -214,7 +171,8 @@ Format is: (setq file (buffer-substring save-pos (point))) (if (and host (string-match "%[0-9][0-9]" host)) (setq host (url-unhex-string host))) - (vector prot user pass host port file refs attr full)))))) + (url-parse-make-urlobj + prot user pass host port file refs attr full)))))) (provide 'url-parse) diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el index 085de1b7deb..ae1f70771d6 100644 --- a/lisp/url/url-privacy.el +++ b/lisp/url/url-privacy.el @@ -27,9 +27,10 @@ (eval-when-compile (require 'cl)) (require 'url-vars) -(if (fboundp 'device-type) - (defalias 'url-device-type 'device-type) - (defun url-device-type (&optional device) (or window-system 'tty))) +(defun url-device-type (&optional device) + (if (fboundp 'device-type) + (device-type device) ; XEmacs + (or window-system 'tty))) ;;;###autoload (defun url-setup-privacy-info () diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index a1b68099e89..7ac07dbf466 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -168,7 +168,7 @@ Strips out default port numbers, etc." type (url-type data)) (if (member type '("www" "about" "mailto" "info")) (setq retval url) - (url-set-target data nil) + (setf (url-target data) nil) (setq retval (url-recreate-url data))) retval)) @@ -427,13 +427,13 @@ WIDTH defaults to the current frame width." (string-match "/" fname)) (setq fname (substring fname (match-end 0) nil) modified (1+ modified)) - (url-set-filename urlobj fname) + (setf (url-filename urlobj) fname) (setq url (url-recreate-url urlobj) str-width (length url))) (if (> modified 1) (setq fname (concat "/.../" fname)) (setq fname (concat "/" fname))) - (url-set-filename urlobj fname) + (setf (url-filename urlobj) fname) (setq url (url-recreate-url urlobj))) url)) diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index aba40c63726..4f9c341b9d5 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -62,12 +62,12 @@ (defvar url-current-mime-headers nil "A parsed representation of the MIME headers for the current url.") -(mapcar 'make-variable-buffer-local - '( - url-current-object - url-current-referer - url-current-mime-headers - )) +(mapc 'make-variable-buffer-local + '( + url-current-object + url-current-referer + url-current-mime-headers + )) (defcustom url-honor-refresh-requests t "*Whether to do automatic page reloads. @@ -398,11 +398,6 @@ Currently supported methods: This should be set, e.g. by mail user agents rendering HTML to avoid `bugs' which call home.") -(defun url-vars-unload-hook () - (remove-hook 'set-language-environment-hook 'url-set-mime-charset-string)) - -(add-hook 'url-vars-unload-hook 'url-vars-unload-hook) - (provide 'url-vars) ;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49 diff --git a/lisp/url/url.el b/lisp/url/url.el index 3a471af5542..34b3f654082 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -46,12 +46,16 @@ (require 'url-parse) (require 'url-util) -;; Fixme: customize? convert-standard-filename? -(defvar url-configuration-directory - (cond - ((file-directory-p "~/.url") "~/.url") - ((file-directory-p "~/.emacs.d") "~/.emacs.d/url") - (t "~/.url"))) + +;; FIXME convert-standard-filename? +(defcustom url-configuration-directory + (if (and (file-directory-p user-emacs-directory) + (not (file-directory-p "~/.url"))) + (expand-file-name "url" user-emacs-directory) + "~/.url") + "Directory used by the URL package for cookies, history, etc." + :type 'directory + :group 'url) (defun url-do-setup () "Setup the url package. |