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

Merge from emacs--cvs-trunk--0

Patches applied:

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

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-445
   Tweak permissions

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

13 files changed, 541 insertions, 232 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 92552debee2..68fe5246458 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,79 @@
+2004-07-10  Luc Teirlinck  <teirllm@auburn.edu>
+
+        * files.el (switch-to-buffer-other-window): Doc fix.
+
+        * window.el (save-selected-window, one-window-p)
+        (split-window-keep-point, split-window-vertically)
+        (split-window-horizontally): Doc fixes.
+
+2004-07-10  Vinicius Jose Latorre  <viniciusjl@ig.com.br>
+
+        * printing.el: Doc fix.  Now it uses call-process instead of
+        shell-command for low command execution.
+        (pr-version): New version number (6.8).
+        (pr-shell-file-name): Option removed.
+        (pr-shell-command): Fun removed.
+        (pr-call-process): New fun.  Replace pr-shell-command.
+        (pr-standard-path, pr-remove-nil-from-list): New funs.
+        (zmacs-region-stays, current-mouse-event, current-menubar): New var.
+        (pr-ps-file-preview, pr-ps-file-using-ghostscript, pr-ps-file-print)
+        (pr-setup, pr-ps-set-printer, pr-txt-set-printer)
+        (pr-ps-utility-process, pr-txt-print): Code fix.
+
+2004-07-10  Stephan Stahl  <stahl@eos.franken.de>  (tiny change)
+
+        * ediff-mult.el (ediff-meta-truncate-filenames): Change type to
+        boolean.
+
+2004-07-09  Lars Hansen  <larsh@math.ku.dk>
+
+        * wid-edit.el (widget-field-buffer): Doc fix.
+
+2004-07-09  John Paul Wallington  <jpw@gnu.org>
+
+        * emacs-lisp/re-builder.el (reb-update-overlays): Distinguish
+        between one and several matches in message.
+
+2004-07-09  Richard M. Stallman  <rms@gnu.org>
+
+        * mouse.el (mouse-set-region-1): If transient-mark-mode
+        is `identity', change it to `only'.
+
+        * simple.el (current-word): Doc fix.
+
+2004-07-09  Mark A. Hershberger  <mah@everybody.org>
+
+        * progmodes/cperl-mode.el (cperl-mode): Adapt defun-prompt-regexp
+        so that it is more understanding of whitespace.
+
+        * xml.el (xml-maybe-do-ns, xml-parse-tag): Produce elements in the
+        form
+        (("ns" . "element") (attr-list) children) instead of
+        ((:ns . "element") (attr-list) children) in order to reduce the
+        number of symbols used.
+        (xml-skip-dtd): Change to use xml-parse-dtd but set
+        xml-validating-parsing to nil.
+        (xml-parse-dtd): Parse entity deleclarations in DOCTYPEs.
+        (xml-substitute-entity): Remove in favor of new entity substitution.
+        (xml-substitute-special): Rewrite in to substitute complex
+        entities from DOCTYPE declarations.
+        (xml-parse-fragment): Parse fragments from entity deleclarations.
+        (xml-parse-region, xml-parse-tag, xml-parse-attlist)
+        (xml-parse-dtd, xml-substitute-special): Make validity checks
+        conditioned on xml-validating-parser.  Add "Not Well Formed" to
+        error messages about well-formedness.
+
+2004-07-08  Steven Tamm  <steventamm@mac.com>
+
+        * term/mac-win.el (mac-scroll-ignore-events, mac-scroll-down)
+        (mac-scroll-down-line, mac-scroll-up, mac-scroll-up-line):
+        Do not treat double clicks and triple clicks specially in the
+        scroll bar (preventing strange repositioning problems)
+
+2004-07-06  Stefan  <monnier@iro.umontreal.ca>
+
+        * replace.el (query-replace-regexp-eval): Fix last change.
+
 2004-07-05  Stefan  <monnier@iro.umontreal.ca>
 
         * replace.el (query-replace-descr): New fun.
diff --git a/lisp/ediff-mult.el b/lisp/ediff-mult.el
index f5eff1eb49d..cf6edc2d129 100644
--- a/lisp/ediff-mult.el
+++ b/lisp/ediff-mult.el
@@ -200,7 +200,7 @@ Should be a sexp. For instance (car ediff-filtering-regexp-history) or nil."
 (defcustom ediff-meta-truncate-filenames t
   "*If non-nil, truncate long file names in the session group buffers.
 This can be toggled with `ediff-toggle-filename-truncation'."
-  :type 'hook
+  :type 'boolean
   :group 'ediff-mult)
 (defcustom ediff-registry-setup-hook nil
   "*Hooks run just after the registry control panel is set up."
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 83d3649006e..c6112c4a105 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -670,9 +670,10 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
                   (overlay-put overlay 'priority i)))
             (setq i (1+ i))))))
     (let ((count (if subexp submatches matches)))
-      (message"%s %smatch(es)%s"
+      (message"%s %smatch%s%s"
                (if (= 0 count) "No" (int-to-string count))
                (if subexp "subexpression " "")
+               (if (= 1 count) "" "es")
                (if (and reb-auto-match-limit
                         (= reb-auto-match-limit count))
                    " (limit reached)" "")))
diff --git a/lisp/files.el b/lisp/files.el
index 1d500379925..30f318fbf69 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -869,8 +869,15 @@ use with M-x."
 
 (defun switch-to-buffer-other-window (buffer &optional norecord)
   "Select buffer BUFFER in another window.
+If BUFFER does not identify an existing buffer, then this function
+creates a buffer with that name.
+
+When called from Lisp, BUFFER can be a buffer, a string \(a buffer name),
+or nil.  If BUFFER is nil, then this function chooses a buffer
+using `other-buffer'.
 Optional second arg NORECORD non-nil means
 do not put this buffer at the front of the list of recently selected ones.
+This function returns the buffer it switched to.
 
 This uses the function `display-buffer' as a subroutine; see its
 documentation for additional customization information."
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 7f9d080478a..b73967b99dc 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -625,7 +625,8 @@ This should be bound to a mouse drag event."
 
 (defun mouse-set-region-1 ()
   ;; Set transient-mark-mode for a little while.
-  (setq transient-mark-mode (or transient-mark-mode 'only))
+  (if (memq transient-mark-mode '(nil identity))
+      (setq transient-mark-mode 'only))
   (setq mouse-last-region-beg (region-beginning))
   (setq mouse-last-region-end (region-end))
   (setq mouse-last-region-tick (buffer-modified-tick)))
diff --git a/lisp/printing.el b/lisp/printing.el
index 57dd0691f99..351d6b64e85 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -3,18 +3,18 @@
 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004
 ;; Free Software Foundation, Inc.
 
-;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Time-stamp: <2004/04/05 23:41:49 vinicius>
+;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Time-stamp: <2004/07/10 18:48:24 vinicius>
 ;; Keywords: wp, print, PostScript
-;; Version: 6.7.4
+;; Version: 6.8
 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
 
-(defconst pr-version "6.7.4"
-  "printing.el, v 6.7.4 <2004/03/31 vinicius>
+(defconst pr-version "6.8"
+  "printing.el, v 6.8 <2004/07/10 vinicius>
 
 Please send all bug fixes and enhancements to
-        Vinicius Jose Latorre <vinicius@cpqd.com.br>
+        Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ")
 
 ;; This file is part of GNU Emacs.
@@ -40,10 +40,23 @@ Please send all bug fixes and enhancements to
 ;; Introduction
 ;; ------------
 ;;
-;; This package provides some printing utilities that includes
-;; previewing/printing a PostScript file, printing a text file and
+;; This package provides an user interface to some printing utilities that
+;; includes previewing/printing a PostScript file, printing a text file and
 ;; previewing/printing some major modes (like mh-folder-mode,
-;; rmail-summary-mode, gnus-summary-mode, etc).
+;; rmail-summary-mode, gnus-summary-mode, etc).  It also includes a
+;; PostScript/text printer database.
+;;
+;; Indeed, there are two user interfaces:
+;;
+;;    * one is via menubar:
+;;      When `printing' is loaded, the menubar is modified to use `printing'
+;;      menu instead of the print options in menubar.
+;;      This is the default user interface.
+;;
+;;    * other is via buffer interface:
+;;      It is an option of `printing' menu, but it can be binded into another
+;;      key, so user can activate the buffer interface directly without using
+;;      a menu.  See `pr-interface' command.
 ;;
 ;; `printing' was inspired on:
 ;;
@@ -172,7 +185,7 @@ Please send all bug fixes and enhancements to
 ;; Tips
 ;; ----
 ;;
-;; 1. If your have a local printer, that is, a printer which is connected
+;; 1. If you have a local printer, that is, a printer which is connected
 ;;    directly to your computer, don't forget to connect the printer to your
 ;;    computer before printing.
 ;;
@@ -187,16 +200,26 @@ Please send all bug fixes and enhancements to
 ;;    another buffer and, then, print the file or the new static buffer.
 ;;    An example of dynamic buffer is the *Messages* buffer.
 ;;
-;; 4. When running Emacs on Windows with cygwin, check if the
-;;    `pr-shell-file-name' variable is set to the proper shell.  This shell
-;;    will execute the commands to preview/print the buffer, file or directory.
-;;    Also check the setting of `pr-path-style' variable.
-;;    Probably, you should use:
+;; 4. When running Emacs on Windows (with or without cygwin), check if your
+;;    printer is a text printer or not by typing in a DOS window:
+;;
+;;       print /D:\\host\printer somefile.txt
+;;
+;;    Where, `host' is the machine where your printer is directly connected,
+;;    `printer' is the printer name and `somefile.txt' is a text file.
 ;;
-;;    (setq pr-shell-file-name "bash")
-;;    (setq pr-path-style 'unix)
+;;    If the printer `\\host\printer' doesn't print the content of
+;;    `somefile.txt' or, instead, it returns the following message:
 ;;
-;;     And use / instead of \ when specifying a directory.
+;;       PostScript Error Handler
+;;       Offending Command = CCC
+;;       Stack =
+;;
+;;    Where `CCC' is whatever is at the beginning of the text to be printed.
+;;
+;;    Therefore, the printer `\\host\printer' is not a text printer, but a
+;;    PostScript printer.  So, please, don't include this printer in
+;;    `pr-txt-printer-alist' (which see).
 ;;
 ;;
 ;; Using `printing'
@@ -479,9 +502,6 @@ Please send all bug fixes and enhancements to
 ;; `pr-buffer-verbose'          Non-nil means to be verbose when editing a
 ;;                              field in interface buffer.
 ;;
-;; `pr-shell-file-name'         Specify file name to load inferior shells
-;;                              from.
-;;
 ;; To set the above options you may:
 ;;
 ;; a) insert the code in your ~/.emacs, like:
@@ -912,8 +932,8 @@ Please send all bug fixes and enhancements to
 (require 'ps-print)
 
 
-(and (string< ps-print-version "6.5.7")
-     (error "`printing' requires `ps-print' package version 6.5.7 or later."))
+(and (string< ps-print-version "6.6.4")
+     (error "`printing' requires `ps-print' package version 6.6.4 or later."))
 
 
 (eval-and-compile
@@ -1064,6 +1084,15 @@ Valid values are:
     path))
 
 
+(defun pr-standard-path (path)
+  "Ensure the proper directory separator depending on the OS.
+That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory
+separator; otherwise, ensure unix-style directory separator."
+  (if (or pr-cygwin-system ps-windows-system)
+      (subst-char-in-string ?/ ?\\ path)
+    (subst-char-in-string ?\\ ?/ path)))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; User Interface (II)
 
@@ -2314,16 +2343,6 @@ It's used by `pr-interface'."
   :group 'printing)
 
 
-(defcustom pr-shell-file-name
-  (if (and (not pr-cygwin-system)
-           ps-windows-system)
-      "cmdproxy.exe"
-    shell-file-name)
-  "*Specify file name to load inferior shells from."
-  :type 'string
-  :group 'printing)
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal Variables
 
@@ -2410,6 +2429,7 @@ See `pr-ps-printer-alist'.")
       (and pr-auto-region transient-mark-mode mark-active)))
 
    ((eq ps-print-emacs-type 'xemacs)    ; XEmacs
+    (defvar zmacs-region-stays nil)     ; to avoid compilation gripes
     (defsubst pr-region-active-p ()
       (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p)))))
 
@@ -3792,9 +3812,7 @@ image in a file with that name."
   "Preview PostScript file FILENAME."
   (interactive (list (pr-ps-infile-preprint "Preview ")))
   (and (stringp filename) (file-exists-p filename)
-       (let ((shell-file-name pr-shell-file-name))
-         (start-process-shell-command "PREVIEW" "*Messages*"
-                                      (pr-command pr-gv-command) filename))))
+       (pr-call-process pr-gv-command filename)))
 
 
 ;;;###autoload
@@ -3815,12 +3833,13 @@ image in a file with that name."
        (let* ((file (pr-expand-file-name filename))
               (tempfile (pr-dosify-path (make-temp-name file))))
          ;; gs use
-         (pr-shell-command
-          (concat (pr-command pr-gs-command)
-                  " -sDEVICE=" pr-gs-device
-                  " -r" (int-to-string pr-gs-resolution)
-                  " " (pr-switches-string pr-gs-switches "pr-gs-switches")
-                  " -sOutputFile=" tempfile " " file " -c quit"))
+         (pr-call-process pr-gs-command
+                          (format "-sDEVICE=%s" pr-gs-device)
+                          (format "-r%d" pr-gs-resolution)
+                          (pr-switches-string pr-gs-switches "pr-gs-switches")
+                          (format "-sOutputFile=\"%s\"" tempfile)
+                          file
+                          "-c quit")
          ;; printing
          (pr-ps-file-print tempfile)
          ;; deleting
@@ -3841,16 +3860,16 @@ image in a file with that name."
                  (erase-buffer)
                  (insert-file-contents-literally file))
                (pr-despool-print))
-           (pr-shell-command
-            (concat (pr-command pr-ps-command) " "
-                    (pr-switches-string pr-ps-switches "pr-gs-switches") " "
-                    (if (string-match "cp" pr-ps-command)
-                        ;; for "cp" (cmd in out)
-                        (concat "\"" file "\" "
-                                pr-ps-printer-switch pr-ps-printer)
-                      ;; else, for others (cmd out in)
-                      (concat pr-ps-printer-switch pr-ps-printer
-                              " \"" file "\""))))))))
+           (apply 'pr-call-process
+                  pr-ps-command
+                  (pr-switches-string pr-ps-switches "pr-gs-switches")
+                  (if (string-match "cp" pr-ps-command)
+                      ;; for "cp" (cmd in out)
+                      (list file
+                            (concat pr-ps-printer-switch pr-ps-printer))
+                    ;; else, for others (cmd out in)
+                    (list (concat pr-ps-printer-switch pr-ps-printer)
+                          file)))))))
 
 
 ;;;###autoload
@@ -4252,9 +4271,22 @@ Or choose the menu option Printing/Show Settings/printing."
      #'ps-print-quote
      (list
       (concat "\n;;; printing.el version " pr-version "\n")
-      '(19 . pr-shell-file-name)
-      '(19 . pr-path-style)
-      '(19 . pr-path-alist)
+      ";; internal vars"
+      (ps-comment-string "pr-txt-command      " pr-txt-command)
+      (ps-comment-string "pr-txt-switches     "
+                         (pr-switches-string pr-txt-switches "pr-txt-switches"))
+      (ps-comment-string "pr-txt-printer      " pr-txt-printer)
+      (ps-comment-string "pr-ps-command       " pr-ps-command)
+      (ps-comment-string "pr-ps-switches      "
+                         (pr-switches-string pr-ps-switches "pr-ps-switches"))
+      (ps-comment-string "pr-ps-printer-switch" pr-ps-printer-switch)
+      (ps-comment-string "pr-ps-printer       " pr-ps-printer)
+      (ps-comment-string "pr-cygwin-system    " pr-cygwin-system)
+      (ps-comment-string "ps-windows-system   " ps-windows-system)
+      (ps-comment-string "ps-lp-system        " ps-lp-system)
+      nil
+      '(14 . pr-path-style)
+      '(14 . pr-path-alist)
       nil
       '(21 . pr-txt-name)
       '(21 . pr-txt-printer-alist)
@@ -4570,6 +4602,7 @@ See `pr-visible-entry-alist'.")
   (cond
    ((eq ps-print-emacs-type 'xemacs)
     ;; XEmacs
+    (defvar current-mouse-event nil)    ; to avoid compilation gripes
     (defun pr-menu-position (entry index horizontal)
       (pr-x-make-event
        'button-release
@@ -4633,6 +4666,7 @@ See `pr-visible-entry-alist'.")
 
    ((eq ps-print-emacs-type 'xemacs)
     ;; XEmacs
+    (defvar current-menubar nil)        ; to avoid compilation gripes
     (defun pr-menu-lookup (path)
       (car (pr-x-find-menu-item current-menubar (cons "Printing" path))))
 
@@ -4973,7 +5007,7 @@ non-nil."
           pr-ps-command        (pr-dosify-path (nth 0 ps))
           pr-ps-switches       (nth 1 ps)
           pr-ps-printer-switch (nth 2 ps)
-          pr-ps-printer        (pr-dosify-path (nth 3 ps)))
+          pr-ps-printer        (nth 3 ps))
     (or (stringp pr-ps-command)
         (setq pr-ps-command
               (cond (ps-windows-system "print")
@@ -4998,7 +5032,7 @@ non-nil."
     (setq pr-txt-name     value
           pr-txt-command  (pr-dosify-path (nth 0 txt))
           pr-txt-switches (nth 1 txt)
-          pr-txt-printer  (pr-dosify-path (nth 2 txt))))
+          pr-txt-printer  (nth 2 txt)))
   (or (stringp pr-txt-command)
       (setq pr-txt-command
             (cond (ps-windows-system "print")
@@ -5211,32 +5245,54 @@ non-nil."
   (let (item)
     (and (stringp infile) (file-exists-p infile)
          (setq item (cdr (assq pr-ps-utility pr-ps-utility-alist)))
-         (pr-shell-command
-          (concat (pr-command (nth 0 item)) " "
-                  (pr-switches-string (nth 1 item)
-                                      "pr-ps-utility-alist entry")
-                  " "
-                  (pr-switches-string (nth 8 item)
-                                      "pr-ps-utility-alist entry")
-                  " "
-                  (and (nth 2 item)
-                       (format (nth 2 item) ps-paper-type))
-                  " " (format (nth 3 item) n-up) " "
-                  (and pr-file-landscape (nth 4 item)) " "
-                  (and pr-file-duplex    (nth 5 item)) " "
-                  (and pr-file-tumble    (nth 6 item))
-                  " \"" (pr-expand-file-name infile) "\" "
-                  (nth 7 item)
-                  " \"" (pr-expand-file-name outfile) "\"")))))
-
-
-(defun pr-shell-command (command)
-  (let ((shell-file-name pr-shell-file-name))
-    (shell-command command)))
+         (pr-call-process (nth 0 item)
+                          (pr-switches-string (nth 1 item)
+                                              "pr-ps-utility-alist entry")
+                          (pr-switches-string (nth 8 item)
+                                              "pr-ps-utility-alist entry")
+                          (and (nth 2 item)
+                               (format (nth 2 item) ps-paper-type))
+                          (format (nth 3 item) n-up)
+                          (and pr-file-landscape (nth 4 item))
+                          (and pr-file-duplex    (nth 5 item))
+                          (and pr-file-tumble    (nth 6 item))
+                          (pr-expand-file-name infile)
+                          (nth 7 item)
+                          (pr-expand-file-name outfile)))))
+
+
+(defun pr-remove-nil-from-list (lst)
+  (while (and lst (null (car lst)))
+    (setq lst (cdr lst)))
+  (let ((b lst)
+        (l (cdr lst)))
+    (while l
+      (if (car l)
+          (setq b l
+                l (cdr l))
+        (setq l (cdr l))
+        (setcdr b l))))
+  lst)
+
+
+(defun pr-call-process (command &rest args)
+  (let ((buffer (get-buffer-create "*Printing Command Output*"))
+        (cmd    (pr-command command))
+        status)
+    (setq args (pr-remove-nil-from-list args))
+    (save-excursion
+      (set-buffer buffer)
+      (goto-char (point-max))
+      (insert (format "%s %S\n" cmd args)))
+    (setq status (apply 'call-process cmd nil buffer nil args))
+    (save-excursion
+      (set-buffer buffer)
+      (goto-char (point-max))
+      (insert (format "Exit status: %s\n" status)))))
 
 
 (defun pr-txt-print (from to)
-  (let ((lpr-command  (pr-command pr-txt-command))
+  (let ((lpr-command  (pr-standard-path (pr-command pr-txt-command)))
         (lpr-switches (pr-switches pr-txt-switches "pr-txt-switches"))
         (printer-name pr-txt-printer))
     (lpr-region from to)))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index c651e06b899..e679a48d642 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1472,7 +1472,7 @@ or as help on variables `cperl-tips', `cperl-problems',
   (make-local-variable 'comment-start-skip)
   (setq comment-start-skip "#+ *")
   (make-local-variable 'defun-prompt-regexp)
-  (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)\\([ \t]*([^()]*)[ \t]*\\)?[ \t]*")
+  (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*)")
   (make-local-variable 'comment-indent-function)
   (setq comment-indent-function 'cperl-comment-indent)
   (make-local-variable 'parse-sexp-ignore-comments)
diff --git a/lisp/replace.el b/lisp/replace.el
index a7c8b859402..60c28d6c48a 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -287,6 +287,7 @@ Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 only matches that are surrounded by word boundaries.
 Fourth and fifth arg START and END specify the region to operate on."
   (interactive
+   (progn
    (barf-if-buffer-read-only)
    (let* ((from
            ;; Let-bind the history var to disable the "foo -> bar" default.
@@ -305,7 +306,7 @@ Fourth and fifth arg START and END specify the region to operate on."
            (if (and transient-mark-mode mark-active)
                (region-beginning))
            (if (and transient-mark-mode mark-active)
-               (region-end)))))
+               (region-end))))))
   (perform-replace regexp (cons 'replace-eval-replacement to-expr)
                    t 'literal delimited nil nil start end))
 
diff --git a/lisp/simple.el b/lisp/simple.el
index 8da9e8028f0..c45437fb123 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3364,7 +3364,8 @@ With argument, do this that many times."
   "Return the symbol or word that point is on (or a nearby one) as a string.
 The return value includes no text properties.
 If optional arg STRICT is non-nil, return nil unless point is within
-or adjacent to a symbol or word.
+or adjacent to a symbol or word.  In all cases the value can be nil
+if there is no word nearby.
 The function, belying its name, normally finds a symbol.
 If optional arg REALLY-WORD is non-nil, it finds just a word."
   (save-excursion
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index 1220c046cb7..15e813c53d3 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -68,24 +68,29 @@
       (goto-char (window-start window))
       (mac-scroll-up-line)))))
 
+(defun mac-scroll-ignore-events ()
+  ;; Ignore confusing non-mouse events
+  (while (not (memq (car-safe (read-event))
+                    '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
+
 (defun mac-scroll-down ()
   (track-mouse
-    (while (not (eq (car-safe (read-event)) 'mouse-1)) nil)
+    (mac-scroll-ignore-events)
     (scroll-down)))
 
 (defun mac-scroll-down-line ()
   (track-mouse
-    (while (not (eq (car-safe (read-event)) 'mouse-1)) nil)
+    (mac-scroll-ignore-events)
     (scroll-down 1)))
 
 (defun mac-scroll-up ()
   (track-mouse
-    (while (not (eq (car-safe (read-event)) 'mouse-1)) nil)
+    (mac-scroll-ignore-events)
     (scroll-up)))
 
 (defun mac-scroll-up-line ()
   (track-mouse
-    (while (not (eq (car-safe (read-event)) 'mouse-1)) nil)
+    (mac-scroll-ignore-events)
     (scroll-up 1)))
 
 (defun xw-defined-colors (&optional frame)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index e6ce5ae71db..bdbe607317d 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1144,7 +1144,7 @@ When not inside a field, move to the previous button or field."
       field)))
 
 (defun widget-field-buffer (widget)
-  "Return the start of WIDGET's editing field."
+  "Return the buffer of WIDGET's editing field."
   (let ((overlay (widget-get widget :field-overlay)))
     (cond ((overlayp overlay)
            (overlay-buffer overlay))
diff --git a/lisp/window.el b/lisp/window.el
index 188b3acf311..96bfc8b5581 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -34,7 +34,8 @@
 Also restore the selected window of each frame as it was at the start
 of this construct.
 However, if a window has become dead, don't get an error,
-just refrain from reselecting it."
+just refrain from reselecting it.
+Return the value of the last form in BODY."
   `(let ((save-selected-window-window (selected-window))
          ;; It is necessary to save all of these, because calling
          ;; select-window changes frame-selected-window for whatever
@@ -63,15 +64,17 @@ This does not include the mode line (if any) or the header line (if any)."
                 (if header-line-format 1 0))))))
 
 (defun one-window-p (&optional nomini all-frames)
-  "Return non-nil if the selected window is the only window (in its frame).
+  "Return non-nil if the selected window is the only window.
 Optional arg NOMINI non-nil means don't count the minibuffer
-even if it is active.
+even if it is active.  Otherwise, the minibuffer is counted
+when it is active.
 
 The optional arg ALL-FRAMES t means count windows on all frames.
 If it is `visible', count windows on all visible frames.
 ALL-FRAMES nil or omitted means count only the selected frame,
 plus the minibuffer it uses (which may be on another frame).
-If ALL-FRAMES is neither nil nor t, count only the selected frame."
+ALL-FRAMES 0 means count all windows in all visible or iconified frames.
+If ALL-FRAMES is anything else, count only the selected frame."
   (let ((base-window (selected-window)))
     (if (and nomini (eq base-window (minibuffer-window)))
         (setq base-window (next-window base-window)))
@@ -87,7 +90,7 @@ bars (top, bottom, or nil)."
   (let ((vert (nth 2 (window-scroll-bars window)))
         (hor nil))
     (when (or (eq vert t) (eq hor t))
-      (let ((fcsb (frame-current-scroll-bars 
+      (let ((fcsb (frame-current-scroll-bars
                    (window-frame (or window (selected-window))))))
         (if (eq vert t)
             (setq vert (car fcsb)))
@@ -268,29 +271,38 @@ If WINDOW is nil or omitted, it defaults to the currently selected window."
 
 ;; I think this should be the default; I think people will prefer it--rms.
 (defcustom split-window-keep-point t
-  "*If non-nil, split windows keeps the original point in both children.
+  "*If non-nil, \\[split-window-vertically] keeps the original point \
+in both children.
 This is often more convenient for editing.
 If nil, adjust point in each of the two windows to minimize redisplay.
-This is convenient on slow terminals, but point can move strangely."
+This is convenient on slow terminals, but point can move strangely.
+
+This option applies only to `split-window-vertically' and
+functions that call it.  `split-window' always keeps the original
+point in both children,"
   :type 'boolean
   :group 'windows)
 
 (defun split-window-vertically (&optional arg)
   "Split current window into two windows, one above the other.
 The uppermost window gets ARG lines and the other gets the rest.
-Negative arg means select the size of the lowermost window instead.
+Negative ARG means select the size of the lowermost window instead.
 With no argument, split equally or close to it.
 Both windows display the same buffer now current.
 
 If the variable `split-window-keep-point' is non-nil, both new windows
 will get the same value of point as the current window.  This is often
-more convenient for editing.
+more convenient for editing.  The upper window is the selected window.
 
-Otherwise, we chose window starts so as to minimize the amount of
+Otherwise, we choose window starts so as to minimize the amount of
 redisplay; this is convenient on slow terminals.  The new selected
 window is the one that the current value of point appears in.  The
 value of point can change if the text around point is hidden by the
-new mode line."
+new mode line.
+
+Regardless of the value of `split-window-keep-point', the upper
+window is the original one and the return value is the new, lower
+window."
   (interactive "P")
   (let ((old-w (selected-window))
         (old-point (point))
@@ -338,10 +350,13 @@ new mode line."
 (defun split-window-horizontally (&optional arg)
   "Split current window into two windows side by side.
 This window becomes the leftmost of the two, and gets ARG columns.
-Negative arg means select the size of the rightmost window instead.
+Negative ARG means select the size of the rightmost window instead.
 The argument includes the width of the window's scroll bar; if there
 are no scroll bars, it includes the width of the divider column
-to the window's right, if any.  No arg means split equally."
+to the window's right, if any.  No ARG means split equally.
+
+The original, leftmost window remains selected.
+The return value is the new, rightmost window."
   (interactive "P")
   (let ((old-w (selected-window))
         (size (and arg (prefix-numeric-value arg))))
diff --git a/lisp/xml.el b/lisp/xml.el
index 03ef6346c70..993ef59b276 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -84,6 +84,20 @@
 ;;**
 ;;*******************************************************************
 
+(defvar xml-entity-alist
+  '(("lt"   . "<")
+    ("gt"   . ">")
+    ("apos" . "'")
+    ("quot" . "\"")
+    ("amp"  . "&"))
+  "The defined entities.  Entities are added to this when the DTD is parsed.")
+
+(defvar xml-sub-parser nil
+  "Dynamically set this to a non-nil value if you want to parse an XML fragment.")
+
+(defvar xml-validating-parser nil
+  "Set to non-nil to get validity checking.")
+
 (defsubst xml-node-name (node)
   "Return the tag associated with NODE.
 Without namespace-aware parsing, the tag is a symbol.
@@ -164,6 +178,48 @@ If PARSE-NS is non-nil, then QNAMES are expanded."
         (kill-buffer (current-buffer)))
       xml)))
 
+
+(let* ((start-chars (concat ":[:alpha:]_"))
+       (name-chars  (concat "-[:digit:]." start-chars))
+;;[3]           S          ::=          (#x20 | #x9 | #xD | #xA)+
+       (whitespace  "[ \t\n\r]"))
+;;[4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] 
+;;                      | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF]
+;;                      | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF]
+;;                      | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]
+  (defvar xml-name-start-char-re (concat "[" start-chars "]"))
+;;[4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]
+  (defvar xml-name-char-re       (concat "[" name-chars  "]"))
+;;[5] Name     ::= NameStartChar (NameChar)*
+  (defvar xml-name-re            (concat xml-name-start-char-re xml-name-char-re "*"))
+;;[6] Names    ::= Name (#x20 Name)*
+  (defvar xml-names-re           (concat xml-name-re "\\(?: " xml-name-re "\\)*"))
+;;[7] Nmtoken ::= (NameChar)+
+  (defvar xml-nmtoken-re         (concat xml-name-char-re "+"))
+;;[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)*
+  (defvar xml-nmtokens-re        (concat xml-nmtoken-re "\\(?: " xml-name-re "\\)*"))
+;;[66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';'
+  (defvar xml-char-ref-re        "\\(?:&#[0-9]+;\\|&#x[0-9a-fA-F]+;\\)")
+;;[68] EntityRef   ::= '&' Name ';'
+  (defvar xml-entity-ref         (concat "&" xml-name-re ";"))
+;;[69] PEReference ::= '%' Name ';'
+  (defvar xml-pe-reference-re    (concat "%" xml-name-re ";"))
+;;[67] Reference   ::= EntityRef | CharRef
+  (defvar xml-reference-re       (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)"))
+;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"'
+;;                 |  "'" ([^%&'] | PEReference | Reference)* "'"
+  (defvar xml-entity-value-re    (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re
+                                         "\\|" xml-reference-re "\\)*\"\\|'\\(?:[^%&']\\|"
+                                         xml-pe-reference-re "\\|" xml-reference-re "\\)*'\\)")))
+;;[75] ExternalID ::= 'SYSTEM' S SystemLiteral
+;;                 | 'PUBLIC' S PubidLiteral S SystemLiteral
+;;[76] NDataDecl ::=    S 'NDATA' S 
+;;[73] EntityDef  ::= EntityValue| (ExternalID NDataDecl?)
+;;[71] GEDecl     ::= '<!ENTITY' S Name S EntityDef S? '>'
+;;[74] PEDef      ::= EntityValue | ExternalID
+;;[72] PEDecl     ::= '<!ENTITY' S '%' S Name S PEDef S? '>'
+;;[70] EntityDecl ::= GEDecl | PEDecl
+
 ;; Note that this is setup so that we can do whitespace-skipping with
 ;; `(skip-syntax-forward " ")', inter alia.  Previously this was slow
 ;; compared with `re-search-forward', but that has been fixed.  Also
@@ -229,9 +285,9 @@ If PARSE-NS is non-nil, then QNAMES are expanded."
                 (progn
                   (forward-char -1)
                   (setq result (xml-parse-tag parse-dtd parse-ns))
-                  (if (and xml result)
+                  (if (and xml result (not xml-sub-parser))
                       ;;  translation of rule [1] of XML specifications
-                      (error "XML files can have only one toplevel tag")
+                      (error "XML: (Not Well-Formed) Only one root tag allowed")
                     (cond
                      ((null result))
                      ((and (listp (car result))
@@ -265,10 +321,24 @@ specify that the name shouldn't be given a namespace."
              ;; matching cons in xml-ns.  In which case we
              (ns (or (cdr (assoc (if special "xmlns" prefix)
                                  xml-ns))
-                     :)))
+                     "")))
         (cons ns (if special "" lname)))
     (intern name)))
 
+(defun xml-parse-fragment (&optional parse-dtd parse-ns)
+  "Parse xml-like fragments."
+  (let ((xml-sub-parser t)
+        children)
+    (while (not (eobp))
+      (let ((bit (xml-parse-tag
+                  parse-dtd parse-ns)))
+        (if children
+            (setq children (append (list bit) children))
+          (if (stringp bit)
+              (setq children (list bit))
+            (setq children bit)))))
+    (reverse children)))
+
 (defun xml-parse-tag (&optional parse-dtd parse-ns)
   "Parse the tag at point.
 If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and
@@ -278,16 +348,17 @@ Returns one of:
  - a list : the matching node
  - nil    : the point is not looking at a tag.
  - a pair : the first element is the DTD, the second is the node."
-  (let ((xml-ns (if (consp parse-ns)
+  (let ((xml-validating-parser (or parse-dtd xml-validating-parser))
+        (xml-ns (if (consp parse-ns)
                     parse-ns
                   (if parse-ns
                       (list
                        ;; Default for empty prefix is no namespace
-                       (cons ""      :)
+                       (cons ""      "")
                        ;; "xml" namespace
-                       (cons "xml"   :http://www.w3.org/XML/1998/namespace)
+                       (cons "xml"   "http://www.w3.org/XML/1998/namespace")
                        ;; We need to seed the xmlns namespace
-                       (cons "xmlns" :http://www.w3.org/2000/xmlns/))))))
+                       (cons "xmlns" "http://www.w3.org/2000/xmlns/"))))))
     (cond
      ;; Processing instructions (like the <?xml version="1.0"?> tag at the
      ;; beginning of a document).
@@ -299,18 +370,15 @@ Returns one of:
      ((looking-at "<!\\[CDATA\\[")
       (let ((pos (match-end 0)))
         (unless (search-forward "]]>" nil t)
-          (error "CDATA section does not end anywhere in the document"))
+          (error "XML: (Not Well Formed) CDATA section does not end anywhere in the document"))
         (buffer-substring pos (match-beginning 0))))
      ;;  DTD for the document
      ((looking-at "<!DOCTYPE")
-      (let (dtd)
-        (if parse-dtd
-            (setq dtd (xml-parse-dtd))
-          (xml-skip-dtd))
-      (skip-syntax-forward " ")
-      (if dtd
-          (cons dtd (xml-parse-tag nil xml-ns))
-        (xml-parse-tag nil xml-ns))))
+      (let ((dtd (xml-parse-dtd parse-ns)))
+        (skip-syntax-forward " ")
+        (if xml-validating-parser
+            (cons dtd (xml-parse-tag nil xml-ns))
+          (xml-parse-tag nil xml-ns))))
      ;;  skip comments
      ((looking-at "<!--")
       (search-forward "-->")
@@ -332,65 +400,76 @@ Returns one of:
         (when (consp xml-ns)
           (dolist (attr attrs)
             (when (and (consp (car attr))
-                       (eq :http://www.w3.org/2000/xmlns/
-                           (caar attr)))
-              (push (cons (cdar attr) (intern (concat ":" (cdr attr))))
+                       (equal "http://www.w3.org/2000/xmlns/"
+                              (caar attr)))
+              (push (cons (cdar attr) (cdr attr))
                     xml-ns))))
 
         (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns)))
 
         ;; is this an empty element ?
         (if (looking-at "/>")
-        (progn
-          (forward-char 2)
-          (nreverse children))
-
-        ;; is this a valid start tag ?
-        (if (eq (char-after) ?>)
             (progn
-              (forward-char 1)
-              ;;  Now check that we have the right end-tag. Note that this
-              ;;  one might contain spaces after the tag name
-              (let ((end (concat "</" node-name "\\s-*>")))
-                (while (not (looking-at end))
-                  (cond
-                   ((looking-at "</")
-                    (error "XML: Invalid end tag (expecting %s) at pos %d"
-                           node-name (point)))
-                   ((= (char-after) ?<)
-                    (let ((tag (xml-parse-tag nil xml-ns)))
-                      (when tag
-                        (push tag children))))
-                   (t
-                    (setq pos (point))
-                    (search-forward "<")
-                    (forward-char -1)
-                    (let ((string (buffer-substring pos (point)))
-                          (pos 0))
-
-                      ;; Clean up the string.  As per XML
-                      ;; specifications, the XML processor should
-                      ;; always pass the whole string to the
-                      ;; application.  But \r's should be replaced:
-                      ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends
-                      (while (string-match "\r\n?" string pos)
-                        (setq string (replace-match "\n" t t string))
-                        (setq pos (1+ (match-beginning 0))))
-
-                      (setq string (xml-substitute-special string))
-                      (setq children
-                            (if (stringp (car children))
-                                ;; The two strings were separated by a comment.
-                                (cons (concat (car children) string)
-                                      (cdr children))
-                              (cons string children))))))))
-
-              (goto-char (match-end 0))
+              (forward-char 2)
               (nreverse children))
-          ;;  This was an invalid start tag
-          (error "XML: Invalid attribute list")))))
-     (t ;; This is not a tag.
-      (error "XML: Invalid character")))))
+
+          ;; is this a valid start tag ?
+          (if (eq (char-after) ?>)
+              (progn
+                (forward-char 1)
+                ;;  Now check that we have the right end-tag. Note that this
+                ;;  one might contain spaces after the tag name
+                (let ((end (concat "</" node-name "\\s-*>")))
+                  (while (not (looking-at end))
+                    (cond
+                     ((looking-at "</")
+                      (error "XML: (Not Well-Formed) Invalid end tag (expecting %s) at pos %d"
+                             node-name (point)))
+                     ((= (char-after) ?<)
+                      (let ((tag (xml-parse-tag nil xml-ns)))
+                        (when tag
+                          (push tag children))))
+                     (t
+                      (let ((expansion (xml-parse-string)))
+                        (setq children
+                              (if (stringp expansion)
+                                  (if (stringp (car children))
+                                      ;; The two strings were separated by a comment.
+                                      (setq children (append (concat (car children) expansion)
+                                                             (cdr children)))
+                                    (setq children (append (list expansion) children)))
+                                (setq children (append expansion children))))))))
+
+                  (goto-char (match-end 0))
+                  (nreverse children)))
+            ;;  This was an invalid start tag (Expected ">", but didn't see it.)
+            (error "XML: (Well-Formed) Couldn't parse tag: %s"
+                   (buffer-substring (- (point) 10) (+ (point) 1)))))))
+     (t ;; (Not one of PI, CDATA, Comment, End tag, or Start tag)
+      (unless xml-sub-parser            ; Usually, we error out.
+        (error "XML: (Well-Formed) Invalid character"))
+
+      ;; However, if we're parsing incrementally, then we need to deal
+      ;; with stray CDATA.
+      (xml-parse-string)))))
+
+(defun xml-parse-string ()
+  "Parse the next whatever.  Could be a string, or an element."
+    (let* ((pos (point))
+           (string (progn (if (search-forward "<" nil t)
+                              (forward-char -1)
+                            (goto-char (point-max)))
+                          (buffer-substring pos (point)))))
+      ;; Clean up the string.  As per XML specifications, the XML
+      ;; processor should always pass the whole string to the
+      ;; application.  But \r's should be replaced:
+      ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends
+      (setq pos 0)
+      (while (string-match "\r\n?" string pos)
+        (setq string (replace-match "\n" t t string))
+        (setq pos (1+ (match-beginning 0))))
+
+      (xml-substitute-special string)))
 
 (defun xml-parse-attlist (&optional xml-ns)
   "Return the attribute-list after point.
@@ -412,18 +491,23 @@ Leave point at the first non-blank character after the tag."
           (setq end-pos (match-end 0))
         (if (looking-at "'\\([^']*\\)'")
             (setq end-pos (match-end 0))
-          (error "XML: Attribute values must be given between quotes")))
+          (error "XML: (Not Well-Formed) Attribute values must be given between quotes")))
 
       ;; Each attribute must be unique within a given element
       (if (assoc name attlist)
-          (error "XML: each attribute must be unique within an element"))
+          (error "XML: (Not Well-Formed) Each attribute must be unique within an element"))
 
       ;; Multiple whitespace characters should be replaced with a single one
       ;; in the attributes
       (let ((string (match-string 1))
             (pos 0))
         (replace-regexp-in-string "\\s-\\{2,\\}" " " string)
-        (push (cons name (xml-substitute-special string)) attlist))
+        (let ((expansion (xml-substitute-special string)))
+          (unless (stringp expansion)
+            ; We say this is the constraint.  It is acctually that
+            ; external entities nor "<" can be in an attribute value.
+            (error "XML: (Not Well-Formed) Entities in attributes cannot expand into elements"))
+          (push (cons name expansion) attlist)))
 
       (goto-char end-pos)
       (skip-syntax-forward " "))
@@ -442,24 +526,16 @@ Leave point at the first non-blank character after the tag."
 (defun xml-skip-dtd ()
   "Skip the DTD at point.
 This follows the rule [28] in the XML specifications."
-  (forward-char (length "<!DOCTYPE"))
-  (if (looking-at "\\s-*>")
-      (error "XML: invalid DTD (excepting name of the document)"))
-  (condition-case nil
-      (progn
-        (forward-sexp)
-        (skip-syntax-forward " ")
-        (if (looking-at "\\[")
-            (re-search-forward "]\\s-*>")
-          (search-forward ">")))
-    (error (error "XML: No end to the DTD"))))
+  (let ((xml-validating-parser nil))
+    (xml-parse-dtd)))
 
-(defun xml-parse-dtd ()
+(defun xml-parse-dtd (&optional parse-ns)
   "Parse the DTD at point."
   (forward-char (eval-when-compile (length "<!DOCTYPE")))
   (skip-syntax-forward " ")
-  (if (looking-at ">")
-      (error "XML: invalid DTD (excepting name of the document)"))
+  (if (and (looking-at ">")
+           xml-validating-parser)
+      (error "XML: (Validity) Invalid DTD (expecting name of the document)"))
 
   ;;  Get the name of the document
   (looking-at xml-name-regexp)
@@ -477,27 +553,27 @@ This follows the rule [28] in the XML specifications."
                        (re-search-forward
                         "\\='\\([[:space:][:alnum:]-()+,./:=?;!*#@$_%]*\\)'"
                         nil t))
-             (error "XML: missing public id"))
+             (error "XML: Missing Public ID"))
            (let ((pubid (match-string 1)))
+             (skip-syntax-forward " ")
              (unless (or (re-search-forward "\\='\\([^']*\\)'" nil t)
                          (re-search-forward "\\=\"\\([^\"]*\\)\"" nil t))
-               (error "XML: missing system id"))
+               (error "XML: Missing System ID"))
              (push (list pubid (match-string 1) 'public) dtd)))
           ((looking-at "SYSTEM\\s-+")
            (goto-char (match-end 0))
            (unless (or (re-search-forward "\\='\\([^']*\\)'" nil t)
                        (re-search-forward "\\=\"\\([^\"]*\\)\"" nil t))
-             (error "XML: missing system id"))
+             (error "XML: Missing System ID"))
            (push (list (match-string 1) 'system) dtd)))
     (skip-syntax-forward " ")
     (if (eq ?> (char-after))
         (forward-char)
-      (skip-syntax-forward " ")
       (if (not (eq (char-after) ?\[))
-          (error "XML: bad DTD")
+          (error "XML: Bad DTD")
         (forward-char)
         ;;  Parse the rest of the DTD
-        ;;  Fixme: Deal with ENTITY, ATTLIST, NOTATION, PIs.
+        ;;  Fixme: Deal with ATTLIST, NOTATION, PIs.
         (while (not (looking-at "\\s-*\\]"))
           (skip-syntax-forward " ")
           (cond
@@ -521,11 +597,13 @@ This follows the rule [28] in the XML specifications."
              ((string-match "^%[^;]+;[ \t\n\r]*$" type) ;; substitution
               nil)
              (t
-              (error "XML: Invalid element type in the DTD")))
+              (if xml-validating-parser 
+                  error "XML: (Validity) Invalid element type in the DTD")))
 
             ;;  rule [45]: the element declaration must be unique
-            (if (assoc element dtd)
-                (error "XML: element declarations must be unique in a DTD (<%s>)"
+            (if (and (assoc element dtd)
+                     xml-validating-parser)
+                (error "XML: (Validity) Element declarations must be unique in a DTD (<%s>)"
                        element))
 
             ;;  Store the element in the DTD
@@ -533,12 +611,49 @@ This follows the rule [28] in the XML specifications."
             (goto-char end-pos))
            ((looking-at "<!--")
             (search-forward "-->"))
-
+           ((looking-at (concat "<!ENTITY[ \t\n\r]*\\(" xml-name-re
+                                "\\)[ \t\n\r]*\\(" xml-entity-value-re
+                                "\\)[ \t\n\r]*>"))
+            (let ((name  (buffer-substring (nth 2 (match-data))
+                                           (nth 3 (match-data))))
+                  (value (buffer-substring (+ (nth 4 (match-data)) 1)
+                                           (- (nth 5 (match-data)) 1))))
+              (goto-char (nth 1 (match-data)))
+              (setq xml-entity-alist
+                    (append xml-entity-alist
+                            (list (cons name 
+                                        (with-temp-buffer
+                                          (insert value)
+                                          (goto-char (point-min))
+                                          (xml-parse-fragment
+                                           xml-validating-parser
+                                           parse-ns))))))))
+           ((or (looking-at (concat "<!ENTITY[ \t\n\r]+\\(" xml-name-re
+                                    "\\)[ \t\n\r]+SYSTEM[ \t\n\r]+"
+                                    "\\(\"[^\"]*\"\\|'[^']*'\\)[ \t\n\r]*>"))
+                (looking-at (concat "<!ENTITY[ \t\n\r]+\\(" xml-name-re
+                                    "\\)[ \t\n\r]+PUBLIC[ \t\n\r]+"
+                                    "\"[- \r\na-zA-Z0-9'()+,./:=?;!*#@$_%]*\""
+                                    "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'"
+                                    "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)"
+                                    "[ \t\n\r]*>")))
+            (let ((name  (buffer-substring (nth 2 (match-data))
+                                           (nth 3 (match-data))))
+                  (file  (buffer-substring (+ (nth 4 (match-data)) 1)
+                                           (- (nth 5 (match-data)) 1))))
+              (goto-char (nth 1 (match-data)))
+              (setq xml-entity-alist
+                    (append xml-entity-alist
+                            (list (cons name (with-temp-buffer
+                                               (insert-file-contents file)
+                                               (goto-char (point-min))
+                                               (xml-parse-fragment
+                                                xml-validating-parser
+                                                parse-ns))))))))
            (t
-            (error "XML: Invalid DTD item")))
-
-          ;;  Skip the end of the DTD
-          (search-forward ">"))))
+            (error "XML: (Validity) Invalid DTD item")))))
+      (if (looking-at "\\s-*]>")
+          (goto-char (nth 1 (match-data)))))
     (nreverse dtd)))
 
 (defun xml-parse-elem-type (string)
@@ -580,41 +695,72 @@ This follows the rule [28] in the XML specifications."
 ;;**
 ;;*******************************************************************
 
-(eval-when-compile
-  (defvar str))                ; dynamic from replace-regexp-in-string
-
-;; Fixme:  Take declared entities from the DTD when they're available.
-(defun xml-substitute-entity (match)
-  "Subroutine of `xml-substitute-special'."
-  (save-match-data
-    (let ((match1 (match-string 1 str)))
-      (cond ((string= match1 "lt") "<")
-            ((string= match1 "gt") ">")
-            ((string= match1 "apos") "'")
-            ((string= match1 "quot") "\"")
-            ((string= match1 "amp") "&")
-            ((and (string-match "#\\([0-9]+\\)" match1)
-                  (let ((c (decode-char
-                            'ucs
-                            (string-to-number (match-string 1 match1)))))
-                    (if c (string c))))) ; else unrepresentable
-            ((and (string-match "#x\\([[:xdigit:]]+\\)" match1)
-                  (let ((c (decode-char
-                            'ucs
-                            (string-to-number (match-string 1 match1) 16))))
-                    (if c (string c)))))
-            ;; Default to asis.  Arguably, unrepresentable code points
-            ;; might be best replaced with U+FFFD.
-            (t match)))))
-
 (defun xml-substitute-special (string)
   "Return STRING, after subsituting entity references."
   ;; This originally made repeated passes through the string from the
   ;; beginning, which isn't correct, since then either "&amp;amp;" or
   ;; "&#38;amp;" won't DTRT.
-  (replace-regexp-in-string "&\\([^;]+\\);"
-                            #'xml-substitute-entity string t t))
 
+  (let ((point 0)
+        children end-point)
+    (while (string-match "&\\([^;]+\\);" string point)
+      (setq end-point (match-end 0))
+      (let* ((this-part (match-string 1 string))
+             (prev-part (substring string point (match-beginning 0)))
+             (entity (assoc this-part xml-entity-alist))
+             (expansion 
+              (cond ((string-match "#\\([0-9]+\\)" this-part)
+                     (let ((c (decode-char
+                               'ucs
+                               (string-to-number (match-string 1 this-part)))))
+                       (if c (string c))))
+                    ((string-match "#x\\([[:xdigit:]]+\\)" this-part)
+                     (let ((c (decode-char
+                               'ucs
+                               (string-to-number (match-string 1 this-part) 16))))
+                       (if c (string c))))
+                    (entity
+                     (cdr entity))
+                    (t
+                     (if xml-validating-parser
+                         (error "XML: (Validity) Undefined entity `%s'"
+                                (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)))))
+              ((stringp children)
+               (if (stringp expansion)
+                   (setq children (concat children prev-part expansion))
+                 (setq children (list expansion (concat prev-part children)))))
+              ((and (stringp expansion)
+                    (stringp (car children)))
+               (setcar children (concat prev-part expansion (car children))))
+              ((stringp expansion)
+               (setq children (append (concat prev-part expansion)
+                                      children)))
+              ((stringp (car children))
+               (setcar children (concat (car children) prev-part))
+               (setq children (append expansion children)))
+              (t
+               (setq children (list expansion
+                                    prev-part
+                                    children))))
+        (setq point end-point)))
+    (cond ((stringp children)
+           (concat children (substring string point)))
+          ((stringp (car (last children)))
+           (concat (car children) (substring string point)))
+          ((null children)
+           string)
+          (t
+           (nreverse children)))))
 ;;*******************************************************************
 ;;**
 ;;**  Printing a tree.