Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-57

Merge from emacs--cvs-trunk--0

Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-594
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-598
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-599
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-600
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-602
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-603
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-604
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-609
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-610
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-611
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-614
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-615
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-42
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-43
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-44
 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-46
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-47
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-48
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-49
   Add {arch}/=commit-merge-make-log

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-50
   {arch}/=commit-merge-make-log: Don't die if there are no ChangeLog changes

77 files changed, 5981 insertions, 622 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 29abaaf21b8..41606eb7e93 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,4 +1,233 @@
-2004-10-03  Stefan  <monnier@iro.umontreal.ca>
+2004-10-13  Daniel Pfeiffer  <occitan@esperanto.org>
+
+        * button.el (button-activate): Allow a marker to display as an
+        action.
+
+        * help-fns.el (describe-variable): Use it to make "below" a
+        hyperlink.
+
+        * help.el (describe-mode): Use it to make minor mode list into
+        hyperlinks.
+
+2004-10-14  Masatake YAMATO  <jet@gyve.org>
+
+        * progmodes/gud.el (gdb-script-beginning-of-defun): New function.
+        (gdb-script-end-of-defun): New function.
+        (gdb-script-mode): Use `gdb-script-beginning-of-defun' and
+        `gdb-script-end-of-defun' as *-of-defun-function.
+
+2004-10-13  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * vc.el (vc-annotate-display-select): Fix typo.
+
+        * subr.el (substitute-key-definition-key): New function.
+        (substitute-key-definition): Use it with map-keymap.
+        (event-modifiers): Use push.
+        (mouse-movement-p, with-temp-buffer): Simplify.
+
+2004-10-12  Michael Albinus  <michael.albinus@gmx.de>
+
+        Sync with Tramp 2.0.45.
+
+        * net/tramp.el (top): Apply `def-edebug-spec' only if function is
+        defined.  This is not the case for XEmacs without package "edebug".
+        (tramp-set-auto-save-file-modes): Set permissions of autosaved
+        remote files to the permissions of the original file.  This is not
+        the case for Emacs < 21.3.50 and XEmacs < 21.5.  Add function to
+        `auto-save-hook'.  Reported by Thomas Prokosch <thomas@nadev.net>.
+        (tramp-perl-decode): Fix an error in Perl implementation.
+        $pending must be cleared every loop.  Reported by Benjamin Place
+        <benjaminplace@sprintmail.com>
+
+        * net/tramp-smb.el (tramp-smb-advice-PC-do-completion):
+        Don't activate advice during definition.  This is done later on,
+        depending on test result of `substitute-in-file-name'.
+        Suggested by Stefan Monnier <monnier@iro.umontreal.ca>.
+
+2004-10-12  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * pcvs-parse.el (cvs-parse-commit): Fix parsing for new commit message.
+
+        * emacs-lisp/lisp.el (mark-sexp): Preserve direction when repeating.
+
+2004-10-12  David Ponce  <david@dponce.com>
+
+        * recentf.el (recentf-edit-list): Update the menu when the recentf
+        list has been modified.
+
+2004-10-12  Simon Josefsson  <jas@extundo.com>
+
+        * net/tls.el (tls-certtool-program): New variable.
+        (tls-certificate-information): New function, based on
+        ssl-certificate-information.
+
+2004-10-12  Kenichi Handa  <handa@m17n.org>
+
+        * international/mule.el (coding-system-equal): Move from mule-util.el.
+
+        * international/mule-util.el (coding-system-equal): Move to mule.el.
+
+2004-10-12  Kim F. Storm  <storm@cua.dk>
+
+        * kmacro.el (kmacro-insert-counter, kmacro-add-counter): Use and
+        reset kmacro-initial-counter-value if set.
+        (kmacro-set-counter): Only set kmacro-counter if defining or executing
+        macro.  Set kmacro-initial-counter-value otherwise. Never set both.
+        (kmacro-display): Show macro counter if non-zero.
+
+        * subr.el (substitute-key-definition): Mention command remapping
+        in doc string.
+
+2004-10-11  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * pcvs-defs.el (pcl-cvs-load-hook): Remove unused var.
+
+        * font-lock.el (font-lock-apply-highlight): Fix last change.
+
+2004-10-11  Simon Josefsson  <jas@extundo.com>
+
+        * mail/smtpmail.el (smtpmail-open-stream): Look for
+        starttls-gnutls-program instead of starttls-program iff
+        starttls-use-gnutls is non-nil.
+        (smtpmail-open-stream): Don't overwrite user settings of
+        starttls-extra-arguments and starttls-extra-args.
+
+2004-10-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * comint.el (comint-mouse-insert-input): Remove.
+        (comint-insert-input): Make it work for mouse bindings.
+        (comint-mode-map): Move defs into the declaration.
+        (comint-output-filter): Typo.
+
+        * diff-mode.el (diff-current-defun): Fix 2004-06-13's change.
+
+2004-10-10  Kai Grossjohann  <kai.grossjohann@gmx.net>
+
+        * net/ange-ftp.el (ange-ftp-remote-shell): Remove variable.
+        (ange-ftp-call-chmod): Reference remote-shell-program instead of
+        ange-ftp-remote-shell.
+
+2004-10-10  Andreas Schwab  <schwab@suse.de>
+
+        * emacs-lisp/byte-opt.el (byte-optimize-backward-word): Optimize
+        `(backward-word)' to `(forward-word -1)', not `(forward-char -1)'.
+        Reported by <sri@asu.edu>.
+
+2004-10-10  Benjamin Rutt  <brutt@bloomington.in.us>
+
+        * vc.el (vc-annotate-mode): Remove variable.
+        (vc-annotate-display-select): Only call vc-annotate-mode
+        if we're not in that mode already.
+
+2004-10-09  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * imenu.el (imenu--completion-buffer): Don't return t for rescan.
+        (imenu-choose-buffer-index): Check here for rescan instead.
+
+        * font-lock.el (font-lock-apply-highlight): Explicitly check the case
+        where the face expression evals to nil.
+
+        * textmodes/tex-mode.el (tex-font-lock-append-prop): New fun.
+        (tex-font-lock-keywords-2): Use it.
+        (tex-font-lock-syntactic-keywords): Fix the `verbatim' treatment.
+
+        * emacs-lisp/lisp-mode.el (lisp-fill-paragraph): Fix backslashes.
+
+2004-10-09  Kim F. Storm  <storm@cua.dk>
+
+        * subr.el (progress-reporter-update): Define before first usage.
+        (make-progress-reporter): Doc fix.
+
+2004-10-09  Luc Teirlinck  <teirllm@auburn.edu>
+
+        * textmodes/paragraphs.el (sentence-end-double-space)
+        (sentence-end-without-period, sentence-end-without-space)
+        (sentence-end): Doc fixes.
+
+2004-10-08  Peter Seibel  <peter@javamonkey.com>  (tiny change)
+
+        * emacs-lisp/lisp-mode.el (lisp-fill-paragraph):
+        Change paragraph-start regexp so we don't fill code starting with #'(.
+
+2004-10-08  Sebastien Kirche  <seki@seki.fr>  (tiny change)
+
+        * mail/mail-extr.el (mail-extr-ignore-realname-equals-mailbox-name):
+        New defcustom.
+        (extract-address-components): Use it.
+
+2004-10-08  Paul Pogonyshev  <pogonyshev@gmx.net>
+
+        * subr.el (make-progress-reporter, progress-reporter-update)
+        (progress-reporter-force-update, progress-reporter-do-update)
+        (progress-reporter-done): New functions.
+
+        * tar-mode.el (tar-summarize-buffer): Use progress reporter.
+
+        * progmodes/etags.el (etags-tags-completion-table): Use progress
+        reporter.
+        (etags-tags-apropos): Likewise.
+
+2004-10-08  Alan Mackenzie  <acm@muc.de>
+
+        * isearch.el (isearch-yank-line): C-y yanks to next EOL, not end
+        of current line.
+
+2004-10-08  Masatake YAMATO  <jet@gyve.org>
+
+        * server.el (server-process-filter): Wrap `process-send-region'
+        by `condition-case' to guard the case when the pipe to PROC is closed.
+
+2004-10-07  Mark A. Hershberger  <mah@everybody.org>
+
+        * xml.el (xml-substitute-special): Limit handling of external entities.
+
+2004-10-06  Nick Roberts  <nickrob@snap.net.nz>
+
+        * progmodes/gdb-ui.el (gdb-ann3): (Re-)initialise gdb-input-queue.
+
+2004-10-06  John Paul Wallington  <jpw@gnu.org>
+
+        * xml.el (xml-parse-dtd): Fix `error' call.
+
+2004-10-05  Mark A. Hershberger  <mah@everybody.org>
+
+        * xml.el (xml-substitute-special): Return a single string instead
+        of a list of strings if an entity substitution is made.
+
+2004-10-05  Ulf Jasper  <ulf.jasper@web.de>
+
+        * calendar/icalendar.el: New file.
+
+2004-10-05  Juri Linkov  <juri@jurta.org>
+
+        * isearch.el (isearch-done): Set mark after running hook.
+        Suggested by Drew Adams <drew.adams@oracle.com>.
+
+        * info.el (Info-history, Info-toc): Fix Info headers.
+        (Info-toc): Narrow buffer before Info-fontify-node.
+        (Info-build-toc): Don't check for special Info file names.
+        Set main-file to nil if Info-find-file returns a symbol.
+
+2004-10-05  Emilio C. Lopes  <eclig@gmx.net>:
+
+        * calendar/calendar.el (calendar-goto-iso-week): Add autoload.
+        (calendar-mode-map): Add binding for `calendar-goto-iso-week'.
+        * calendar/cal-menu.el (calendar-mode-map): Ditto.
+
+2004-10-05  Glenn Morris  <gmorris@ast.cam.ac.uk>
+
+        * calendar/cal-iso.el (calendar-iso-read-args): New function,
+        for old interactive spec from calendar-goto-iso-date.
+        (calendar-goto-iso-date): Use it.
+        (calendar-goto-iso-week): New function.  Suggested by Emilio
+        C. Lopes <eclig@gmx.net>.
+
+2004-10-04  Luc Teirlinck  <teirllm@auburn.edu>
+
+        * textmodes/enriched.el (enriched-mode-map): Give `set-left-margin' and
+        `set-right-margin' bindings that follow the minor mode conventions.
+
+2004-10-03  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * textmodes/tex-mode.el (tex-dvi-view-command): Use `yap' on w32.
         (tex-font-lock-keywords-1): Add url and nolinkurl for args with `_'.
@@ -62,7 +291,7 @@
         * diff-mode.el (diff-file-header-re): Tighten up regexp a tiny bit.
         (diff-fixup-modifs): Catch unified-diff file-headers.
 
-2004-09-28  Stefan  <monnier@iro.umontreal.ca>
+2004-09-28  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * dired.el (dired-view-command-alist): Use more efficient regexps.
         Remove dubious arguments.
@@ -102,7 +331,7 @@
         (pr-delete-file): Check if file exists before deleting it.
         Reported by Lennart Borgman <lennart.borgman.073@student.lu.se>.
 
-2004-09-26  Stefan  <monnier@iro.umontreal.ca>
+2004-09-26  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * term.el (term-display-table): New variable.
         (term-mode): Use it.
@@ -126,7 +355,7 @@
         (term-stop-output-log): Rename from `term-stop-photo'.
         (term-switch-to-alternate-sub-buffer): Comment out, unused.
 
-2004-09-25  Stefan  <monnier@iro.umontreal.ca>
+2004-09-25  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * dired.el (dired-move-to-filename): Don't output a message if
         raise-error is non-nil.  Fix return position and value.
@@ -270,7 +499,7 @@
         * progmodes/sh-script.el (sh-mode-default-syntax-table): Set syntax
         of = to "." (punctuation).
 
-2004-09-19  Stefan  <monnier@iro.umontreal.ca>
+2004-09-19  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * subr.el (event-basic-type): Fix mask (extend to 22bits).
 
diff --git a/lisp/button.el b/lisp/button.el
index 35905b9e1e4..dcd26846d10 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -78,6 +78,7 @@ Mode-specific keymaps may want to use this as their parent keymap.")
 (put 'default-button 'mouse-face 'highlight)
 (put 'default-button 'keymap button-map)
 (put 'default-button 'type 'button)
+;; action may be either a function to call, or a marker to go to
 (put 'default-button 'action 'ignore)
 (put 'default-button 'help-echo "mouse-2, RET: Push this button")
 ;; Make overlay buttons go away if their underlying text is deleted.
@@ -217,9 +218,14 @@ changes to a supertype are not reflected in its subtypes)."
 If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
 instead of its normal action; if the button has no mouse-action,
 the normal action is used instead."
-  (funcall (or (and use-mouse-action (button-get button 'mouse-action))
-               (button-get button 'action))
-           button))
+  (let ((action (or (and use-mouse-action (button-get button 'mouse-action))
+                    (button-get button 'action))))
+    (if (markerp action)
+        (save-selected-window
+          (select-window (display-buffer (marker-buffer action)))
+          (goto-char action)
+          (recenter 0))
+      (funcall action button))))
 
 (defun button-label (button)
   "Return BUTTON's text label."
@@ -373,10 +379,11 @@ instead of starting at the next button."
 
 (defun push-button (&optional pos use-mouse-action)
   "Perform the action specified by a button at location POS.
-POS may be either a buffer position or a mouse-event.
-If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
+POS may be either a buffer position or a mouse-event.  If
+USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
 instead of its normal action; if the button has no mouse-action,
-the normal action is used instead.
+the normal action is used instead.  The action may be either a
+function to call or a marker to display.
 POS defaults to point, except when `push-button' is invoked
 interactively as the result of a mouse-event, in which case, the
 mouse event is used.
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index e66f50bd40c..c24a13b91d7 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -93,18 +93,15 @@ C-w  Describe how there is no warranty for Calc."
 
 (defun calc-describe-copying ()
   (interactive)
-  (calc-info)
-  (Info-goto-node "Copying"))
+  (calc-info-goto-node "Copying"))
 
 (defun calc-describe-distribution ()
   (interactive)
-  (calc-info)
-  (Info-goto-node "Reporting Bugs"))
+  (calc-info-goto-node "Reporting Bugs"))
 
 (defun calc-describe-no-warranty ()
   (interactive)
-  (calc-info)
-  (Info-goto-node "Copying")
+  (calc-info-goto-node "Copying")
   (let ((case-fold-search nil))
     (search-forward "     NO WARRANTY"))
   (beginning-of-line)
@@ -190,13 +187,13 @@ C-w  Describe how there is no warranty for Calc."
                              (message "Reading Calc summary from manual...")
                              (save-window-excursion
                                (save-excursion
-                                 (calc-info)
-                                 (Info-goto-node "Summary")
+                                 (calc-info-goto-node "Summary")
                                  (goto-char (point-min))
                                  (forward-line 1)
                                  (copy-to-buffer "*Calc Summary*"
                                                  (point) (point-max))
-                                 (Info-last)))
+                                 (if Info-history
+                                     (Info-last))))
                              (setq case-fold-search nil)
                              (re-search-forward "^\\(.*\\)\\[\\.\\. a b")
                              (setq calc-summary-indentation
@@ -299,35 +296,62 @@ C-w  Describe how there is no warranty for Calc."
         (calc-describe-thing desc "Key Index" nil
                              (string-match "[A-Z][A-Z][A-Z]" desc))))))
 
+(defvar calc-help-function-list nil
+  "List of functions provided by Calc.")
+
+(defvar calc-help-variable-list nil
+  "List of variables provided by Calc.")
+
+(defun calc-help-index-entries (&rest indices)
+  "Create a list of entries from the INDICES in the Calc info manual."
+  (let ((entrylist '())
+        entry)
+    (require 'info nil t)
+    (while indices
+      (condition-case nil
+          (with-temp-buffer
+            (Info-mode)
+            (Info-goto-node (concat "(Calc)" (car indices) " Index"))
+            (goto-char (point-min))
+            (while (re-search-forward "\n\\* \\(.*\\): " nil t)
+              (setq entry (match-string 1))
+              (if (and (not (string-match "<[1-9]+>" entry))
+                       (not (string-match "(.*)" entry))
+                       (not (string= entry "Menu")))
+                  (unless (assoc entry entrylist)
+                    (setq entrylist (cons entry entrylist))))))
+        (error nil))
+      (setq indices (cdr indices)))
+    entrylist))
+
 (defun calc-describe-function (&optional func)
   (interactive)
+  (unless calc-help-function-list
+    (setq calc-help-function-list 
+          (calc-help-index-entries "Function" "Command")))
   (or func
-      (setq func (intern (completing-read "Describe function: "
-                                          obarray nil t "calcFunc-"))))
-  (setq func (symbol-name func))
+      (setq func (completing-read "Describe function: "
+                                  calc-help-function-list 
+                                  nil t)))
   (if (string-match "\\`calc-." func)
       (calc-describe-thing func "Command Index")
-    (calc-describe-thing (if (string-match "\\`calcFunc-." func)
-                             (substring func 9)
-                           func)
-                         "Function Index")))
+    (calc-describe-thing func "Function Index")))
 
 (defun calc-describe-variable (&optional var)
   (interactive)
+  (unless calc-help-variable-list
+    (setq calc-help-variable-list 
+          (calc-help-index-entries "Variable")))
   (or var
-      (setq var (intern (completing-read "Describe variable: "
-                                         obarray nil t "var-"))))
-  (setq var (symbol-name var))
-  (calc-describe-thing var "Variable Index"
-                       (if (string-match "\\`var-." var)
-                           (substring var 4)
-                         var)))
+      (setq var (completing-read "Describe variable: "
+                                 calc-help-variable-list
+                                 nil t)))
+  (calc-describe-thing var "Variable Index"))
 
 (defun calc-describe-thing (thing where &optional target not-quoted)
   (message "Looking for `%s' in %s..." thing where)
   (let ((savewin (current-window-configuration)))
-    (calc-info)
-    (Info-goto-node where)
+    (calc-info-goto-node where)
     (or (let ((case-fold-search nil))
           (re-search-forward (format "\n\\* +%s: \\(.*\\)\\."
                                      (regexp-quote thing))
@@ -338,7 +362,8 @@ C-w  Describe how there is no warranty for Calc."
                                 nil t)
              (setq thing (format "%s9" (substring thing 0 -1))))
         (progn
-          (Info-last)
+          (if Info-history
+              (Info-last))
           (set-window-configuration savewin)
           (error "Can't find `%s' in %s" thing where)))
     (let (Info-history)
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 772b39ffed4..c01d37e6848 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -160,21 +160,25 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)."
   (select-window (get-largest-window))
   (info "Calc"))
 
+(defun calc-info-goto-node (node)
+  "Go to a node in the Calculator info documentation."
+  (interactive)
+  (select-window (get-largest-window))
+  (Info-goto-node (concat "(Calc)" node)))
+
 (defun calc-tutorial ()
   "Run the Emacs Info system on the Calculator Tutorial."
   (interactive)
   (if (get-buffer-window "*Calculator*")
       (calc-quit))
-  (calc-info)
-  (Info-goto-node "Interactive Tutorial")
+  (calc-info-goto-node "Interactive Tutorial")
   (calc-other-window)
   (message "Welcome to the Calc Tutorial!"))
 
 (defun calc-info-summary ()
   "Run the Emacs Info system on the Calculator Summary."
   (interactive)
-  (calc-info)
-  (Info-goto-node "Summary"))
+  (calc-info-goto-node "Summary"))
 
 (defun calc-help ()
   (interactive)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 5c7e24ed646..c17449a8450 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -942,7 +942,8 @@ If nil, selections displayed but ignored.")
     calcDigit-algebraic calcDigit-edit)
 
  ("calc-misc" another-calc calc-big-or-small calc-dispatch-help
-    calc-help calc-info calc-info-summary calc-inv calc-last-args-stub
+    calc-help calc-info calc-info-goto-node calc-info-summary calc-inv 
+    calc-last-args-stub
     calc-missing-key calc-mod calc-other-window calc-over calc-percent
     calc-pop-above calc-power calc-roll-down calc-roll-up
     calc-shift-Y-prefix-help calc-tutorial calcDigit-letter
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index 0d9ad45c7d6..058bdf071d7 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -1,8 +1,9 @@
 ;;; cal-iso.el --- calendar functions for the ISO calendar
 
-;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2004 Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
 ;; Keywords: calendar
 ;; Human-Keywords: ISO calendar, calendar, diary
 
@@ -96,27 +97,39 @@ Defaults to today's date if DATE is not given."
   (message "ISO date: %s"
            (calendar-iso-date-string (calendar-cursor-to-date t))))
 
+(defun calendar-iso-read-args (&optional dayflag)
+  "Interactively read the arguments for an iso date command."
+  (let* ((today (calendar-current-date))
+         (year (calendar-read
+                "ISO calendar year (>0): "
+                '(lambda (x) (> x 0))
+                (int-to-string (extract-calendar-year today))))
+         (no-weeks (extract-calendar-month
+                    (calendar-iso-from-absolute
+                     (1-
+                      (calendar-dayname-on-or-before
+                       1 (calendar-absolute-from-gregorian
+                          (list 1 4 (1+ year))))))))
+         (week (calendar-read
+                (format "ISO calendar week (1-%d): " no-weeks)
+                '(lambda (x) (and (> x 0) (<= x no-weeks)))))
+         (day (if dayflag (calendar-read
+                           "ISO day (1-7): "
+                           '(lambda (x) (and (<= 1 x) (<= x 7))))
+                1)))
+    (list (list week day year))))
+
 (defun calendar-goto-iso-date (date &optional noecho)
   "Move cursor to ISO DATE; echo ISO date unless NOECHO is t."
-  (interactive
-   (let* ((today (calendar-current-date))
-          (year (calendar-read
-                 "ISO calendar year (>0): "
-                 '(lambda (x) (> x 0))
-                 (int-to-string (extract-calendar-year today))))
-          (no-weeks (extract-calendar-month
-                     (calendar-iso-from-absolute
-                      (1-
-                       (calendar-dayname-on-or-before
-                        1 (calendar-absolute-from-gregorian
-                           (list 1 4 (1+ year))))))))
-          (week (calendar-read
-                 (format "ISO calendar week (1-%d): " no-weeks)
-                 '(lambda (x) (and (> x 0) (<= x no-weeks)))))
-          (day (calendar-read
-                "ISO day (1-7): "
-                '(lambda (x) (and (<= 1 x) (<= x 7))))))
-     (list (list week day year))))
+  (interactive (calendar-iso-read-args t))
+  (calendar-goto-date (calendar-gregorian-from-absolute
+                       (calendar-absolute-from-iso date)))
+  (or noecho (calendar-print-iso-date)))
+
+(defun calendar-goto-iso-week (date &optional noecho)
+  "Move cursor to ISO DATE; echo ISO date unless NOECHO is t.
+Interactively, goes to the first day of the specified week."
+  (interactive (calendar-iso-read-args))
   (calendar-goto-date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-iso date)))
   (or noecho (calendar-print-iso-date)))
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index a652e7ca768..ceb4c56f7fd 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -1,9 +1,10 @@
 ;;; cal-menu.el --- calendar functions for menu bar and popup menu support
 
-;; Copyright (C) 1994, 1995, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 2001, 2003, 2004 Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
 ;;      Lara Rios <lrios@coewl.cen.uiuc.edu>
+;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
 ;; Keywords: calendar
 ;; Human-Keywords: calendar, popup menus, menu bar
 
@@ -121,6 +122,8 @@
   '("Astronomical Date" . calendar-goto-astro-day-number))
 (define-key calendar-mode-map [menu-bar goto iso]
   '("ISO Date" . calendar-goto-iso-date))
+(define-key calendar-mode-map [menu-bar goto iso-week]
+  '("ISO Week" . calendar-goto-iso-week))
 (define-key calendar-mode-map [menu-bar goto day-of-year]
   '("Day of Year" . calendar-goto-day-of-year))
 (define-key calendar-mode-map [menu-bar goto gregorian]
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 9d38cde21ce..aa0b3005fad 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1769,6 +1769,10 @@ Driven by the variable `calendar-date-display-form'.")
   "Move cursor to ISO date."
   t)
 
+(autoload 'calendar-goto-iso-week "cal-iso"
+  "Move cursor to start of ISO week."
+  t)
+
 (autoload 'calendar-print-iso-date "cal-iso"
   "Show the ISO date equivalents of date."
   t)
@@ -2204,6 +2208,7 @@ the inserted text.  Value is always t."
   (define-key calendar-mode-map "ge"  'calendar-goto-ethiopic-date)
   (define-key calendar-mode-map "gp"  'calendar-goto-persian-date)
   (define-key calendar-mode-map "gc"  'calendar-goto-iso-date)
+  (define-key calendar-mode-map "gw"  'calendar-goto-iso-week)
   (define-key calendar-mode-map "gf"  'calendar-goto-french-date)
   (define-key calendar-mode-map "gml"  'calendar-goto-mayan-long-count-date)
   (define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date)
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
new file mode 100644
index 00000000000..e83e8e980b6
--- /dev/null
+++ b/lisp/calendar/icalendar.el
@@ -0,0 +1,1299 @@
+;;; icalendar.el --- iCalendar implementation
+
+;; Copyright (C) 2002, 2003, 2004  Free Software Foundation, Inc.
+
+;; Author:   Ulf Jasper <ulf.jasper@web.de>
+;; Created:  August 2002
+;; Keywords: calendar
+;; Human-Keywords: calendar, diary, iCalendar, vCalendar
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package is documented in the Emacs Manual.
+
+
+;;; History:
+
+;;  0.06  Bugfixes regarding icalendar-import-format-*.
+;;        Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau.
+
+;;  0.05: New import format scheme: Replaced icalendar-import-prefix-*,
+;;        icalendar-import-ignored-properties, and
+;;        icalendar-import-separator with icalendar-import-format(-*).
+;;        icalendar-import-file and icalendar-convert-diary-to-ical
+;;        have an extra parameter which should prevent them from
+;;        erasing their target files (untested!).
+;;        Tested with Emacs 21.3.2
+
+;;  0.04: Bugfix: import: double quoted param values did not work
+;;        Read DURATION property when importing.
+;;        Added parameter icalendar-duration-correction.
+
+;;  0.03: Export takes care of european-calendar-style.
+;;        Tested with Emacs 21.3.2 and XEmacs 21.4.12
+
+;;  0.02: Should work in XEmacs now.  Thanks to Len Trigg for the
+;;        XEmacs patches!
+;;        Added exporting from Emacs diary to ical.
+;;        Some bugfixes, after testing with calendars from
+;;        http://icalshare.com.
+;;        Tested with Emacs 21.3.2 and XEmacs 21.4.12
+
+;;  0.01: First published version.  Trial version.  Alpha version.
+
+;; ======================================================================
+;; To Do:
+
+;;  * Import from ical:
+;;    + Need more properties for icalendar-import-format
+;;    + check vcalendar version
+;;    + check (unknown) elements
+;;    + recurring events!
+;;    + works for european style calendars only! Does it?
+;;    + alarm
+;;    + exceptions in recurring events
+;;    + the parser is too soft
+;;    + error log is incomplete
+;;    + nice to have: #include "webcal://foo.com/some-calendar.ics"
+
+;;  * Export into ical
+;;    + diary-date, diary-float, and self-made sexp entries are not
+;;      understood
+;;    + timezones, currently all times are local!
+
+;;  * Other things
+;;    + defcustom icalendar-import-ignored-properties does not work with
+;;      XEmacs.
+;;    + clean up all those date/time parsing functions
+;;    + Handle todo items?
+;;    + Check iso 8601 for datetime and period
+;;    + Which chars to (un)escape?
+;;    + Time to find out how the profiler works?
+
+
+;;; Code:
+
+(defconst icalendar-version 0.06
+  "Version number of icalendar.el.")
+
+;; ======================================================================
+;; Customizables
+;; ======================================================================
+(defgroup icalendar nil
+  "Icalendar support."
+  :prefix "icalendar-"
+  :group 'calendar)
+
+(defcustom icalendar-import-format
+  "%s%d%l%o"
+  "Format string for importing events from iCalendar into Emacs diary.
+This string defines how iCalendar events are inserted into diary
+file.  Meaning of the specifiers:
+%d Description, see `icalendar-import-format-description'
+%l Location, see `icalendar-import-format-location'
+%o Organizer, see `icalendar-import-format-organizer'
+%s Subject, see `icalendar-import-format-subject'"
+  :type 'string
+  :group 'icalendar)
+
+(defcustom icalendar-import-format-subject
+  "%s"
+  "Format string defining how the subject element is formatted.
+This applies only if the subject is not empty! `%s' is replaced
+by the subject."
+  :type 'string
+  :group 'icalendar)
+
+(defcustom icalendar-import-format-description
+  "\n Desc: %s"
+  "Format string defining how the description element is formatted.
+This applies only if the description is not empty! `%s' is
+replaced by the description."
+  :type 'string
+  :group 'icalendar)
+
+(defcustom icalendar-import-format-location
+  "\n Location: %s"
+  "Format string defining how the location element is formatted.
+This applies only if the location is not empty! `%s' is replaced
+by the location."
+  :type 'string
+  :group 'icalendar)
+
+(defcustom icalendar-import-format-organizer
+  "\n Organizer: %s"
+  "Format string defining how the organizer element is formatted.
+This applies only if the organizer is not empty! `%s' is
+replaced by the organizer."
+  :type 'string
+  :group 'icalendar)
+
+(defcustom icalendar-duration-correction
+  t
+  "Workaround for all-day events.
+If non-nil the length=duration of iCalendar appointments that
+have a length of exactly n days is decreased by one day.  This
+fixes problems with all-day events, which appear to be one day
+longer than they are."
+  :type 'boolean
+  :group 'icalendar)
+
+
+;; ======================================================================
+;; NO USER SERVICABLE PARTS BELOW THIS LINE
+;; ======================================================================
+
+(defconst icalendar-weekdayabbrev-table
+  '(("mon\\(day\\)?"    . "MO")
+    ("tue\\(sday\\)?"   . "TU")
+    ("wed\\(nesday\\)?" . "WE")
+    ("thu\\(rsday\\)?"  . "TH")
+    ("fri\\(day\\)?"    . "FR")
+    ("sat\\(urday\\)?"  . "SA")
+    ("sun\\(day\\)?"    . "SU"))
+  "Translation table for weekdays.")
+
+(defconst icalendar-monthnumber-table
+  '(("^jan\\(uar\\)?y?$"       . 1)
+    ("^feb\\(ruar\\)?y?$"      . 2)
+    ("^mar\\(ch\\)?\\|märz?$" . 3)
+    ("^apr\\(il\\)?$"          . 4)
+    ("^ma[iy]$"                . 5)
+    ("^jun[ie]?$"              . 6)
+    ("^jul[iy]?$"              . 7)
+    ("^aug\\(ust\\)?$"         . 8)
+    ("^sep\\(tember\\)?$"      . 9)
+    ("^o[ck]t\\(ober\\)?$"     . 10)
+    ("^nov\\(ember\\)?$"       . 11)
+    ("^de[cz]\\(ember\\)?$"    . 12))
+  "Regular expressions for month names.
+Currently this matches only German and English.")
+
+(defvar icalendar-debug nil ".")
+
+;; ======================================================================
+;; all the other libs we need
+;; ======================================================================
+(require 'calendar)
+(require 'appt)
+
+;; ======================================================================
+;; Core functionality
+;; Functions for parsing icalendars, importing and so on
+;; ======================================================================
+
+(defun icalendar-get-unfolded-buffer (folded-ical-buffer)
+  "Return a new buffer containing the unfolded contents of a buffer.
+Folding is the iCalendar way of wrapping long lines.  In the
+created buffer all occurrences of CR LF BLANK are replaced by the
+empty string.  Argument FOLDED-ICAL-BUFFER is the unfolded input
+buffer."
+  (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
+    (save-current-buffer
+      (set-buffer unfolded-buffer)
+      (erase-buffer)
+      (insert-buffer folded-ical-buffer)
+      (while (re-search-forward "\r?\n[ \t]" nil t)
+        (replace-match "" nil nil))
+      )
+    unfolded-buffer))
+
+;; Replace regexp RE with RP in string ST and return the new string.
+;; This is here for compatibility with XEmacs.
+(defsubst icalendar-rris (re rp st)
+  ;; XEmacs:
+  (if (fboundp 'replace-in-string)
+      (save-match-data ;; apparently XEmacs needs save-match-data
+        (replace-in-string st re rp))
+    ;; Emacs:
+    (replace-regexp-in-string re rp st)))
+
+(defun icalendar-read-element (invalue inparams)
+  "Recursively read the next iCalendar element in the current buffer.
+INVALUE gives the current iCalendar element we are reading.
+INPARAMS gives the current parameters.....
+This function calls itself recursively for each nested calendar element
+it finds"
+  (let (element children line name params param param-name param-value
+                value
+        (continue t))
+    (setq children '())
+    (while (and continue
+                (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
+      (setq name (intern (match-string 1)))
+      (backward-char 1)
+      (setq params '())
+      (setq line '())
+      (while (looking-at ";")
+        (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
+        (setq param-name (intern (match-string 1)))
+        (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
+                           nil t)
+        (backward-char 1)
+        (setq param-value (or (match-string 2) (match-string 3)))
+        (setq param (list param-name param-value))
+        (while (looking-at ",")
+          (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
+                             nil t)
+          (if (match-string 2)
+              (setq param-value (match-string 2))
+            (setq param-value (match-string 3)))
+          (setq param (append param param-value)))
+        (setq params (append params param)))
+      (unless (looking-at ":")
+        (error "Oops"))
+      (forward-char 1)
+      (re-search-forward  "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t)
+      (setq value (icalendar-rris "\r?\n[ \t]" "" (match-string 0)))
+      (setq line (list name params value))
+      (cond ((eq name 'BEGIN)
+             (setq children
+                   (append children
+                           (list (icalendar-read-element (intern value)
+                                                         params)))))
+            ((eq name 'END)
+             (setq continue nil))
+            (t
+             (setq element (append element (list line))))))
+    (if invalue
+        (list invalue inparams element children)
+      children)))
+
+;; ======================================================================
+;; helper functions for examining events
+;; ======================================================================
+
+(defsubst icalendar-get-all-event-properties (event)
+  "Return the list of properties in this EVENT."
+  (car (cddr event)))
+
+(defun icalendar-get-event-property (event prop)
+  "For the given EVENT return the value of the property PROP."
+  (catch 'found
+    (let ((props (car (cddr event))) pp)
+      (while props
+        (setq pp (car props))
+        (if (eq (car pp) prop)
+            (throw 'found (car (cddr pp))))
+        (setq props (cdr props))))
+    nil))
+
+(defun icalendar-set-event-property (event prop new-value)
+  "For the given EVENT set the property PROP to the value NEW-VALUE."
+  (catch 'found
+    (let ((props (car (cddr event))) pp)
+      (while props
+        (setq pp (car props))
+        (when (eq (car pp) prop)
+          (setcdr (cdr pp) new-value)
+          (throw 'found (car (cddr pp))))
+        (setq props (cdr props)))
+      (setq props (car (cddr event)))
+      (setcar (cddr event)
+              (append props (list (list prop nil new-value)))))))
+
+(defun icalendar-get-children (node name)
+  "Return all children of the given NODE which have a name NAME.
+For instance the VCALENDAR node can have VEVENT children as well as VTODO
+children."
+  (let ((result nil)
+        (children (cadr (cddr node))))
+    (when (eq (car node) name)
+      (setq result node))
+    ;;(message "%s" node)
+    (when children
+      (let ((subresult
+             (delq nil
+                   (mapcar (lambda (n)
+                             (icalendar-get-children n name))
+                           children))))
+        (if subresult
+            (if result
+                (setq result (append result subresult))
+              (setq result subresult)))))
+    result))
+
+; private
+(defun icalendar-all-events (icalendar)
+  "Return the list of all existing events in the given ICALENDAR."
+  (interactive "")
+  (icalendar-get-children (car icalendar) 'VEVENT))
+
+(defun icalendar-split-value (value-string)
+  "Splits VALUE-STRING at ';='."
+  (let ((result '())
+        param-name param-value)
+    (when value-string
+      (save-current-buffer
+        (set-buffer (get-buffer-create " *ical-temp*"))
+        (set-buffer-modified-p nil)
+        (erase-buffer)
+        (insert value-string)
+        (goto-char (point-min))
+        (while
+            (re-search-forward
+             "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
+             nil t)
+          (setq param-name (intern (match-string 1)))
+          (setq param-value (match-string 2))
+          (setq result
+                (append result (list (list param-name param-value)))))))
+    result))
+
+(defun icalendar-decode-isodatetime (isodatetimestring)
+  "Return ISODATETIMESTRING in format like `decode-time'.
+Converts from ISO-8601 to Emacs representation.  If ISODATETIMESTRING
+specifies UTC time (trailing letter Z) the decoded time is given in
+the local time zone! FIXME: TZID-attributes are ignored....! FIXME:
+multiple comma-separated values should be allowed!"
+  (icalendar-dmsg isodatetimestring)
+  (if isodatetimestring
+      ;; day/month/year must be present
+      (let ((year  (read (substring isodatetimestring 0 4)))
+            (month (read (substring isodatetimestring 4 6)))
+            (day   (read (substring isodatetimestring 6 8)))
+            (hour 0)
+            (minute 0)
+            (second 0))
+        (when (> (length isodatetimestring) 12)
+          ;; hour/minute present
+          (setq hour (read (substring isodatetimestring 9 11)))
+          (setq minute (read (substring isodatetimestring 11 13))))
+        (when (> (length isodatetimestring) 14)
+          ;; seconds present
+          (setq second (read (substring isodatetimestring 13 15))))
+        (when (and (> (length isodatetimestring) 15)
+                   ;; UTC specifier present
+                   (char-equal ?Z (aref isodatetimestring 15)))
+          ;; if not UTC add current-time-zone offset
+          (setq second (+ (car (current-time-zone)) second)))
+        ;; create the decoded date-time
+        ;; FIXME!?!
+        (condition-case nil
+            (decode-time (encode-time second minute hour day month year))
+          (error
+           (message "Cannot decode \"%s\"" isodatetimestring)
+           ;; hope for the best...
+           (list second minute hour day month year 0 nil 0))))
+    ;; isodatetimestring == nil
+    nil))
+
+(defun icalendar-decode-isoduration (isodurationstring)
+  "Return ISODURATIONSTRING in format like `decode-time'.
+Converts from ISO-8601 to Emacs representation.  If ISODURATIONSTRING
+specifies UTC time (trailing letter Z) the decoded time is given in
+the local time zone! FIXME: TZID-attributes are ignored....! FIXME:
+multiple comma-separated values should be allowed!"
+  (if isodurationstring
+      (save-match-data
+        (string-match
+         (concat
+          "^P[+-]?\\("
+          "\\(\\([0-9]+\\)D\\)"         ; days only
+          "\\|"
+          "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
+          "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
+          "\\|"
+          "\\(\\([0-9]+\\)W\\)"         ; weeks only
+          "\\)$") isodurationstring)
+        (let ((seconds 0)
+              (minutes 0)
+              (hours 0)
+              (days 0)
+              (months 0)
+              (years 0))
+        (cond
+         ((match-beginning 2)           ;days only
+          (setq days (read (substring isodurationstring
+                                      (match-beginning 3)
+                                      (match-end 3))))
+          (when icalendar-duration-correction
+            (setq days (1- days))))
+         ((match-beginning 4)           ;days and time
+          (if (match-beginning 5)
+              (setq days (* 7 (read (substring isodurationstring
+                                               (match-beginning 6)
+                                               (match-end 6))))))
+          (if (match-beginning 7)
+              (setq hours (read (substring isodurationstring
+                                           (match-beginning 8)
+                                           (match-end 8)))))
+          (if (match-beginning 9)
+              (setq minutes (read (substring isodurationstring
+                                             (match-beginning 10)
+                                             (match-end 10)))))
+          (if (match-beginning 11)
+              (setq seconds (read (substring isodurationstring
+                                             (match-beginning 12)
+                                             (match-end 12)))))
+          )
+         ((match-beginning 13)          ;weeks only
+          (setq days (* 7 (read (substring isodurationstring
+                                           (match-beginning 14)
+                                           (match-end 14))))))
+         )
+        (list seconds minutes hours days months years)))
+    ;; isodatetimestring == nil
+    nil))
+
+(defun icalendar-add-decoded-times (time1 time2)
+  "Add TIME1 to TIME2.
+Both times must be given in decoded form.  One of these times must be
+valid (year > 1900 or something)."
+  ;; FIXME: does this function exist already?
+  (decode-time (encode-time
+                (+ (nth 0 time1) (nth 0 time2))
+                (+ (nth 1 time1) (nth 1 time2))
+                (+ (nth 2 time1) (nth 2 time2))
+                (+ (nth 3 time1) (nth 3 time2))
+                (+ (nth 4 time1) (nth 4 time2))
+                (+ (nth 5 time1) (nth 5 time2))
+                nil
+                nil
+                ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
+                )))
+
+(defun icalendar-datetime-to-noneuropean-date (datetime)
+  "Convert the decoded DATETIME to non-european-style format.
+Non-European format: (month day year)."
+  (if datetime
+      (list (nth 4 datetime) ;month
+            (nth 3 datetime) ;day
+            (nth 5 datetime));year
+    ;; datetime == nil
+    nil))
+
+(defun icalendar-datetime-to-european-date (datetime)
+  "Convert the decoded DATETIME to European format.
+European format: (day month year).
+FIXME"
+  (if datetime
+      (format "%d %d %d" (nth 3 datetime); day
+              (nth 4 datetime) ;month
+              (nth 5 datetime));year
+    ;; datetime == nil
+    nil))
+
+(defun icalendar-datetime-to-colontime (datetime)
+  "Extract the time part of a decoded DATETIME into 24-hour format.
+Note that this silently ignores seconds."
+  (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
+
+(defun icalendar-get-month-number (monthname)
+  "Return the month number for the given MONTHNAME."
+  (save-match-data
+    (let ((case-fold-search t))
+      (assoc-default monthname icalendar-monthnumber-table
+                     'string-match))))
+
+(defun icalendar-get-weekday-abbrev (weekday)
+  "Return the abbreviated WEEKDAY."
+  ;;FIXME: ISO-like(?).
+  (save-match-data
+    (let ((case-fold-search t))
+      (assoc-default weekday icalendar-weekdayabbrev-table
+                     'string-match))))
+
+(defun icalendar-datestring-to-isodate (datestring &optional day-shift)
+  "Convert diary-style DATESTRING to iso-style date.
+If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
+-- DAY-SHIFT must be either nil or an integer.  This function
+takes care of european-style."
+  (let ((day -1) month year)
+    (save-match-data
+      (cond (;; numeric date
+             (string-match (concat "\\s-*"
+                                   "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
+                                   "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
+                                   "\\([0-9]\\{4\\}\\)")
+                           datestring)
+             (setq day (read (substring datestring (match-beginning 1)
+                                        (match-end 1))))
+             (setq month (read (substring datestring (match-beginning 2)
+                                          (match-end 2))))
+             (setq year (read (substring datestring (match-beginning 3)
+                                         (match-end 3))))
+             (unless european-calendar-style
+               (let ((x month))
+                 (setq month day)
+                 (setq day x))))
+            (;; date contains month names -- european-style
+             (and european-calendar-style
+                  (string-match (concat "\\s-*"
+                                        "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
+                                        "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
+                                        "\\([0-9]\\{4\\}\\)")
+                                datestring))
+                 (setq day (read (substring datestring (match-beginning 1)
+                                            (match-end 1))))
+                 (setq month (icalendar-get-month-number
+                              (substring datestring (match-beginning 2)
+                                         (match-end 2))))
+                 (setq year (read (substring datestring (match-beginning 3)
+                                             (match-end 3)))))
+            (;; date contains month names -- non-european-style
+             (and (not european-calendar-style)
+                  (string-match (concat "\\s-*"
+                                        "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
+                                        "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
+                                        "\\([0-9]\\{4\\}\\)")
+                                datestring))
+             (setq day (read (substring datestring (match-beginning 2)
+                                        (match-end 2))))
+             (setq month (icalendar-get-month-number
+                          (substring datestring (match-beginning 1)
+                                     (match-end 1))))
+             (setq year (read (substring datestring (match-beginning 3)
+                                         (match-end 3)))))
+            (t
+             nil)))
+    (if (> day 0)
+        (let ((mdy (calendar-gregorian-from-absolute
+                    (+ (calendar-absolute-from-gregorian (list month day year))
+                       (or day-shift 0)))))
+          (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
+      nil)))
+
+(defun icalendar-dmsg (&rest args)
+  "Print message ARGS if `icalendar-debug' is non-nil."
+  (if icalendar-debug
+      (apply 'message args)))
+
+(defun icalendar-diarytime-to-isotime (timestring ampmstring)
+  "Convert a a time like 9:30pm to an iso-conform string like T213000.
+In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
+would be \"pm\"."
+  (if timestring
+      (let ((starttimenum (read (icalendar-rris ":" "" timestring))))
+        ;; take care of am/pm style
+        (if (and ampmstring (string= "pm" ampmstring))
+            (setq starttimenum (+ starttimenum 1200)))
+        (format "T%04d00" starttimenum))
+    nil))
+
+(defun icalendar-convert-string-for-export (s)
+  "Escape comma and other critical characters in string S."
+  (icalendar-rris "," "\\\\," s))
+
+(defun icalendar-convert-for-import (string)
+  "Remove escape chars for comma, semicolon etc. from STRING."
+  (icalendar-rris
+   "\\\\n" "\n " (icalendar-rris
+               "\\\\\"" "\"" (icalendar-rris
+                              "\\\\;" ";" (icalendar-rris
+                                           "\\\\," "," string)))))
+
+;; ======================================================================
+;; export -- convert emacs-diary to icalendar
+;; ======================================================================
+
+(defun icalendar-convert-diary-to-ical (diary-filename ical-filename
+                                        &optional do-not-clear-diary-file)
+  "Export diary file to iCalendar format -- erases ical-filename!!!.
+Argument DIARY-FILENAME is the input `diary-file'.
+Argument ICAL-FILENAME is the output iCalendar file.
+If DO-NOT-CLEAR-DIARY-FILE is not nil the target iCalendar file
+is not erased."
+  (interactive "FExport diary data from file:
+Finto iCalendar file: ")
+  (let ((result "")
+        (start 0)
+        (entry-main "")
+        (entry-rest "")
+        (header "")
+        (contents)
+        (oops nil)
+        (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
+                           "?")))
+    (save-current-buffer
+      (set-buffer (find-file diary-filename))
+      (goto-char (point-min))
+      (while (re-search-forward
+              "^\\([^ \t\n].*\\)\\(\n[ \t].*\\)*" nil t)
+        (setq entry-main (match-string 1))
+        (if (match-beginning 2)
+            (setq entry-rest (match-string 2))
+          (setq entry-rest ""))
+        (setq header (format "\nBEGIN:VEVENT\nUID:emacs%d%d%d"
+                             (car (current-time))
+                             (cadr (current-time))
+                             (car (cddr (current-time)))))
+        (setq oops nil)
+        (cond
+         ;; anniversaries
+         ((string-match
+           (concat nonmarker
+                   "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)")
+           entry-main)
+          (icalendar-dmsg "diary-anniversary %s" entry-main)
+          (let* ((datetime (substring entry-main (match-beginning 1)
+                                      (match-end 1)))
+                 (summary (icalendar-convert-string-for-export
+                           (substring entry-main (match-beginning 2)
+                                      (match-end 2))))
+                 (startisostring (icalendar-datestring-to-isodate
+                                  datetime))
+                 (endisostring (icalendar-datestring-to-isodate
+                                datetime 1)))
+            (setq contents
+                  (concat "\nDTSTART;VALUE=DATE:" startisostring
+                          "\nDTEND;VALUE=DATE:" endisostring
+                          "\nSUMMARY:" summary
+                          "\nRRULE:FREQ=YEARLY;INTERVAL=1"
+                          ;; the following is redundant,
+                          ;; but korganizer seems to expect this... ;(
+                          ;; and evolution doesn't understand it... :(
+                          ;; so... who is wrong?!
+                          ";BYMONTH=" (substring startisostring 4 6)
+                          ";BYMONTHDAY=" (substring startisostring 6 8)
+                          )))
+          (unless (string= entry-rest "")
+            (setq contents (concat contents "\nDESCRIPTION:"
+                                   (icalendar-convert-string-for-export
+                                    entry-rest)))))
+         ;; cyclic events
+         ;; %%(diary-cyclic )
+         ((string-match
+           (concat nonmarker
+                   "%%(diary-cyclic \\([^ ]+\\) +"
+                   "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
+           entry-main)
+          (icalendar-dmsg "diary-cyclic %s" entry-main)
+          (let* ((frequency (substring entry-main (match-beginning 1)
+                                       (match-end 1)))
+                 (datetime (substring entry-main (match-beginning 2)
+                                      (match-end 2)))
+                 (summary (icalendar-convert-string-for-export
+                           (substring entry-main (match-beginning 3)
+                                      (match-end 3))))
+                 (startisostring (icalendar-datestring-to-isodate
+                                  datetime))
+                 (endisostring (icalendar-datestring-to-isodate
+                                datetime 1)))
+            (setq contents
+                  (concat "\nDTSTART;VALUE=DATE:" startisostring
+                          "\nDTEND;VALUE=DATE:" endisostring
+                          "\nSUMMARY:" summary
+                          "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
+                          ;; strange: korganizer does not expect
+                          ;; BYSOMETHING here...
+                          )))
+          (unless (string= entry-rest "")
+            (setq contents (concat contents "\nDESCRIPTION:"
+                                   (icalendar-convert-string-for-export
+                                    entry-rest)))))
+         ;; diary-date -- FIXME
+         ((string-match
+           (concat nonmarker
+                   "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)")
+           entry-main)
+          (icalendar-dmsg "diary-date %s" entry-main)
+          (setq oops t))
+         ;; float events -- FIXME
+         ((string-match
+           (concat nonmarker
+                   "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)")
+           entry-main)
+          (icalendar-dmsg "diary-float %s" entry-main)
+          (setq oops t))
+         ;; block events
+         ((string-match
+           (concat nonmarker
+                   "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +"
+                   "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
+           entry-main)
+          (icalendar-dmsg "diary-block %s" entry-main)
+          (let* ((startstring (substring entry-main (match-beginning 1)
+                                         (match-end 1)))
+                 (endstring (substring entry-main (match-beginning 2)
+                                       (match-end 2)))
+                 (summary (icalendar-convert-string-for-export
+                           (substring entry-main (match-beginning 3)
+                                      (match-end 3))))
+                 (startisostring (icalendar-datestring-to-isodate
+                                  startstring))
+                 (endisostring (icalendar-datestring-to-isodate
+                                endstring 1)))
+            (setq contents
+                  (concat "\nDTSTART;VALUE=DATE:" startisostring
+                          "\nDTEND;VALUE=DATE:" endisostring
+                          "\nSUMMARY:" summary
+                          ))
+            (unless (string= entry-rest "")
+              (setq contents (concat contents "\nDESCRIPTION:"
+                                     (icalendar-convert-string-for-export
+                                      entry-rest))))))
+         ;; other sexp diary entries -- FIXME
+         ((string-match
+           (concat nonmarker
+                   "%%(\\([^)]+\\))\\s-*\\(.*\\)")
+           entry-main)
+          (icalendar-dmsg "diary-sexp %s" entry-main)
+          (setq oops t))
+         ;; weekly by day
+         ;; Monday 8:30 Team meeting
+         ((and (string-match
+                (concat nonmarker
+                        "\\([a-z]+\\)\\s-+"
+                        "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
+                        "\\(-0?"
+                        "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
+                        "\\)?"
+                        "\\s-*\\(.*\\)$")
+                entry-main)
+               (icalendar-get-weekday-abbrev
+                (substring entry-main (match-beginning 1) (match-end 1))))
+          (icalendar-dmsg "weekly %s" entry-main)
+          (let* ((day (icalendar-get-weekday-abbrev
+                       (substring entry-main (match-beginning 1)
+                                  (match-end 1))))
+                 (starttimestring (icalendar-diarytime-to-isotime
+                                   (if (match-beginning 3)
+                                       (substring entry-main
+                                                  (match-beginning 3)
+                                                  (match-end 3))
+                                     nil)
+                                   (if (match-beginning 4)
+                                       (substring entry-main
+                                                  (match-beginning 4)
+                                                  (match-end 4))
+                                     nil)))
+                 (endtimestring (icalendar-diarytime-to-isotime
+                                 (if (match-beginning 6)
+                                     (substring entry-main
+                                                (match-beginning 6)
+                                                (match-end 6))
+                                   nil)
+                                 (if (match-beginning 7)
+                                     (substring entry-main
+                                                (match-beginning 7)
+                                                (match-end 7))
+                                   nil)))
+                 (summary (icalendar-convert-string-for-export
+                           (substring entry-main (match-beginning 8)
+                                      (match-end 8)))))
+            (when starttimestring
+              (unless endtimestring
+                (let ((time (read (icalendar-rris "^T0?" ""
+                                                  starttimestring))))
+                  (setq endtimestring (format "T%06d" (+ 10000 time))))))
+            (setq contents
+                  (concat "\nDTSTART"
+                          (if starttimestring "" ";VALUE=DATE")
+                          ":19000101" ;; FIXME? Probability that this
+                          ;; is the right day is 1/7
+                          (or starttimestring "")
+                          "\nDTEND"
+                          (if endtimestring "" ";VALUE=DATE")
+                          ":19000101" ;; FIXME?
+                          (or endtimestring "")
+                          "\nSUMMARY:" summary
+                          "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day
+                          )))
+          (unless (string= entry-rest "")
+            (setq contents (concat contents "\nDESCRIPTION:"
+                                   (icalendar-convert-string-for-export
+                                    entry-rest)))))
+         ;; yearly by day
+         ;; 1 May Tag der Arbeit
+         ((string-match
+           (concat nonmarker
+                   (if european-calendar-style
+                       "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
+                     "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
+                   "\\*?\\s-*"
+                   "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
+                   "\\("
+                   "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
+                   "\\)?"
+                   "\\s-*\\([^0-9]+.*\\)$"; must not match years
+                   )
+           entry-main)
+          (icalendar-dmsg "yearly %s" entry-main)
+          (let* ((daypos (if european-calendar-style 1 2))
+                 (monpos (if european-calendar-style 2 1))
+                 (day (read (substring entry-main (match-beginning daypos)
+                                       (match-end daypos))))
+                 (month (icalendar-get-month-number
+                         (substring entry-main (match-beginning monpos)
+                                    (match-end monpos))))
+                 (starttimestring (icalendar-diarytime-to-isotime
+                                   (if (match-beginning 4)
+                                       (substring entry-main
+                                                  (match-beginning 4)
+                                                  (match-end 4))
+                                     nil)
+                                   (if (match-beginning 5)
+                                       (substring entry-main
+                                                  (match-beginning 5)
+                                                  (match-end 5))
+                                     nil)))
+                 (endtimestring (icalendar-diarytime-to-isotime
+                                 (if (match-beginning 7)
+                                     (substring entry-main
+                                                (match-beginning 7)
+                                                (match-end 7))
+                                   nil)
+                                 (if (match-beginning 8)
+                                     (substring entry-main
+                                                (match-beginning 8)
+                                                (match-end 8))
+                                   nil)))
+                 (summary (icalendar-convert-string-for-export
+                           (substring entry-main (match-beginning 9)
+                                      (match-end 9)))))
+            (when starttimestring
+              (unless endtimestring
+                (let ((time (read (icalendar-rris "^T0?" ""
+                                                  starttimestring))))
+                  (setq endtimestring (format "T%06d" (+ 10000 time))))))
+            (setq contents
+                  (concat "\nDTSTART"
+                          (if starttimestring "" ";VALUE=DATE")
+                          (format ":1900%02d%02d" month day)
+                          (or starttimestring "")
+                          "\nDTEND"
+                          (if endtimestring "" ";VALUE=DATE")
+                          (format ":1900%02d%02d" month day)
+                          (or endtimestring "")
+                          "\nSUMMARY:" summary
+                          "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
+                          (format "%2d" month)
+                          ";BYMONTHDAY="
+                          (format "%2d" day)
+                          )))
+          (unless (string= entry-rest "")
+            (setq contents (concat contents "\nDESCRIPTION:"
+                                   (icalendar-convert-string-for-export
+                                    entry-rest)))))
+         ;; "ordinary" events, start and end time given
+         ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich
+         ((string-match
+           (concat nonmarker
+                   "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+"
+                   "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
+                   "\\("
+                   "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
+                   "\\)?"
+                   "\\s-*\\(.*\\)")
+           entry-main)
+          (icalendar-dmsg "ordinary %s" entry-main)
+          (let* ((datestring (icalendar-datestring-to-isodate
+                              (substring entry-main (match-beginning 1)
+                                         (match-end 1))))
+                 (starttimestring (icalendar-diarytime-to-isotime
+                                   (if (match-beginning 3)
+                                       (substring entry-main
+                                                  (match-beginning 3)
+                                                  (match-end 3))
+                                     nil)
+                                   (if (match-beginning 4)
+                                       (substring entry-main
+                                                  (match-beginning 4)
+                                                  (match-end 4))
+                                     nil)))
+                 (endtimestring (icalendar-diarytime-to-isotime
+                                 (if (match-beginning 6)
+                                     (substring entry-main
+                                                (match-beginning 6)
+                                                (match-end 6))
+                                   nil)
+                                 (if (match-beginning 7)
+                                     (substring entry-main
+                                                (match-beginning 7)
+                                                (match-end 7))
+                                   nil)))
+                 (summary (icalendar-convert-string-for-export
+                           (substring entry-main (match-beginning 8)
+                                      (match-end 8)))))
+            (when starttimestring
+              (unless endtimestring
+                (let ((time (read (icalendar-rris "^T0?" ""
+                                                  starttimestring))))
+                  (setq endtimestring (format "T%06d" (+ 10000 time))))))
+            (setq contents (format
+                            "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s"
+                            (if starttimestring "" ";VALUE=DATE")
+                            datestring
+                            (or starttimestring "")
+                            (if endtimestring ""
+                              ";VALUE=DATE")
+                            datestring
+                            (or endtimestring "")
+                            summary))
+            (unless (string= entry-rest "")
+              (setq contents (concat contents "\nDESCRIPTION:"
+                                     (icalendar-convert-string-for-export
+                                      entry-rest))))))
+         ;; everything else
+         (t
+          ;; Oops! what's that?
+          (setq oops t)))
+        (if oops
+            (message "Cannot export entry on line %d"
+                     (count-lines (point-min) (point)))
+          (setq result (concat result header contents "\nEND:VEVENT"))))
+      ;; we're done, insert everything into the file
+      (let ((coding-system-for-write 'utf8))
+        (set-buffer (find-file ical-filename))
+        (unless do-not-clear-diary-file
+          (erase-buffer))
+        (insert
+         "BEGIN:VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
+        (insert "\nVERSION:2.0")
+        (insert result)
+        (insert "\nEND:VCALENDAR\n")))))
+
+
+;; ======================================================================
+;; import -- convert icalendar to emacs-diary
+;; ======================================================================
+
+;; user function
+(defun icalendar-import-file (ical-filename diary-filename
+                                            &optional non-marking
+                                            do-not-clear-diary-file)
+  "Import a iCalendar file and save to a diary file -- erases diary-file!
+Argument ICAL-FILENAME output iCalendar file.
+Argument DIARY-FILENAME input `diary-file'.
+Optional argument NON-MARKING determines whether events are created as
+non-marking or not.
+If DO-NOT-CLEAR-DIARY-FILE is not nil the target diary file is
+not erased."
+  (interactive "fImport iCalendar data from file:
+Finto diary file (will be erased!):
+p")
+  ;; clean up the diary file
+  (save-current-buffer
+    (unless do-not-clear-diary-file
+      ;; clear the target diary file
+      (set-buffer (find-file diary-filename))
+      (erase-buffer))
+    ;; now load and convert from the ical file
+    (set-buffer (find-file ical-filename))
+    (icalendar-extract-ical-from-buffer diary-filename t non-marking)))
+
+; user function
+(defun icalendar-extract-ical-from-buffer (&optional
+                                           diary-file do-not-ask
+                                           non-marking)
+  "Extract iCalendar events from current buffer.
+
+This function searches the current buffer for the first iCalendar
+object, reads it and adds all VEVENT elements to the diary
+DIARY-FILE.
+
+It will ask for each appointment whether to add it to the diary
+when DO-NOT-ASK is non-nil.  When called interactively,
+DO-NOT-ASK is set to t, so that you are asked fore each event.
+
+NON-MARKING determines whether diary events are created as
+non-marking.
+
+This function attempts to notify about problems that occur when
+reading, parsing, or converting iCalendar data!"
+  (interactive)
+  (save-current-buffer
+    ;; prepare ical
+    (message "Preparing icalendar...")
+    (set-buffer (icalendar-get-unfolded-buffer (current-buffer)))
+    (goto-char (point-min))
+    (message "Preparing icalendar...done")
+    (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
+        (let (ical-contents ical-errors)
+          ;; read ical
+          (message "Reading icalendar...")
+          (beginning-of-line)
+          (setq ical-contents (icalendar-read-element nil nil))
+          (message "Reading icalendar...done")
+          ;; convert ical
+          (message "Converting icalendar...")
+          (setq ical-errors (icalendar-convert-ical-to-diary
+                             ical-contents
+                             diary-file do-not-ask non-marking))
+          (when diary-file
+            ;; save the diary file
+            (save-current-buffer
+              (set-buffer (find-buffer-visiting diary-file))
+              (save-buffer)))
+          (message "Converting icalendar...done")
+          (if (and ical-errors (y-or-n-p
+                                (concat "Something went wrong -- "
+                                        "do you want to see the "
+                                        "error log? ")))
+              (switch-to-buffer " *icalendar-errors*")))
+      (message
+       "Current buffer does not contain icalendar contents!"))))
+
+;; ----------------------------------------------------------------------
+;; private area
+;; ----------------------------------------------------------------------
+(defun icalendar-format-ical-event (event)
+  "Create a string representation of an iCalendar EVENT."
+  (let ((string icalendar-import-format)
+        (conversion-list
+         '(("%d" DESCRIPTION icalendar-import-format-description)
+           ("%s" SUMMARY     icalendar-import-format-subject)
+           ("%l" LOCATION    icalendar-import-format-location)
+           ("%o" ORGANIZER   icalendar-import-format-organizer))))
+    ;; convert the specifiers in the format string
+    (mapcar (lambda (i)
+              (let* ((spec (car i))
+                     (prop (cadr i))
+                     (format (car (cddr i)))
+                     (contents (icalendar-get-event-property event prop))
+                     (formatted-contents ""))
+                ;;(message "%s" event)
+                ;;(message "contents%s = %s" prop contents)
+                (when (and contents (> (length contents) 0))
+                  (setq formatted-contents
+                        (icalendar-rris "%s"
+                                        (icalendar-convert-for-import
+                                         contents)
+                                        (symbol-value format))))
+                (setq string (icalendar-rris spec
+                                             formatted-contents
+                                             string))))
+            conversion-list)
+    string))
+
+(defun icalendar-convert-ical-to-diary (ical-list diary-file
+                                                  &optional do-not-ask
+                                                  non-marking)
+  "Convert an iCalendar file to an Emacs diary file.
+Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
+DIARY-FILE.  If DO-NOT-ASK is nil the user is asked for each event
+whether to actually import it.  NON-MARKING determines whether diary
+events are created as non-marking.
+This function attempts to return t if something goes wrong.  In this
+case an error string which describes all the errors and problems is
+written into the buffer ` *icalendar-errors*'."
+  (let* ((ev (icalendar-all-events ical-list))
+         (error-string "")
+         (event-ok t)
+         (found-error nil)
+         e diary-string)
+    ;; step through all events/appointments
+    (while ev
+      (setq e (car ev))
+      (setq ev (cdr ev))
+      (setq event-ok nil)
+      (condition-case error-val
+          (let* ((dtstart (icalendar-decode-isodatetime
+                           (icalendar-get-event-property e 'DTSTART)))
+                 (start-d (calendar-date-string
+                           (icalendar-datetime-to-noneuropean-date
+                            dtstart)
+                           t t))
+                 (start-t (icalendar-datetime-to-colontime dtstart))
+                 (dtend (icalendar-decode-isodatetime
+                         (icalendar-get-event-property e 'DTEND)))
+                 end-d
+                 end-t
+                 (subject (icalendar-convert-for-import
+                           (or (icalendar-get-event-property e 'SUMMARY)
+                               "No Subject")))
+                 (rrule (icalendar-get-event-property e 'RRULE))
+                 (rdate (icalendar-get-event-property e 'RDATE))
+                 (duration (icalendar-get-event-property e 'DURATION)))
+            (icalendar-dmsg "%s: %s" start-d subject)
+            (when duration
+              (let ((dtend2 (icalendar-add-decoded-times
+                             dtstart
+                             (icalendar-decode-isoduration duration))))
+                (if (and dtend (not (eq dtend dtend2)))
+                    (message "Inconsistent endtime and duration for %s"
+                             subject))
+                (setq dtend dtend2)))
+            (setq end-d (if dtend
+                            (calendar-date-string
+                             (icalendar-datetime-to-noneuropean-date
+                              dtend)
+                             t t)
+                          start-d))
+            (setq end-t (if dtend
+                            (icalendar-datetime-to-colontime dtend)
+                          start-t))
+            (icalendar-dmsg "start-d: %s, end-d: %s" start-d end-d)
+            (cond
+             ;; recurring event
+             (rrule
+              (icalendar-dmsg "recurring event")
+              (let* ((rrule-props (icalendar-split-value rrule))
+                     (frequency (car (cdr (assoc 'FREQ rrule-props))))
+                     (until (car (cdr (assoc 'UNTIL rrule-props))))
+                     (interval  (read (car (cdr (assoc 'INTERVAL
+                                                       rrule-props))))))
+                (cond ((string-equal frequency "WEEKLY")
+                       (if (not start-t)
+                           (progn
+                             ;; weekly and all-day
+                             (icalendar-dmsg "weekly all-day")
+                             (setq diary-string
+                                   (format
+                                    "%%%%(diary-cyclic %d %s)"
+                                    (* interval 7)
+                                    (icalendar-datetime-to-european-date
+                                     dtstart))))
+                         ;; weekly and not all-day
+                         (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
+                                (weekday
+                                 (cdr (rassoc
+                                       byday
+                                       icalendar-weekdayabbrev-table))))
+                           (icalendar-dmsg "weekly not-all-day")
+                           (if weekday
+                               (setq diary-string
+                                     (format "%s %s%s%s" weekday
+                                             start-t (if end-t "-" "")
+                                             (or end-t "")))
+                             ;; FIXME!!!!
+                             ;; DTSTART;VALUE=DATE-TIME:20030919T090000
+                             ;; DTEND;VALUE=DATE-TIME:20030919T113000
+                             (setq diary-string
+                                   (format
+                                    "%%%%(diary-cyclic %s %s) %s%s%s"
+                                    (* interval 7)
+                                    (icalendar-datetime-to-european-date
+                                     dtstart)
+                                    start-t (if end-t "-" "") (or end-t ""))))
+                           (setq event-ok t))))
+                      ;; yearly
+                      ((string-equal frequency "YEARLY")
+                       (icalendar-dmsg "yearly")
+                       (setq diary-string
+                             (format
+                              "%%%%(diary-anniversary %s)"
+                              (icalendar-datetime-to-european-date dtstart)))
+                       (setq event-ok t))
+                      ;; FIXME: war auskommentiert:
+                      ((and (string-equal frequency "DAILY")
+                            ;;(not (string= start-d end-d))
+                            ;;(not start-t)
+                            ;;(not end-t)
+                            )
+                       (let ((ds (icalendar-datetime-to-noneuropean-date
+                                  (icalendar-decode-isodatetime
+                                   (icalendar-get-event-property e
+                                                                 'DTSTART))))
+                             (de (icalendar-datetime-to-noneuropean-date
+                                  (icalendar-decode-isodatetime
+                                   until))))
+                         (setq diary-string
+                               (format
+                                "%%%%(diary-block %d %d %d  %d %d %d)"
+                                (nth 1 ds) (nth 0 ds) (nth 2 ds)
+                                (nth 1 de) (nth 0 de) (nth 2 de))))
+                       (setq event-ok t)))
+                ))
+             (rdate
+              (icalendar-dmsg "rdate event")
+              (setq diary-string "")
+              (mapcar (lambda (datestring)
+                        (setq diary-string
+                              (concat diary-string
+                                      (format "......"))))
+                      (icalendar-split-value rdate)))
+             ;; non-recurring event
+             ;; long event
+             ((not (string= start-d end-d))
+              (icalendar-dmsg "non-recurring event")
+              (let ((ds (icalendar-datetime-to-noneuropean-date dtstart))
+                    (de (icalendar-datetime-to-noneuropean-date dtend)))
+                (setq diary-string
+                      (format "%%%%(diary-block %d %d %d   %d %d %d)"
+                              (nth 1 ds) (nth 0 ds) (nth 2 ds)
+                              (nth 1 de) (nth 0 de) (nth 2 de))))
+              (setq event-ok t))
+             ;; not all-day
+             ((and start-t (or (not end-t)
+                               (not (string= start-t end-t))))
+              (icalendar-dmsg "not all day event")
+              (cond (end-t
+                     (setq diary-string (format "%s %s-%s" start-d
+                                                start-t end-t)))
+                    (t
+                     (setq diary-string (format "%s %s" start-d
+                                                start-t))))
+              (setq event-ok t))
+             ;; all-day event
+             (t
+              (icalendar-dmsg "all day event")
+              (setq diary-string start-d)
+              (setq event-ok t)))
+            ;; add all other elements unless the user doesn't want to have
+            ;; them
+            (if event-ok
+                (progn
+                  (setq diary-string
+                        (concat diary-string " "
+                                (icalendar-format-ical-event e)))
+                  (if do-not-ask (setq subject nil))
+                  (icalendar-add-diary-entry diary-string diary-file
+                                             non-marking subject))
+              ;; event was not ok
+              (setq found-error t)
+              (setq error-string
+                    (format "%s\nCannot handle this event:%s"
+                            error-string e))))
+        ;; handle errors
+        (error
+         (message "Ignoring event \"%s\"" e)
+         (setq found-error t)
+         (setq error-string (format "%s\nCannot handle this event: %s"
+                                    error-string e)))))
+    (if found-error
+        (save-current-buffer
+          (set-buffer (get-buffer-create " *icalendar-errors*"))
+          (erase-buffer)
+          (insert error-string)))
+    (message "Converting icalendar...done")
+    found-error))
+
+(defun icalendar-add-diary-entry (string diary-file non-marking
+                                         &optional subject)
+  "Add STRING to the diary file DIARY-FILE.
+STRING must be a properly formatted valid diary entry.  NON-MARKING
+determines whether diary events are created as non-marking.  If
+SUBJECT is not nil it must be a string that gives the subject of the
+entry.  In this case the user will be asked whether he wants to insert
+the entry."
+  (when (or (not subject)                       ;
+            (y-or-n-p (format "Add appointment for `%s' to diary? "
+                              subject)))
+    (when subject
+      (setq non-marking
+            (y-or-n-p (format "Make appointment non-marking? "))))
+    (save-window-excursion
+      (unless diary-file
+        (setq diary-file
+              (read-file-name "Add appointment to this diary file: ")))
+      (make-diary-entry string non-marking diary-file))))
+
+;; ======================================================================
+;; (add-hook 'list-diary-entries-hook 'include-icalendar-files)
+;; ======================================================================
+(defun include-icalendar-files ()
+  "Not yet implemented.")
+
+(provide 'icalendar)
+
+;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
+;;; icalendar.el ends here
diff --git a/lisp/comint.el b/lisp/comint.el
index 8b5a107c7d7..8b2c779ecd3 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1,7 +1,7 @@
 ;;; comint.el --- general command interpreter in a window stuff
 
-;; Copyright (C) 1988,90,92,93,94,95,96,97,98,99,2000,01,02,03,2004
-;;      Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;;   2000, 2001, 2002, 2003, 2004  Free Software Foundation, Inc.
 
 ;; Author: Olin Shivers <shivers@cs.cmu.edu>
 ;;      Simon Marshall <simon@gnu.org>
@@ -185,10 +185,10 @@ the remaining prompts will be accidentally messed up.  You may
 wish to put something like the following in your `.emacs' file:
 
 \(add-hook 'comint-mode-hook
-          '(lambda ()
-             (define-key comint-mode-map \"\C-w\" 'comint-kill-region)
-             (define-key comint-mode-map [C-S-backspace]
-               'comint-kill-whole-line)))
+          (lambda ()
+            (define-key comint-mode-map \"\C-w\" 'comint-kill-region)
+            (define-key comint-mode-map [C-S-backspace]
+              'comint-kill-whole-line)))
 
 If you sometimes use comint-mode on text-only terminals or with `emacs-nw',
 you might wish to use another binding for `comint-kill-whole-line'."
@@ -369,11 +369,8 @@ Takes one argument, the input.  If non-nil, the input may be saved on the input
 history list.  Default is to save anything that isn't all whitespace.")
 
 (defvar comint-input-filter-functions '()
-  "Functions to call before input is sent to the process.
-These functions get one argument, a string containing the text to send.
-
-You can use `add-hook' to add functions to this list
-either globally or locally.")
+  "Special hook run before input is sent to the process.
+These functions get one argument, a string containing the text to send.")
 
 (defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom)
   "Functions to call after output is inserted into the buffer.
@@ -411,7 +408,7 @@ See `comint-send-input'."
 (defcustom comint-use-prompt-regexp-instead-of-fields nil
   "*If non-nil, use `comint-prompt-regexp' to distinguish prompts from user-input.
 If nil, then program output and user-input are given different `field'
-properties, which emacs commands can use to distinguish them (in
+properties, which Emacs commands can use to distinguish them (in
 particular, common movement commands such as begining-of-line respect
 field boundaries in a natural way)."
   :type 'boolean
@@ -432,7 +429,106 @@ executed once when the buffer is created."
   :type 'hook
   :group 'comint)
 
-(defvar comint-mode-map nil)
+(defvar comint-mode-map
+  (let ((map (make-sparse-keymap)))
+    ;; Keys:
+    (define-key map "\ep"         'comint-previous-input)
+    (define-key map "\en"         'comint-next-input)
+    (define-key map [C-up]        'comint-previous-input)
+    (define-key map [C-down]      'comint-next-input)
+    (define-key map "\er"         'comint-previous-matching-input)
+    (define-key map "\es"         'comint-next-matching-input)
+    (define-key map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input)
+    (define-key map [?\C-c ?\M-s] 'comint-next-matching-input-from-input)
+    (define-key map "\e\C-l"      'comint-show-output)
+    (define-key map "\C-m"        'comint-send-input)
+    (define-key map "\C-d"        'comint-delchar-or-maybe-eof)
+    (define-key map "\C-c "       'comint-accumulate)
+    (define-key map "\C-c\C-x"    'comint-get-next-from-history)
+    (define-key map "\C-c\C-a"    'comint-bol-or-process-mark)
+    (define-key map "\C-c\C-u"    'comint-kill-input)
+    (define-key map "\C-c\C-w"    'backward-kill-word)
+    (define-key map "\C-c\C-c"    'comint-interrupt-subjob)
+    (define-key map "\C-c\C-z"    'comint-stop-subjob)
+    (define-key map "\C-c\C-\\"   'comint-quit-subjob)
+    (define-key map "\C-c\C-m"    'comint-insert-input)
+    (define-key map "\C-c\C-o"    'comint-delete-output)
+    (define-key map "\C-c\C-r"    'comint-show-output)
+    (define-key map "\C-c\C-e"    'comint-show-maximum-output)
+    (define-key map "\C-c\C-l"    'comint-dynamic-list-input-ring)
+    (define-key map "\C-c\C-n"    'comint-next-prompt)
+    (define-key map "\C-c\C-p"    'comint-previous-prompt)
+    (define-key map "\C-c\C-d"    'comint-send-eof)
+    (define-key map "\C-c\C-s"    'comint-write-output)
+    (define-key map "\C-c."       'comint-insert-previous-argument)
+    ;; Mouse Buttons:
+    (define-key map [mouse-2]     'comint-insert-input)
+    ;; Menu bars:
+    ;; completion:
+    (define-key map [menu-bar completion]
+      (cons "Complete" (make-sparse-keymap "Complete")))
+    (define-key map [menu-bar completion complete-expand]
+      '("Expand File Name" . comint-replace-by-expanded-filename))
+    (define-key map [menu-bar completion complete-listing]
+      '("File Completion Listing" . comint-dynamic-list-filename-completions))
+    (define-key map [menu-bar completion complete-file]
+      '("Complete File Name" . comint-dynamic-complete-filename))
+    (define-key map [menu-bar completion complete]
+      '("Complete Before Point" . comint-dynamic-complete))
+    ;; Input history:
+    (define-key map [menu-bar inout]
+      (cons "In/Out" (make-sparse-keymap "In/Out")))
+    (define-key map [menu-bar inout delete-output]
+      '("Delete Current Output Group" . comint-delete-output))
+    (define-key map [menu-bar inout append-output-to-file]
+      '("Append Current Output Group to File" . comint-append-output-to-file))
+    (define-key map [menu-bar inout write-output]
+      '("Write Current Output Group to File" . comint-write-output))
+    (define-key map [menu-bar inout next-prompt]
+      '("Forward Output Group" . comint-next-prompt))
+    (define-key map [menu-bar inout previous-prompt]
+      '("Backward Output Group" . comint-previous-prompt))
+    (define-key map [menu-bar inout show-maximum-output]
+      '("Show Maximum Output" . comint-show-maximum-output))
+    (define-key map [menu-bar inout show-output]
+      '("Show Current Output Group" . comint-show-output))
+    (define-key map [menu-bar inout kill-input]
+      '("Kill Current Input" . comint-kill-input))
+    (define-key map [menu-bar inout copy-input]
+      '("Copy Old Input" . comint-insert-input))
+    (define-key map [menu-bar inout forward-matching-history]
+      '("Forward Matching Input..." . comint-forward-matching-input))
+    (define-key map [menu-bar inout backward-matching-history]
+      '("Backward Matching Input..." . comint-backward-matching-input))
+    (define-key map [menu-bar inout next-matching-history]
+      '("Next Matching Input..." . comint-next-matching-input))
+    (define-key map [menu-bar inout previous-matching-history]
+      '("Previous Matching Input..." . comint-previous-matching-input))
+    (define-key map [menu-bar inout next-matching-history-from-input]
+      '("Next Matching Current Input" . comint-next-matching-input-from-input))
+    (define-key map [menu-bar inout previous-matching-history-from-input]
+      '("Previous Matching Current Input" . comint-previous-matching-input-from-input))
+    (define-key map [menu-bar inout next-history]
+      '("Next Input" . comint-next-input))
+    (define-key map [menu-bar inout previous-history]
+      '("Previous Input" . comint-previous-input))
+    (define-key map [menu-bar inout list-history]
+      '("List Input History" . comint-dynamic-list-input-ring))
+    (define-key map [menu-bar inout expand-history]
+      '("Expand History Before Point" . comint-replace-by-expanded-history))
+    ;; Signals
+    (let ((signals-map (make-sparse-keymap "Signals")))
+      (define-key map [menu-bar signals] (cons "Signals" signals-map))
+      (define-key signals-map [eof]   '("EOF"   . comint-send-eof))
+      (define-key signals-map [kill]  '("KILL"  . comint-kill-subjob))
+      (define-key signals-map [quit]  '("QUIT"  . comint-quit-subjob))
+      (define-key signals-map [cont]  '("CONT"  . comint-continue-subjob))
+      (define-key signals-map [stop]  '("STOP"  . comint-stop-subjob))
+      (define-key signals-map [break] '("BREAK" . comint-interrupt-subjob)))
+    ;; Put them in the menu bar:
+    (setq menu-bar-final-items (append '(completion inout signals)
+                                       menu-bar-final-items))
+    map))
 
 ;; Fixme: Is this still relevant?
 (defvar comint-ptyp t
@@ -548,114 +644,6 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
   ;; This behavior is not useful in comint buffers, and is annoying
   (set (make-local-variable 'next-line-add-newlines) nil))
 
-(if comint-mode-map
-    nil
-  ;; Keys:
-  (setq comint-mode-map (make-sparse-keymap))
-  (define-key comint-mode-map "\ep" 'comint-previous-input)
-  (define-key comint-mode-map "\en" 'comint-next-input)
-  (define-key comint-mode-map [C-up] 'comint-previous-input)
-  (define-key comint-mode-map [C-down] 'comint-next-input)
-  (define-key comint-mode-map "\er" 'comint-previous-matching-input)
-  (define-key comint-mode-map "\es" 'comint-next-matching-input)
-  (define-key comint-mode-map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input)
-  (define-key comint-mode-map [?\C-c ?\M-s] 'comint-next-matching-input-from-input)
-  (define-key comint-mode-map "\e\C-l" 'comint-show-output)
-  (define-key comint-mode-map "\C-m" 'comint-send-input)
-  (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
-  (define-key comint-mode-map "\C-c " 'comint-accumulate)
-  (define-key comint-mode-map "\C-c\C-x" 'comint-get-next-from-history)
-  (define-key comint-mode-map "\C-c\C-a" 'comint-bol-or-process-mark)
-  (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
-  (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
-  (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
-  (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)
-  (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)
-  (define-key comint-mode-map "\C-c\C-m" 'comint-insert-input)
-  (define-key comint-mode-map "\C-c\C-o" 'comint-delete-output)
-  (define-key comint-mode-map "\C-c\C-r" 'comint-show-output)
-  (define-key comint-mode-map "\C-c\C-e" 'comint-show-maximum-output)
-  (define-key comint-mode-map "\C-c\C-l" 'comint-dynamic-list-input-ring)
-  (define-key comint-mode-map "\C-c\C-n" 'comint-next-prompt)
-  (define-key comint-mode-map "\C-c\C-p" 'comint-previous-prompt)
-  (define-key comint-mode-map "\C-c\C-d" 'comint-send-eof)
-  (define-key comint-mode-map "\C-c\C-s" 'comint-write-output)
-  (define-key comint-mode-map "\C-c." 'comint-insert-previous-argument)
-  ;; Mouse Buttons:
-  (define-key comint-mode-map [mouse-2] 'comint-mouse-insert-input)
-  ;; Menu bars:
-  ;; completion:
-  (define-key comint-mode-map [menu-bar completion]
-    (cons "Complete" (make-sparse-keymap "Complete")))
-  (define-key comint-mode-map [menu-bar completion complete-expand]
-    '("Expand File Name" . comint-replace-by-expanded-filename))
-  (define-key comint-mode-map [menu-bar completion complete-listing]
-    '("File Completion Listing" . comint-dynamic-list-filename-completions))
-  (define-key comint-mode-map [menu-bar completion complete-file]
-    '("Complete File Name" . comint-dynamic-complete-filename))
-  (define-key comint-mode-map [menu-bar completion complete]
-    '("Complete Before Point" . comint-dynamic-complete))
-  ;; Input history:
-  (define-key comint-mode-map [menu-bar inout]
-    (cons "In/Out" (make-sparse-keymap "In/Out")))
-  (define-key comint-mode-map [menu-bar inout delete-output]
-    '("Delete Current Output Group" . comint-delete-output))
-  (define-key comint-mode-map [menu-bar inout append-output-to-file]
-    '("Append Current Output Group to File" . comint-append-output-to-file))
-  (define-key comint-mode-map [menu-bar inout write-output]
-    '("Write Current Output Group to File" . comint-write-output))
-  (define-key comint-mode-map [menu-bar inout next-prompt]
-    '("Forward Output Group" . comint-next-prompt))
-  (define-key comint-mode-map [menu-bar inout previous-prompt]
-    '("Backward Output Group" . comint-previous-prompt))
-  (define-key comint-mode-map [menu-bar inout show-maximum-output]
-    '("Show Maximum Output" . comint-show-maximum-output))
-  (define-key comint-mode-map [menu-bar inout show-output]
-    '("Show Current Output Group" . comint-show-output))
-  (define-key comint-mode-map [menu-bar inout kill-input]
-    '("Kill Current Input" . comint-kill-input))
-  (define-key comint-mode-map [menu-bar inout copy-input]
-    '("Copy Old Input" . comint-insert-input))
-  (define-key comint-mode-map [menu-bar inout forward-matching-history]
-    '("Forward Matching Input..." . comint-forward-matching-input))
-  (define-key comint-mode-map [menu-bar inout backward-matching-history]
-    '("Backward Matching Input..." . comint-backward-matching-input))
-  (define-key comint-mode-map [menu-bar inout next-matching-history]
-    '("Next Matching Input..." . comint-next-matching-input))
-  (define-key comint-mode-map [menu-bar inout previous-matching-history]
-    '("Previous Matching Input..." . comint-previous-matching-input))
-  (define-key comint-mode-map [menu-bar inout next-matching-history-from-input]
-    '("Next Matching Current Input" . comint-next-matching-input-from-input))
-  (define-key comint-mode-map [menu-bar inout previous-matching-history-from-input]
-    '("Previous Matching Current Input" . comint-previous-matching-input-from-input))
-  (define-key comint-mode-map [menu-bar inout next-history]
-    '("Next Input" . comint-next-input))
-  (define-key comint-mode-map [menu-bar inout previous-history]
-    '("Previous Input" . comint-previous-input))
-  (define-key comint-mode-map [menu-bar inout list-history]
-    '("List Input History" . comint-dynamic-list-input-ring))
-  (define-key comint-mode-map [menu-bar inout expand-history]
-    '("Expand History Before Point" . comint-replace-by-expanded-history))
-  ;; Signals
-  (define-key comint-mode-map [menu-bar signals]
-    (cons "Signals" (make-sparse-keymap "Signals")))
-  (define-key comint-mode-map [menu-bar signals eof]
-    '("EOF" . comint-send-eof))
-  (define-key comint-mode-map [menu-bar signals kill]
-    '("KILL" . comint-kill-subjob))
-  (define-key comint-mode-map [menu-bar signals quit]
-    '("QUIT" . comint-quit-subjob))
-  (define-key comint-mode-map [menu-bar signals cont]
-    '("CONT" . comint-continue-subjob))
-  (define-key comint-mode-map [menu-bar signals stop]
-    '("STOP" . comint-stop-subjob))
-  (define-key comint-mode-map [menu-bar signals break]
-    '("BREAK" . comint-interrupt-subjob))
-  ;; Put them in the menu bar:
-  (setq menu-bar-final-items (append '(completion inout signals)
-                                     menu-bar-final-items))
-  )
-
 (defun comint-check-proc (buffer)
   "Return t if there is a living process associated w/buffer BUFFER.
 Living means the status is `open', `run', or `stop'.
@@ -798,9 +786,10 @@ buffer.  The hook `comint-exec-hook' is run after each exec."
         (set-process-coding-system proc decoding encoding))
     proc))
 
-(defun comint-insert-input ()
+(defun comint-insert-input (&optional event)
   "In a Comint buffer, set the current input to the previous input at point."
-  (interactive)
+  (interactive (list last-input-event))
+  (if event (mouse-set-point event))
   (let ((pos (point)))
     (if (not (eq (get-char-property pos 'field) 'input))
         ;; No input at POS, fall back to the global definition.
@@ -818,13 +807,7 @@ buffer.  The hook `comint-exec-hook' is run after each exec."
       ;; Insert the input at point
       (insert (buffer-substring-no-properties
                (previous-single-char-property-change (1+ pos) 'field)
-               (next-single-char-property-change pos 'field))))))
-
-(defun comint-mouse-insert-input (event)
-  "In a Comint buffer, set the current input to the previous input you click on."
-  (interactive "e")
-  (mouse-set-point event)
-  (comint-insert-input)) 
+               (next-single-char-property-change pos 'field)))))) 
 
 
 ;; Input history processing in a buffer
@@ -1734,7 +1717,7 @@ Make backspaces delete the previous character."
                      (1- prompt-start) prompt-start 'read-only 'fence))
                 (add-text-properties
                  prompt-start (point)
-                 '(read-only t rear-non-sticky t front-sticky (read-only))))
+                 '(read-only t rear-nonsticky t front-sticky (read-only))))
               (unless (and (bolp) (null comint-last-prompt-overlay))
                 ;; Need to create or move the prompt overlay (in the case
                 ;; where there is no prompt ((bolp) == t), we still do
@@ -2136,8 +2119,8 @@ This command also kills the pending input
 between the process mark and point.
 
 WARNING: if there is no current subjob, you can end up suspending
-the top-level process running in the buffer. If you accidentally do
-this, use \\[comint-continue-subjob] to resume the process. (This
+the top-level process running in the buffer.  If you accidentally do
+this, use \\[comint-continue-subjob] to resume the process.  (This
 is not a problem with most shells, since they ignore this signal.)"
   (interactive)
   (comint-skip-input)
@@ -2357,9 +2340,9 @@ preceding newline is removed."
 
 (defun comint-kill-whole-line (&optional arg)
   "Kill current line, ignoring read-only and field properties.
-With prefix arg, kill that many lines starting from the current line.
+With prefix ARG, kill that many lines starting from the current line.
 If arg is negative, kill backward.  Also kill the preceding newline,
-instead of the trailing one.  \(This is meant to make C-x z work well
+instead of the trailing one.  \(This is meant to make \\[repeat] work well
 with negative arguments.)
 If arg is zero, kill current line but exclude the trailing newline.
 The read-only status of newlines is updated with `comint-update-fence',
@@ -2505,7 +2488,7 @@ Provides a default, if there is one, and returns the result filename.
 
 See `comint-source-default' for more on determining defaults.
 
-PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
+PROMPT is the prompt string.  PREV-DIR/FILE is the (directory . file) pair
 from the last source processing command.  SOURCE-MODES is a list of major
 modes used to determine what file buffers contain source files.  (These
 two arguments are used for determining defaults).  If MUSTMATCH-P is true,
@@ -3503,5 +3486,5 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
 
 (provide 'comint)
 
-;;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164
+;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164
 ;;; comint.el ends here
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index 0a7f1a1950a..c945a6a7221 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -1,6 +1,7 @@
 ;;; diff-mode.el --- a mode for viewing/editing context diffs
 
-;; Copyright (C) 1998,1999,2000,01,02,03,2004  Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;;           Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
 ;; Keywords: convenience patch diff
@@ -171,75 +172,73 @@ when editing big diffs)."
 
 (defface diff-header-face
   '((((class color) (min-colors 88) (background light))
-     (:background "grey85"))
+     :background "grey85")
     (((class color) (min-colors 88) (background dark))
-     (:background "grey45"))
+     :background "grey45")
     (((class color) (background light))
-     (:foreground "blue1" :weight bold))
+     :foreground "blue1" :weight bold)
     (((class color) (background dark))
-     (:foreground "green" :weight bold))
-    (t (:weight bold)))
+     :foreground "green" :weight bold)
+    (t :weight bold))
   "`diff-mode' face inherited by hunk and index header faces.")
 (defvar diff-header-face 'diff-header-face)
 
 (defface diff-file-header-face
   '((((class color) (min-colors 88) (background light))
-     (:background "grey70" :weight bold))
+     :background "grey70" :weight bold)
     (((class color) (min-colors 88) (background dark))
-     (:background "grey60" :weight bold))
+     :background "grey60" :weight bold)
     (((class color) (background light))
-     (:foreground "yellow" :weight bold))
+     :foreground "yellow" :weight bold)
     (((class color) (background dark))
-     (:foreground "cyan" :weight bold))
-    (t (:weight bold)))                 ; :height 1.3
+     :foreground "cyan" :weight bold)
+    (t :weight bold))                   ; :height 1.3
   "`diff-mode' face used to highlight file header lines.")
 (defvar diff-file-header-face 'diff-file-header-face)
 
 (defface diff-index-face
-  '((t (:inherit diff-file-header-face)))
+  '((t :inherit diff-file-header-face))
   "`diff-mode' face used to highlight index header lines.")
 (defvar diff-index-face 'diff-index-face)
 
 (defface diff-hunk-header-face
-  '((t (:inherit diff-header-face)))
+  '((t :inherit diff-header-face))
   "`diff-mode' face used to highlight hunk header lines.")
 (defvar diff-hunk-header-face 'diff-hunk-header-face)
 
 (defface diff-removed-face
-  '((t (:inherit diff-changed-face)))
+  '((t :inherit diff-changed-face))
   "`diff-mode' face used to highlight removed lines.")
 (defvar diff-removed-face 'diff-removed-face)
 
 (defface diff-added-face
-  '((t (:inherit diff-changed-face)))
+  '((t :inherit diff-changed-face))
   "`diff-mode' face used to highlight added lines.")
 (defvar diff-added-face 'diff-added-face)
 
 (defface diff-changed-face
   '((((type tty pc) (class color) (background light))
-     (:foreground "magenta" :weight bold :slant italic))
+     :foreground "magenta" :weight bold :slant italic)
     (((type tty pc) (class color) (background dark))
-     (:foreground "yellow" :weight bold :slant italic))
-    (t ()))
+     :foreground "yellow" :weight bold :slant italic))
   "`diff-mode' face used to highlight changed lines.")
 (defvar diff-changed-face 'diff-changed-face)
 
 (defface diff-function-face
-  '((t (:inherit diff-context-face)))
+  '((t :inherit diff-context-face))
   "`diff-mode' face used to highlight function names produced by \"diff -p\".")
 (defvar diff-function-face 'diff-function-face)
 
 (defface diff-context-face
   '((((class color) (background light))
-     (:foreground "grey50"))
+     :foreground "grey50")
     (((class color) (background dark))
-     (:foreground "grey70"))
-    (t ))
+     :foreground "grey70"))
   "`diff-mode' face used to highlight context and other side-information.")
 (defvar diff-context-face 'diff-context-face)
 
 (defface diff-nonexistent-face
-  '((t (:inherit diff-file-header-face)))
+  '((t :inherit diff-file-header-face))
   "`diff-mode' face used to highlight nonexistent files in recursive diffs.")
 (defvar diff-nonexistent-face 'diff-nonexistent-face)
 
@@ -1255,7 +1254,7 @@ For use in `add-log-current-defun-function'."
   (save-excursion
     (when (looking-at diff-hunk-header-re)
       (forward-line 1)
-      (while (and (looking-at " ") (not (zerop (forward-line 1))))))
+      (re-search-forward "^[^ ]" nil t))
     (destructuring-bind (buf line-offset pos src dst &optional switched)
         (diff-find-source-location)
       (beginning-of-line)
@@ -1355,5 +1354,5 @@ For use in `add-log-current-defun-function'."
 ;; use `combine-after-change-calls' to minimize the slowdown of font-lock.
 ;;
 
-;;; arch-tag: 2571d7ff-bc28-4cf9-8585-42e21890be66
+;; arch-tag: 2571d7ff-bc28-4cf9-8585-42e21890be66
 ;;; diff-mode.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 825df2526c0..18913893642 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1152,7 +1152,7 @@ of FORM by signalling the error at compile-time."
               (numberp (nth 1 form)))
          (list 'forward-word (eval (- (nth 1 form)))))
         ((= 1 (safe-length form))
-         '(forward-char -1))
+         '(forward-word -1))
         (t form)))
 
 (put 'char-before 'byte-optimizer 'byte-optimize-char-before)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 700fc5f80a8..f4364c38e8d 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1,6 +1,7 @@
 ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
 
-;; Copyright (C) 1985,86,1999,2000,01,03,2004  Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2003, 2004
+;;           Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: lisp, languages
@@ -1153,7 +1154,8 @@ paragraph of it that point is in, preserving the comment's indentation
 and initial semicolons."
   (interactive "P")
   (or (fill-comment-paragraph justify)
-      ;; Point is on a program line (a line no comment); we are interested
+      ;; Since fill-comment-paragraph returned nil, that means we're not in
+      ;; a comment: Point is on a program line; we are interested
       ;; particularly in docstring lines.
       ;;
       ;; We bind `paragraph-start' and `paragraph-separate' temporarily.  They
@@ -1182,7 +1184,7 @@ and initial semicolons."
       ;; The `fill-column' is temporarily bound to
       ;; `emacs-lisp-docstring-fill-column' if that value is an integer.
       (let ((paragraph-start (concat paragraph-start
-                                     "\\|\\s-*\\([\(;:\"]\\|`\(\\)"))
+                                     "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)"))
             (paragraph-separate
              (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
             (fill-column (if (integerp emacs-lisp-docstring-fill-column)
@@ -1227,5 +1229,5 @@ means don't indent that line."
 
 (provide 'lisp-mode)
 
-;;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
+;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
 ;;; lisp-mode.el ends here
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 63d9f759ceb..87b3fcff96c 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -75,17 +75,19 @@ The place mark goes is the same place \\[forward-sexp] would
 move to with the same argument.
 If this command is repeated, it marks the next ARG sexps after the ones
 already marked."
-  (interactive "p")
+  (interactive "P")
   (cond ((and (eq last-command this-command) (mark t))
+         (setq arg (if arg (prefix-numeric-value arg)
+                     (if (> (mark) (point)) 1 -1)))
          (set-mark
           (save-excursion
            (goto-char (mark))
-           (forward-sexp (or arg 1))
+           (forward-sexp arg)
            (point))))
         (t
          (push-mark
           (save-excursion
-            (forward-sexp (or arg 1))
+            (forward-sexp (prefix-numeric-value arg))
             (point))
           nil t))))
 
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index f5b68a3c243..2a2777d102b 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1324,6 +1324,12 @@ HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'."
           (add-text-properties start end (cddr val))
           (setq val (cadr val)))
         (cond
+         ((not (or val (eq override t)))
+          ;; If `val' is nil, don't do anything.  It is important to do it
+          ;; explicitly, because when adding nil via things like
+          ;; font-lock-append-text-property, the property is actually
+          ;; changed from <face> to (<face>) which is undesirable.  --Stef
+          nil)
          ((not override)
           ;; Cannot override existing fontification.
           (or (text-property-not-all start end 'face nil)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 907ad5f3411..292d36ce9e1 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,55 @@
+2004-10-13  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * message.el (message-tokenize-header): Fix 2004-09-06 change
+        which used point-min in the wrong place.
+
+2004-10-12  Simon Josefsson  <jas@extundo.com>
+
+        * net/tls.el (tls-certtool-program): New variable.
+        (tls-certificate-information): New function, based on
+        ssl-certificate-information.
+
+2004-10-10  Reiner Steib  <Reiner.Steib@gmx.de>
+
+        * gnus-sum.el: Mention that multibyte characters don't work as marks.
+
+        * gnus.el (message-y-or-n-p): Autoload.
+
+        * pop3.el (pop3-maildrop, pop3-mailhost, pop3-port)
+        (pop3-password-required, pop3-authentication-scheme)
+        (pop3-leave-mail-on-server): Made customizable.
+        (pop3): New custom group.
+        (pop3-retr): Remove `sleep-for' statements.
+        Suggested by Dave Love <fx@gnu.org>.
+
+        * nnheader.el (nnheader-read-timeout): Explain 1.0 timeout for
+        Windows/DOS.
+
+        * imap.el (imap-parse-flag-list, imap-parse-body-extension)
+        (imap-parse-body): Fix incorrect use of `assert'.  Suggested by
+        Dave Love <fx@gnu.org>.
+
+        * mml.el (mml-minibuffer-read-disposition): Require match.
+        Suggested by Dave Love <fx@gnu.org>.
+
+2004-10-06  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * gnus-group.el (gnus-update-group-mark-positions):
+        * gnus-sum.el (gnus-update-summary-mark-positions):
+        * message.el (message-check-news-body-syntax):
+        * gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead
+        of string-as-multibyte.
+
+        * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq.
+
+2004-10-05  Juri Linkov  <juri@jurta.org>
+
+        * gnus-group.el (gnus-update-group-mark-positions):
+        * gnus-sum.el (gnus-update-summary-mark-positions):
+        * message.el (message-check-news-body-syntax):
+        * gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert
+        8-bit unibyte values to a multibyte string for search functions.
+
 2004-10-01  Katsumi Yamaoka  <yamaoka@jpl.org>
 
         * gnus-sum.el (gnus-summary-toggle-header): Make it work even if
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 9f7b259e066..435acb1d6c2 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1046,7 +1046,8 @@ The following commands are available:
       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
       (goto-char (point-min))
       (setq gnus-group-mark-positions
-            (list (cons 'process (and (search-forward "\200" nil t)
+            (list (cons 'process (and (search-forward
+                                       (mm-string-as-multibyte "\200") nil t)
                                       (- (point) 2))))))))
 
 (defun gnus-mouse-pick-group (e)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 33531e7f8a4..7dcef4b813b 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1534,7 +1534,8 @@ The source file has to be in the Emacs load path."
     ;; Remove any control chars - they seem to cause trouble for some
     ;; mailers.  (Byte-compiled output from the stuff above.)
     (goto-char point)
-    (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t)
+    (while (re-search-forward (mm-string-as-multibyte
+                               "[\000-\010\013-\037\200-\237]") nil t)
       (replace-match (format "\\%03o" (string-to-char (match-string 0)))
                      t t))))
 
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 40278da4716..42c699ef552 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -428,6 +428,9 @@ this variable specifies group names."
                          (cons :value ("" "") regexp (repeat string))
                          (sexp :value nil))))
 
+;; FIXME: Although the custom type is `character' for the following variables,
+;; using multibyte characters (Latin-1, UTF-8) doesn't work.  -- rs
+
 (defcustom gnus-unread-mark ?           ;Whitespace
   "*Mark used for unread articles."
   :group 'gnus-summary-marks
@@ -3231,20 +3234,24 @@ buffer that was in action when the last article was fetched."
            [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
            0 nil t 128 t nil "" nil 1)
           (goto-char (point-min))
-          (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
-                                             (- (point) (point-min) 1)))))
+          (setq pos (list (cons 'unread
+                                (and (search-forward
+                                      (mm-string-as-multibyte "\200") nil t)
+                                     (- (point) (point-min) 1)))))
           (goto-char (point-min))
-          (push (cons 'replied (and (search-forward "\201" nil t)
+          (push (cons 'replied (and (search-forward
+                                     (mm-string-as-multibyte "\201") nil t)
                                     (- (point) (point-min) 1)))
                 pos)
           (goto-char (point-min))
-          (push (cons 'score (and (search-forward "\202" nil t)
+          (push (cons 'score (and (search-forward
+                                   (mm-string-as-multibyte "\202") nil t)
                                   (- (point) (point-min) 1)))
                 pos)
           (goto-char (point-min))
-          (push (cons 'download
-                      (and (search-forward "\203" nil t)
-                           (- (point) (point-min) 1)))
+          (push (cons 'download (and (search-forward
+                                      (mm-string-as-multibyte "\203") nil t)
+                                     (- (point) (point-min) 1)))
                 pos)))
       (setq gnus-summary-mark-positions pos))))
 
@@ -6009,8 +6016,7 @@ the subject line on."
       ;; Remove list identifiers from subject.
       (when gnus-list-identifiers
         (let ((gnus-newsgroup-headers (list header)))
-          (gnus-summary-remove-list-identifiers)
-          (setq header (car gnus-newsgroup-headers))))
+          (gnus-summary-remove-list-identifiers)))
       (when old-header
         (mail-header-set-number header (mail-header-number old-header)))
       (setq gnus-newsgroup-sparse
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 979ee2a7c24..bff1c3bba2f 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -34,6 +34,7 @@
 (require 'wid-edit)
 (require 'mm-util)
 (require 'nnheader)
+(autoload 'message-y-or-n-p "message" nil nil 'macro)
 
 (defgroup gnus nil
   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el
index 754473fa8ec..326c998c5d9 100644
--- a/lisp/gnus/imap.el
+++ b/lisp/gnus/imap.el
@@ -2421,7 +2421,7 @@ Return nil if no complete line has arrived."
 
 (defun imap-parse-flag-list ()
   (let (flag-list start)
-    (assert (eq (char-after) ?\() t "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
     (while (and (not (eq (char-after) ?\)))
                 (setq start (progn
                               (imap-forward)
@@ -2430,7 +2430,7 @@ Return nil if no complete line has arrived."
                               (point)))
                 (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
       (push (buffer-substring start (point)) flag-list))
-    (assert (eq (char-after) ?\)) t "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
     (imap-forward)
     (nreverse flag-list)))
 
@@ -2515,7 +2515,7 @@ Return nil if no complete line has arrived."
         (while (eq (char-after) ?\ )
           (imap-forward)
           (push (imap-parse-body-extension) b-e))
-        (assert (eq (char-after) ?\)) t "In imap-parse-body-extension")
+        (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
         (imap-forward)
         (nreverse b-e))
     (or (imap-parse-number)
@@ -2641,7 +2641,7 @@ Return nil if no complete line has arrived."
                 (push (and (imap-parse-nil) nil) body))
               (setq body
                     (append (imap-parse-body-ext) body))) ;; body-ext-...
-            (assert (eq (char-after) ?\)) t "In imap-parse-body")
+            (assert (eq (char-after) ?\)) nil "In imap-parse-body")
             (imap-forward)
             (nreverse body))
 
@@ -2701,7 +2701,7 @@ Return nil if no complete line has arrived."
           (push (imap-parse-nstring) body) ;; body-fld-md5
           (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
 
-        (assert (eq (char-after) ?\)) t "In imap-parse-body 2")
+        (assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
         (imap-forward)
         (nreverse body)))))
 
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 8e5edbc048a..c9d05d1a0fe 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1615,11 +1615,11 @@ is used by default."
   (if (not header)
       nil
     (let ((regexp (format "[%s]+" (or separator ",")))
-          (beg (point-min))
           (first t)
-          quoted elems paren)
+          beg quoted elems paren)
       (with-temp-buffer
         (mm-enable-multibyte)
+        (setq beg (point-min))
         (insert header)
         (goto-char (point-min))
         (while (not (eobp))
@@ -4399,7 +4399,9 @@ Otherwise, generate and save a value for `canlock-password' first."
              nil))))
    ;; Check for control characters.
    (message-check 'control-chars
-     (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)
+     (if (re-search-forward
+          (mm-string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
+          nil t)
          (y-or-n-p
           "The article contains control characters.  Really post? ")
        t))
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 1843cf2068d..221e1712611 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -945,8 +945,7 @@ See Info node `(emacs-mime)Composing'.
                         "attachment")))
          (disposition (completing-read "Disposition: "
                                        '(("attachment") ("inline") (""))
-                                       nil
-                                       nil)))
+                                       nil t)))
     (if (not (equal disposition ""))
         disposition
       default)))
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 1b6ec636734..7df5ecae205 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -74,7 +74,15 @@ Integer values will in effect be rounded up to the nearest multiple of
 (defvar nnheader-read-timeout
   (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
                     (symbol-name system-type))
-      1.0                               ; why?
+      ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
+      ;;
+      ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS.
+      ;;
+      ;; There should probably be a runtime test to determine the timing
+      ;; resolution, or a primitive to report it.  I don't know off-hand
+      ;; what's possible.  Perhaps better, maybe the Windows/DOS primitive
+      ;; could round up non-zero timeouts to a minimum of 1.0?
+      1.0
     0.1)
   "How long nntp should wait between checking for the end of output.
 Shorter values mean quicker response, but are more CPU intensive.")
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 567ab24e004..e288f6cace2 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -37,25 +37,56 @@
 
 (require 'mail-utils)
 
-(defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)
-  "*POP3 maildrop.")
-(defvar pop3-mailhost (or (getenv "MAILHOST") nil)
-  "*POP3 mailhost.")
-(defvar pop3-port 110
-  "*POP3 port.")
-
-(defvar pop3-password-required t
-  "*Non-nil if a password is required when connecting to POP server.")
+(defgroup pop3 nil
+  "Post Office Protocol"
+  :group 'mail
+  :group 'mail-source)
+
+(defcustom pop3-maildrop (or (user-login-name)
+                             (getenv "LOGNAME")
+                             (getenv "USER"))
+  "*POP3 maildrop."
+  :version "21.4" ;; Oort Gnus
+  :type 'string
+  :group 'pop3)
+
+(defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch
+                             "pop3")
+  "*POP3 mailhost."
+  :version "21.4" ;; Oort Gnus
+  :type 'string
+  :group 'pop3)
+
+(defcustom pop3-port 110
+  "*POP3 port."
+  :version "21.4" ;; Oort Gnus
+  :type 'number
+  :group 'pop3)
+
+(defcustom pop3-password-required t
+  "*Non-nil if a password is required when connecting to POP server."
+  :version "21.4" ;; Oort Gnus
+  :type 'boolean
+  :group 'pop3)
+
+;; Should this be customizable?
 (defvar pop3-password nil
   "*Password to use when connecting to POP server.")
 
-(defvar pop3-authentication-scheme 'pass
+(defcustom pop3-authentication-scheme 'pass
   "*POP3 authentication scheme.
 Defaults to 'pass, for the standard USER/PASS authentication.  Other valid
-values are 'apop.")
-
-(defvar pop3-leave-mail-on-server nil
-  "*Non-nil if the mail is to be left on the POP server after fetching.")
+values are 'apop."
+  :version "21.4" ;; Oort Gnus
+  :type '(choice (const :tag "USER/PASS" pass)
+                 (const :tag "APOP" apop))
+  :group 'pop3)
+
+(defcustom pop3-leave-mail-on-server nil
+  "*Non-nil if the mail is to be left on the POP server after fetching."
+  :version "21.4" ;; Oort Gnus
+  :type 'boolean
+  :group 'pop3)
 
 (defvar pop3-timestamp nil
   "Timestamp returned when initially connected to the POP server.
@@ -71,8 +102,7 @@ Used for APOP authentication.")
          (crashbuf (get-buffer-create " *pop3-retr*"))
          (n 1)
          message-count
-         (pop3-password pop3-password)
-         )
+         (pop3-password pop3-password))
     ;; for debugging only
     (if pop3-debug (switch-to-buffer (process-buffer process)))
     ;; query for password
@@ -114,8 +144,7 @@ Used for APOP authentication.")
   "Return the number of messages in the maildrop."
   (let* ((process (pop3-open-server pop3-mailhost pop3-port))
          message-count
-         (pop3-password pop3-password)
-         )
+         (pop3-password pop3-password))
     ;; for debugging only
     (if pop3-debug (switch-to-buffer (process-buffer process)))
     ;; query for password
@@ -159,15 +188,14 @@ Returns the process associated with the connection."
     (insert output)))
 
 (defun pop3-send-command (process command)
-    (set-buffer (process-buffer process))
-    (goto-char (point-max))
-;;    (if (= (aref command 0) ?P)
-;;      (insert "PASS <omitted>\r\n")
-;;      (insert command "\r\n"))
-    (setq pop3-read-point (point))
-    (goto-char (point-max))
-    (process-send-string process (concat command "\r\n"))
-    )
+  (set-buffer (process-buffer process))
+  (goto-char (point-max))
+  ;; (if (= (aref command 0) ?P)
+  ;;     (insert "PASS <omitted>\r\n")
+  ;;   (insert command "\r\n"))
+  (setq pop3-read-point (point))
+  (goto-char (point-max))
+  (process-send-string process (concat command "\r\n")))
 
 (defun pop3-read-response (process &optional return)
   "Read the response from the server.
@@ -355,27 +383,15 @@ This function currently does nothing.")
       (while (not (re-search-forward "^\\.\r\n" nil t))
         ;; Fixme: Shouldn't depend on nnheader.
         (nnheader-accept-process-output process)
-        ;; bill@att.com ... to save wear and tear on the heap
-        ;; uncommented because the condensed version below is a problem for
-        ;; some.
-        (if (> (buffer-size)  20000) (sleep-for 1))
-        (if (> (buffer-size)  50000) (sleep-for 1))
-        (if (> (buffer-size) 100000) (sleep-for 1))
-        (if (> (buffer-size) 200000) (sleep-for 1))
-        (if (> (buffer-size) 500000) (sleep-for 1))
-        ;; bill@att.com
-        ;; condensed into:
-        ;; (sometimes causes problems for really large messages.)
-;       (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000)))
         (goto-char start))
       (setq pop3-read-point (point-marker))
-;; this code does not seem to work for some POP servers...
-;; and I cannot figure out why not.
-;      (goto-char (match-beginning 0))
-;      (backward-char 2)
-;      (if (not (looking-at "\r\n"))
-;         (insert "\r\n"))
-;      (re-search-forward "\\.\r\n")
+      ;; this code does not seem to work for some POP servers...
+      ;; and I cannot figure out why not.
+      ;;      (goto-char (match-beginning 0))
+      ;;      (backward-char 2)
+      ;;      (if (not (looking-at "\r\n"))
+      ;;          (insert "\r\n"))
+      ;;      (re-search-forward "\\.\r\n")
       (goto-char (match-beginning 0))
       (setq end (point-marker))
       (pop3-clean-region start end)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index d193ad344f5..57b0b39767e 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -552,9 +552,15 @@ it is displayed along with the global value."
                     (forward-line 1)
                   (forward-sexp 1)
                   (delete-region (point) (progn (end-of-line) (point)))
-                  (insert " value is shown below.\n\n")
                   (save-excursion
-                    (insert "\n\nValue:"))))
+                    (insert "\n\nValue:")
+                    (set (make-local-variable 'help-button-cache)
+                         (point-marker)))
+                  (insert " value is shown ")
+                  (insert-button "below"
+                                 'action help-button-cache
+                                 'help-echo "mouse-2, RET: show value")
+                  (insert ".\n\n")))
               ;; Add a note for variables that have been make-var-buffer-local.
               (when (and (local-variable-if-set-p variable)
                          (or (not (local-variable-p variable))
diff --git a/lisp/help.el b/lisp/help.el
index bf0df4358a7..5a2867bdc18 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -111,6 +111,9 @@
 
 (define-key help-map "q" 'help-quit)
 
+;; insert-button makes the action nil if it is not store somewhere
+(defvar help-button-cache nil)
+
 
 (defun help-quit ()
   "Just exit from the Help command's command loop."
@@ -655,32 +658,42 @@ whose documentation describes the minor mode."
                     (lambda (a b) (string-lessp (car a) (car b)))))
         (when minor-modes
           (princ "Summary of minor modes:\n")
-          (dolist (mode minor-modes)
-            (let ((pretty-minor-mode (nth 0 mode))
-                  (indicator (nth 2 mode)))
-              (princ (format "  %s minor mode (%s):\n"
-                             pretty-minor-mode
-                             (if indicator
-                                 (format "indicator%s" indicator)
-                               "no indicator")))))
+          (make-local-variable 'help-button-cache)
+          (with-current-buffer standard-output
+            (dolist (mode minor-modes)
+              (let ((pretty-minor-mode (nth 0 mode))
+                    (mode-function (nth 1 mode))
+                    (indicator (nth 2 mode)))
+                (add-text-properties 0 (length pretty-minor-mode)
+                                     '(face bold) pretty-minor-mode)
+                (save-excursion
+                  (goto-char (point-max))
+                  (princ "\n\f\n")
+                  (push (point-marker) help-button-cache)
+                  ;; Document the minor modes fully.
+                  (insert pretty-minor-mode)
+                  (princ (format " minor mode (%s):\n"
+                                 (if indicator
+                                     (format "indicator%s" indicator)
+                                   "no indicator")))
+                  (princ (documentation mode-function)))
+                (princ "  ")
+                (insert-button pretty-minor-mode
+                               'action (car help-button-cache)
+                               'help-echo "mouse-2, RET: show full information")
+                (princ (format " minor mode (%s):\n"
+                               (if indicator
+                                   (format "indicator%s" indicator)
+                                 "no indicator"))))))
           (princ "\n(Full information about these minor modes
 follows the description of the major mode.)\n\n"))
         ;; Document the major mode.
-        (princ mode-name)
+        (let ((mode mode-name))
+          (with-current-buffer standard-output
+            (insert mode)
+            (add-text-properties (- (point) (length mode)) (point) '(face bold))))
         (princ " mode:\n")
-        (princ (documentation major-mode))
-        ;; Document the minor modes fully.
-        (dolist (mode minor-modes)
-          (let ((pretty-minor-mode (nth 0 mode))
-                (mode-function (nth 1 mode))
-                (indicator (nth 2 mode)))
-            (princ "\n\f\n")
-            (princ (format "%s minor mode (%s):\n"
-                           pretty-minor-mode
-                           (if indicator
-                               (format "indicator%s" indicator)
-                             "no indicator")))
-            (princ (documentation mode-function)))))
+        (princ (documentation major-mode)))
       (print-help-return-message))))
 
 
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 1c82fcacf34..6859c0c74c7 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -317,9 +317,12 @@ The function in this variable is called when selecting a normal index-item.")
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; Return the current/previous sexp and the location of the sexp (its
-;; beginning) without moving the point.
+;; FIXME: This is the only imenu-example-* definition that's actually used,
+;; and it seems to only be used by cperl-mode.el.  We should just move it to
+;; cperl-mode.el and remove the rest.
 (defun imenu-example--name-and-position ()
+  "Return the current/previous sexp and its (beginning) location.
+Don't move point."
   (save-excursion
     (forward-sexp -1)
     ;; [ydi] modified for imenu-use-markers
@@ -549,12 +552,10 @@ A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).")
              (cond
               ((consp (cdr item))
                (imenu--truncate-items (cdr item)))
-              (t
-               ;; truncate if necessary
-               (if (and (numberp imenu-max-item-length)
-                        (> (length (car item)) imenu-max-item-length))
-                   (setcar item (substring (car item) 0
-                                           imenu-max-item-length)))))))
+              ;; truncate if necessary
+              ((and (numberp imenu-max-item-length)
+                    (> (length (car item)) imenu-max-item-length))
+               (setcar item (substring (car item) 0 imenu-max-item-length))))))
           menulist))
 
 
@@ -854,7 +855,7 @@ depending on PATTERNS."
 (defun imenu--completion-buffer (index-alist &optional prompt)
   "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.
 
-Returns t for rescan and otherwise a position number."
+Return one of the entries in index-alist or nil."
   ;; Create a list for this buffer only when needed.
   (let ((name (thing-at-point 'symbol))
         choice
@@ -880,13 +881,11 @@ Returns t for rescan and otherwise a position number."
                                   prepared-index-alist
                                   nil t nil 'imenu--history-list name)))
 
-    (cond ((not (stringp name)) nil)
-          ((string= name (car imenu--rescan-item)) t)
-          (t
-           (setq choice (assoc name prepared-index-alist))
-           (if (imenu--subalist-p choice)
-               (imenu--completion-buffer (cdr choice) prompt)
-             choice)))))
+    (when (stringp name)
+      (setq choice (assoc name prepared-index-alist))
+      (if (imenu--subalist-p choice)
+          (imenu--completion-buffer (cdr choice) prompt)
+        choice))))
 
 (defun imenu--mouse-menu (index-alist event &optional title)
   "Let the user select from a buffer index from a mouse menu.
@@ -937,9 +936,9 @@ The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
                      (or (eq imenu-use-popup-menu t) mouse-triggered))
                 (imenu--mouse-menu index-alist last-nonmenu-event)
               (imenu--completion-buffer index-alist prompt)))
-      (and (eq result t)
+      (and (equal result imenu--rescan-item)
            (imenu--cleanup)
-           (setq imenu--index-alist nil)))
+           (setq result t imenu--index-alist nil)))
     result))
 
 ;;;###autoload
@@ -1014,7 +1013,7 @@ A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
     nil))
 
 (defun imenu-default-goto-function (name position &optional rest)
-  "Move the point to the given position.
+  "Move to the given position.
 
 NAME is ignored.  POSITION is where to move.  REST is also ignored.
 The ignored args just make this function have the same interface as a
@@ -1054,5 +1053,5 @@ for more information."
 
 (provide 'imenu)
 
-;;; arch-tag: 98a2f5f5-4b91-4704-b18c-3aacf77d77a7
+;; arch-tag: 98a2f5f5-4b91-4704-b18c-3aacf77d77a7
 ;;; imenu.el ends here
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 644ee3d6c20..3f3ea7c2fd4 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -245,6 +245,7 @@ system."
   (interactive)
   (setq info-lookup-cache nil))
 
+;;;###autoload (put 'info-lookup-symbol 'info-file "emacs")
 ;;;###autoload
 (defun info-lookup-symbol (symbol &optional mode)
   "Display the definition of SYMBOL, as found in the relevant manual.
@@ -258,6 +259,7 @@ With prefix arg a query for the symbol help mode is offered."
    (info-lookup-interactive-arguments 'symbol current-prefix-arg))
   (info-lookup 'symbol symbol mode))
 
+;;;###autoload (put 'info-lookup-file 'info-file "emacs")
 ;;;###autoload
 (defun info-lookup-file (file &optional mode)
   "Display the documentation of a file.
diff --git a/lisp/info.el b/lisp/info.el
index b779bb41ca6..386f5b612ec 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -79,8 +79,8 @@ The Lisp code is executed when the node is selected.")
   :group 'info)
 
 (defface info-xref
-  '((((class color) (background light)) :foreground "blue")
-    (((class color) (background dark)) :foreground "cyan")
+  '((((class color) (background light)) :foreground "blue" :underline t)
+    (((class color) (background dark)) :foreground "cyan" :underline t)
     (t :underline t))
   "Face for Info cross-references."
   :group 'info)
@@ -455,6 +455,7 @@ Do the right thing if the file has been compressed or zipped."
 
 ;;;###autoload (add-hook 'same-window-regexps "\\*info\\*\\(\\|<[0-9]+>\\)")
 
+;;;###autoload (put 'info 'info-file "emacs")
 ;;;###autoload
 (defun info (&optional file buffer)
   "Enter Info, the documentation browser.
@@ -1729,7 +1730,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
       (let ((inhibit-read-only t))
         (erase-buffer)
         (goto-char (point-min))
-        (insert "\n\^_\nFile: history Node: Top, Up: (dir)\n\n")
+        (insert "\n\^_\nFile: history,  Node: Top,  Up: (dir)\n\n")
         (insert "Recently Visited Nodes\n**********************\n\n")
         (insert "* Menu:\n\n")
         (let ((hl (delete '("history" "Top") Info-history-list)))
@@ -1749,26 +1750,31 @@ If SAME-FILE is non-nil, do not move to a different Info file."
   "Go to a node with table of contents of the current Info file.
 Table of contents is created from the tree structure of menus."
   (interactive)
-  (let ((curr-file Info-current-file)
-        (curr-node Info-current-node)
+  (let ((curr-file (substring-no-properties Info-current-file))
+        (curr-node (substring-no-properties Info-current-node))
         p)
     (with-current-buffer (get-buffer-create " *info-toc*")
       (let ((inhibit-read-only t)
             (node-list (Info-build-toc curr-file)))
         (erase-buffer)
         (goto-char (point-min))
-        (insert "\n\^_\nFile: toc Node: Top, Up: (dir)\n\n")
+        (insert "\n\^_\nFile: toc,  Node: Top,  Up: (dir)\n\n")
         (insert "Table of Contents\n*****************\n\n")
-        (insert "*Note Top::\n")
+        (insert "*Note Top: (" curr-file ")Top.\n")
         (Info-insert-toc
          (nth 2 (assoc "Top" node-list)) ; get Top nodes
-         node-list 0 (substring-no-properties curr-file)))
+         node-list 0 curr-file))
       (if (not (bobp))
           (let ((Info-hide-note-references 'hide)
                 (Info-fontify-visited-nodes nil))
             (Info-mode)
             (setq Info-current-file "toc" Info-current-node "Top")
-            (Info-fontify-node)))
+            (goto-char (point-min))
+            (narrow-to-region (or (re-search-forward "\n[\^_\f]\n" nil t)
+                                  (point-min))
+                              (point-max))
+            (Info-fontify-node)
+            (widen)))
       (goto-char (point-min))
       (if (setq p (search-forward (concat "*Note " curr-node ":") nil t))
           (setq p (- p (length curr-node) 2))))
@@ -1789,14 +1795,12 @@ Table of contents is created from the tree structure of menus."
 
 (defun Info-build-toc (file)
   "Build table of contents from menus of Info FILE and its subfiles."
-  (if (equal file "dir")
-      (error "Table of contents for Info directory is not supported yet"))
   (with-temp-buffer
-    (let* ((default-directory (or (and (stringp file)
-                                       (file-name-directory
-                                        (setq file (Info-find-file file))))
+    (let* ((file (and (stringp file) (Info-find-file file)))
+           (default-directory (or (and (stringp file)
+                                       (file-name-directory file))
                                   default-directory))
-           (main-file file)
+           (main-file (and (stringp file) file))
            (sections '(("Top" "Top")))
            nodes subfiles)
       (while (or main-file subfiles)
@@ -3258,6 +3262,7 @@ The locations are of the format used in `Info-history', i.e.
                            (car elt)
                          elt))
                  (file (if (consp elt) (cdr elt) elt))
+                 (case-fold-search nil)
                  (regexp (concat "\\`" (regexp-quote name)
                                  "\\(\\'\\|-\\)")))
             (if (string-match regexp (symbol-name command))
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 6fc3477fd34..2199420fd3c 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -870,6 +870,18 @@ like `mime-charset' as well as the current style like `:mime-charset'."
                  (and (not (> (downcase c1) (downcase c2)))
                       (< c1 c2)))))))
 
+(defun coding-system-equal (coding-system-1 coding-system-2)
+  "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical.
+Two coding systems are identical if two symbols are equal
+or one is an alias of the other."
+  (or (eq coding-system-1 coding-system-2)
+      (and (equal (coding-system-spec coding-system-1)
+                  (coding-system-spec coding-system-2))
+           (let ((eol-type-1 (coding-system-eol-type coding-system-1))
+                 (eol-type-2 (coding-system-eol-type coding-system-2)))
+             (or (eq eol-type-1 eol-type-2)
+                 (and (vectorp eol-type-1) (vectorp eol-type-2)))))))
+
 (defun add-to-coding-system-list (coding-system)
   "Add CODING-SYSTEM to `coding-system-list' while keeping it sorted."
   (if (or (null coding-system-list)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 1e8e0f6586e..0d1d7e32cde 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -676,16 +676,7 @@ is treated as a regexp.  See \\[isearch-forward] for more info."
     (if isearch-small-window
         (goto-char found-point)
       ;; Exiting the save-window-excursion clobbers window-start; restore it.
-      (set-window-start (selected-window) found-start t))
-
-    ;; If there was movement, mark the starting position.
-    ;; Maybe should test difference between and set mark iff > threshold.
-    (if (/= (point) isearch-opoint)
-        (or (and transient-mark-mode mark-active)
-            (progn
-              (push-mark isearch-opoint t)
-              (or executing-kbd-macro (> (minibuffer-depth) 0)
-                  (message "Mark saved where search started"))))))
+      (set-window-start (selected-window) found-start t)))
 
   (setq isearch-mode nil)
   (if isearch-input-method-local-p
@@ -710,6 +701,16 @@ is treated as a regexp.  See \\[isearch-forward] for more info."
       (isearch-update-ring isearch-string isearch-regexp))
 
   (run-hooks 'isearch-mode-end-hook)
+
+  ;; If there was movement, mark the starting position.
+  ;; Maybe should test difference between and set mark iff > threshold.
+  (if (/= (point) isearch-opoint)
+      (or (and transient-mark-mode mark-active)
+          (progn
+            (push-mark isearch-opoint t)
+            (or executing-kbd-macro (> (minibuffer-depth) 0)
+                (message "Mark saved where search started")))))
+
   (and (not edit) isearch-recursive-edit (exit-recursive-edit)))
 
 (defun isearch-update-ring (string &optional regexp)
@@ -1249,8 +1250,8 @@ might return the position of the end of the line."
 (defun isearch-yank-line ()
   "Pull rest of line from buffer into search string."
   (interactive)
-  (isearch-yank-internal 'line-end-position))
-
+  (isearch-yank-internal
+   (lambda () (line-end-position (if (eolp) 2 1)))))
 
 (defun isearch-search-and-update ()
   ;; Do the search and update the display.
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index b2226d4a895..2b4cbcaf323 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -248,7 +248,9 @@ macro to be executed before appending to it."
   "Insert macro counter and increment with ARG or 1 if missing.
 With \\[universal-argument], insert previous kmacro-counter (but do not modify counter)."
   (interactive "P")
-  (setq kmacro-initial-counter-value nil)
+  (if kmacro-initial-counter-value
+      (setq kmacro-counter kmacro-initial-counter-value
+            kmacro-initial-counter-value nil))
   (if (and arg (listp arg))
       (insert (format kmacro-counter-format kmacro-last-counter))
     (insert (format kmacro-counter-format kmacro-counter))
@@ -275,23 +277,23 @@ With \\[universal-argument], insert previous kmacro-counter (but do not modify c
   "Set kmacro-counter to ARG or prompt if missing.
 With \\[universal-argument] prefix, reset counter to its value prior to this iteration of the macro."
   (interactive "NMacro counter value: ")
-  (setq kmacro-last-counter kmacro-counter
-        kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg))
-                           kmacro-counter-value-start
-                         arg))
-  ;; setup initial macro counter value if we are not executing a macro.
-  (setq kmacro-initial-counter-value
-        (and (not (or defining-kbd-macro executing-kbd-macro))
-             kmacro-counter))
-  (unless executing-kbd-macro
-    (kmacro-display-counter)))
+  (if (not (or defining-kbd-macro executing-kbd-macro))
+      (kmacro-display-counter (setq kmacro-initial-counter-value arg))
+    (setq kmacro-last-counter kmacro-counter
+          kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg))
+                             kmacro-counter-value-start
+                           arg))
+    (unless executing-kbd-macro
+      (kmacro-display-counter))))
 
 
 (defun kmacro-add-counter (arg)
   "Add numeric prefix arg (prompt if missing) to macro counter.
 With \\[universal-argument], restore previous counter value."
   (interactive "NAdd to macro counter: ")
-  (setq kmacro-initial-counter-value nil)
+  (if kmacro-initial-counter-value
+      (setq kmacro-counter kmacro-initial-counter-value
+            kmacro-initial-counter-value nil))
   (let ((last kmacro-last-counter))
     (setq kmacro-last-counter kmacro-counter
           kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg))
@@ -394,7 +396,10 @@ Optional arg EMPTY is message to print if no macros are defined."
              (m (format-kbd-macro macro))
              (l (length m))
              (z (and nil trunc (> l x))))
-        (message (format "%s: %s%s" (or descr "Macro")
+        (message (format "%s%s: %s%s" (or descr "Macro")
+                         (if (= kmacro-counter 0) ""
+                           (format " [%s]"
+                                   (format kmacro-counter-format-start kmacro-counter)))
                          (if z (substring m 0 (1- x)) m) (if z "..." ""))))
     (message (or empty "No keyboard macros defined"))))
 
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 675444d7ba4..b7521ad8e91 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -234,6 +234,13 @@ we will act as though we couldn't find a full name in the address."
   :version "21.4"
   :group 'mail-extr)
 
+(defcustom mail-extr-ignore-realname-equals-mailbox-name t
+"*Whether to ignore a name that is equal to the mailbox name.
+If true, then when the address is like \"Single <single@address.com>\"
+we will act as though we couldn't find a full name in the address."
+  :type 'boolean
+  :group 'mail-extr)
+
 ;; Matches a leading title that is not part of the name (does not
 ;; contribute to uniquely identifying the person).
 (defcustom mail-extr-full-name-prefixes
@@ -694,7 +701,7 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
   "Given an RFC-822 address ADDRESS, extract full name and canonical address.
 Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
 If no name can be extracted, FULL-NAME will be nil.  Also see
-`mail-extr-ignore-single-names'.
+`mail-extr-ignore-single-names' and `mail-extr-ignore-realname-equals-mailbox-name'.
 
 If the optional argument ALL is non-nil, then ADDRESS can contain zero
 or more recipients, separated by commas, and we return a list of
@@ -1404,8 +1411,9 @@ consing a string.)"
                     (setq names-match-flag nil))
                 (setq i (1+ i)))
               (delete-region (+ (point-min) buffer-length) (point-max))
-              (if names-match-flag
-                  (narrow-to-region (point) (point)))))
+              (and names-match-flag 
+                           mail-extr-ignore-realname-equals-mailbox-name
+                           (narrow-to-region (point) (point)))))
 
           ;; Nuke name if it's just one word.
           (goto-char (point-min))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 84a61350145..d356979ea26 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -471,26 +471,32 @@ This is relative to `smtpmail-queue-dir'.")
     (if (null (and cred (condition-case ()
                             (progn
                               (require 'starttls)
-                              (call-process starttls-program))
+                              (call-process (if starttls-use-gnutls
+                                                starttls-gnutls-program
+                                              starttls-program)))
                           (error nil))))
         ;; The normal case.
         (open-network-stream "SMTP" process-buffer host port)
       (let* ((cred-key (smtpmail-cred-key cred))
              (cred-cert (smtpmail-cred-cert cred))
              (starttls-extra-args
-              (when (and (stringp cred-key) (stringp cred-cert)
-                         (file-regular-p
-                          (setq cred-key (expand-file-name cred-key)))
-                         (file-regular-p
-                          (setq cred-cert (expand-file-name cred-cert))))
-                (list "--key-file" cred-key "--cert-file" cred-cert)))
+              (append
+               starttls-extra-args
+               (when (and (stringp cred-key) (stringp cred-cert)
+                          (file-regular-p
+                           (setq cred-key (expand-file-name cred-key)))
+                          (file-regular-p
+                           (setq cred-cert (expand-file-name cred-cert))))
+                 (list "--key-file" cred-key "--cert-file" cred-cert))))
              (starttls-extra-arguments
-              (when (and (stringp cred-key) (stringp cred-cert)
-                         (file-regular-p
-                          (setq cred-key (expand-file-name cred-key)))
-                         (file-regular-p
-                          (setq cred-cert (expand-file-name cred-cert))))
-                (list "--x509keyfile" cred-key "--x509certfile" cred-cert))))
+              (append
+               starttls-extra-arguments
+               (when (and (stringp cred-key) (stringp cred-cert)
+                          (file-regular-p
+                           (setq cred-key (expand-file-name cred-key)))
+                          (file-regular-p
+                           (setq cred-cert (expand-file-name cred-cert))))
+                 (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
         (starttls-open-stream "SMTP" process-buffer host port)))))
 
 (defun smtpmail-try-auth-methods (process supported-extensions host port)
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index c1f3c0a8d52..16a4826b8ae 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4514,9 +4514,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
                1))
     (apply 'call-process program nil (not discard) nil arguments)))
 
-(defvar ange-ftp-remote-shell "rsh"
-  "Remote shell to use for chmod, if FTP server rejects the `chmod' command.")
-
 ;; Handle an attempt to run chmod on a remote file
 ;; by using the ftp chmod command.
 (defun ange-ftp-call-chmod (args)
@@ -4541,7 +4538,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
                                                        abbr))))
                (or (car result)
                    (call-process
-                    ange-ftp-remote-shell
+                    remote-shell-program
                     nil t nil host dired-chmod-program mode name))))))
      rest))
   (setq ange-ftp-ls-cache-file nil)     ;Stop confusing Dired.
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index d7c8a47a2c0..5f57c084f9b 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -1,6 +1,6 @@
 ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
 
-;; Copyright (C) 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2003, 2004 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 ;; Keywords: comm, tls, gnutls, ssl
@@ -76,6 +76,35 @@ The default is what GNUTLS's \"gnutls-cli\" outputs."
   :type 'regexp
   :group 'tls)
 
+(defcustom tls-certtool-program (executable-find "certtool")
+  "Name of  GnuTLS certtool.
+Used by `tls-certificate-information'."
+  :type '(repeat string)
+  :group 'tls)
+
+(defun tls-certificate-information (der)
+  "Parse X.509 certificate in DER format into an assoc list."
+  (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
+                             (base64-encode-string der)
+                             "\n-----END CERTIFICATE-----\n"))
+        (exit-code 0))
+    (with-current-buffer (get-buffer-create " *certtool*")
+      (erase-buffer)
+      (insert certificate)
+      (setq exit-code (condition-case ()
+                          (call-process-region (point-min) (point-max)
+                                               tls-certtool-program
+                                               t (list (current-buffer) nil) t
+                                               "--certificate-info")
+                        (error -1)))
+      (if (/= exit-code 0)
+          nil
+        (let ((vals nil))
+          (goto-char (point-min))
+          (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
+            (push (cons (match-string 1) (match-string 2)) vals))
+          (nreverse vals))))))
+
 (defun open-tls-stream (name buffer host service)
   "Open a TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 6a888d9d75d..4628af88178 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1087,7 +1087,7 @@ Return the difference in the format of a time value."
 ;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'.
 ;; Must be corrected.
 
-(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion activate)
+(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion)
   "Changes \"$\" back to \"$$\" in minibuffer."
   (if (funcall PC-completion-as-file-name-predicate)
 
@@ -1123,6 +1123,13 @@ Return the difference in the format of a time value."
     ;; No file names. Behave unchanged.
     ad-do-it))
 
+;; Activate advice.  Recent Emacsen don't need that.
+(when (functionp 'PC-do-completion)
+  (condition-case nil
+      (substitute-in-file-name "C$/")
+    (error
+     (ad-activate 'PC-do-completion))))
+
 (provide 'tramp-smb)
 
 ;;; TODO:
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index cda0d41fd8d..a30280dbd4f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1668,6 +1668,7 @@ while (my $data = <STDIN>) {
 
     my $len = length($pending);
     my $chunk = substr($pending, 0, $len & ~3);
+    $pending = substr($pending, $len & ~3 + 1);
 
     # Easy method: translate from chars to (pregenerated) six-bit packets, join,
     # split in 8-bit chunks and convert back to char.
@@ -1883,7 +1884,11 @@ If VAR is nil, then we bind `v' to the structure and `multi-method',
 
 (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
 ;; To be activated for debugging containing this macro
-(def-edebug-spec with-parsed-tramp-file-name t)
+;; It works only when VAR is nil.  Otherwise, it can be deactivated by
+;; (def-edebug-spec with-parsed-tramp-file-name 0)
+;; I'm too stupid to write a precise SPEC for it.
+(if (functionp 'def-edebug-spec)
+  (def-edebug-spec with-parsed-tramp-file-name t))
 
 (defmacro tramp-let-maybe (variable value &rest body)
   "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
@@ -6731,6 +6736,31 @@ as default."
             (tramp-make-auto-save-file-name (buffer-file-name)))
     ad-do-it))
 
+;; In Emacs < 21.4 and XEmacs < 21.5 autosaved remote files have
+;; permission 666 minus umask. This is a security threat.
+
+(defun tramp-set-auto-save-file-modes ()
+  "Set permissions of autosaved remote files to the original permissions."
+  (let ((bfn (buffer-file-name)))
+    (when (and (stringp bfn)
+               (tramp-tramp-file-p bfn)
+               (stringp buffer-auto-save-file-name)
+               (not (equal bfn buffer-auto-save-file-name))
+               (not (file-exists-p buffer-auto-save-file-name)))
+      (write-region "" nil buffer-auto-save-file-name)
+      (set-file-modes buffer-auto-save-file-name (file-modes bfn)))))
+
+(unless (or (> emacs-major-version 21)
+            (and (featurep 'xemacs)
+                 (= emacs-major-version 21)
+                 (> emacs-minor-version 4))
+            (and (not (featurep 'xemacs))
+                 (= emacs-major-version 21)
+                 (or (> emacs-minor-version 3)
+                     (and (string-match "^21\\.3\\.\\([0-9]+\\)" emacs-version)
+                          (>= (string-to-int (match-string 1 emacs-version)) 50)))))
+  (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))
+
 (defun tramp-subst-strs-in-string (alist string)
   "Replace all occurrences of the string FROM with TO in STRING.
 ALIST is of the form ((FROM . TO) ...)."
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 46b33b2d50f..7456bc1660f 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -30,7 +30,7 @@
 ;; are auto-frobbed from configure.ac, so you should edit that file and run
 ;; "autoconf && ./configure" to change them.
 
-(defconst tramp-version "2.0.44"
+(defconst tramp-version "2.0.45"
   "This version of Tramp.")
 
 (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"
diff --git a/lisp/pcvs-defs.el b/lisp/pcvs-defs.el
index 16e2ff82553..cd379afab77 100644
--- a/lisp/pcvs-defs.el
+++ b/lisp/pcvs-defs.el
@@ -1,7 +1,7 @@
 ;;; pcvs-defs.el --- variable definitions for PCL-CVS
 
-;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 03, 2004
-;;           Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;;   2000, 2003, 2004  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
 ;; Keywords: pcl-cvs
@@ -249,9 +249,6 @@ Output from cvs is placed here for asynchronous commands.")
   :type '(choice (const :tag "Ediff" (cvs-ediff-diff . cvs-ediff-merge))
                  (const :tag "Emerge" (cvs-emerge-diff . cvs-emerge-merge))))
 
-(defvar pcl-cvs-load-hook nil
-  "Run after loading pcl-cvs.")
-
 (defvar cvs-mode-hook nil
   "Run after `cvs-mode' was setup.")
 
@@ -510,5 +507,5 @@ message and replace it with a message tell you to change this variable.")
 ;;
 (provide 'pcvs-defs)
 
-;;; arch-tag: c7c701d0-d1d4-4aa9-a302-007bb03aca5e
+;; arch-tag: c7c701d0-d1d4-4aa9-a302-007bb03aca5e
 ;;; pcvs-defs.el ends here
diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el
index 84dbf218581..7ab6c53b4a0 100644
--- a/lisp/pcvs-parse.el
+++ b/lisp/pcvs-parse.el
@@ -511,15 +511,19 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
        (cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$"
                   (subtype 'COMMITTED) (base-rev 1)))
       (cvs-or (cvs-match "done$") t)
+      ;; In cvs-1.12.9 commit messages have been changed and became
+      ;; ambiguous.  More specifically, the `path' above is not given.
+      ;; We assume here that in future releases the corresponding info will
+      ;; be put into `file'.
       (progn
         ;; Try to remove the temp files used by VC.
-        (vc-delete-automatic-version-backups (expand-file-name path))
+        (vc-delete-automatic-version-backups (expand-file-name (or path file)))
         ;; it's important here not to rely on the default directory management
         ;; because `cvs commit' might begin by a series of Examining messages
         ;; so the processing of the actual checkin messages might begin with
         ;; a `current-dir' set to something different from ""
         (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype)
-                             (or path file) (if path 'trust)
+                             (or path file) 'trust
                              :base-rev base-rev)))
 
      ;; useless message added before the actual addition: ignored
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index ddbd2ce6f35..0569d26db61 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1229,10 +1229,10 @@ where they were found."
 
 (defun etags-tags-completion-table ()
   (let ((table (make-vector 511 0))
-        (point-max (/ (float (point-max)) 100.0))
-        (msg-fmt (format 
-                  "Making tags completion table for %s...%%d%%%%"
-                  buffer-file-name)))
+        (progress-reporter
+         (make-progress-reporter
+          (format "Making tags completion table for %s..." buffer-file-name)
+          (point-min) (point-max))))
     (save-excursion
       (goto-char (point-min))
       ;; This monster regexp matches an etags tag line.
@@ -1253,7 +1253,7 @@ where they were found."
                            (buffer-substring (match-beginning 5) (match-end 5))
                          ;; No explicit tag name.  Best guess.
                          (buffer-substring (match-beginning 3) (match-end 3)))
-                  (message msg-fmt (/ (point) point-max)))
+                  (progress-reporter-update progress-reporter (point)))
                 table)))
     table))
 
@@ -1433,11 +1433,12 @@ where they were found."
     (tags-with-face 'highlight (princ buffer-file-name))
     (princ "':\n\n"))
   (goto-char (point-min))
-  (let ((point-max (/ (float (point-max)) 100.0)))
+  (let ((progress-reporter (make-progress-reporter
+                            (format "Making tags apropos buffer for `%s'..."
+                                    string)
+                            (point-min) (point-max))))
     (while (re-search-forward string nil t)
-      (message "Making tags apropos buffer for `%s'...%d%%"
-               string
-               (/ (point) point-max))
+      (progress-reporter-update progress-reporter (point))
       (beginning-of-line)
 
       (let* ( ;; Get the local value in the tags table
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index 612a2034e00..d8f2cf34867 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -188,6 +188,7 @@ detailed description of this mode.
   (setq gdb-var-changed nil)
   (setq gdb-first-prompt nil)
   (setq gdb-prompting nil)
+  (setq gdb-input-queue nil)
   (setq gdb-current-item nil)
   (setq gdb-pending-triggers nil)
   (setq gdb-output-sink 'user)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 4ea4fcb6ea2..37fe13ce585 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3027,6 +3027,27 @@ class of the file (using s to separate nested class ids)."
           (save-excursion (indent-line-to indent))
         (indent-line-to indent)))))
 
+;; Derived from cfengine.el.
+(defun gdb-script-beginning-of-defun ()
+  "`beginning-of-defun' function for Gdb script mode.
+Treats actions as defuns."
+  (unless (<= (current-column) (current-indentation))
+    (end-of-line))
+  (if (re-search-backward "^define \\|^document " nil t)
+      (beginning-of-line)
+    (goto-char (point-min)))
+  t)
+
+;; Derived from cfengine.el.
+(defun gdb-script-end-of-defun ()
+  "`end-of-defun' function for Gdb script mode.
+Treats actions as defuns."
+  (end-of-line)
+  (if (re-search-forward "^end" nil t)
+      (beginning-of-line)
+    (goto-char (point-max)))
+  t)
+
 ;;;###autoload
 (add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode))
 
@@ -3039,6 +3060,10 @@ class of the file (using s to separate nested class ids)."
   (set (make-local-variable 'imenu-generic-expression)
        '((nil "^define[ \t]+\\(\\w+\\)" 1)))
   (set (make-local-variable 'indent-line-function) 'gdb-script-indent-line)
+  (set (make-local-variable 'beginning-of-defun-function)
+       #'gdb-script-beginning-of-defun)
+  (set (make-local-variable 'end-of-defun-function)
+       #'gdb-script-end-of-defun)
   (set (make-local-variable 'font-lock-defaults)
        '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
          (font-lock-syntactic-keywords
diff --git a/lisp/recentf.el b/lisp/recentf.el
index efe4ebc63a4..4ef55d4e1bf 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1032,7 +1032,8 @@ Click on Cancel or type \"q\" to quit.\n")
                      (dolist (e recentf-edit-selected-items)
                        (setq recentf-list (delq e recentf-list)
                              i (1+ i)))
-                     (message "%S file(s) removed from the list" i))
+                     (message "%S file(s) removed from the list" i)
+                     (recentf-clear-data))
                  (message "No file selected")))
      "Ok")
     (widget-insert " ")
diff --git a/lisp/server.el b/lisp/server.el
index fe2fc0f59f4..3a330f07a3c 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -343,7 +343,11 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
                     (with-temp-buffer
                       (let ((standard-output (current-buffer)))
                         (pp v)
-                        (process-send-region proc (point-min) (point-max))))))
+                        ;; Suppress the error rose when the pipe to PROC is closed.
+                        (condition-case err
+                            (process-send-region proc (point-min) (point-max))
+                          (file-error nil))
+                        ))))
               ;; ARG is a file name.
               ;; Collapse multiple slashes to single slashes.
               (setq arg (command-line-normalize-file-name arg))
diff --git a/lisp/subr.el b/lisp/subr.el
index e5a967310d5..eb4577b1a8d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -367,15 +367,6 @@ but optional second arg NODIGITS non-nil treats them like other chars."
           (define-key map (char-to-string loop) 'digit-argument)
           (setq loop (1+ loop))))))
 
-;Moved to keymap.c
-;(defun copy-keymap (keymap)
-;  "Return a copy of KEYMAP"
-;  (while (not (keymapp keymap))
-;    (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
-;  (if (vectorp keymap)
-;      (copy-sequence keymap)
-;      (copy-alist keymap)))
-
 (defvar key-substitution-in-progress nil
  "Used internally by substitute-key-definition.")
 
@@ -383,7 +374,10 @@ but optional second arg NODIGITS non-nil treats them like other chars."
   "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
 Alternatively, if optional fourth argument OLDMAP is specified, we redefine
-in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP."
+in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP.
+
+For most uses, it is simpler and safer to use command remappping like this:
+  \(define-key KEYMAP [remap OLDDEF] NEWDEF)"
   ;; Don't document PREFIX in the doc string because we don't want to
   ;; advertise it.  It's meant for recursive calls only.  Here's its
   ;; meaning
@@ -393,126 +387,54 @@ in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP."
   ;; original key, with PREFIX added at the front.
   (or prefix (setq prefix ""))
   (let* ((scan (or oldmap keymap))
-         (vec1 (vector nil))
-         (prefix1 (vconcat prefix vec1))
+         (prefix1 (vconcat prefix [nil]))
          (key-substitution-in-progress
           (cons scan key-substitution-in-progress)))
     ;; Scan OLDMAP, finding each char or event-symbol that
     ;; has any definition, and act on it with hack-key.
-    (while (consp scan)
-      (if (consp (car scan))
-          (let ((char (car (car scan)))
-                (defn (cdr (car scan))))
-            ;; The inside of this let duplicates exactly
-            ;; the inside of the following let that handles array elements.
-            (aset vec1 0 char)
-            (aset prefix1 (length prefix) char)
-            (let (inner-def skipped)
-              ;; Skip past menu-prompt.
-              (while (stringp (car-safe defn))
-                (setq skipped (cons (car defn) skipped))
-                (setq defn (cdr defn)))
-              ;; Skip past cached key-equivalence data for menu items.
-              (and (consp defn) (consp (car defn))
-                   (setq defn (cdr defn)))
-              (setq inner-def defn)
-              ;; Look past a symbol that names a keymap.
-              (while (and (symbolp inner-def)
-                          (fboundp inner-def))
-                (setq inner-def (symbol-function inner-def)))
-              (if (or (eq defn olddef)
-                      ;; Compare with equal if definition is a key sequence.
-                      ;; That is useful for operating on function-key-map.
-                      (and (or (stringp defn) (vectorp defn))
-                           (equal defn olddef)))
-                  (define-key keymap prefix1 (nconc (nreverse skipped) newdef))
-                (if (and (keymapp defn)
-                         ;; Avoid recursively scanning
-                         ;; where KEYMAP does not have a submap.
-                         (let ((elt (lookup-key keymap prefix1)))
-                           (or (null elt)
-                               (keymapp elt)))
-                         ;; Avoid recursively rescanning keymap being scanned.
-                         (not (memq inner-def
-                                    key-substitution-in-progress)))
-                    ;; If this one isn't being scanned already,
-                    ;; scan it now.
-                    (substitute-key-definition olddef newdef keymap
-                                               inner-def
-                                               prefix1)))))
-        (if (vectorp (car scan))
-            (let* ((array (car scan))
-                   (len (length array))
-                   (i 0))
-              (while (< i len)
-                (let ((char i) (defn (aref array i)))
-                  ;; The inside of this let duplicates exactly
-                  ;; the inside of the previous let.
-                  (aset vec1 0 char)
-                  (aset prefix1 (length prefix) char)
-                  (let (inner-def skipped)
-                    ;; Skip past menu-prompt.
-                    (while (stringp (car-safe defn))
-                      (setq skipped (cons (car defn) skipped))
-                      (setq defn (cdr defn)))
-                    (and (consp defn) (consp (car defn))
-                         (setq defn (cdr defn)))
-                    (setq inner-def defn)
-                    (while (and (symbolp inner-def)
-                                (fboundp inner-def))
-                      (setq inner-def (symbol-function inner-def)))
-                    (if (or (eq defn olddef)
-                            (and (or (stringp defn) (vectorp defn))
-                                 (equal defn olddef)))
-                        (define-key keymap prefix1
-                          (nconc (nreverse skipped) newdef))
-                      (if (and (keymapp defn)
-                               (let ((elt (lookup-key keymap prefix1)))
-                                 (or (null elt)
-                                     (keymapp elt)))
-                               (not (memq inner-def
-                                          key-substitution-in-progress)))
-                          (substitute-key-definition olddef newdef keymap
-                                                     inner-def
-                                                     prefix1)))))
-                (setq i (1+ i))))
-          (if (char-table-p (car scan))
-              (map-char-table
-               (function (lambda (char defn)
-                           (let ()
-                             ;; The inside of this let duplicates exactly
-                             ;; the inside of the previous let,
-                             ;; except that it uses set-char-table-range
-                             ;; instead of define-key.
-                             (aset vec1 0 char)
-                             (aset prefix1 (length prefix) char)
-                             (let (inner-def skipped)
-                               ;; Skip past menu-prompt.
-                               (while (stringp (car-safe defn))
-                                 (setq skipped (cons (car defn) skipped))
-                                 (setq defn (cdr defn)))
-                               (and (consp defn) (consp (car defn))
-                                    (setq defn (cdr defn)))
-                               (setq inner-def defn)
-                               (while (and (symbolp inner-def)
-                                           (fboundp inner-def))
-                                 (setq inner-def (symbol-function inner-def)))
-                               (if (or (eq defn olddef)
-                                       (and (or (stringp defn) (vectorp defn))
-                                            (equal defn olddef)))
-                                   (define-key keymap prefix1
-                                     (nconc (nreverse skipped) newdef))
-                                 (if (and (keymapp defn)
-                                          (let ((elt (lookup-key keymap prefix1)))
-                                            (or (null elt)
-                                                (keymapp elt)))
-                                          (not (memq inner-def
-                                                     key-substitution-in-progress)))
-                                     (substitute-key-definition olddef newdef keymap
-                                                                inner-def
-                                                                prefix1)))))))
-               (car scan)))))
-      (setq scan (cdr scan)))))
+    (map-keymap
+     (lambda (char defn)
+       (aset prefix1 (length prefix) char)
+       (substitute-key-definition-key defn olddef newdef prefix1 keymap))
+     scan)))
+
+(defun substitute-key-definition-key (defn olddef newdef prefix keymap)
+  (let (inner-def skipped menu-item)
+    ;; Find the actual command name within the binding.
+    (if (eq (car-safe defn) 'menu-item)
+        (setq menu-item defn defn (nth 2 defn))
+      ;; Skip past menu-prompt.
+      (while (stringp (car-safe defn))
+        (push (pop defn) skipped))
+      ;; Skip past cached key-equivalence data for menu items.
+      (if (consp (car-safe defn))
+          (setq defn (cdr defn))))
+    (if (or (eq defn olddef)
+            ;; Compare with equal if definition is a key sequence.
+            ;; That is useful for operating on function-key-map.
+            (and (or (stringp defn) (vectorp defn))
+                 (equal defn olddef)))
+        (define-key keymap prefix
+          (if menu-item
+              (let ((copy (copy-sequence menu-item)))
+                (setcar (nthcdr 2 copy) newdef)
+                copy)
+            (nconc (nreverse skipped) newdef)))
+      ;; Look past a symbol that names a keymap.
+      (setq inner-def
+            (condition-case nil (indirect-function defn) (error defn)))
+      ;; For nested keymaps, we use `inner-def' rather than `defn' so as to
+      ;; avoid autoloading a keymap.  This is mostly done to preserve the
+      ;; original non-autoloading behavior of pre-map-keymap times.
+      (if (and (keymapp inner-def)
+               ;; Avoid recursively scanning
+               ;; where KEYMAP does not have a submap.
+               (let ((elt (lookup-key keymap prefix)))
+                 (or (null elt) (natnump elt) (keymapp elt)))
+               ;; Avoid recursively rescanning keymap being scanned.
+               (not (memq inner-def key-substitution-in-progress)))
+          ;; If this one isn't being scanned already, scan it now.
+          (substitute-key-definition olddef newdef keymap inner-def prefix)))))
 
 (defun define-key-after (keymap key definition &optional after)
   "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
@@ -658,19 +580,19 @@ even when EVENT actually has modifiers."
             (char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
                                                ?\H-\^@ ?\s-\^@ ?\A-\^@)))))
         (if (not (zerop (logand type ?\M-\^@)))
-            (setq list (cons 'meta list)))
+            (push 'meta list))
         (if (or (not (zerop (logand type ?\C-\^@)))
                 (< char 32))
-            (setq list (cons 'control list)))
+            (push 'control list))
         (if (or (not (zerop (logand type ?\S-\^@)))
                 (/= char (downcase char)))
-            (setq list (cons 'shift list)))
+            (push 'shift list))
         (or (zerop (logand type ?\H-\^@))
-            (setq list (cons 'hyper list)))
+            (push 'hyper list))
         (or (zerop (logand type ?\s-\^@))
-            (setq list (cons 'super list)))
+            (push 'super list))
         (or (zerop (logand type ?\A-\^@))
-            (setq list (cons 'alt list)))
+            (push 'alt list))
         list))))
 
 (defun event-basic-type (event)
@@ -688,8 +610,7 @@ in the current Emacs session, then this function may return nil."
 
 (defsubst mouse-movement-p (object)
   "Return non-nil if OBJECT is a mouse movement event."
-  (and (consp object)
-       (eq (car object) 'mouse-movement)))
+  (eq (car-safe object) 'mouse-movement))
 
 (defsubst event-start (event)
   "Return the starting position of EVENT.
@@ -1880,8 +1801,7 @@ Use a MESSAGE of \"\" to temporarily clear the echo area."
 See also `with-temp-file' and `with-output-to-string'."
   (declare (indent 0) (debug t))
   (let ((temp-buffer (make-symbol "temp-buffer")))
-    `(let ((,temp-buffer
-            (get-buffer-create (generate-new-buffer-name " *temp*"))))
+    `(let ((,temp-buffer (generate-new-buffer " *temp*")))
        (unwind-protect
            (with-current-buffer ,temp-buffer
              ,@body)
@@ -2652,5 +2572,132 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
 
+;; Standardized progress reporting
+
+;; Progress reporter has the following structure:
+;;
+;;      (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
+;;                            MIN-VALUE
+;;                            MAX-VALUE
+;;                            MESSAGE
+;;                            MIN-CHANGE
+;;                            MIN-TIME])
+;;
+;; This weirdeness is for optimization reasons: we want
+;; `progress-reporter-update' to be as fast as possible, so
+;; `(car reporter)' is better than `(aref reporter 0)'.
+;;
+;; NEXT-UPDATE-TIME is a float.  While `float-time' loses a couple
+;; digits of precision, it doesn't really matter here.  On the other
+;; hand, it greatly simplifies the code.
+
+(defsubst progress-reporter-update (reporter value)
+  "Report progress of an operation in the echo area.
+However, if the change since last echo area update is too small
+or not enough time has passed, then do nothing (see
+`make-progress-reporter' for details).
+
+First parameter, REPORTER, should be the result of a call to
+`make-progress-reporter'.  Second, VALUE, determines the actual
+progress of operation; it must be between MIN-VALUE and MAX-VALUE
+as passed to `make-progress-reporter'.
+
+This function is very inexpensive, you may not bother how often
+you call it."
+  (when (>= value (car reporter))
+    (progress-reporter-do-update reporter value)))
+
+(defun make-progress-reporter (message min-value max-value
+                                       &optional current-value
+                                       min-change min-time)
+  "Return progress reporter object usage with `progress-reporter-update'.
+
+MESSAGE is shown in the echo area.  When at least 1% of operation
+is complete, the exact percentage will be appended to the
+MESSAGE.  When you call `progress-reporter-done', word \"done\"
+is printed after the MESSAGE.  You can change MESSAGE of an
+existing progress reporter with `progress-reporter-force-update'.
+
+MIN-VALUE and MAX-VALUE designate starting (0% complete) and
+final (100% complete) states of operation.  The latter should be
+larger; if this is not the case, then simply negate all values.
+Optional CURRENT-VALUE specifies the progress by the moment you
+call this function.  You should omit it or set it to nil in most
+cases since it defaults to MIN-VALUE.
+
+Optional MIN-CHANGE determines the minimal change in percents to
+report (default is 1%.)  Optional MIN-TIME specifies the minimal
+time before echo area updates (default is 0.2 seconds.)  If
+`float-time' function is not present, then time is not tracked
+at all.  If OS is not capable of measuring fractions of seconds,
+then this parameter is effectively rounded up."
+
+  (unless min-time
+    (setq min-time 0.2))
+  (let ((reporter
+         (cons min-value ;; Force a call to `message' now
+               (vector (if (and (fboundp 'float-time)
+                                (>= min-time 0.02))
+                           (float-time) nil)
+                       min-value
+                       max-value
+                       message
+                       (if min-change (max (min min-change 50) 1) 1)
+                       min-time))))
+    (progress-reporter-update reporter (or current-value min-value))
+    reporter))
+
+(defun progress-reporter-force-update (reporter value &optional new-message)
+  "Report progress of an operation in the echo area unconditionally.
+
+First two parameters are the same as for
+`progress-reporter-update'.  Optional NEW-MESSAGE allows you to
+change the displayed message."
+  (let ((parameters (cdr reporter)))
+    (when new-message
+      (aset parameters 3 new-message))
+    (when (aref parameters 0)
+      (aset parameters 0 (float-time)))
+    (progress-reporter-do-update reporter value)))
+
+(defun progress-reporter-do-update (reporter value)
+  (let* ((parameters   (cdr reporter))
+         (min-value    (aref parameters 1))
+         (max-value    (aref parameters 2))
+         (one-percent  (/ (- max-value min-value) 100.0))
+         (percentage   (truncate (/ (- value min-value) one-percent)))
+         (update-time  (aref parameters 0))
+         (current-time (float-time))
+         (enough-time-passed
+          ;; See if enough time has passed since the last update.
+          (or (not update-time)
+              (when (>= current-time update-time)
+                ;; Calculate time for the next update
+                (aset parameters 0 (+ update-time (aref parameters 5)))))))
+    ;;
+    ;; Calculate NEXT-UPDATE-VALUE.  If we are not going to print
+    ;; message this time because not enough time has passed, then use
+    ;; 1 instead of MIN-CHANGE.  This makes delays between echo area
+    ;; updates closer to MIN-TIME.
+    (setcar reporter
+            (min (+ min-value (* (+ percentage
+                                    (if enough-time-passed
+                                        (aref parameters 4) ;; MIN-CHANGE
+                                      1))
+                                 one-percent))
+                 max-value))
+    (when (integerp value)
+      (setcar reporter (ceiling (car reporter))))
+    ;;
+    ;; Only print message if enough time has passed
+    (when enough-time-passed
+      (if (> percentage 0)
+          (message "%s%d%%" (aref parameters 3) percentage)
+        (message "%s" (aref parameters 3))))))
+
+(defun progress-reporter-done (reporter)
+  "Print reporter's message followed by word \"done\" in echo area."
+  (message "%sdone" (aref (cdr reporter) 3)))
+
 ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
 ;;; subr.el ends here
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index a2e9ac8fff6..181fc9baca5 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -405,11 +405,12 @@ MODE should be an integer which is a file mode value."
 Place a dired-like listing on the front;
 then narrow to it, so that only that listing
 is visible (and the real data of the buffer is hidden)."
-  (message "Parsing tar file...")
+  (set-buffer-multibyte nil)
   (let* ((result '())
          (pos (point-min))
-         (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
-         (bs100 (max 1 (/ bs 100)))
+         (progress-reporter
+          (make-progress-reporter "Parsing tar file..."
+                                  (point-min) (max 1 (- (buffer-size) 1024))))
          tokens)
     (while (and (<= (+ pos 512) (point-max))
                 (not (eq 'empty-tar-block
@@ -417,10 +418,7 @@ is visible (and the real data of the buffer is hidden)."
                                (tar-header-block-tokenize
                                 (buffer-substring pos (+ pos 512)))))))
       (setq pos (+ pos 512))
-      (message "Parsing tar file...%d%%"
-               ;(/ (* pos 100) bs)   ; this gets round-off lossage
-               (/ pos bs100)         ; this doesn't
-               )
+      (progress-reporter-update progress-reporter pos)
       (if (eq (tar-header-link-type tokens) 20)
           ;; Foo.  There's an extra empty block after these.
           (setq pos (+ pos 512)))
@@ -447,7 +445,7 @@ is visible (and the real data of the buffer is hidden)."
     ;; A tar file should end with a block or two of nulls,
     ;; but let's not get a fatal error if it doesn't.
     (if (eq tokens 'empty-tar-block)
-        (message "Parsing tar file...done")
+        (progress-reporter-done progress-reporter)
       (message "Warning: premature EOF parsing tar file")))
   (save-excursion
     (goto-char (point-min))
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index c2ed47cb48d..71bb6cf137d 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -258,8 +258,8 @@ Commands:
 (define-key enriched-mode-map "\M-j" 'facemenu-justification-menu)
 (define-key enriched-mode-map "\M-S" 'set-justification-center)
 (define-key enriched-mode-map "\C-x\t" 'increase-left-margin)
-(define-key enriched-mode-map "\C-c\C-l" 'set-left-margin)
-(define-key enriched-mode-map "\C-c\C-r" 'set-right-margin)
+(define-key enriched-mode-map "\C-c[" 'set-left-margin)
+(define-key enriched-mode-map "\C-c]" 'set-right-margin)
 
 ;;;
 ;;; Some functions dealing with text-properties, especially indentation
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 868dcb2d107..206f7a42f78 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -1,6 +1,6 @@
 ;;; paragraphs.el --- paragraph and sentence parsing
 
-;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96, 1997, 1999, 2000, 2001
+;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96, 1997, 1999, 2000, 2001, 2004
 ;;    Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -122,8 +122,8 @@ This is relevant for filling.  See also `sentence-end-without-period'
 and `colon-double-space'.
 
 This value is used by the function `sentence-end' to construct the
-regexp describing the end of a sentence, in case when the value of
-the variable `sentence-end' is nil.  See Info node `Sentences'."
+regexp describing the end of a sentence, when the value of the variable
+`sentence-end' is nil.  See Info node `(elisp)Standard Regexps'."
   :type 'boolean
   :group 'fill)
 
@@ -133,18 +133,18 @@ For example, a sentence in Thai text ends with double space but
 without a period.
 
 This value is used by the function `sentence-end' to construct the
-regexp describing the end of a sentence, in case when the value of
-the variable `sentence-end' is nil.  See Info node `Sentences'."
+regexp describing the end of a sentence, when the value of the variable
+`sentence-end' is nil.  See Info node `(elisp)Standard Regexps'."
   :type 'boolean
   :group 'fill)
 
 (defcustom sentence-end-without-space
   "$B!#!%!)!*$A!##.#?#!$(0!$!%!)!*$(G!$!%!)!*(B"
-  "*String containing characters that end sentence without following spaces.
+  "*String of characters that end sentence without following spaces.
 
 This value is used by the function `sentence-end' to construct the
-regexp describing the end of a sentence, in case when the value of
-the variable `sentence-end' is nil.  See Info node `Sentences'."
+regexp describing the end of a sentence, when the value of the variable
+`sentence-end' is nil.  See Info node `(elisp)Standard Regexps'."
   :group 'paragraphs
   :type 'string)
 
@@ -169,7 +169,7 @@ and `sentence-end-without-space'.  The default value specifies
 that in order to be recognized as the end of a sentence, the
 ending period, question mark, or exclamation point must be
 followed by two spaces, unless it's inside some sort of quotes or
-parenthesis.  See Info node `Sentences'."
+parenthesis.  See Info node `(elisp)Standard Regexps'."
   (or sentence-end
       (concat (if sentence-end-without-period "\\w  \\|")
               "\\([.?!][]\"'\xd0c9\x5397d)}]*"
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 24347479e57..5a8d0df40d1 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -500,6 +500,11 @@ An alternative value is \" . \", if you use a font with a narrow period."
          1 font-lock-function-name-face))))
   "Subdued expressions to highlight in TeX modes.")
 
+(defun tex-font-lock-append-prop (prop)
+  (unless (memq (get-text-property (match-end 1) 'face)
+                '(font-lock-comment-face tex-verbatim-face))
+    prop))
+
 (defconst tex-font-lock-keywords-2
   (append tex-font-lock-keywords-1
    (eval-when-compile
@@ -553,16 +558,19 @@ An alternative value is \" . \", if you use a font with a narrow period."
         ;;
         ;; Font environments.  It seems a bit dubious to use `bold' etc. faces
         ;; since we might not be able to display those fonts.
-        (list (concat slash bold " *" arg) 2 '(quote bold) 'append)
-        (list (concat slash italic " *" arg) 2 '(quote italic) 'append)
+        (list (concat slash bold " *" arg) 2
+              '(tex-font-lock-append-prop 'bold) 'append)
+        (list (concat slash italic " *" arg) 2
+              '(tex-font-lock-append-prop 'italic) 'append)
         ;; (list (concat slash type arg) 2 '(quote bold-italic) 'append)
         ;;
         ;; Old-style bf/em/it/sl.  Stop at `\\' and un-escaped `&', for tables.
         (list (concat "\\\\\\(em\\|it\\|sl\\)\\>" args)
-              2 '(quote italic) 'append)
+              2 '(tex-font-lock-append-prop 'italic) 'append)
         ;; This is separate from the previous one because of cases like
         ;; {\em foo {\bf bar} bla} where both match.
-        (list (concat "\\\\bf\\>" args) 1 '(quote bold) 'append)))))
+        (list (concat "\\\\\\(bf\\)\\>" args)
+              2 '(tex-font-lock-append-prop 'bold) 'append)))))
    "Gaudy expressions to highlight in TeX modes.")
 
 (defun tex-font-lock-suscript (pos)
@@ -604,11 +612,14 @@ An alternative value is \" . \", if you use a font with a narrow period."
 (defvar tex-font-lock-syntactic-keywords
   (let ((verbs (regexp-opt tex-verbatim-environments t)))
     `((,(concat "^\\\\begin *{" verbs "}.*\\(\n\\)") 2 "|")
-      (,(concat "^\\\\end *{" verbs "}\\(.?\\)") 2
-       (unless (<= (match-beginning 0) (point-min))
-         (put-text-property (1- (match-beginning 0)) (match-beginning 0)
-                            'syntax-table (string-to-syntax "|"))
-         "<"))
+      ;; Technically, we'd like to put the "|" property on the \n preceding
+      ;; the \end, but this would have 2 disadvantages:
+      ;; 1 - it's wrong if the verbatim env is empty (the same \n is used to
+      ;;     start and end the fenced-string).
+      ;; 2 - font-lock considers the preceding \n as being part of the
+      ;;     preceding line, so things gets screwed every time the previous
+      ;;     line is re-font-locked on its own.
+      (,(concat "^\\(\\\\\\)end *{" verbs "}\\(.?\\)") (1 "|") (3 "<"))
       ;; ("^\\(\\\\\\)begin *{comment}" 1 "< b")
       ;; ("^\\\\end *{comment}.*\\(\n\\)" 1 "> b")
       ("\\\\verb\\**\\([^a-z@*]\\)" 1 "\""))))
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 69851ac5046..91a6c869a21 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,64 @@
+2004-10-12  Simon Josefsson  <jas@extundo.com>
+
+        * url-vars.el (url-gateway-method): Add new method `tls'.
+
+        * url-news.el (url-snews): Use nntp-open-tls-stream if
+        url-gateway-method is tls.
+
+        * url-ldap.el (url-ldap-certificate-formatter): Use
+        tls-certificate-information if ssl.el is not available.
+
+        * url-https.el (url-https-create-secure-wrapper): Use tls if ssl
+        is not available.
+
+        * url-gw.el (url-open-stream): Support tls url-gateway-method.
+        (url-open-stream): Likewise.
+
+2004-10-10  Lars Hansen  <larsh@math.ku.dk>
+
+        * url-auth.el: Fix copyright notice.
+
+        * url-cache.el: Fix copyright notice.
+
+        * url-cookie.el: Fix copyright notice.
+
+        * url-dired.el: Fix copyright notice.
+
+        * url-file.el: Fix copyright notice.
+
+        * url-ftp.el: Fix copyright notice.
+
+        * url-handlers.el: Fix copyright notice.
+
+        * url-history.el: Fix copyright notice.
+
+        * url-irc.el: Fix copyright notice.
+
+        * url-mailto.el: Fix copyright notice.
+
+        * url-methods.el: Fix copyright notice.
+
+        * url-misc.el: Fix copyright notice.
+
+        * url-news.el: Fix copyright notice.
+
+        * url-nfs.el: Fix copyright notice.
+
+        * url-parse.el: Fix copyright notice.
+
+        * url-privacy.el: Fix copyright notice.
+
+        * url-vars.el: Fix copyright notice.
+
+        * url.el: Fix copyright notice.
+
+        * url-util.el: Fix copyright notice.
+
+2004-10-06  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * url-handlers.el (url-insert-file-contents): Use the URL to decide the
+        encoding, not the buffer-file-name (which might not even exist).
+
 2004-09-20  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * url-handlers.el (url-insert-file-contents): Decode contents.
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
new file mode 100644
index 00000000000..39bb730bebc
--- /dev/null
+++ b/lisp/url/url-auth.el
@@ -0,0 +1,316 @@
+;;; url-auth.el --- Uniform Resource Locator authorization modules
+;; Keywords: comm, data, processes, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'url-vars)
+(require 'url-parse)
+(autoload 'url-warn "url")
+
+(defsubst url-auth-user-prompt (url realm)
+  "String to usefully prompt for a username."
+  (concat "Username [for "
+          (or realm (url-truncate-url-for-viewing
+                     (url-recreate-url url)
+                     (- (window-width) 10 20)))
+          "]: "))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Basic authorization code
+;;; ------------------------
+;;; This implements the BASIC authorization type.  See the online
+;;; documentation at
+;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
+;;; for the complete documentation on this type.
+;;;
+;;; This is very insecure, but it works as a proof-of-concept
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar url-basic-auth-storage 'url-http-real-basic-auth-storage
+  "Where usernames and passwords are stored.
+
+Must be a symbol pointing to another variable that will actually store
+the information.  The value of this variable is an assoc list of assoc
+lists.  The first assoc list is keyed by the server name.  The cdr of
+this is an assoc list based on the 'directory' specified by the url we
+are looking up.")
+
+(defun url-basic-auth (url &optional prompt overwrite realm args)
+  "Get the username/password for the specified URL.
+If optional argument PROMPT is non-nil, ask for the username/password
+to use for the url and its descendants.  If optional third argument
+OVERWRITE is non-nil, overwrite the old username/password pair if it
+is found in the assoc list.  If REALM is specified, use that as the realm
+instead of the pathname inheritance method."
+  (let* ((href (if (stringp url)
+                   (url-generic-parse-url url)
+                 url))
+         (server (url-host href))
+         (port (url-port href))
+         (path (url-filename href))
+         user pass byserv retval data)
+    (setq server (format "%s:%d" server port)
+          path (cond
+                (realm realm)
+                ((string-match "/$" path) path)
+                (t (url-basepath path)))
+          byserv (cdr-safe (assoc server
+                                  (symbol-value url-basic-auth-storage))))
+    (cond
+     ((and prompt (not byserv))
+      (setq user (read-string (url-auth-user-prompt url realm)
+                              (user-real-login-name))
+            pass (funcall url-passwd-entry-func "Password: "))
+      (set url-basic-auth-storage
+           (cons (list server
+                       (cons path
+                             (setq retval
+                                   (base64-encode-string
+                                    (format "%s:%s" user pass)))))
+                 (symbol-value url-basic-auth-storage))))
+     (byserv
+      (setq retval (cdr-safe (assoc path byserv)))
+      (if (and (not retval)
+               (string-match "/" path))
+          (while (and byserv (not retval))
+            (setq data (car (car byserv)))
+            (if (or (not (string-match "/" data)) ; Its a realm - take it!
+                    (and
+                     (>= (length path) (length data))
+                     (string= data (substring path 0 (length data)))))
+                (setq retval (cdr (car byserv))))
+            (setq byserv (cdr byserv))))
+      (if (or (and (not retval) prompt) overwrite)
+          (progn
+            (setq user (read-string (url-auth-user-prompt url realm)
+                                    (user-real-login-name))
+                  pass (funcall url-passwd-entry-func "Password: ")
+                  retval (base64-encode-string (format "%s:%s" user pass))
+                  byserv (assoc server (symbol-value url-basic-auth-storage)))
+            (setcdr byserv
+                    (cons (cons path retval) (cdr byserv))))))
+     (t (setq retval nil)))
+    (if retval (setq retval (concat "Basic " retval)))
+    retval))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Digest authorization code
+;;; ------------------------
+;;; This implements the DIGEST authorization type.  See the internet draft
+;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; for the complete documentation on this type.
+;;;
+;;; This is very secure
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar url-digest-auth-storage nil
+  "Where usernames and passwords are stored.  Its value is an assoc list of
+assoc lists.  The first assoc list is keyed by the server name.  The cdr of
+this is an assoc list based on the 'directory' specified by the url we are
+looking up.")
+
+(defun url-digest-auth-create-key (username password realm method uri)
+  "Create a key for digest authentication method"
+  (let* ((info (if (stringp uri)
+                   (url-generic-parse-url uri)
+                 uri))
+         (a1 (md5 (concat username ":" realm ":" password)))
+         (a2 (md5 (concat method ":" (url-filename info)))))
+    (list a1 a2)))
+
+(defun url-digest-auth (url &optional prompt overwrite realm args)
+  "Get the username/password for the specified URL.
+If optional argument PROMPT is non-nil, ask for the username/password
+to use for the url and its descendants.  If optional third argument
+OVERWRITE is non-nil, overwrite the old username/password pair if it
+is found in the assoc list.  If REALM is specified, use that as the realm
+instead of hostname:portnum."
+  (if args
+      (let* ((href (if (stringp url)
+                       (url-generic-parse-url url)
+                     url))
+             (server (url-host href))
+             (port (url-port href))
+             (path (url-filename href))
+             user pass byserv retval data)
+        (setq path (cond
+                    (realm realm)
+                    ((string-match "/$" path) path)
+                    (t (url-basepath path)))
+              server (format "%s:%d" server port)
+              byserv (cdr-safe (assoc server url-digest-auth-storage)))
+        (cond
+         ((and prompt (not byserv))
+          (setq user (read-string (url-auth-user-prompt url realm)
+                                  (user-real-login-name))
+                pass (funcall url-passwd-entry-func "Password: ")
+                url-digest-auth-storage
+                (cons (list server
+                            (cons path
+                                  (setq retval
+                                        (cons user
+                                              (url-digest-auth-create-key
+                                               user pass realm
+                                               (or url-request-method "GET")
+                                               url)))))
+                      url-digest-auth-storage)))
+         (byserv
+          (setq retval (cdr-safe (assoc path byserv)))
+          (if (and (not retval)         ; no exact match, check directories
+                   (string-match "/" path)) ; not looking for a realm
+              (while (and byserv (not retval))
+                (setq data (car (car byserv)))
+                (if (or (not (string-match "/" data))
+                        (and
+                         (>= (length path) (length data))
+                         (string= data (substring path 0 (length data)))))
+                    (setq retval (cdr (car byserv))))
+                (setq byserv (cdr byserv))))
+          (if (or (and (not retval) prompt) overwrite)
+              (progn
+                (setq user (read-string (url-auth-user-prompt url realm)
+                                        (user-real-login-name))
+                      pass (funcall url-passwd-entry-func "Password: ")
+                      retval (setq retval
+                                   (cons user
+                                         (url-digest-auth-create-key
+                                          user pass realm
+                                          (or url-request-method "GET")
+                                          url)))
+                      byserv (assoc server url-digest-auth-storage))
+                (setcdr byserv
+                        (cons (cons path retval) (cdr byserv))))))
+         (t (setq retval nil)))
+        (if retval
+            (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
+                  (opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven")))
+              (format
+               (concat "Digest username=\"%s\", realm=\"%s\","
+                       "nonce=\"%s\", uri=\"%s\","
+                       "response=\"%s\", opaque=\"%s\"")
+               (nth 0 retval) realm nonce (url-filename href)
+               (md5 (concat (nth 1 retval) ":" nonce ":"
+                            (nth 2 retval))) opaque))))))
+
+(defvar url-registered-auth-schemes nil
+  "A list of the registered authorization schemes and various and sundry
+information associated with them.")
+
+;;;###autoload
+(defun url-get-authentication (url realm type prompt &optional args)
+  "Return an authorization string suitable for use in the WWW-Authenticate
+header in an HTTP/1.0 request.
+
+URL    is the url you are requesting authorization to.  This can be either a
+       string representing the URL, or the parsed representation returned by
+       `url-generic-parse-url'
+REALM  is the realm at a specific site we are looking for.  This should be a
+       string specifying the exact realm, or nil or the symbol 'any' to
+       specify that the filename portion of the URL should be used as the
+       realm
+TYPE   is the type of authentication to be returned.  This is either a string
+       representing the type (basic, digest, etc), or nil or the symbol 'any'
+       to specify that any authentication is acceptable.  If requesting 'any'
+       the strongest matching authentication will be returned.  If this is
+       wrong, its no big deal, the error from the server will specify exactly
+       what type of auth to use
+PROMPT is boolean - specifies whether to ask the user for a username/password
+       if one cannot be found in the cache"
+  (if (not realm)
+      (setq realm (cdr-safe (assoc "realm" args))))
+  (if (stringp url)
+      (setq url (url-generic-parse-url url)))
+  (if (or (null type) (eq type 'any))
+      ;; Whooo doogies!
+      ;; Go through and get _all_ the authorization strings that could apply
+      ;; to this URL, store them along with the 'rating' we have in the list
+      ;; of schemes, then sort them so that the 'best' is at the front of the
+      ;; list, then get the car, then get the cdr.
+      ;; Zooom zooom zoooooom
+      (cdr-safe
+       (car-safe
+        (sort
+         (mapcar
+          (function
+           (lambda (scheme)
+             (if (fboundp (car (cdr scheme)))
+                 (cons (cdr (cdr scheme))
+                       (funcall (car (cdr scheme)) url nil nil realm))
+               (cons 0 nil))))
+          url-registered-auth-schemes)
+         (function
+          (lambda (x y)
+            (cond
+             ((null (cdr x)) nil)
+             ((and (cdr x) (null (cdr y))) t)
+             ((and (cdr x) (cdr y))
+              (>= (car x) (car y)))
+             (t nil)))))))
+    (if (symbolp type) (setq type (symbol-name type)))
+    (let* ((scheme (car-safe
+                    (cdr-safe (assoc (downcase type)
+                                     url-registered-auth-schemes)))))
+      (if (and scheme (fboundp scheme))
+          (funcall scheme url prompt
+                   (and prompt
+                        (funcall scheme url nil nil realm args))
+                   realm args)))))
+
+;;;###autoload
+(defun url-register-auth-scheme (type &optional function rating)
+  "Register an HTTP authentication method.
+
+TYPE     is a string or symbol specifying the name of the method.   This
+         should be the same thing you expect to get returned in an Authenticate
+         header in HTTP/1.0 - it will be downcased.
+FUNCTION is the function to call to get the authorization information.  This
+         defaults to `url-?-auth', where ? is TYPE
+RATING   a rating between 1 and 10 of the strength of the authentication.
+         This is used when asking for the best authentication for a specific
+         URL.  The item with the highest rating is returned."
+  (let* ((type (cond
+                ((stringp type) (downcase type))
+                ((symbolp type) (downcase (symbol-name type)))
+                (t (error "Bad call to `url-register-auth-scheme'"))))
+         (function (or function (intern (concat "url-" type "-auth"))))
+         (rating (cond
+                  ((null rating) 2)
+                  ((stringp rating) (string-to-int rating))
+                  (t rating)))
+         (node (assoc type url-registered-auth-schemes)))
+    (if (not (fboundp function))
+        (url-warn 'security
+                  (format (concat
+                           "Tried to register `%s' as an auth scheme"
+                           ", but it is not a function!") function)))
+
+    (if node
+        (setcdr node (cons function rating))
+      (setq url-registered-auth-schemes
+            (cons (cons type (cons function rating))
+                  url-registered-auth-schemes)))))
+
+(defun url-auth-registered (scheme)
+  ;; Return non-nil iff SCHEME is registered as an auth type
+  (assoc scheme url-registered-auth-schemes))
+
+(provide 'url-auth)
+
+;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
new file mode 100644
index 00000000000..1e3374639e1
--- /dev/null
+++ b/lisp/url/url-cache.el
@@ -0,0 +1,202 @@
+;;; url-cache.el --- Uniform Resource Locator retrieval tool
+;; Keywords: comm, data, processes, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(require 'url-parse)
+(require 'url-util)
+
+(defcustom url-cache-directory
+  (expand-file-name "cache" url-configuration-directory)
+  "*The directory where cache files should be stored."
+  :type 'directory
+  :group 'url-file)
+
+;; Cache manager
+(defun url-cache-file-writable-p (file)
+  "Follows the documentation of `file-writable-p', unlike `file-writable-p'."
+  (and (file-writable-p file)
+       (if (file-exists-p file)
+           (not (file-directory-p file))
+         (file-directory-p (file-name-directory file)))))
+                
+(defun url-cache-prepare (file)
+  "Makes it possible to cache data in FILE.
+Creates any necessary parent directories, deleting any non-directory files
+that would stop this.  Returns nil if parent directories can not be
+created.  If FILE already exists as a non-directory, it changes
+permissions of FILE or deletes FILE to make it possible to write a new
+version of FILE.  Returns nil if this can not be done.  Returns nil if
+FILE already exists as a directory.  Otherwise, returns t, indicating that
+FILE can be created or overwritten."
+  (cond
+   ((url-cache-file-writable-p file)
+    t)
+   ((file-directory-p file)
+    nil)
+   (t
+    (condition-case ()
+        (or (make-directory (file-name-directory file) t) t)
+      (error nil)))))
+
+;;;###autoload
+(defun url-store-in-cache (&optional buff)
+  "Store buffer BUFF in the cache."
+  (if (not (and buff (get-buffer buff)))
+      nil
+    (save-excursion
+      (and buff (set-buffer buff))
+      (let* ((fname (url-cache-create-filename (url-view-url t))))
+        (if (url-cache-prepare fname)
+            (let ((coding-system-for-write 'binary))
+              (write-region (point-min) (point-max) fname nil 5)))))))
+        
+;;;###autoload
+(defun url-is-cached (url)
+  "Return non-nil if the URL is cached."
+  (let* ((fname (url-cache-create-filename url))
+         (attribs (file-attributes fname)))
+    (and fname                          ; got a filename
+         (file-exists-p fname)          ; file exists
+         (not (eq (nth 0 attribs) t))   ; Its not a directory
+         (nth 5 attribs))))             ; Can get last mod-time
+
+(defun url-cache-create-filename-human-readable (url)
+  "Return a filename in the local cache for URL"
+  (if url
+      (let* ((url (if (vectorp url) (url-recreate-url url) url))
+             (urlobj (url-generic-parse-url url))
+             (protocol (url-type urlobj))
+             (hostname (url-host urlobj))
+             (host-components
+              (cons
+               (user-real-login-name)
+               (cons (or protocol "file")
+                     (reverse (split-string (or hostname "localhost")
+                                            (eval-when-compile
+                                              (regexp-quote ".")))))))
+             (fname    (url-filename urlobj)))
+        (if (and fname (/= (length fname) 0) (= (aref fname 0) ?/))
+            (setq fname (substring fname 1 nil)))
+        (if fname
+            (let ((slash nil))
+              (setq fname
+                    (mapconcat
+                     (function
+                      (lambda (x)
+                        (cond
+                         ((and (= ?/ x) slash)
+                          (setq slash nil)
+                          "%2F")
+                         ((= ?/ x)
+                          (setq slash t)
+                          "/")
+                         (t
+                          (setq slash nil)
+                          (char-to-string x))))) fname ""))))
+
+        (setq fname (and fname
+                         (mapconcat
+                          (function (lambda (x)
+                                      (if (= x ?~) "" (char-to-string x))))
+                          fname ""))
+              fname (cond
+                     ((null fname) nil)
+                     ((or (string= "" fname) (string= "/" fname))
+                      url-directory-index-file)
+                     ((= (string-to-char fname) ?/)
+                      (if (string= (substring fname -1 nil) "/")
+                          (concat fname url-directory-index-file)
+                        (substring fname 1 nil)))
+                     (t
+                      (if (string= (substring fname -1 nil) "/")
+                          (concat fname url-directory-index-file)
+                        fname))))
+        (and fname
+             (expand-file-name fname
+                               (expand-file-name
+                                (mapconcat 'identity host-components "/")
+                                url-cache-directory))))))
+
+(defun url-cache-create-filename-using-md5 (url)
+  "Create a cached filename using MD5.
+Very fast if you have an `md5' primitive function, suitably fast otherwise."
+  (require 'md5)
+  (if url
+      (let* ((url (if (vectorp url) (url-recreate-url url) url))
+             (checksum (md5 url))
+             (urlobj (url-generic-parse-url url))
+             (protocol (url-type urlobj))
+             (hostname (url-host urlobj))
+             (host-components
+              (cons
+               (user-real-login-name)
+               (cons (or protocol "file")
+                     (nreverse
+                      (delq nil
+                            (split-string (or hostname "localhost")
+                                          (eval-when-compile
+                                            (regexp-quote "."))))))))
+             (fname    (url-filename urlobj)))
+        (and fname
+             (expand-file-name checksum
+                               (expand-file-name
+                                (mapconcat 'identity host-components "/")
+                                url-cache-directory))))))
+
+(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5
+  "*What function to use to create a cached filename."
+  :type '(choice (const :tag "MD5 of filename (low collision rate)"
+                        :value url-cache-create-filename-using-md5)
+                 (const :tag "Human readable filenames (higher collision rate)"
+                        :value url-cache-create-filename-human-readable)
+                 (function :tag "Other"))
+  :group 'url-cache)
+
+(defun url-cache-create-filename (url)
+  (funcall url-cache-creation-function url))
+
+;;;###autoload
+(defun url-cache-extract (fnam)
+  "Extract FNAM from the local disk cache"
+  (erase-buffer)
+  (insert-file-contents-literally fnam))
+
+;;;###autoload
+(defun url-cache-expired (url mod)
+  "Return t iff a cached file has expired."
+  (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url)))
+         (type (url-type urlobj)))
+    (cond
+     (url-standalone-mode
+      (not (file-exists-p (url-cache-create-filename url))))
+     ((string= type "http")
+      t)
+     ((member type '("file" "ftp"))
+      (if (or (equal mod '(0 0)) (not mod))
+          t
+        (or (> (nth 0 mod) (nth 0 (current-time)))
+            (> (nth 1 mod) (nth 1 (current-time))))))
+     (t nil))))
+
+(provide 'url-cache)
+
+;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
new file mode 100644
index 00000000000..9f7db867597
--- /dev/null
+++ b/lisp/url/url-cookie.el
@@ -0,0 +1,466 @@
+;;; url-cookie.el --- Netscape Cookie support
+
+;; Copyright (c) 1996 - 1999,2004  Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'timezone)
+(require 'url-util)
+(require 'url-parse)
+(eval-when-compile (require 'cl))
+
+;; 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 path 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-path    (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-path    (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)
+  (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-path retval (url-cookie-retrieve-arg :path 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)
+  (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie)))
+
+(defgroup url-cookie nil
+  "URL cookies"
+  :prefix "url-"
+  :prefix "url-cookie-"
+  :group 'url)
+
+(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            "*Where cookies are stored on disk."
+  :type '(choice (const :tag "Default" :value nil) file)
+  :group 'url-file
+  :group 'url-cookie)
+
+(defcustom url-cookie-confirmation nil
+  "*If non-nil, confirmation by the user is required to accept HTTP cookies."
+  :type 'boolean
+  :group 'url-cookie)
+
+(defcustom url-cookie-multiple-line nil
+  "*If nil, HTTP requests put all cookies for the server on one line.
+Some web servers, such as http://www.hotmail.com/, only accept cookies
+when they are on one line.  This is broken behaviour, but just try
+telling Microsoft that.")
+
+(defvar url-cookies-changed-since-last-save nil
+  "Whether the cookies list has changed since the last save operation.")
+
+;;;###autoload
+(defun url-cookie-parse-file (&optional fname)
+  (setq fname (or fname url-cookie-file))
+  (condition-case ()
+      (load fname nil t)
+    (error (message "Could not load cookie file %s" fname))))
+
+(defun url-cookie-clean-up (&optional secure)
+  (let* (
+         (var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
+         (val (symbol-value var))
+         (cur nil)
+         (new nil)
+         (cookies nil)
+         (cur-cookie nil)
+         (new-cookies nil)
+         )
+    (while val
+      (setq cur (car val)
+            val (cdr val)
+            new-cookies nil
+            cookies (cdr cur))
+      (while cookies
+        (setq cur-cookie (car cookies)
+              cookies (cdr cookies))
+        (if (or (not (url-cookie-p cur-cookie))
+                (url-cookie-expired-p cur-cookie)
+                (null (url-cookie-expires cur-cookie)))
+            nil
+          (setq new-cookies (cons cur-cookie new-cookies))))
+      (if (not new-cookies)
+          nil
+        (setcdr cur new-cookies)
+        (setq new (cons cur new))))
+    (set var new)))
+
+;;;###autoload
+(defun url-cookie-write-file (&optional fname)
+  (setq fname (or fname url-cookie-file))
+  (cond
+   ((not url-cookies-changed-since-last-save) nil)
+   ((not (file-writable-p fname))
+    (message "Cookies file %s (see variable `url-cookie-file') is unwritable." fname))
+   (t
+    (url-cookie-clean-up)
+    (url-cookie-clean-up t)
+    (save-excursion
+      (set-buffer (get-buffer-create " *cookies*"))
+      (erase-buffer)
+      (fundamental-mode)
+      (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")
+      (write-file fname)
+      (kill-buffer (current-buffer))))))
+
+(defun url-cookie-store (name value &optional expires domain path secure)
+  "Store a netscape-style cookie."
+  (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage))
+         (tmp storage)
+         (cur nil)
+         (found-domain nil))
+
+    ;; First, look for a matching domain
+    (setq found-domain (assoc domain storage))
+
+    (if found-domain
+        ;; Need to either stick the new cookie in existing domain storage
+        ;; or possibly replace an existing cookie if the names match.
+        (progn
+          (setq storage (cdr found-domain)
+                tmp nil)
+          (while storage
+            (setq cur (car storage)
+                  storage (cdr storage))
+            (if (and (equal path (url-cookie-path cur))
+                     (equal name (url-cookie-name cur)))
+                (progn
+                  (url-cookie-set-expires cur expires)
+                  (url-cookie-set-value cur value)
+                  (setq tmp t))))
+          (if (not tmp)
+              ;; New cookie
+              (setcdr found-domain (cons
+                                    (url-cookie-create :name name
+                                                       :value value
+                                                       :expires expires
+                                                       :domain domain
+                                                       :path path
+                                                       :secure secure)
+                                    (cdr found-domain)))))
+      ;; Need to add a new top-level domain
+      (setq tmp (url-cookie-create :name name
+                                   :value value
+                                   :expires expires
+                                   :domain domain
+                                   :path path
+                                   :secure secure))
+      (cond
+       (storage
+        (setcdr storage (cons (list domain tmp) (cdr storage))))
+       (secure
+        (setq url-cookie-secure-storage (list (list domain tmp))))
+       (t
+        (setq url-cookie-storage (list (list domain tmp))))))))
+
+(defun url-cookie-expired-p (cookie)
+  (let* (
+         (exp (url-cookie-expires cookie))
+         (cur-date (and exp (timezone-parse-date (current-time-string))))
+         (exp-date (and exp (timezone-parse-date exp)))
+         (cur-greg (and cur-date (timezone-absolute-from-gregorian
+                                  (string-to-int (aref cur-date 1))
+                                  (string-to-int (aref cur-date 2))
+                                  (string-to-int (aref cur-date 0)))))
+         (exp-greg (and exp (timezone-absolute-from-gregorian
+                             (string-to-int (aref exp-date 1))
+                             (string-to-int (aref exp-date 2))
+                             (string-to-int (aref exp-date 0)))))
+         (diff-in-days (and exp (- cur-greg exp-greg)))
+         )
+    (cond
+     ((not exp) nil)                    ; No expiry == expires at browser quit
+     ((< diff-in-days 0) nil)           ; Expires sometime after today
+     ((> diff-in-days 0) t)             ; Expired before today
+     (t                                 ; Expires sometime today, check times
+      (let* ((cur-time (timezone-parse-time (aref cur-date 3)))
+             (exp-time (timezone-parse-time (aref exp-date 3)))
+             (cur-norm (+ (* 360 (string-to-int (aref cur-time 2)))
+                          (*  60 (string-to-int (aref cur-time 1)))
+                          (*   1 (string-to-int (aref cur-time 0)))))
+             (exp-norm (+ (* 360 (string-to-int (aref exp-time 2)))
+                          (*  60 (string-to-int (aref exp-time 1)))
+                          (*   1 (string-to-int (aref exp-time 0))))))
+        (> (- cur-norm exp-norm) 1))))))
+
+;;;###autoload
+(defun url-cookie-retrieve (host path &optional secure)
+  "Retrieve all the netscape-style cookies for a specified HOST and PATH."
+  (let ((storage (if secure
+                     (append url-cookie-secure-storage url-cookie-storage)
+                   url-cookie-storage))
+        (case-fold-search t)
+        (cookies nil)
+        (cur nil)
+        (retval nil)
+        (path-regexp nil))
+    (while storage
+      (setq cur (car storage)
+            storage (cdr storage)
+            cookies (cdr cur))
+      (if (and (car cur)
+               (string-match (concat "^.*" (regexp-quote (car cur)) "$") host))
+          ;; The domains match - a possible hit!
+          (while cookies
+            (setq cur (car cookies)
+                  cookies (cdr cookies)
+                  path-regexp (concat "^" (regexp-quote
+                                           (url-cookie-path cur))))
+            (if (and (string-match path-regexp path)
+                     (not (url-cookie-expired-p cur)))
+                (setq retval (cons cur retval))))))
+    retval))
+
+;;;###autolaod
+(defun url-cookie-generate-header-lines (host path secure)
+  (let* ((cookies (url-cookie-retrieve host path secure))
+        (retval nil)
+        (cur nil)
+        (chunk nil))
+    ;; Have to sort this for sending most specific cookies first
+    (setq cookies (and cookies
+                       (sort cookies
+                             (function
+                              (lambda (x y)
+                                (> (length (url-cookie-path x))
+                                   (length (url-cookie-path y))))))))
+    (while cookies
+      (setq cur (car cookies)
+            cookies (cdr cookies)
+            chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur))
+            retval (if (and url-cookie-multiple-line
+                            (< 80 (+ (length retval) (length chunk) 4)))
+                       (concat retval "\r\nCookie: " chunk)
+                     (if retval
+                         (concat retval "; " chunk)
+                       (concat "Cookie: " chunk)))))
+    (if retval
+        (concat retval "\r\n")
+      "")))
+
+(defvar url-cookie-two-dot-domains
+  (concat "\\.\\("
+   (mapconcat 'identity (list "com" "edu" "net" "org" "gov" "mil" "int")
+              "\\|")
+   "\\)$")
+  "A regexp of top level domains that only require two matching
+'.'s in the domain name in order to set a cookie.")
+
+(defcustom url-cookie-trusted-urls nil
+  "*A list of regular expressions matching URLs to always accept cookies from."
+  :type '(repeat regexp)
+  :group 'url-cookie)
+
+(defcustom url-cookie-untrusted-urls nil
+  "*A list of regular expressions matching URLs to never accept cookies from."
+  :type '(repeat regexp)
+  :group 'url-cookie)
+
+(defun url-cookie-host-can-set-p (host domain)
+  (let ((numdots 0)
+        (tmp domain)
+        (last nil)
+        (case-fold-search t)
+        (mindots 3))
+    (while (setq last (string-match "\\." domain last))
+      (setq numdots (1+ numdots)
+            last (1+ last)))
+    (if (string-match url-cookie-two-dot-domains domain)
+        (setq mindots 2))
+    (cond
+     ((string= host domain)             ; Apparently netscape lets you do this
+      t)
+     ((>= numdots mindots)              ; We have enough dots in domain name
+      ;; Need to check and make sure the host is actually _in_ the
+      ;; domain it wants to set a cookie for though.
+      (string-match (concat (regexp-quote domain) "$") host))
+     (t
+      nil))))
+
+;;;###autoload
+(defun url-cookie-handle-set-cookie (str)
+  (setq url-cookies-changed-since-last-save t)
+  (let* ((args (url-parse-args str t))
+         (case-fold-search t)
+         (secure (and (assoc-string "secure" args t) t))
+         (domain (or (cdr-safe (assoc-string "domain" args t))
+                     (url-host url-current-object)))
+         (current-url (url-view-url t))
+         (trusted url-cookie-trusted-urls)
+         (untrusted url-cookie-untrusted-urls)
+         (expires (cdr-safe (assoc-string "expires" args t)))
+         (path (or (cdr-safe (assoc-string "path" args t))
+                   (file-name-directory
+                    (url-filename url-current-object))))
+         (rest nil))
+    (while args
+      (if (not (member (downcase (car (car args)))
+                       '("secure" "domain" "expires" "path")))
+          (setq rest (cons (car args) rest)))
+      (setq args (cdr args)))
+
+    ;; Sometimes we get dates that the timezone package cannot handle very
+    ;; gracefully - take care of this here, instead of in url-cookie-expired-p
+    ;; to speed things up.
+    (if (and expires
+             (string-match
+              (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
+                      "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
+              expires))
+        (setq expires (concat (match-string 1 expires) " "
+                              (match-string 2 expires) " "
+                              (match-string 3 expires) " "
+                              (match-string 4 expires) " ["
+                              (match-string 5 expires) "]")))
+
+    ;; This one is for older Emacs/XEmacs variants that don't
+    ;; understand this format without tenths of a second in it.
+    ;; Wednesday, 30-Dec-2037 16:00:00 GMT
+    ;;       - vs -
+    ;; Wednesday, 30-Dec-2037 16:00:00.00 GMT
+    (if (and expires
+             (string-match
+              "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
+              expires))
+        (setq expires (concat (match-string 1 expires) "-"      ; day
+                              (match-string 2 expires) "-"      ; month
+                              (match-string 3 expires) " "      ; year
+                              (match-string 4 expires) ".00 " ; hour:minutes:seconds
+                              (match-string 6 expires)))) ":" ; timezone
+
+    (while (consp trusted)
+      (if (string-match (car trusted) current-url)
+          (setq trusted (- (match-end 0) (match-beginning 0)))
+        (pop trusted)))
+    (while (consp untrusted)
+      (if (string-match (car untrusted) current-url)
+          (setq untrusted (- (match-end 0) (match-beginning 0)))
+        (pop untrusted)))
+    (if (and trusted untrusted)
+        ;; Choose the more specific match
+        (if (> trusted untrusted)
+            (setq untrusted nil)
+          (setq trusted nil)))
+    (cond
+     (untrusted
+      ;; The site was explicity marked as untrusted by the user
+      nil)
+     ((or (eq url-privacy-level 'paranoid)
+          (and (listp url-privacy-level) (memq 'cookies url-privacy-level)))
+      ;; user never wants cookies
+      nil)
+     ((and url-cookie-confirmation
+           (not trusted)
+           (save-window-excursion
+             (with-output-to-temp-buffer "*Cookie Warning*"
+               (mapcar
+                (function
+                 (lambda (x)
+                   (princ (format "%s - %s" (car x) (cdr x))))) rest))
+             (prog1
+                 (not (funcall url-confirmation-func
+                               (format "Allow %s to set these cookies? "
+                                       (url-host url-current-object))))
+               (if (get-buffer "*Cookie Warning*")
+                   (kill-buffer "*Cookie Warning*")))))
+      ;; user wants to be asked, and declined.
+      nil)
+     ((url-cookie-host-can-set-p (url-host url-current-object) domain)
+      ;; Cookie is accepted by the user, and passes our security checks
+      (let ((cur nil))
+        (while rest
+          (setq cur (pop rest))
+          (url-cookie-store (car cur) (cdr cur)
+                            expires domain path secure))))
+     (t
+      (message "%s tried to set a cookie for domain %s - rejected."
+               (url-host url-current-object) domain)))))
+
+(defvar url-cookie-timer nil)
+
+(defcustom url-cookie-save-interval 3600
+  "*The number of seconds between automatic saves of cookies.
+Default is 1 hour.  Note that if you change this variable outside of
+the `customize' interface after `url-do-setup' has been run, you need
+to run the `url-cookie-setup-save-timer' function manually."
+  :set (function (lambda (var val)
+                   (set-default var val)
+                   (and (featurep 'url)
+                        (fboundp 'url-cookie-setup-save-timer)
+                        (url-cookie-setup-save-timer))))
+  :type 'integer
+  :group 'url)
+
+;;;###autoload
+(defun url-cookie-setup-save-timer ()
+  "Reset the cookie saver timer."
+  (interactive)
+  (ignore-errors
+    (cond ((fboundp 'cancel-timer) (cancel-timer url-cookie-timer))
+          ((fboundp 'delete-itimer) (delete-itimer url-cookie-timer))))
+  (setq url-cookie-timer nil)
+  (if url-cookie-save-interval
+      (setq url-cookie-timer
+            (cond
+             ((fboundp 'run-at-time)
+              (run-at-time url-cookie-save-interval
+                           url-cookie-save-interval
+                           'url-cookie-write-file))
+             ((fboundp 'start-itimer)
+              (start-itimer "url-cookie-saver" 'url-cookie-write-file
+                            url-cookie-save-interval
+                            url-cookie-save-interval))))))
+
+(provide 'url-cookie)
+
+;; arch-tag: 2568751b-6452-4398-aa2d-303edadb54d7
+;;; url-cookie.el ends here
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
new file mode 100644
index 00000000000..73307412e1e
--- /dev/null
+++ b/lisp/url/url-dired.el
@@ -0,0 +1,100 @@
+;;; url-dired.el --- URL Dired minor mode
+;; Keywords: comm, files
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(autoload 'w3-fetch "w3")
+(autoload 'w3-open-local "w3")
+(autoload 'dired-get-filename "dired")
+
+(defvar url-dired-minor-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-m" 'url-dired-find-file)
+    (if (featurep 'xemacs)
+        (define-key map [button2] 'url-dired-find-file-mouse)
+      (define-key map [mouse-2] 'url-dired-find-file-mouse))
+    map)
+  "Keymap used when browsing directories.")
+
+(defvar url-dired-minor-mode nil
+  "Whether we are in url-dired-minor-mode")
+
+(make-variable-buffer-local 'url-dired-minor-mode)
+
+(defun url-dired-find-file ()
+  "In dired, visit the file or directory named on this line, using Emacs-W3."
+  (interactive)
+  (let ((filename (dired-get-filename)))
+    (cond ((string-match "/\\(.*@.*\\):\\(/.*\\)" filename)
+           (w3-fetch (concat "file://" (match-string 1 filename) (match-string 2 filename))))
+          (t
+           (w3-open-local filename)))))
+
+(defun url-dired-find-file-mouse (event)
+  "In dired, visit the file or directory name you click on, using Emacs-W3."
+  (interactive "@e")
+  (mouse-set-point event)
+  (url-dired-find-file))
+
+(defun url-dired-minor-mode (&optional arg)
+  "Minor mode for directory browsing with Emacs-W3."
+  (interactive "P")
+  (cond
+   ((null arg)
+    (setq url-dired-minor-mode (not url-dired-minor-mode)))
+   ((equal 0 arg)
+    (setq url-dired-minor-mode nil))
+   (t
+    (setq url-dired-minor-mode t))))
+
+(if (not (fboundp 'add-minor-mode))
+    (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
+      "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
+TOGGLE is a symbol which is used as the variable which toggle the minor mode,
+NAME is the name that should appear in the modeline (it should be a string
+beginning with a space), KEYMAP is a keymap to make active when the minor
+mode is active, and AFTER is the toggling symbol used for another minor
+mode.  If AFTER is non-nil, then it is used to position the new mode in the
+minor-mode alists.  TOGGLE-FUN specifies an interactive function that
+is called to toggle the mode on and off; this affects what appens when
+button2 is pressed on the mode, and when button3 is pressed somewhere
+in the list of modes.  If TOGGLE-FUN is nil and TOGGLE names an
+interactive function, TOGGLE is used as the toggle function.
+
+Example:  (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
+      (if (not (assq toggle minor-mode-alist))
+          (setq minor-mode-alist (cons (list toggle name) minor-mode-alist)))
+      (if (and keymap (not (assq toggle minor-mode-map-alist)))
+          (setq minor-mode-map-alist (cons (cons toggle keymap)
+                                           minor-mode-map-alist)))))
+
+(add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map)
+
+(defun url-find-file-dired (dir)
+  "\"Edit\" directory DIR, but with additional URL-friendly bindings."
+  (interactive "DURL Dired (directory): ")
+  (find-file dir)
+  (url-dired-minor-mode t))
+
+(provide 'url-dired)
+
+;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 77c2e74555f..0aa23acc0ec 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -1,7 +1,6 @@
 ;;; url-file.el --- File retrieval code
 
 ;; Copyright (c) 1996 - 1999,2004  Free Software Foundation, Inc.
-;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
 
 ;; Keywords: comm, data, processes
 
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el
new file mode 100644
index 00000000000..4346f3910b1
--- /dev/null
+++ b/lisp/url/url-ftp.el
@@ -0,0 +1,42 @@
+;;; url-ftp.el --- FTP wrapper
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; We knew not what we did when we overloaded 'file' to mean 'file'
+;; and 'ftp' back in the dark ages of the web.
+;;
+;; This stub file is just here to please the auto-scheme-loading code
+;; in url-methods.el and just maps everything onto the code in
+;; url-file.
+
+(require 'url-parse)
+(require 'url-file)
+
+(defconst url-ftp-default-port 21 "Default FTP port.")
+(defconst url-ftp-asynchronous-p t "FTP transfers are asynchronous.")
+(defalias 'url-ftp-expand-file-name 'url-default-expander)
+(defalias 'url-ftp 'url-file)
+
+(provide 'url-ftp)
+
+;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
new file mode 100644
index 00000000000..608827d7cee
--- /dev/null
+++ b/lisp/url/url-gw.el
@@ -0,0 +1,268 @@
+;;; url-gw.el --- Gateway munging for URL loading
+;; Author: Bill Perry <wmperry@gnu.org>
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(eval-when-compile (require 'cl))
+(require 'url-vars)
+
+;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program?
+
+(autoload 'socks-open-network-stream "socks")
+(autoload 'open-ssl-stream "ssl")
+(autoload 'open-tls-stream "tls")
+
+(defgroup url-gateway nil
+  "URL gateway variables"
+  :group 'url)
+
+(defcustom url-gateway-local-host-regexp nil
+  "*A regular expression specifying local hostnames/machines."
+  :type '(choice (const nil) regexp)
+  :group 'url-gateway)
+
+(defcustom url-gateway-prompt-pattern
+  "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?"
+  "*A regular expression matching a shell prompt."
+  :type 'regexp
+  :group 'url-gateway)
+
+(defcustom url-gateway-rlogin-host nil
+  "*What hostname to actually rlog into before doing a telnet."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-rlogin-user-name nil
+  "*Username to log into the remote machine with when using rlogin."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-rlogin-parameters '("telnet" "-8")
+  "*Parameters to `url-open-rlogin'.
+This list will be used as the parameter list given to rsh."
+  :type '(repeat string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-host nil
+  "*What hostname to actually login to before doing a telnet."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8")
+  "*Parameters to `url-open-telnet'.
+This list will be executed as a command after logging in via telnet."
+  :type '(repeat string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-login-prompt "^\r*.?login:"
+  "*Prompt that tells us we should send our username when loggin in w/telnet."
+  :type 'regexp
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-password-prompt "^\r*.?password:"
+  "*Prompt that tells us we should send our password when loggin in w/telnet."
+  :type 'regexp
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-user-name nil
+  "User name to log in via telnet with."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-password nil
+  "Password to use to log in via telnet with."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-broken-resolution nil
+  "*Whether to use nslookup to resolve hostnames.
+This should be used when your version of Emacs cannot correctly use DNS,
+but your machine can.  This usually happens if you are running a statically
+linked Emacs under SunOS 4.x"
+  :type 'boolean
+  :group 'url-gateway)
+
+(defcustom url-gateway-nslookup-program "nslookup"
+  "*If non-NIL then a string naming nslookup program."
+  :type '(choice (const :tag "None" :value nil) string)
+  :group 'url-gateway)
+
+;; Stolen from ange-ftp
+;;;###autoload
+(defun url-gateway-nslookup-host (host)
+  "Attempt to resolve the given HOST using nslookup if possible."
+  (interactive "sHost:  ")
+  (if url-gateway-nslookup-program
+      (let ((proc (start-process " *nslookup*" " *nslookup*"
+                                 url-gateway-nslookup-program host))
+            (res host))
+        (process-kill-without-query proc)
+        (save-excursion
+          (set-buffer (process-buffer proc))
+          (while (memq (process-status proc) '(run open))
+            (accept-process-output proc))
+          (goto-char (point-min))
+          (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
+              (setq res (buffer-substring (match-beginning 1)
+                                          (match-end 1))))
+          (kill-buffer (current-buffer)))
+        res)
+    host))
+
+;; Stolen from red gnus nntp.el
+(defun url-wait-for-string (regexp proc)
+  "Wait until string matching REGEXP arrives in process PROC's buffer."
+  (let ((buf (current-buffer)))
+    (goto-char (point-min))
+    (while (not (re-search-forward regexp nil t))
+      (accept-process-output proc)
+      (set-buffer buf)
+      (goto-char (point-min)))))
+
+;; Stolen from red gnus nntp.el
+(defun url-open-rlogin (name buffer host service)
+  "Open a connection using rsh."
+  (if (not (stringp service))
+      (setq service (int-to-string service)))
+  (let ((proc (if url-gateway-rlogin-user-name
+                  (start-process
+                   name buffer "rsh"
+                   url-gateway-rlogin-host "-l" url-gateway-rlogin-user-name
+                   (mapconcat 'identity
+                              (append url-gateway-rlogin-parameters
+                                      (list host service)) " "))
+                (start-process
+                 name buffer "rsh" url-gateway-rlogin-host
+                 (mapconcat 'identity
+                            (append url-gateway-rlogin-parameters
+                                    (list host service))
+                            " ")))))
+    (set-buffer buffer)
+    (url-wait-for-string "^\r*200" proc)
+    (beginning-of-line)
+    (delete-region (point-min) (point))
+    proc))
+
+;; Stolen from red gnus nntp.el
+(defun url-open-telnet (name buffer host service)
+  (if (not (stringp service))
+      (setq service (int-to-string service)))
+  (save-excursion
+    (set-buffer (get-buffer-create buffer))
+    (erase-buffer)
+    (let ((proc (start-process name buffer "telnet" "-8"))
+          (case-fold-search t))
+      (when (memq (process-status proc) '(open run))
+        (process-send-string proc "set escape \^X\n")
+        (process-send-string proc (concat
+                                   "open " url-gateway-telnet-host "\n"))
+        (url-wait-for-string url-gateway-telnet-login-prompt proc)
+        (process-send-string
+         proc (concat
+               (or url-gateway-telnet-user-name
+                   (setq url-gateway-telnet-user-name (read-string "login: ")))
+               "\n"))
+        (url-wait-for-string url-gateway-telnet-password-prompt proc)
+        (process-send-string
+         proc (concat
+               (or url-gateway-telnet-password
+                   (setq url-gateway-telnet-password
+                         (funcall url-passwd-entry-func "Password: ")))
+               "\n"))
+        (erase-buffer)
+        (url-wait-for-string url-gateway-prompt-pattern proc)
+        (process-send-string
+         proc (concat (mapconcat 'identity
+                                 (append url-gateway-telnet-parameters
+                                         (list host service)) " ") "\n"))
+        (url-wait-for-string "^\r*Escape character.*\r*\n+" proc)
+        (delete-region (point-min) (match-end 0))
+        (process-send-string proc "\^]\n")
+        (url-wait-for-string "^telnet" proc)
+        (process-send-string proc "mode character\n")
+        (accept-process-output proc 1)
+        (sit-for 1)
+        (goto-char (point-min))
+        (forward-line 1)
+        (delete-region (point) (point-max)))
+      proc)))
+
+;;;###autoload
+(defun url-open-stream (name buffer host service)
+  "Open a stream to HOST, possibly via a gateway.
+Args per `open-network-stream'.
+Will not make a connexion if `url-gateway-unplugged' is non-nil."
+  (unless url-gateway-unplugged
+    (let ((gw-method (if (and url-gateway-local-host-regexp
+                              (not (eq 'tls url-gateway-method))
+                              (not (eq 'ssl url-gateway-method))
+                              (string-match
+                               url-gateway-local-host-regexp
+                               host))
+                         'native
+                       url-gateway-method))
+;;;     ;; This hack is for OS/2 Emacs so that it will not do bogus CRLF
+;;;     ;; conversions while trying to be 'helpful'
+;;;     (tcp-binary-process-output-services (if (stringp service)
+;;;                                             (list service)
+;;;                                           (list service
+;;;                                                 (int-to-string service))))
+
+          ;; An attempt to deal with denied connections, and attempt
+          ;; to reconnect
+          (cur-retries 0)
+          (retry t)
+          (errobj nil)
+          (conn nil))
+
+      ;; If the user told us to do DNS for them, do it.
+      (if url-gateway-broken-resolution
+          (setq host (url-gateway-nslookup-host host)))
+
+      (condition-case errobj
+          ;; This is a clean way to ensure the new process inherits the
+          ;; right coding systems in both Emacs and XEmacs.
+          (let ((coding-system-for-read 'binary)
+                (coding-system-for-write 'binary))
+            (setq conn (case gw-method
+                         (tls
+                          (open-tls-stream name buffer host service))
+                         (ssl
+                          (open-ssl-stream name buffer host service))
+                         ((native)
+                          (open-network-stream name buffer host service))
+                         (socks
+                          (socks-open-network-stream name buffer host service))
+                         (telnet
+                          (url-open-telnet name buffer host service))
+                         (rlogin
+                          (url-open-rlogin name buffer host service))
+                         (otherwise
+                          (error "Bad setting of url-gateway-method: %s"
+                                 url-gateway-method)))))
+        (error
+         (setq conn nil)))
+      conn)))
+
+(provide 'url-gw)
+
+;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 56497b00119..db961b9c27e 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -1,7 +1,6 @@
 ;;; url-handlers.el --- file-name-handler stuff for URL loading
 
 ;; Copyright (c) 1996, 1997, 1998, 1999, 2004  Free Software Foundation, Inc.
-;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
 
 ;; Keywords: comm, data, processes, hypermedia
 
@@ -208,7 +207,7 @@ accessible."
         ;; annotation which we could use as a hint of the locale in use
         ;; at the remote site.  Not sure how/if that should be done.  --Stef
         (decode-coding-inserted-region
-         start (point) buffer-file-name visit beg end replace)))
+         start (point) url visit beg end replace)))
     (list url (length data))))
 
 (defun url-file-name-completion (url directory)
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
new file mode 100644
index 00000000000..6a2d87cfbc1
--- /dev/null
+++ b/lisp/url/url-history.el
@@ -0,0 +1,199 @@
+;;; url-history.el --- Global history tracking for URL package
+
+;; Copyright (c) 1996 - 1999,2004  Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+;; This can get a recursive require.
+;;(require 'url)
+(eval-when-compile (require 'cl))
+(require 'url-parse)
+(autoload 'url-do-setup "url")
+
+(defgroup url-history nil
+  "History variables in the URL package"
+  :prefix "url-history"
+  :group 'url)
+
+(defcustom url-history-track nil
+  "*Controls whether to keep a list of all the URLS being visited.
+If non-nil, url will keep track of all the URLS visited.
+If eq to `t', then the list is saved to disk at the end of each emacs
+session."
+  :type 'boolean
+  :group 'url-history)
+
+(defcustom url-history-file nil
+  "*The global history file for the URL package.
+This file contains a list of all the URLs you have visited.  This file
+is parsed at startup and used to provide URL completion."
+  :type '(choice (const :tag "Default" :value nil) file)
+  :group 'url-history)
+
+(defcustom url-history-save-interval 3600
+  "*The number of seconds between automatic saves of the history list.
+Default is 1 hour.  Note that if you change this variable outside of
+the `customize' interface after `url-do-setup' has been run, you need
+to run the `url-history-setup-save-timer' function manually."
+  :set (function (lambda (var val)
+                   (set-default var val)
+                   (and (featurep 'url)
+                        (fboundp 'url-history-setup-save-timer)
+                        (let ((def (symbol-function
+                                    'url-history-setup-save-timer)))
+                          (not (and (listp def) (eq 'autoload (car def)))))
+                        (url-history-setup-save-timer))))
+  :type 'integer
+  :group 'url-history)
+
+(defvar url-history-timer nil)
+
+(defvar url-history-list nil
+  "List of urls visited this session.")
+
+(defvar url-history-changed-since-last-save nil
+  "Whether the history list has changed since the last save operation.")
+
+(defvar url-history-hash-table nil
+  "Hash table for global history completion.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun url-history-setup-save-timer ()
+  "Reset the history list timer."
+  (interactive)
+  (ignore-errors 
+    (cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer))
+          ((fboundp 'delete-itimer) (delete-itimer url-history-timer))))
+  (setq url-history-timer nil)
+  (if url-history-save-interval
+      (setq url-history-timer
+            (cond
+             ((fboundp 'run-at-time)
+              (run-at-time url-history-save-interval
+                           url-history-save-interval
+                           'url-history-save-history))
+             ((fboundp 'start-itimer)
+              (start-itimer "url-history-saver" 'url-history-save-history
+                            url-history-save-interval
+                            url-history-save-interval))))))
+
+;;;###autoload
+(defun url-history-parse-history (&optional fname)
+  "Parse a history file stored in FNAME."
+  ;; Parse out the mosaic global history file for completions, etc.
+  (or fname (setq fname (expand-file-name url-history-file)))
+  (cond
+   ((not (file-exists-p fname))
+    (message "%s does not exist." fname))
+   ((not (file-readable-p fname))
+    (message "%s is unreadable." fname))
+   (t
+    (condition-case nil
+        (load fname nil t)
+      (error (message "Could not load %s" fname)))))
+  (if (not url-history-hash-table)
+      (setq url-history-hash-table (make-hash-table :size 31 :test 'equal))))
+
+(defun url-history-update-url (url time)
+  (setq url-history-changed-since-last-save t)
+  (puthash (if (vectorp url) (url-recreate-url url) url) time url-history-hash-table))
+
+;;;###autoload
+(defun url-history-save-history (&optional fname)
+  "Write the global history file into `url-history-file'.
+The type of data written is determined by what is in the file to begin
+with.  If the type of storage cannot be determined, then prompt the
+user for what type to save as."
+  (interactive)
+  (or fname (setq fname (expand-file-name url-history-file)))
+  (cond
+   ((not url-history-changed-since-last-save) nil)
+   ((not (file-writable-p fname))
+    (message "%s is unwritable." fname))
+   (t
+    (let ((make-backup-files nil)
+          (version-control nil)
+          (require-final-newline t))
+      (save-excursion
+        (set-buffer (get-buffer-create " *url-tmp*"))
+        (erase-buffer)
+        (let ((count 0))
+          (maphash (function
+                       (lambda (key value)
+                         (while (string-match "[\r\n]+" key)
+                           (setq key (concat (substring key 0 (match-beginning 0))
+                                             (substring key (match-end 0) nil))))
+                         (setq count (1+ count))
+                         (insert "(puthash \"" key "\""
+                                 (if (not (stringp value)) " '" "")
+                                 (prin1-to-string value)
+                                 " url-history-hash-table)\n")))
+                      url-history-hash-table)
+          (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))
+        (kill-buffer (current-buffer))))))
+  (setq url-history-changed-since-last-save nil))
+
+(defun url-have-visited-url (url)
+  (url-do-setup)
+  (gethash url url-history-hash-table nil))
+
+(defun url-completion-function (string predicate function)
+  (url-do-setup)
+  (cond
+   ((eq function nil)
+    (let ((list nil))
+      (maphash (function (lambda (key val)
+                              (setq list (cons (cons key val)
+                                               list))))
+                  url-history-hash-table)
+      (try-completion string (nreverse list) predicate)))
+   ((eq function t)
+    (let ((stub (concat "^" (regexp-quote string)))
+          (retval nil))
+      (maphash
+       (function
+        (lambda (url time)
+          (if (string-match stub url)
+              (setq retval (cons url retval)))))
+       url-history-hash-table)
+      retval))
+   ((eq function 'lambda)
+    (and url-history-hash-table
+         (gethash string url-history-hash-table)
+         t))
+   (t
+    (error "url-completion-function very confused."))))
+
+(provide 'url-history)
+
+;; arch-tag: fbbbaf63-db36-4e88-bc9f-2939aa93afb2
+;;; url-history.el ends here
diff --git a/lisp/url/url-https.el b/lisp/url/url-https.el
index 11b2593ea80..9631aeb18e4 100644
--- a/lisp/url/url-https.el
+++ b/lisp/url/url-https.el
@@ -1,4 +1,4 @@
-;;; url-https.el --- HTTP over SSL routines
+;;; url-https.el --- HTTP over SSL/TLS routines
 
 ;; Copyright (c) 1999, 2004 Free Software Foundation, Inc.
 
@@ -30,6 +30,7 @@
 (require 'url-parse)
 (require 'url-cookie)
 (require 'url-http)
+(require 'tls)
 
 (defconst url-https-default-port 443 "Default HTTPS port.")
 (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
@@ -38,12 +39,11 @@
 (defmacro url-https-create-secure-wrapper (method args)
   `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args
     ,(format "HTTPS wrapper around `%s' call." (or method "url-http"))
-    (condition-case ()
-        (require 'ssl)
-      (error
-       (error "HTTPS support could not find `ssl' library")))
-    (let ((url-gateway-method 'ssl))
-      ( ,(intern (format (if method "url-http-%s" "url-http") method)) ,@(remove '&rest (remove '&optional args))))))
+    (let ((url-gateway-method (condition-case ()
+                                  (require 'ssl)
+                                (error 'tls))))
+      (,(intern (format (if method "url-http-%s" "url-http") method))
+       ,@(remove '&rest (remove '&optional args))))))
 
 (url-https-create-secure-wrapper nil (url callback cbargs))
 (url-https-create-secure-wrapper file-exists-p (url))
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
new file mode 100644
index 00000000000..a4b195f253f
--- /dev/null
+++ b/lisp/url/url-irc.el
@@ -0,0 +1,76 @@
+;;; url-irc.el --- IRC URL interface
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
+
+(require 'url-vars)
+(require 'url-parse)
+
+(defconst url-irc-default-port 6667 "Default port for IRC connections")
+
+(defcustom url-irc-function 'url-irc-zenirc
+  "*Function to actually open an IRC connection.
+Should be a function that takes several argument:
+    HOST - the hostname of the IRC server to contact
+    PORT - the port number of the IRC server to contact
+ CHANNEL - What channel on the server to visit right away (can be nil)
+    USER - What username to use
+PASSWORD - What password to use"
+  :type '(choice (const :tag "ZEN IRC" :value 'url-irc-zenirc)
+                 (function :tag "Other"))
+  :group 'url)
+
+(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)
+                              (format "%s:%d" host port)))
+        (zenirc-server-alist
+         (list
+          (list host port password nil user))))
+    (zenirc)
+    (goto-char (point-max))
+    (if (not channel)
+        nil
+      (insert "/join " channel)
+      (zenirc-send-line))))
+
+;;;###autoload
+(defun url-irc (url)
+  (let* ((host (url-host url))
+         (port (string-to-int (url-port url)))
+         (pass (url-password url))
+         (user (url-user url))
+         (chan (url-filename url)))
+    (if (url-target url)
+        (setq chan (concat chan "#" (url-target url))))
+    (if (string-match "^/" chan)
+        (setq chan (substring chan 1 nil)))
+    (if (= (length chan) 0)
+        (setq chan nil))
+    (funcall url-irc-function host port chan user pass)
+    nil))
+    
+(provide 'url-irc)
+
+;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
new file mode 100644
index 00000000000..24a3ade4922
--- /dev/null
+++ b/lisp/url/url-ldap.el
@@ -0,0 +1,240 @@
+;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
+;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-vars)
+(require 'url-parse)
+(require 'url-util)
+(require 'ldap)
+(autoload 'tls-certificate-information "tls")
+
+;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997)
+;;
+;; basic format is: ldap://host:port/dn?attributes?scope?filter?extensions
+;;
+;; Test URLs:
+;; ldap://ldap.itd.umich.edu/cn%3Dumbflabmanager%2C%20ou%3DUser%20Groups%2C%20ou%3DGroups%2C%20o%3DUniversity%20of%20Michigan%2C%20c%3DUS
+;; ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US
+;;
+;; For simple queries, I have verified compatibility with Netscape
+;; Communicator v4.5 under GNU/Linux.
+;;
+;; For anything _useful_ though, like specifying the attributes,
+;; scope, filter, or extensions, netscape claims the URL format is
+;; unrecognized.  So I don't think it supports anything other than the
+;; defaults (scope=base,attributes=*,filter=(objectClass=*)
+
+(defconst url-ldap-default-port 389 "Default LDAP port.")
+(defalias 'url-ldap-expand-file-name 'url-default-expander)
+
+(defvar url-ldap-pretty-names
+  '(("l"           . "City")
+    ("objectclass" . "Object Class")
+    ("o"           . "Organization")
+    ("ou"          . "Organizational Unit")
+    ("cn"          . "Name")
+    ("sn"          . "Last Name")
+    ("givenname"   . "First Name")
+    ("mail"        . "Email")
+    ("title"       . "Title")
+    ("c"           . "Country")
+    ("postalcode"  . "ZIP Code")
+    ("telephonenumber"          . "Phone Number")
+    ("facsimiletelephonenumber" . "Fax")
+    ("postaladdress"            . "Mailing Address")
+    ("description"              . "Notes"))
+  "*An assoc list mapping LDAP attribute names to pretty descriptions of them.")
+
+(defvar url-ldap-attribute-formatters
+  '(("mail"       . (lambda (x) (format "<a href='mailto:%s'>%s</a>" x x)))
+    ("owner"      . url-ldap-dn-formatter)
+    ("creatorsname" . url-ldap-dn-formatter)
+    ("jpegphoto"     . url-ldap-image-formatter)
+    ("usercertificate" . url-ldap-certificate-formatter)
+    ("modifiersname" . url-ldap-dn-formatter)
+    ("namingcontexts" . url-ldap-dn-formatter)
+    ("defaultnamingcontext" . url-ldap-dn-formatter)
+    ("member"     . url-ldap-dn-formatter))
+  "*An assoc list mapping LDAP attribute names to pretty formatters for them.")
+
+(defsubst url-ldap-attribute-pretty-name (n)
+  (or (cdr-safe (assoc (downcase n) url-ldap-pretty-names)) n))
+
+(defsubst url-ldap-attribute-pretty-desc (n v)
+  (if (string-match "^\\([^;]+\\);" n)
+      (setq n (match-string 1 n)))
+  (funcall (or (cdr-safe (assoc (downcase n) url-ldap-attribute-formatters)) 'identity) v))
+
+(defun url-ldap-dn-formatter (dn)
+  (concat "<a href='/"
+          (url-hexify-string dn)
+          "'>" dn "</a>"))
+
+(defun url-ldap-certificate-formatter (data)
+  (condition-case ()
+      (require 'ssl)
+    (error nil))
+  (let ((vals (if (fboundp 'ssl-certificate-information)
+                  (ssl-certificate-information data)
+                (tls-certificate-information data))))
+    (if (not vals)
+        "<b>Unable to parse certificate</b>"
+      (concat "<table border=0>\n"
+              (mapconcat
+               (lambda (ava)
+                 (format "<tr><td>%s</td><td>%s</td></tr>\n" (car ava) (cdr ava)))
+               vals "\n")
+              "</table>\n"))))
+
+(defun url-ldap-image-formatter (data)
+  (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"
+          (url-hexify-string (base64-encode-string data))))
+
+;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically
+;; calls of ldap-open, ldap-close, ldap-search-internal
+;;;###autoload
+(defun url-ldap (url)
+  (save-excursion
+    (set-buffer (generate-new-buffer " *url-ldap*"))
+    (setq url-current-object url)
+    (insert "Content-type: text/html\r\n\r\n")
+    (if (not (fboundp 'ldap-search-internal))
+        (insert "<html>\n"
+                " <head>\n"
+                "  <title>LDAP Not Supported</title>\n"
+                "  <base href='" (url-recreate-url url) "'>\n"
+                " </head>\n"
+                " <body>\n"
+                "  <h1>LDAP Not Supported</h1>\n"
+                "  <p>\n"
+                "    This version of Emacs does not support LDAP.\n"
+                "  </p>\n"
+                " </body>\n"
+                "</html>\n")
+      (let* ((binddn nil)
+             (data (url-filename url))
+             (host (url-host url))
+             (port (url-port url))
+             (base-object nil)
+             (attributes nil)
+             (scope nil)
+             (filter nil)
+             (extensions nil)
+             (connection nil)
+             (results nil)
+             (extract-dn (and (fboundp 'function-max-args)
+                              (= (function-max-args 'ldap-search-internal) 7))))
+
+        ;; Get rid of leading /
+        (if (string-match "^/" data)
+            (setq data (substring data 1)))
+
+        (setq data (mapcar (lambda (x) (if (/= (length x) 0) x nil)) (split-string data "\\?"))
+              base-object (nth 0 data)
+              attributes (nth 1 data)
+              scope (nth 2 data)
+              filter (nth 3 data)
+              extensions (nth 4 data))
+
+        ;; fill in the defaults
+        (setq base-object (url-unhex-string (or base-object ""))
+              scope (intern (url-unhex-string (or scope "base")))
+              filter (url-unhex-string (or filter "(objectClass=*)")))
+
+        (if (not (memq scope '(base one tree)))
+            (error "Malformed LDAP URL: Unknown scope: %S" scope))
+
+        ;; Convert to the internal LDAP support scoping names.
+        (setq scope (cdr (assq scope '((base . base) (one . onelevel) (sub . subtree)))))
+
+        (if attributes
+            (setq attributes (mapcar 'url-unhex-string (split-string attributes ","))))
+
+        ;; Parse out the exentions
+        (if extensions
+            (setq extensions (mapcar (lambda (ext)
+                                       (if (string-match "\\([^=]*\\)=\\(.*\\)" ext)
+                                           (cons (match-string 1 ext) (match-string 2 ext))
+                                         (cons ext ext)))
+                                     (split-string extensions ","))
+                  extensions (mapcar (lambda (ext)
+                                       (cons (url-unhex-string (car ext))
+                                             (url-unhex-string (cdr ext))))
+                                     extensions)))
+
+        (setq binddn (cdr-safe (or (assoc "bindname" extensions)
+                                   (assoc "!bindname" extensions))))
+    
+        ;; Now, let's actually do something with it.
+        (setq connection (ldap-open host (if binddn (list 'binddn binddn)))
+              results (if extract-dn
+                          (ldap-search-internal connection filter base-object scope attributes nil t)
+                        (ldap-search-internal connection filter base-object scope attributes nil)))
+                      
+        (ldap-close connection)
+        (insert "<html>\n"
+                " <head>\n"
+                "  <title>LDAP Search Results</title>\n"
+                "  <base href='" (url-recreate-url url) "'>\n"
+                " </head>\n"
+                " <body>\n"
+                "  <h1>" (int-to-string (length results)) " matches</h1>\n")
+
+        (mapc (lambda (obj)
+                (insert "  <hr>\n"
+                        "  <table border=1>\n")
+                (if extract-dn
+                    (insert "   <tr><th colspan=2>" (car obj) "</th></tr>\n"))
+                (mapc (lambda (attr)
+                        (if (= (length (cdr attr)) 1)
+                            ;; single match, easy
+                            (insert "   <tr><td>"
+                                    (url-ldap-attribute-pretty-name (car attr))
+                                    "</td><td>"
+                                    (url-ldap-attribute-pretty-desc (car attr) (car (cdr attr)))
+                                    "</td></tr>\n")
+                          ;; Multiple matches, slightly uglier
+                          (insert "   <tr>\n"
+                                  (format "    <td valign=top>")
+                                  (url-ldap-attribute-pretty-name (car attr)) "</td><td>"
+                                  (mapconcat (lambda (x)
+                                               (url-ldap-attribute-pretty-desc (car attr) x))
+                                             (cdr attr)
+                                             "<br>\n")
+                                  "</td>"
+                                  "   </tr>\n")))
+                      (if extract-dn (cdr obj) obj))
+                (insert "  </table>\n"))
+              results)
+
+        (insert "  <hr>\n"
+                " </body>\n"
+                "</html>\n")))
+    (current-buffer)))
+
+(provide 'url-ldap)
+
+;; arch-tag: 6230e21c-41ae-4174-bd83-82c835676fc8
+;;; url-ldap.el ends here
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
new file mode 100644
index 00000000000..bcb6bad4179
--- /dev/null
+++ b/lisp/url/url-mailto.el
@@ -0,0 +1,131 @@
+;;; url-mail.el --- Mail Uniform Resource Locator retrieval code
+
+;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'url-vars)
+(require 'url-parse)
+(require 'url-util)
+
+;;;###autoload
+(defun url-mail (&rest args)
+  (interactive "P")
+  (if (fboundp 'message-mail)
+      (apply 'message-mail args)
+    (or (apply 'mail args)
+        (error "Mail aborted"))))
+
+(defun url-mail-goto-field (field)
+  (if (not field)
+      (goto-char (point-max))
+    (let ((dest nil)
+          (lim nil)
+          (case-fold-search t))
+      (save-excursion
+        (goto-char (point-min))
+        (if (re-search-forward (regexp-quote mail-header-separator) nil t)
+            (setq lim (match-beginning 0)))
+        (goto-char (point-min))
+        (if (re-search-forward (concat "^" (regexp-quote field) ":") lim t)
+            (setq dest (match-beginning 0))))
+      (if dest
+          (progn
+            (goto-char dest)
+            (end-of-line))
+        (goto-char lim)
+        (insert (capitalize field) ": ")
+        (save-excursion
+          (insert "\n"))))))
+
+;;;###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))))
+  (setq url (url-filename url))
+  (let (to args source-url subject func headers-start)
+    (if (string-match (regexp-quote "?") url)
+        (setq headers-start (match-end 0)
+              to (url-unhex-string (substring url 0 (match-beginning 0)))
+              args (url-parse-query-string
+                    (substring url headers-start nil) t))
+      (setq to (url-unhex-string url)))
+    (setq source-url (url-view-url t))
+    (if (and url-request-data (not (assoc "subject" args)))
+        (setq args (cons (list "subject"
+                               (concat "Automatic submission from "
+                                       url-package-name "/"
+                                       url-package-version)) args)))
+    (if (and source-url (not (assoc "x-url-from" args)))
+        (setq args (cons (list "x-url-from" source-url) args)))
+
+    (if (assoc "to" args)
+        (push to (cdr (assoc "to" args)))
+      (setq args (cons (list "to" to) args)))
+    (setq subject (cdr-safe (assoc "subject" args)))
+    (if (fboundp url-mail-command) (funcall url-mail-command) (mail))
+    (while args
+      (if (string= (caar args) "body")
+          (progn
+            (goto-char (point-max))
+            (insert (mapconcat 'identity (cdar args) "\n")))
+        (url-mail-goto-field (caar args))
+        (setq func (intern-soft (concat "mail-" (caar args))))
+        (insert (mapconcat 'identity (cdar args) ", ")))
+      (setq args (cdr args)))
+    ;; (url-mail-goto-field "User-Agent")
+;;     (insert url-package-name "/" url-package-version " URL/" url-version)
+    (if (not url-request-data)
+        (progn
+          (set-buffer-modified-p nil)
+          (if subject
+              (url-mail-goto-field nil)
+            (url-mail-goto-field "subject")))
+      (if url-request-extra-headers
+          (mapconcat
+           (lambda (x)
+             (url-mail-goto-field (car x))
+             (insert (cdr x)))
+           url-request-extra-headers ""))
+      (goto-char (point-max))
+      (insert url-request-data)
+      ;; It seems Microsoft-ish to send without warning.
+      ;; Fixme: presumably this should depend on a privacy setting.
+      (if (y-or-n-p "Send this auto-generated mail? ")
+          (cond ((eq url-mail-command 'compose-mail)
+                 (funcall (get mail-user-agent 'sendfunc) nil))
+                ;; otherwise, we can't be sure
+                ((fboundp 'message-send-and-exit)
+                 (message-send-and-exit))
+                (t (mail-send-and-exit nil)))))
+    nil))
+
+(provide 'url-mailto)
+
+;; arch-tag: 7b7ad52e-8760-497b-9444-75fae14e34c5
+;;; url-mailto.el ends here
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
new file mode 100644
index 00000000000..75d746f3e3f
--- /dev/null
+++ b/lisp/url/url-methods.el
@@ -0,0 +1,150 @@
+;;; url-methods.el --- Load URL schemes as needed
+
+;; Copyright (c) 1996,1997,1998,1999,2004  Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+;; This loads up some of the small, silly URLs that I really don't
+;; want to bother putting in their own separate files.
+(require 'url-parse)
+
+(defvar url-scheme-registry (make-hash-table :size 7 :test 'equal))
+
+(defconst url-scheme-methods
+  '((default-port      . variable)
+    (asynchronous-p    . variable)
+    (expand-file-name  . function)
+    (file-exists-p     . function)
+    (file-attributes   . function)
+    (parse-url         . function)
+    (file-symlink-p    . function)
+    (file-writable-p   . function)
+    (file-directory-p  . function)
+    (file-executable-p . function)
+    (directory-files   . function)
+    (file-truename     . function))
+  "Assoc-list of methods that each URL loader can provide.")
+
+(defconst url-scheme-default-properties
+  (list 'name "unknown"
+        'loader 'url-scheme-default-loader
+        'default-port 0
+        'expand-file-name 'url-identity-expander
+        'parse-url 'url-generic-parse-url
+        'asynchronous-p nil
+        'file-directory-p 'ignore
+        'file-truename (lambda (&rest args)
+                         (url-recreate-url (car args)))
+        'file-exists-p 'ignore
+        'file-attributes 'ignore))
+
+(defun url-scheme-default-loader (url &optional callback cbargs)
+  "Signal an error for an unknown URL scheme."
+  (error "Unkown URL scheme: %s" (url-type url)))
+
+(defun url-scheme-register-proxy (scheme)
+  "Automatically find a proxy for SCHEME and put it in `url-proxy-services'."
+  (let* ((env-var (concat scheme "_proxy"))
+         (env-proxy (or (getenv (upcase env-var))
+                        (getenv (downcase env-var))))
+         (cur-proxy (assoc scheme url-proxy-services))
+         (urlobj nil))
+
+    ;; Store any proxying information - this will not overwrite an old
+    ;; entry, so that people can still set this information in their
+    ;; .emacs file
+    (cond
+     (cur-proxy nil)                    ; Keep their old settings
+     ((null env-proxy) nil)             ; No proxy setup
+     ;; 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))))
+     ;; 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))
+     ;; 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)))
+
+     (if (and (not cur-proxy) urlobj)
+         (progn
+           (setq url-proxy-services
+                 (cons (cons scheme (format "%s:%d" (url-host urlobj)
+                                            (url-port urlobj)))
+                       url-proxy-services))
+           (message "Using a proxy for %s..." scheme)))))
+
+(defun url-scheme-get-property (scheme property)
+  "Get property of a URL SCHEME.
+Will automatically try to load a backend from url-SCHEME.el if
+it has not already been loaded."
+  (setq scheme (downcase scheme))
+  (let ((desc (gethash scheme url-scheme-registry)))
+    (if (not desc)
+        (let* ((stub (concat "url-" scheme))
+               (loader (intern stub)))
+          (condition-case ()
+              (require loader)
+            (error nil))
+          (if (fboundp loader)
+              (progn
+                ;; Found the module to handle <scheme> URLs
+                (url-scheme-register-proxy scheme)
+                (setq desc (list 'name scheme
+                                 'loader loader))
+                (dolist (cell url-scheme-methods)
+                  (let ((symbol (intern-soft (format "%s-%s" stub (car cell))))
+                        (type (cdr cell)))
+                    (if symbol
+                        (case type
+                          (function
+                           ;; Store the symbol name of a function
+                           (if (fboundp symbol)
+                               (setq desc (plist-put desc (car cell) symbol))))
+                          (variable
+                           ;; Store the VALUE of a variable
+                           (if (boundp symbol)
+                               (setq desc (plist-put desc (car cell)
+                                                     (symbol-value symbol)))))
+                          (otherwise
+                           (error "Malformed url-scheme-methods entry: %S"
+                                  cell))))))
+                (puthash scheme desc url-scheme-registry)))))
+    (or (plist-get desc property)
+        (plist-get url-scheme-default-properties property))))
+
+(provide 'url-methods)
+
+;; arch-tag: 336863f8-5a07-4906-9be5-b3c6bcebbe67
+;;; url-methods.el ends here
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
new file mode 100644
index 00000000000..ff2f1282137
--- /dev/null
+++ b/lisp/url/url-misc.el
@@ -0,0 +1,117 @@
+;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'url-vars)
+(require 'url-parse)
+(autoload 'Info-goto-node "info" "" t)
+(autoload 'man "man" nil t)
+
+;;;###autoload
+(defun url-man (url)
+  "Fetch a Unix manual page URL."
+  (man (url-filename url))
+  nil)
+
+;;;###autoload
+(defun url-info (url)
+  "Fetch a GNU Info URL."
+  ;; Fetch an info node
+  (let* ((fname (url-filename url))
+         (node (url-unhex-string (or (url-target url) "Top"))))
+    (if (and fname node)
+        (Info-goto-node (concat "(" fname ")" node))
+      (error "Malformed url: %s" (url-recreate-url url)))
+    nil))
+
+(defun url-do-terminal-emulator (type server port user)
+  (terminal-emulator
+   (generate-new-buffer (format "%s%s" (if user (concat user "@") "") server))
+   (case type
+     (rlogin "rlogin")
+     (telnet "telnet")
+     (tn3270 "tn3270")
+     (otherwise
+      (error "Unknown terminal emulator required: %s" type)))
+   (case type
+     (rlogin
+      (if user
+          (list server "-l" user)
+        (list server)))
+     (telnet
+      (if user (message "Please log in as user: %s" user))
+      (if port
+          (list server port)
+        (list server)))
+     (tn3270
+      (if user (message "Please log in as user: %s" user))
+      (list server)))))
+
+;;;###autoload
+(defun url-generic-emulator-loader (url)
+  (let* ((type (intern (downcase (url-type url))))
+         (server (url-host url))
+         (name (url-user url))
+         (port (url-port url)))
+    (url-do-terminal-emulator type server port name))
+  nil)
+
+;;;###autoload
+(defalias 'url-rlogin 'url-generic-emulator-loader)
+;;;###autoload
+(defalias 'url-telnet 'url-generic-emulator-loader)
+;;;###autoload
+(defalias 'url-tn3270 'url-generic-emulator-loader)
+
+;; RFC 2397
+;;;###autoload
+(defun url-data (url)
+  "Fetch a data URL (RFC 2397)."
+  (let ((mediatype nil)
+        ;; The mediatype may need to be hex-encoded too -- see the RFC.
+        (desc (url-unhex-string (url-filename url)))
+        (encoding "8bit")
+        (data nil))
+    (save-excursion
+      (if (not (string-match "\\([^,]*\\)?," desc))
+          (error "Malformed data URL: %s" desc)
+        (setq mediatype (match-string 1 desc))
+        (if (and mediatype (string-match ";base64\\'" mediatype))
+            (setq mediatype (substring mediatype 0 (match-beginning 0))
+                  encoding "base64"))
+        (if (or (null mediatype)
+                (eq ?\; (aref mediatype 0)))
+          (setq mediatype (concat "text/plain" mediatype)))
+        (setq data (url-unhex-string (substring desc (match-end 0)))))
+      (set-buffer (generate-new-buffer " *url-data*"))
+      (mm-disable-multibyte)
+      (insert (format "Content-Length: %d\n" (length data))
+              "Content-Type: " mediatype "\n"
+              "Content-Encoding: " encoding "\n"
+              "\n")
+      (if data (insert data))
+      (current-buffer))))
+
+(provide 'url-misc)
+
+;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
new file mode 100644
index 00000000000..59364c9ccd0
--- /dev/null
+++ b/lisp/url/url-news.el
@@ -0,0 +1,135 @@
+;;; url-news.el --- News Uniform Resource Locator retrieval code
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(require 'url-vars)
+(require 'url-util)
+(require 'url-parse)
+(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"
+  :group 'url)
+
+(defun url-news-open-host (host port user pass)
+  (if (fboundp 'nnheader-init-server-buffer)
+      (nnheader-init-server-buffer))
+  (nntp-open-server host (list (string-to-int port)))
+  (if (and user pass)
+      (progn
+        (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
+        (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass)
+        (if (not (nntp-server-opened host))
+            (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed"
+                                   host user))))))
+
+(defun url-news-fetch-message-id (host message-id)
+  (let ((buf (generate-new-buffer " *url-news*")))
+    (if (eq ?> (aref message-id (1- (length message-id))))
+        nil
+      (setq message-id (concat "<" message-id ">")))
+    (if (cdr-safe (nntp-request-article message-id nil host buf))
+        ;; Successfully retrieved the article
+        nil
+      (save-excursion
+        (set-buffer buf)
+        (insert "Content-type: text/html\n\n"
+                "<html>\n"
+                " <head>\n"
+                "  <title>Error</title>\n"
+                " </head>\n"
+                " <body>\n"
+                "  <div>\n"
+                "   <h1>Error requesting article...</h1>\n"
+                "   <p>\n"
+                "    The status message returned by the NNTP server was:"
+                "<br><hr>\n"
+                "    <xmp>\n"
+                (nntp-status-message)
+                "    </xmp>\n"
+                "   </p>\n"
+                "   <p>\n"
+                "    If you If you feel this is an error, <a href=\""
+                "mailto:" url-bug-address "\">send mail</a>\n"
+                "   </p>\n"
+                "  </div>\n"
+                " </body>\n"
+                "</html>\n"
+                "<!-- Automatically generated by URL v" url-version " -->\n"
+                )))
+    buf))
+
+(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)
+      (setq newsgroup (substring newsgroup 0 (match-beginning 0))))
+
+  ;; This saves us from checking new news if Gnus is already running
+  ;; FIXME - is it relatively safe to use gnus-alive-p here? FIXME
+  (if (or (not (get-buffer gnus-group-buffer))
+          (save-excursion
+            (set-buffer gnus-group-buffer)
+            (not (eq major-mode 'gnus-group-mode))))
+      (gnus))
+  (set-buffer gnus-group-buffer)
+  (goto-char (point-min))
+  (gnus-group-read-ephemeral-group newsgroup
+                                   (list 'nntp host
+                                         'nntp-open-connection-function
+                                         nntp-open-connection-function)
+                                   nil
+                                   (cons (current-buffer) 'browse)))
+  
+;;;###autoload
+(defun url-news (url)
+  ;; Find a news reference
+  (let* ((host (or (url-host url) url-news-server))
+         (port (url-port url))
+         (article-brackets nil)
+         (buf nil)
+         (article (url-filename url)))
+    (url-news-open-host host port (url-user url) (url-password url))
+    (setq article (url-unhex-string article))
+    (cond
+     ((string-match "@" article)        ; Its a specific article
+      (setq buf (url-news-fetch-message-id host article)))
+     ((string= article "")              ; List all newsgroups
+      (gnus))
+     (t                                 ; Whole newsgroup
+      (url-news-fetch-newsgroup article host)))
+    buf))
+
+;;;###autoload
+(defun url-snews (url)
+  (let ((nntp-open-connection-function (if (eq 'tls url-gateway-method)
+                                           nntp-open-tls-stream
+                                         nntp-open-ssl-stream)))
+    (url-news url)))
+
+(provide 'url-news)
+
+;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index d068341b1c2..3b834bba75f 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -1,7 +1,6 @@
 ;;; url-nfs.el --- NFS URL interface
 
-;; Copyright (c) 1996,97,98,1999,2004  Free Software Foundation, Inc.
-;; Copyright (c) 1996 by William M. Perry <wmperry@cs.indiana.edu>
+;; Copyright (c) 1996,1997,1998,1999,2004  Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes
 
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
new file mode 100644
index 00000000000..97348ab5db2
--- /dev/null
+++ b/lisp/url/url-parse.el
@@ -0,0 +1,210 @@
+;;; url-parse.el --- Uniform Resource Locator parser
+
+;; Copyright (c) 1996,1997,1998,1999,2004  Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-vars)
+
+(autoload 'url-scheme-get-property "url-methods")
+
+(defmacro url-type (urlobj)
+  `(aref ,urlobj 0))
+
+(defmacro url-user (urlobj)
+  `(aref ,urlobj 1))
+
+(defmacro url-password (urlobj)
+  `(aref ,urlobj 2))
+
+(defmacro url-host (urlobj)
+  `(aref ,urlobj 3))
+
+(defmacro url-port (urlobj)
+  `(or (aref ,urlobj 4)
+      (if (url-fullness ,urlobj)
+          (url-scheme-get-property (url-type ,urlobj) 'default-port))))
+
+(defmacro url-filename (urlobj)
+  `(aref ,urlobj 5))
+
+(defmacro url-target (urlobj)
+  `(aref ,urlobj 6))
+
+(defmacro url-attributes (urlobj)
+  `(aref ,urlobj 7))
+
+(defmacro url-fullness (urlobj)
+  `(aref ,urlobj 8))
+
+(defmacro url-set-type (urlobj type)
+  `(aset ,urlobj 0 ,type))
+
+(defmacro url-set-user (urlobj user)
+  `(aset ,urlobj 1 ,user))
+
+(defmacro url-set-password (urlobj pass)
+  `(aset ,urlobj 2 ,pass))
+
+(defmacro url-set-host (urlobj host)
+  `(aset ,urlobj 3 ,host))
+
+(defmacro url-set-port (urlobj port)
+  `(aset ,urlobj 4 ,port))
+
+(defmacro url-set-filename (urlobj file)
+  `(aset ,urlobj 5 ,file))
+
+(defmacro url-set-target (urlobj targ)
+  `(aset ,urlobj 6 ,targ))
+
+(defmacro url-set-attributes (urlobj targ)
+  `(aset ,urlobj 7 ,targ))
+
+(defmacro url-set-full (urlobj val)
+  `(aset ,urlobj 8 ,val))
+  
+;;;###autoload
+(defun url-recreate-url (urlobj)
+  "Recreate a URL string from the parsed URLOBJ."
+  (concat (url-type urlobj) ":" (if (url-host urlobj) "//" "")
+          (if (url-user urlobj)
+              (concat (url-user urlobj)
+                      (if (url-password urlobj)
+                          (concat ":" (url-password urlobj)))
+                      "@"))
+          (url-host urlobj)
+          (if (and (url-port urlobj)
+                   (not (equal (url-port urlobj)
+                               (url-scheme-get-property (url-type urlobj) 'default-port))))
+              (format ":%d" (url-port urlobj)))
+          (or (url-filename urlobj) "/")
+          (if (url-target urlobj)
+              (concat "#" (url-target urlobj)))
+          (if (url-attributes urlobj)
+              (concat ";"
+                      (mapconcat
+                       (function
+                        (lambda (x)
+                          (if (cdr x)
+                              (concat (car x) "=" (cdr x))
+                            (car x)))) (url-attributes urlobj) ";")))))
+
+;;;###autoload
+(defun url-generic-parse-url (url)
+  "Return a vector of the parts of URL.
+Format is:
+\[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]"
+  (cond
+   ((null url)
+    (make-vector 9 nil))
+   ((or (not (string-match url-nonrelative-link url))
+        (= ?/ (string-to-char url)))
+    (let ((retval (make-vector 9 nil)))
+      (url-set-filename retval url)
+      (url-set-full retval nil)
+      retval))
+   (t
+    (save-excursion
+      (set-buffer (get-buffer-create " *urlparse*"))
+      (set-syntax-table url-parse-syntax-table)
+      (let ((save-pos nil)
+            (prot nil)
+            (user nil)
+            (pass nil)
+            (host nil)
+            (port nil)
+            (file nil)
+            (refs nil)
+            (attr nil)
+            (full nil)
+            (inhibit-read-only t))
+        (erase-buffer)
+        (insert url)
+        (goto-char (point-min))
+        (setq save-pos (point))
+        (if (not (looking-at "//"))
+            (progn
+              (skip-chars-forward "a-zA-Z+.\\-")
+              (downcase-region save-pos (point))
+              (setq prot (buffer-substring save-pos (point)))
+              (skip-chars-forward ":")
+              (setq save-pos (point))))
+
+        ;; We are doing a fully specified URL, with hostname and all
+        (if (looking-at "//")
+            (progn
+              (setq full t)
+              (forward-char 2)
+              (setq save-pos (point))
+              (skip-chars-forward "^/")
+              (setq host (buffer-substring save-pos (point)))
+              (if (string-match "^\\([^@]+\\)@" host)
+                  (setq user (match-string 1 host)
+                        host (substring host (match-end 0) nil)))
+              (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user))
+                  (setq pass (match-string 2 user)
+                        user (match-string 1 user)))
+              (if (string-match ":\\([0-9+]+\\)" host)
+                  (setq port (string-to-int (match-string 1 host))
+                        host (substring host 0 (match-beginning 0))))
+              (if (string-match ":$" host)
+                  (setq host (substring host 0 (match-beginning 0))))
+              (setq host (downcase host)
+                    save-pos (point))))
+
+        (if (not port)
+            (setq port (url-scheme-get-property prot 'default-port)))
+
+        ;; Gross hack to preserve ';' in data URLs
+
+        (setq save-pos (point))
+
+        (if (string= "data" prot)
+            (goto-char (point-max))
+          ;; Now check for references
+          (skip-chars-forward "^#")
+          (if (eobp)
+              nil
+            (delete-region
+             (point)
+             (progn
+               (skip-chars-forward "#")
+               (setq refs (buffer-substring (point) (point-max)))
+               (point-max))))
+          (goto-char save-pos)
+          (skip-chars-forward "^;")
+          (if (not (eobp))
+              (setq attr (url-parse-args (buffer-substring (point) (point-max)) t)
+                    attr (nreverse attr))))
+
+        (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))))))
+
+(provide 'url-parse)
+
+;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403
+;;; url-parse.el ends here
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
new file mode 100644
index 00000000000..cb64cfbd4fc
--- /dev/null
+++ b/lisp/url/url-privacy.el
@@ -0,0 +1,81 @@
+;;; url-privacy.el --- Global history tracking for URL package
+;; Keywords: comm, data, processes, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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)))
+
+;;;###autoload
+(defun url-setup-privacy-info ()
+  (interactive)
+  (setq url-system-type
+        (cond
+         ((or (eq url-privacy-level 'paranoid)
+              (and (listp url-privacy-level)
+                   (memq 'os url-privacy-level)))
+          nil)
+         ;; First, we handle the inseparable OS/Windowing system
+         ;; combinations
+         ((eq system-type 'Apple-Macintosh) "Macintosh")
+         ((eq system-type 'next-mach) "NeXT")
+         ((eq system-type 'windows-nt) "Windows-NT; 32bit")
+         ((eq system-type 'ms-windows) "Windows; 16bit")
+         ((eq system-type 'ms-dos) "MS-DOS; 32bit")
+         ((memq (url-device-type) '(win32 w32)) "Windows; 32bit")
+         ((eq (url-device-type) 'pm) "OS/2; 32bit")
+         (t
+          (case (url-device-type)
+            (x "X11")
+            (ns "OpenStep")
+            (tty "TTY")
+            (otherwise nil)))))
+
+  (setq url-personal-mail-address (or url-personal-mail-address
+                                      user-mail-address
+                                      (format "%s@%s"  (user-real-login-name)
+                                              (system-name))))
+
+  (if (or (memq url-privacy-level '(paranoid high))
+          (and (listp url-privacy-level)
+               (memq 'email url-privacy-level)))
+      (setq url-personal-mail-address nil))
+
+  (setq url-os-type
+        (cond
+         ((or (eq url-privacy-level 'paranoid)
+              (and (listp url-privacy-level)
+                   (memq 'os url-privacy-level)))
+          nil)
+         ((boundp 'system-configuration)
+          system-configuration)
+         ((boundp 'system-type)
+          (symbol-name system-type))
+         (t nil))))
+
+(provide 'url-privacy)
+
+;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index d4a3733eab5..5d1f73e0d5d 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -1,7 +1,6 @@
 ;;; url-util.el --- Miscellaneous helper routines for URL library
 
-;; Copyright (c) 1996,97,98,99,2001,2004  Free Software Foundation, Inc.
-;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
+;; Copyright (c) 1996,1997,1998,1999,2001,2004  Free Software Foundation, Inc.
 
 ;; Author: Bill Perry <wmperry@gnu.org>
 ;; Keywords: comm, data, processes
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
new file mode 100644
index 00000000000..a33d8ba43e3
--- /dev/null
+++ b/lisp/url/url-vars.el
@@ -0,0 +1,431 @@
+;;; url-vars.el --- Variables for Uniform Resource Locator tool
+;; Keywords: comm, data, processes, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'mm-util)
+
+(defconst url-version "Emacs"
+  "Version number of URL package.")
+
+(defgroup url nil
+  "Uniform Resource Locator tool"
+  :version "21.4"
+  :group 'hypermedia)
+
+(defgroup url-file nil
+  "URL storage"
+  :prefix "url-"
+  :group 'url)
+
+(defgroup url-cache nil
+  "URL cache"
+  :prefix "url-"
+  :prefix "url-cache-"
+  :group 'url)
+
+(defgroup url-mime nil
+  "MIME options of URL"
+  :prefix "url-"
+  :group 'url)
+
+(defgroup url-hairy nil
+  "Hairy options of URL"
+  :prefix "url-"
+  :group 'url)
+
+
+(defvar url-current-object nil
+  "A parsed representation of the current url.")
+
+(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
+          ))
+
+(defcustom url-honor-refresh-requests t
+  "*Whether to do automatic page reloads.
+These are done at the request of the document author or the server via
+the `Refresh' header in an HTTP response.  If nil, no refresh
+requests will be honored.  If t, all refresh requests will be honored.
+If non-nil and not t, the user will be asked for each refresh
+request."
+  :type '(choice (const :tag "off" nil)
+                 (const :tag "on" t)
+                 (const :tag "ask" 'ask))
+  :group 'url-hairy)
+
+(defcustom url-automatic-caching nil
+  "*If non-nil, all documents will be automatically cached to the local disk."
+  :type 'boolean
+  :group 'url-cache)
+
+;; Fixme: sanitize this.
+(defcustom url-cache-expired
+  (lambda (t1 t2) (>= (- (car t2) (car t1)) 5))
+  "*A function determining if a cached item has expired.
+It takes two times (numbers) as its arguments, and returns non-nil if
+the second time is 'too old' when compared to the first time."
+  :type 'function
+  :group 'url-cache)
+
+(defconst url-bug-address "bug-gnu-emacs@gnu.org"
+  "Where to send bug reports.")
+
+(defcustom url-personal-mail-address nil
+  "*Your full email address.
+This is what is sent to HTTP servers as the FROM field in an HTTP
+request."
+  :type '(choice (const :tag "Unspecified" nil) string)
+  :group 'url)
+
+(defcustom url-directory-index-file "index.html"
+  "*The filename to look for when indexing a directory.
+If this file exists, and is readable, then it will be viewed instead of
+using `dired' to view the directory."
+  :type 'string
+  :group 'url-file)
+
+;; Fixme: this should have a setter which calls url-setup-privacy-info.
+(defcustom url-privacy-level '(email)
+  "*How private you want your requests to be.
+HTTP has header fields for various information about the user, including
+operating system information, email addresses, the last page you visited, etc.
+This variable controls how much of this information is sent.
+
+This should a symbol or a list.
+Valid values if a symbol are:
+none     -- Send all information
+low      -- Don't send the last location
+high     -- Don't send the email address or last location
+paranoid -- Don't send anything
+
+If a list, this should be a list of symbols of what NOT to send.
+Valid symbols are:
+email    -- the email address
+os       -- the operating system info
+lastloc  -- the last location
+agent    -- Do not send the User-Agent string
+cookie   -- never accept HTTP cookies
+
+Samples:
+
+ (setq url-privacy-level 'high)
+ (setq url-privacy-level '(email lastloc))    ;; equivalent to 'high
+ (setq url-privacy-level '(os))
+
+::NOTE::
+This variable controls several other variables and is _NOT_ automatically
+updated.  Call the function `url-setup-privacy-info' after modifying this
+variable."
+  :type '(radio (const :tag "None (you believe in the basic goodness of humanity)"
+                       :value none)
+                (const :tag "Low (do not reveal last location)"
+                       :value low)
+                (const :tag "High (no email address or last location)"
+                       :value high)
+                (const :tag "Paranoid (reveal nothing!)"
+                       :value paranoid)
+                (checklist :tag "Custom"
+                           (const :tag "Email address" :value email)
+                           (const :tag "Operating system" :value os)
+                           (const :tag "Last location" :value lastloc)
+                           (const :tag "Browser identification" :value agent)
+                           (const :tag "No cookies" :value cookie)))
+  :group 'url)
+
+(defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.")
+
+(defcustom url-uncompressor-alist '((".z"  . "x-gzip")
+                                    (".gz" . "x-gzip")
+                                    (".uue" . "x-uuencoded")
+                                    (".hqx" . "x-hqx")
+                                    (".Z"  . "x-compress")
+                                    (".bz2"  . "x-bzip2"))
+  "*An alist of file extensions and appropriate content-transfer-encodings."
+  :type '(repeat (cons :format "%v"
+                       (string :tag "Extension")
+                       (string :tag "Encoding")))
+  :group 'url-mime)
+
+(defcustom url-mail-command (if (fboundp 'compose-mail)
+                                'compose-mail
+                              'url-mail)
+  "*This function will be called whenever url needs to send mail.
+It should enter a mail-mode-like buffer in the current window.
+The commands `mail-to' and `mail-subject' should still work in this
+buffer, and it should use `mail-header-separator' if possible."
+  :type 'function
+  :group 'url)
+
+(defcustom url-proxy-services nil
+  "*An alist of schemes and proxy servers that gateway them.
+Looks like ((\"http\" . \"hostname:portnumber\") ...).  This is set up
+from the ACCESS_proxy environment variables."
+  :type '(repeat (cons :format "%v"
+                       (string :tag "Protocol")
+                       (string :tag "Proxy")))
+  :group 'url)
+
+(defcustom url-passwd-entry-func nil
+  "*Symbol indicating which function to call to read in a password.
+It will be set up depending on whether you are running EFS or ange-ftp
+at startup if it is nil.  This function should accept the prompt
+string as its first argument, and the default value as its second
+argument."
+  :type '(choice (const :tag "Guess" :value nil)
+                 (const :tag "Use Ange-FTP" :value ange-ftp-read-passwd)
+                 (const :tag "Use EFS"      :value efs-read-passwd)
+                 (const :tag "Use Password Package" :value read-passwd)
+                 (function :tag "Other"))
+  :group 'url-hairy)
+
+(defcustom url-standalone-mode nil
+  "*Rely solely on the cache?"
+  :type 'boolean
+  :group 'url-cache)
+
+(defvar url-mime-separator-chars (mapcar 'identity
+                                        (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                                "abcdefghijklmnopqrstuvwxyz"
+                                                "0123456789'()+_,-./=?"))
+  "Characters allowable in a MIME multipart separator.")
+
+(defcustom url-bad-port-list
+  '("25" "119" "19")
+  "*List of ports to warn the user about connecting to.
+Defaults to just the mail, chargen, and NNTP ports so you cannot be
+tricked into sending fake mail or forging messages by a malicious HTML
+document."
+  :type '(repeat (string :tag "Port"))
+  :group 'url-hairy)
+
+(defvar url-mime-content-type-charset-regexp
+  ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
+  "Regexp used in parsing `Content-Type' for a charset indication.")
+
+(defvar url-request-data nil "Any data to send with the next request.")
+
+(defvar url-request-extra-headers nil
+  "A list of extra headers to send with the next request.
+Should be an assoc list of headers/contents.")
+
+(defvar url-request-method nil "The method to use for the next request.")
+
+;; FIXME!!  (RFC 2616 gives examples like `compress, gzip'.)
+(defvar url-mime-encoding-string nil
+  "*String to send in the Accept-encoding: field in HTTP requests.")
+
+;; `mm-mime-mule-charset-alist' in Gnus 5.8/9 contains elements whose
+;; cars aren't valid MIME charsets/coding systems, at least in Emacs.
+;; This gets it correct by construction in Emacs.  Fixme: DTRT for
+;; XEmacs -- its `coding-system-list' doesn't have the BASE-ONLY arg.
+(when (and (not (featurep 'xemacs))
+           (fboundp 'coding-system-list))
+  (setq mm-mime-mule-charset-alist
+        (apply
+         'nconc
+         (mapcar
+          (lambda (cs)
+            (when (and (coding-system-get cs 'mime-charset)
+                       (not (eq t (coding-system-get cs 'safe-charsets))))
+              (list (cons (coding-system-get cs 'mime-charset)
+                          (delq 'ascii
+                                (coding-system-get cs 'safe-charsets))))))
+          (coding-system-list 'base-only)))))
+
+;; Perhaps the first few should actually be given decreasing `q's and
+;; the list should be trimmed significantly.
+;; Fixme: do something sane if we don't have `sort-coding-systems'
+;; (Emacs 20, XEmacs).
+(defun url-mime-charset-string ()
+  "Generate a list of preferred MIME charsets for HTTP requests.
+Generated according to current coding system priorities."
+  (if (fboundp 'sort-coding-systems)
+      (let ((ordered (sort-coding-systems
+                      (let (accum)
+                        (dolist (elt mm-mime-mule-charset-alist)
+                          (if (mm-coding-system-p (car elt))
+                              (push (car elt) accum)))
+                        (nreverse accum)))))
+        (concat (format "%s;q=1, " (pop ordered))
+                (mapconcat 'symbol-name ordered ";q=0.5, ")
+                ";q=0.5"))))
+
+(defvar url-mime-charset-string (url-mime-charset-string)
+  "*String to send in the Accept-charset: field in HTTP requests.
+The MIME charset corresponding to the most preferred coding system is
+given priority 1 and the rest are given priority 0.5.")
+
+(defun url-set-mime-charset-string ()
+  (setq url-mime-charset-string (url-mime-charset-string)))
+;; Regenerate if the language environment changes.
+(add-hook 'set-language-environment-hook 'url-set-mime-charset-string)
+
+;; Fixme: set from the locale.
+(defcustom url-mime-language-string nil
+  "*String to send in the Accept-language: field in HTTP requests.
+
+Specifies the preferred language when servers can serve documents in
+several languages.  Use RFC 1766 abbreviations, e.g.@: `en' for
+English, `de' for German.  A comma-separated specifies descending
+order of preference.  The ordering can be made explicit using `q'
+factors defined by HTTP, e.g. `de,en-gb;q=0.8,en;q=0.7'.  `*' means
+get the first available language (as opposed to the default)."
+  :type '(radio
+          (const :tag "None (get default language version)" :value nil)
+          (const :tag "Any (get first available language version)" :value "*")
+          (string :tag "Other"))
+  :group 'url-mime
+  :group 'i18n)
+
+(defvar url-mime-accept-string nil
+  "String to send to the server in the Accept: field in HTTP requests.")
+
+(defvar url-package-version nil
+  "Version number of package using URL.")
+
+(defvar url-package-name nil "Version number of package using URL.")
+
+(defvar url-system-type nil
+  "What type of system we are on.")
+(defvar url-os-type nil
+  "What OS we are on.")
+
+(defcustom url-max-password-attempts 5
+  "*Maximum number of times a password will be prompted for.
+Applies when a protected document is denied by the server."
+  :type 'integer
+  :group 'url)
+
+(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
+  "*Where temporary files go."
+  :type 'directory
+  :group 'url-file)
+
+(defcustom url-show-status t
+  "*Whether to show a running total of bytes transferred.
+Can cause a large hit if using a remote X display over a slow link, or
+a terminal with a slow modem."
+  :type 'boolean
+  :group 'url)
+
+(defvar url-using-proxy nil
+  "Either nil or the fully qualified proxy URL in use, e.g.
+http://www.domain.com/")
+
+(defcustom url-news-server nil
+  "*The default news server from which to get newsgroups/articles.
+Applies if no server is specified in the URL.  Defaults to the
+environment variable NNTPSERVER or \"news\" if NNTPSERVER is
+undefined."
+  :type '(choice (const :tag "None" :value nil) string)
+  :group 'url)
+
+(defvar url-nonrelative-link
+  "\\`\\([-a-zA-Z0-9+.]+:\\)"
+  "A regular expression that will match an absolute URL.")
+
+(defcustom url-confirmation-func 'y-or-n-p
+  "*What function to use for asking yes or no functions.
+Possible values are `yes-or-no-p' or `y-or-n-p', or any function that
+takes a single argument (the prompt), and returns t only if a positive
+answer is given."
+  :type '(choice (const :tag "Short (y or n)" :value y-or-n-p)
+                 (const :tag "Long (yes or no)" :value yes-or-no-p)
+                 (function :tag "Other"))
+  :group 'url-hairy)
+
+(defcustom url-gateway-method 'native
+  "*The type of gateway support to use.
+Should be a symbol specifying how to get a connection from the local machine.
+
+Currently supported methods:
+`telnet': Run telnet in a subprocess to connect;
+`rlogin': Rlogin to another machine to connect;
+`socks': Connect through a socks server;
+`tls': Connect with TLS;
+`ssl': Connect with SSL (deprecated, use `tls' instead);
+`native': Connect directy."
+  :type '(radio (const :tag "Telnet to gateway host" :value telnet)
+                (const :tag "Rlogin to gateway host" :value rlogin)
+                (const :tag "Use SOCKS proxy" :value socks)
+                (const :tag "Use SSL/TLS for all connections" :value tls)
+                (const :tag "Use SSL for all connections (obsolete)" :value ssl)
+                (const :tag "Direct connection" :value native))
+  :group 'url-hairy)
+
+(defvar url-setup-done nil "Has setup configuration been done?")
+
+(defconst weekday-alist
+  '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3)
+    ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6)
+    ("Tues" . 2) ("Thurs" . 4)
+    ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
+    ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
+
+(defconst monthabbrev-alist
+  '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
+    ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11)
+    ("Dec" . 12)))
+
+(defvar url-lazy-message-time 0)
+
+;; Fixme: We may not be able to run SSL.
+(defvar url-extensions-header "Security/Digest Security/SSL")
+
+(defvar url-parse-syntax-table
+  (copy-syntax-table emacs-lisp-mode-syntax-table)
+  "*A syntax table for parsing URLs.")
+
+(modify-syntax-entry ?' "\"" url-parse-syntax-table)
+(modify-syntax-entry ?` "\"" url-parse-syntax-table)
+(modify-syntax-entry ?< "(>" url-parse-syntax-table)
+(modify-syntax-entry ?> ")<" url-parse-syntax-table)
+(modify-syntax-entry ?/ " " url-parse-syntax-table)
+
+(defvar url-load-hook nil
+  "*Hooks to be run after initalizing the URL library.")
+
+;;; Make OS/2 happy - yeeks
+;; (defvar      tcp-binary-process-input-services nil
+;;   "*Make OS/2 happy with our CRLF pairs...")
+
+(defconst url-working-buffer " *url-work")
+
+(defvar url-gateway-unplugged nil
+  "Non-nil means don't open new network connexions.
+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))
+
+(provide 'url-vars)
+
+;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49
+;;; url-vars.el ends here
diff --git a/lisp/url/url.el b/lisp/url/url.el
new file mode 100644
index 00000000000..f7b1b717681
--- /dev/null
+++ b/lisp/url/url.el
@@ -0,0 +1,269 @@
+;;; url.el --- Uniform Resource Locator retrieval tool
+
+;; Copyright (c) 1996,1997,1998,1999,2001,2004  Free Software Foundation, Inc.
+
+;; Author: Bill Perry <wmperry@gnu.org>
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+;; Don't require CL at runtime if we can avoid it (Emacs 21).
+;; Otherwise we need it for hashing functions.  `puthash' was never
+;; defined in the Emacs 20 cl.el for some reason.
+(if (fboundp 'puthash)
+    nil                                 ; internal or CL is loaded
+  (defalias 'puthash 'cl-puthash)
+  (autoload 'cl-puthash "cl")
+  (autoload 'gethash "cl")
+  (autoload 'maphash "cl")
+  (autoload 'make-hash-table "cl"))
+
+(eval-when-compile
+  (require 'mm-decode)
+  (require 'mm-view))
+
+(require 'mailcap)
+(require 'url-vars)
+(require 'url-cookie)
+(require 'url-history)
+(require 'url-expand)
+(require 'url-privacy)
+(require 'url-methods)
+(require 'url-proxy)
+(require 'url-parse)
+(require 'url-util)
+
+;; Fixme: customize? convert-standard-filename? 
+;;;###autoload
+(defvar url-configuration-directory "~/.url")
+
+(defun url-do-setup ()
+  "Setup the url package.
+This is to avoid conflict with user settings if URL is dumped with
+Emacs."
+  (unless url-setup-done
+
+    ;; Make OS/2 happy
+    ;;(push '("http" "80") tcp-binary-process-input-services)
+
+    (mailcap-parse-mailcaps)
+    (mailcap-parse-mimetypes)
+    
+    ;; Register all the authentication schemes we can handle
+    (url-register-auth-scheme "basic" nil 4)
+    (url-register-auth-scheme "digest" nil 7)
+
+    (setq url-cookie-file
+          (or url-cookie-file
+              (expand-file-name "cookies" url-configuration-directory)))
+    
+    (setq url-history-file
+          (or url-history-file
+              (expand-file-name "history" url-configuration-directory)))
+  
+    ;; Parse the global history file if it exists, so that it can be used
+    ;; for URL completion, etc.
+    (url-history-parse-history)
+    (url-history-setup-save-timer)
+
+    ;; Ditto for cookies
+    (url-cookie-setup-save-timer)
+    (url-cookie-parse-file url-cookie-file)
+
+    ;; Read in proxy gateways
+    (let ((noproxy (and (not (assoc "no_proxy" url-proxy-services))
+                        (or (getenv "NO_PROXY")
+                            (getenv "no_PROXY")
+                            (getenv "no_proxy")))))
+      (if noproxy
+          (setq url-proxy-services
+                (cons (cons "no_proxy"
+                            (concat "\\("
+                                    (mapconcat
+                                     (lambda (x)
+                                       (cond
+                                        ((= x ?,) "\\|")
+                                        ((= x ? ) "")
+                                        ((= x ?.) (regexp-quote "."))
+                                        ((= x ?*) ".*")
+                                        ((= x ??) ".")
+                                        (t (char-to-string x))))
+                                     noproxy "") "\\)"))
+                      url-proxy-services))))
+
+    ;; Set the password entry funtion based on user defaults or guess
+    ;; based on which remote-file-access package they are using.
+    (cond
+     (url-passwd-entry-func nil)        ; Already been set
+     ((fboundp 'read-passwd)            ; Use secure password if available
+      (setq url-passwd-entry-func 'read-passwd))
+     ((or (featurep 'efs)               ; Using EFS
+          (featurep 'efs-auto))         ; or autoloading efs
+      (if (not (fboundp 'read-passwd))
+          (autoload 'read-passwd "passwd" "Read in a password" nil))
+      (setq url-passwd-entry-func 'read-passwd))
+     ((or (featurep 'ange-ftp)          ; Using ange-ftp
+          (and (boundp 'file-name-handler-alist)
+               (not (featurep 'xemacs)))) ; ??
+      (setq url-passwd-entry-func 'ange-ftp-read-passwd))
+     (t
+      (url-warn
+       'security
+       "(url-setup): Can't determine how to read passwords, winging it.")))
+  
+    (url-setup-privacy-info)
+    (run-hooks 'url-load-hook)
+    (setq url-setup-done t)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Retrieval functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun url-retrieve (url callback &optional cbargs)
+  "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
+The callback is called when the object has been completely retrieved, with
+the current buffer containing the object, and any MIME headers associated
+with it.  URL is either a string or a parsed URL.
+
+Return the buffer URL will load into, or nil if the process has
+already completed."
+  (url-do-setup)
+  (url-gc-dead-buffers)
+  (if (stringp url)
+       (set-text-properties 0 (length url) nil url))
+  (if (not (vectorp url))
+      (setq url (url-generic-parse-url url)))
+  (if (not (functionp callback))
+      (error "Must provide a callback function to url-retrieve"))
+  (unless (url-type url)
+    (error "Bad url: %s" (url-recreate-url url)))
+  (let ((loader (url-scheme-get-property (url-type url) 'loader))
+        (url-using-proxy (if (url-host url)
+                             (url-find-proxy-for-url url (url-host url))))
+        (buffer nil)
+        (asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
+    (if url-using-proxy
+        (setq asynch t
+              loader 'url-proxy))
+    (if asynch
+        (setq buffer (funcall loader url callback cbargs))
+      (setq buffer (funcall loader url))
+      (if buffer
+          (with-current-buffer buffer
+            (apply callback cbargs))))
+    (url-history-update-url url (current-time))
+    buffer))
+
+(defun url-retrieve-synchronously (url)
+  "Retrieve URL synchronously.
+Return the buffer containing the data, or nil if there are no data
+associated with it (the case for dired, info, or mailto URLs that need
+no further processing).  URL is either a string or a parsed URL."
+  (url-do-setup)
+
+  (lexical-let ((retrieval-done nil)
+                (asynch-buffer nil))
+    (setq asynch-buffer
+          (url-retrieve url (lambda (&rest ignored)
+                              (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
+                              (setq retrieval-done t
+                                    asynch-buffer (current-buffer)))))
+    (if (not asynch-buffer)
+        ;; We do not need to do anything, it was a mailto or something
+        ;; similar that takes processing completely outside of the URL
+        ;; package.
+        nil
+      (while (not retrieval-done)
+        (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)"
+                   retrieval-done asynch-buffer)
+        ;; Quoth Stef:
+        ;; It turns out that the problem seems to be that the (sit-for
+        ;; 0.1) below doesn't actually process the data: instead it
+        ;; returns immediately because there is keyboard input
+        ;; waiting, so we end up spinning endlessly waiting for the
+        ;; process to finish while not letting it finish.
+
+        ;; However, raman claims that it blocks Emacs with Emacspeak
+        ;; for unexplained reasons.  Put back for his benefit until
+        ;; someone can understand it.
+        ;; (sleep-for 0.1)
+        (sit-for 0.1))
+      asynch-buffer)))
+
+(defun url-mm-callback (&rest ignored)
+  (let ((handle (mm-dissect-buffer t)))
+    (save-excursion
+      (url-mark-buffer-as-dead (current-buffer))
+      (set-buffer (generate-new-buffer (url-recreate-url url-current-object)))
+      (if (eq (mm-display-part handle) 'external)
+          (progn
+            (set-process-sentinel
+             ;; Fixme: this shouldn't have to know the form of the
+             ;; undisplayer produced by `mm-display-part'.
+             (get-buffer-process (cdr (mm-handle-undisplayer handle)))
+             `(lambda (proc event)
+                (mm-destroy-parts (quote ,handle))))
+            (message "Viewing externally")
+            (kill-buffer (current-buffer)))
+        (display-buffer (current-buffer))
+        (mm-destroy-parts handle)))))
+
+(defun url-mm-url (url)
+  "Retrieve URL and pass to the appropriate viewing application."
+  (require 'mm-decode)
+  (require 'mm-view)
+  (url-retrieve url 'url-mm-callback nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellaneous
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar url-dead-buffer-list nil)
+
+(defun url-mark-buffer-as-dead (buff)
+  (push buff url-dead-buffer-list))
+
+(defun url-gc-dead-buffers ()
+  (let ((buff))
+    (while (setq buff (pop url-dead-buffer-list))
+      (if (buffer-live-p buff)
+          (kill-buffer buff)))))
+
+(cond
+ ((fboundp 'display-warning)
+  (defalias 'url-warn 'display-warning))
+ ((fboundp 'warn)
+  (defun url-warn (class message &optional level)
+    (warn "(%s/%s) %s" class (or level 'warning) message)))
+ (t
+  (defun url-warn (class message &optional level)
+    (with-current-buffer (get-buffer-create "*URL-WARNINGS*")
+      (goto-char (point-max))
+      (save-excursion
+        (insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
+      (display-buffer (current-buffer))))))
+
+(provide 'url)
+
+;; arch-tag: bc182f1f-d187-4f10-b961-47af2066579a
+;;; url.el ends here
diff --git a/lisp/vc.el b/lisp/vc.el
index 663c45fd466..a0d3d1cd4be 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -646,9 +646,6 @@ List of factors, used to expand/compress the time scale.  See `vc-annotate'."
   :group 'vc)
 
 ;; vc-annotate functionality (CVS only).
-(defvar vc-annotate-mode nil
-  "Variable indicating if VC-Annotate mode is active.")
-
 (defvar vc-annotate-mode-map
   (let ((m (make-sparse-keymap)))
     (define-key m [menu-bar] (make-sparse-keymap "VC-Annotate"))
@@ -3004,7 +3001,7 @@ use; you may override this using the second optional arg MODE."
   (when buffer
     (set-buffer buffer)
     (display-buffer buffer))
-  (if (not vc-annotate-mode)            ; Turn on vc-annotate-mode if not done
+  (if (not vc-annotate-parent-rev)
       (vc-annotate-mode))
   (cond ((null vc-annotate-display-mode)
          (vc-annotate-display-default vc-annotate-ratio))
diff --git a/lisp/xml.el b/lisp/xml.el
index 993ef59b276..b0d5d45f98d 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -598,8 +598,8 @@ This follows the rule [28] in the XML specifications."
               nil)
              (t
               (if xml-validating-parser 
-                  error "XML: (Validity) Invalid element type in the DTD")))
-
+                  (error "XML: (Validity) Invalid element type in the DTD"))))
+            
             ;;  rule [45]: the element declaration must be unique
             (if (and (assoc element dtd)
                      xml-validating-parser)
@@ -727,14 +727,9 @@ This follows the rule [28] in the XML specifications."
                                 (match-string 1 this-part)))))))
 
         (cond ((null children)
-               (if (stringp expansion)
-                   (setq children (concat prev-part expansion))
-                 (if (stringp (car (last expansion)))
-                     (progn 
-                            (setq children
-                                  (list (concat prev-part (car expansion))
-                                        (cdr expansion))))
-                   (setq children (append expansion prev-part)))))
+               ;; FIXME: If we have an entity that expands into XML, this won't work.
+               (setq children
+                     (concat prev-part expansion)))
               ((stringp children)
                (if (stringp expansion)
                    (setq children (concat children prev-part expansion))
@@ -756,11 +751,15 @@ This follows the rule [28] in the XML specifications."
     (cond ((stringp children)
            (concat children (substring string point)))
           ((stringp (car (last children)))
-           (concat (car children) (substring string point)))
+           (concat (car (last children)) (substring string point)))
           ((null children)
            string)
           (t
-           (nreverse children)))))
+           (concat (mapconcat 'identity
+                              (nreverse children)
+                              "")
+                   (substring string point))))))
+
 ;;*******************************************************************
 ;;**
 ;;**  Printing a tree.