Commits

Anonymous committed 327167f

Sync with upstream 1.3.2 <200705271503.15886.scop@xemacs.org>

  • Participants
  • Parent commits f1092fe

Comments (0)

Files changed (18)

+2007-05-26  Ville Skyttä  <scop@xemacs.org>
+
+	* Sync with upstream 1.3.2.
+
+	* psgml-ids.el: New.
+	* Makefile: Update FSF's address.
+	(AUTHOR_VERSION): 1.3.2.
+	(ELCS): Add psgml-ids.elc.
+	* package-info.in (provides): Add psgml-ids.
+
+	* psgml-html.el (sgml-html-netscape-file): Use browse-url.
+	(sgml-html-kfm-file): Ditto.
+
 2005-04-05  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.44 released.

File ChangeLog.upstream

+2005-03-02  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml.el (sgml-mode-map): bind C-c C-s to new comman
+	sgml-show-structure.
+	Update autoloads.
+
+	* psgml-edit.el (sgml-show-structure): new command
+	(sgml-show-structure-insert, sgml-show-struct-element-p)
+	(sgml-structure-elements): new functions
+
+2005-02-27  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml.el (sgml-content-indent-function): moved
+	(sgml-attribute-indent-function): moved
+
+	* psgml-edit.el (sgml-show-context): use new option
+	sgml-show-context-function.
+	(sgml-show-context-standard, sgml-show-context-backslash): new
+	functions for sgml-show-context-function
+	(sgml-right-menu): new command for use on a mouse button
+
+	* psgml.el (sgml-mode-map): bind C-c C-t to
+	sgml-show-current-element-type
+	(sgml-show-context-function): new option
+
+	* psgml-edit.el (sgml-show-current-element-type): new command
+
+	* psgml.el (sgml-mode-map): change C-c C-p to sgml-load-doctype
+
+	* psgml-parse.el (sgml-load-doctype): make interactive, this is a
+	more useful command than sgml-parse-prolog.
+
+	* psgml-info.el (sgml-describe-dtd): rename sgml-general-dtd-info
+	to sgml-describe-dtd. Keep old name as alias.
+
+	* psgml-other.el (sgml-set-face-for): added face setting for content
+
+	* psgml-parse.el (sgml--pi-element-handler): use sgml-parse-s not
+	sgml-skip-ps.
+
+2005-02-24  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-parse.el (sgml-do-processing-instruction): call
+	sgml--pi-psgml-handler with end point of PI.
+	(sgml--pi-psgml-handler): Take end point, and narrow buffer before
+	parsing.
+
+2005-02-17  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-parse.el (sgml-parse-prolog): apply sgml-general-case to
+	sgml-default-doctype-name.
+
+
+2005-02-09  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml.el (sgml-debug): remove sgml-log-message
+	remove log related keybinding/menu entry
+
+	* psgml-parse.el (sgml-compile-dtd, sgml-check-entities)
+	(sgml-log-warning, sgml-error): remove sgml-log-message
+	(sgml-entity-stack): new func
+
+	* psgml-ids.el: New file (From: Jean-Daniel.Fekete)
+	* psgml-edit.el: ID/IDREF patch (From: Jean-Daniel.Fekete)
+	* psgml-maint.el: ID/IDREF patch (From: Jean-Daniel.Fekete)
+	* psgml-parse.el: ID/IDREF patch (From: Jean-Daniel.Fekete)
+
+2003-06-09  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-parse.el (sgml-modify-dtd): added some error checking for
+	the has-seen-elements.
+
+2003-03-28  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-parse.el (sgml-do-processing-instruction): new handling
+	of <?PSGML> processing instruction.
+	(sgml--pi-psgml-handler): new func
+	(sgml--pi-element-handler): new func. handles <?PSGML ELEMENT ..>
+	(sgml-psgml-pi-enable-outside-dtd): new variable. controls when
+	<?PSGML> is evaluated.
+
+2003-03-27  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-parse.el: fix wrong file name in error trace
+
+2003-03-25  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-dtd.el (sgml-parse-parameter-literal):
+	Modified to use unibyte-char-to-multibyte if
+	enable-multibyte-characters. I hope this is correct.
+
+2003-03-25  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-dtd.el (sgml-parse-parameter-literal):
+	Modified to use unibyte-char-to-multibyte if
+	enable-multibyte-characters. I hope this is correct.
+
+2003-02-12  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-parse.el (sgml-setup-doctype): add Predefined Entities
+	for XML.
+
+2003-01-24  Lennart Staflin  <lenst@lysator.liu.se>
+
+	* psgml-parse.el (sgml-do-move): undo wrong optimization, fix
+	problem with non working exclusions.
+
 2002-12-13  Lennart Staflin  <lenst@lysator.liu.se>
 
 	* Version 1.3.1 released
 	parameter.
 	(sgml-do-start-tag): use new parameter on sgml-open-element.
 	Fixes bug with NET (tc17).
-	
+
 	* psgml-edit.el (sgml-edit-attrib-field-start,
 	sgml-edit-attrib-clear, sgml-attribute-buffer,
 	sgml-edit-attrib-specification-list): change sgml-category to
 2002-05-08  Lennart Staflin  <lenst@lysator.liu.se>
 
 	* Version 1.3.0 released
-	
+
 	* psgml.el (sgml-default-nonsticky): moved from psgml-other.el
 
 2002-05-07  Lennart Staflin  <lenst@lysator.liu.se>
 	* psgml.el (sgml-mode): make adding to
 	text-property-default-nonsticky conditional on
 	sgml-default-nonsticky to work with Emacs < 21.
-	
+
 2002-04-25  Lennart Staflin  <lenst@lysator.liu.se>
 
 	fixing merge of Dave Love's patch.
-	
+
 2002-02-08  Dave Love  <fx@gnu.org>
 	[Merging from 1.2.4 branch /lenst]
-	
+
 	Changes for various things: Useful DTD-less XML editing; avoiding
 	CL at runtime; some Emacs portability; Mule-related fixes,
 	particularly for non-ASCII names in DTD.
 
 	* psgml-lucid.el (sgml-insert): Use property name `sgml-category',
 	not `category'. [backed out //lenst]
-	
+
 	* psgml.el: Require cl only when compiling.  Doc fixes.
 	(sgml-mode): Set text-property-default-nonsticky.  In Emacs, use
 	which-fun-mode hook instead of trying to modify mode-line-format.
 	sgml-entity-case use.
 	(sgml-update-display): Call force-mode-line-update.
 	(sgml-parse-attribute-specification-list): Use sgml-dtd-less.
-	
+
 	* psgml-other.el (sgml-insert): Use plist-get rather than CL
 	runtime's getf.
 	(sgml-use-text-properties): Default to t.
 
 	* psgml-debug.el: Require cl, elp and edebug when compiling.
 
-	
+
 2002-04-19  Lennart Staflin  <lenst@lysator.liu.se>
 
 	* Version 1.2.5 released
 2002-02-08  Lennart Staflin  <lenst@lysator.liu.se>
 
 	* psgml-parse.el (sgml-set-buffer-multibyte): support setting to
-	default 
+	default
 	(sgml-compile-dtd): removed sgml-set-buffer-multibyte, this is
 	done by sgml-write-dtd
 	(sgml-push-to-entity): reset buffer to default multibyte support
 
 # You should have received a copy of the GNU General Public License
 # along with XEmacs; see the file COPYING.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
+# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+# Boston, MA 02110-1301 USA.
 
 VERSION = 1.44
-AUTHOR_VERSION = 1.3.1
+AUTHOR_VERSION = 1.3.2
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = psgml
 PKG_TYPE = regular
 
 ELCS = iso-sgml.elc psgml-api.elc psgml-charent.elc psgml-debug.elc \
 	psgml-dtd.elc psgml-edit.elc psgml-fs.elc psgml-html.elc \
-	psgml-info.elc psgml-parse.elc psgml-xemacs.elc psgml.elc \
-	psgml-sysdep.elc
+	psgml-ids.elc psgml-info.elc psgml-parse.elc psgml-xemacs.elc \
+	psgml.elc psgml-sysdep.elc
 
 EXPLICIT_DOCS = $(PACKAGE).texi $(PACKAGE)-api.texi
 

File README.psgml

-This is the READ ME file for psgml.el version 1.3.1.       -*- text -*-
+This is the READ ME file for psgml.el version 1.3.2.       -*- outline -*-
 
 This is an ALPHA release. 
+
+
+* User interface changes
+
+** Rename sgml-general-dtd-info to sgml-describe-dtd. Keep old name as
+   alias.
+
+** Made menus compact, only one top level menu.
+
+** Added new function sgml-show-structure (C-c C-s)
+(May need latest emacs version (22))
+
+** Changed C-c C-t to sgml-show-current-element-type
+New more comprehensive information display.
+
+** New mouse menu, sgml-right-menu on S-mouse-3 
+If invoked on a start-tag will include entries to manipulate the
+tag/element, including setting attributes. If invoked in content it
+will be a menu of valid elements.
+
+** The <?PSGML> process instruction
+Not new, but now documented and improved.
+
+<?PSGML ELEMENT FOO  
+     face=italic
+     nofill=t
+     help-text="marks a foo"
+     attnames=("ID" "STYLE")
+     structure=ignore ?>
+
+Must be placed in the DTD.
+

File iso88591.map

 253 [yacute]
 254 [thorn ]
 255 [yuml  ]
+34 "
 192 Ŕ
 193 Á
 194 Â

File package-info.in

    filename FILENAME
    md5sum MD5SUM
    size SIZE
-   provides (iso-sgml psgml-api psgml-charent psgml-debug psgml-dtd psgml-edit psgml-fs psgml-html psgml-info psgml-parse psgml-sysdep psgml-xemacs psgml sgml-mode)
+   provides (iso-sgml psgml-api psgml-charent psgml-debug psgml-dtd psgml-edit psgml-fs psgml-html psgml-ids psgml-info psgml-parse psgml-sysdep psgml-xemacs psgml sgml-mode)
    requires (REQUIRES)
    type regular
 ))

File psgml-charent.el

   (let ((case-fold-search nil))
     (save-excursion
       (loop for pair in (sgml-charent-to-dispchar-alist)
-	do (goto-char (point-min))
-	(while (search-forward (cdr pair) nil t)
-	  (replace-match (concat "&" (car pair) ";") t t))))))
+	    do (goto-char (point-min))
+	    (while (search-forward (cdr pair) nil t)
+	      (replace-match (concat "&" (car pair) ";") t t))))))
 
 
 

File psgml-debug.el

 )
 
 (eval-when (load)
-  (unless running-xemacs
+  (unless running-xemacs ;; XEmacs change
     (def-edebug-spec sgml-with-parser-syntax (&rest form))
     (def-edebug-spec sgml-with-parser-syntax-ro (&rest form))
     (def-edebug-spec sgml-skip-upto (sexp))
     (with-output-to-temp-buffer "*Testing psgml*"
       (while
 	  (progn
-	    (setq file (format "/ni/src/sgmls-1.1/test/test%03d.sgm"
+	    (setq file (format "/u2/src/sgmls-1.1/test/test%03d.sgm"
 			       start))
 	    (file-exists-p file))
 	(princ (format "*** File test%03d ***\n" start))
 	  ))
   (elp-instrument-list))
 
-;;;; Structure Viewing and Navigating
-
-(require 'psgml-api)
-
-(defvar show-structure-buffer nil)
-(defvar show-structure-positions nil)
-(defvar show-structure-source-buffer nil)
-
-(defun show-structure ()
-  (interactive)
-  (let* ((source (current-buffer))
-         (result (get-buffer-create "*Struct*"))
-         (show-structure-buffer result))
-    (set-buffer result)
-    (erase-buffer)
-    (make-local-variable 'show-structure-positions)
-    (setq show-structure-positions nil)
-    (make-local-variable 'show-structure-source-buffer)
-    (setq show-structure-source-buffer source)
-    (use-local-map (make-sparse-keymap))
-    (local-set-key "\C-c\C-c" 'show-structure-goto)
-    (set-buffer source)
-    (show-element (sgml-top-element))
-    (display-buffer result)))
-
-
-(defun show-structure-goto ()
-  (interactive)
-  (beginning-of-line)
-  (let ((pos-pair (assoc (point) show-structure-positions)))
-    (when pos-pair
-      (select-window
-       (display-buffer show-structure-source-buffer))
-      (goto-char (cdr pos-pair)))))
-
-
-(defun show-struct-element-p (element)
-  (or (and (not (sgml-element-data-p element))
-           (not (sgml-element-empty element)))
-      (sgml-element-appdata element 'structure)))
-
-
-(defun show-element (element)
-  (cond ((show-struct-element-p element)
-         (let ((gi (sgml-element-gi element))
-               (level (sgml-element-level element)))
-           (save-excursion
-             (set-buffer show-structure-buffer)
-             (if (not (bolp))
-                 (insert "\n"))
-             (push (cons (point) (sgml-element-start element))
-                   show-structure-positions)
-             (insert (format "%s[%15s] " (make-string (- level 1) ? ) gi))))
-         (catch 'show-data-stop
-             (show-element-data element))
-         (sgml-map-content element #'show-element))))
-
-(defun show-element-data (element)
-  (sgml-map-content element #'show-element-data #'show-data)
-  (throw 'show-data-stop nil))
-
-(defun show-data (data)
-  (save-excursion
-    (set-buffer show-structure-buffer)
-    (let ((start (point)))
-      (insert data)
-      (let ((end (point)))
-        (subst-char-in-region start end ?\n ? )
-        (when (> (current-column) fill-column)
-          (move-to-column fill-column)
-          (delete-region (point) end)
-          (throw 'show-data-stop nil))))))
-
-;;;; Show current element type
-;; Candidate for C-c C-t
-
-(autoload 'sgml-princ-names "psgml-info")
-(autoload 'sgml-eltype-refrenced-elements "psgml-info")
-
-(define-key sgml-mode-map "\C-c\C-t" 'sgml-show-current-element-type)
-
-(defun sgml-show-current-element-type ()
-  (interactive)
-  (let* ((el (sgml-find-context-of (point)))
-         (et (sgml-element-eltype el)))
-    (with-output-to-temp-buffer "*Current Element Type*"
-      (princ (format "ELEMENT: %s%s\n" (sgml-eltype-name et)
-                     (let ((help-text (sgml-eltype-appdata et 'help-text)))
-                       (if help-text
-                           (format " -- %s" help-text)
-                           ""))))
-      (when sgml-omittag
-        (princ (format "\n Start-tag is %s.\n End-tag is %s.\n"
-                       (if (sgml-eltype-stag-optional et)
-                           "optional" "required")
-                       (if (sgml-eltype-etag-optional et)
-                           "optional" "required"))))
-      ;; ----
-      (princ "\nCONTENT: ")
-      (cond ((symbolp (sgml-eltype-model et)) (princ (sgml-eltype-model et)))
-	    (t
-	     (princ (if (sgml-eltype-mixed et)
-                        "mixed\n"
-                      "element\n"))
-             (sgml-print-position-in-model el et (point) sgml-current-state)
-             (princ "\n\n")
-	     (sgml-princ-names
-	      (mapcar #'symbol-name (sgml-eltype-refrenced-elements et))
-              "All: ")))
-      (let ((incl (sgml-eltype-includes et))
-            (excl (sgml-eltype-excludes et)))
-        (when (or incl excl)
-          (princ "\n\nEXCEPTIONS:"))
-        (when incl
-          (princ "\n + ")
-          (sgml-princ-names (mapcar #'symbol-name incl)))
-        (when excl
-          (princ "\n - ")
-          (sgml-princ-names (mapcar #'symbol-name excl))))
-      ;; ----
-      (princ "\n\nATTRIBUTES:\n")
-      (sgml-print-attlist et)
-      ;; ----
-      (let ((s (sgml-eltype-shortmap et)))
-	(when s
-	  (princ (format "\nUSEMAP: %s\n" s))))
-      ;; ----
-      (princ "\nOCCURS IN:\n")
-      (let ((occurs-in ()))
-	(sgml-map-eltypes
-	 (function (lambda (cand)
-		     (when (memq et (sgml-eltype-refrenced-elements cand))
-		       (push cand occurs-in))))
-	 (sgml-pstate-dtd sgml-buffer-parse-state))
-        (sgml-princ-names (mapcar 'sgml-eltype-name
-                                  (sort occurs-in (function string-lessp))))))))
-
-(defun sgml-print-attlist (et)
-  (let ((ob (current-buffer)))
-    (set-buffer standard-output)
-    (unwind-protect
-        (loop
-         for attdecl in (sgml-eltype-attlist et) do
-         (princ " ")
-         (princ (sgml-attdecl-name attdecl))
-         (let ((dval (sgml-attdecl-declared-value attdecl))
-               (defl (sgml-attdecl-default-value attdecl)))
-           (when (listp dval)
-             (setq dval (concat (if (eq (first dval)
-                                        'NOTATION)
-                                    "#NOTATION (" "(")
-                                (mapconcat (function identity)
-                                           (second dval)
-                                           "|")
-                                ")")))
-           (indent-to 15 1)
-           (princ dval)
-           (cond ((sgml-default-value-type-p 'FIXED defl)
-                  (setq defl (format "#FIXED '%s'"
-                                     (sgml-default-value-attval defl))))
-                 ((symbolp defl)
-                  (setq defl (upcase (format "#%s" defl))))
-                 (t
-                  (setq defl (format "'%s'"
-                                     (sgml-default-value-attval defl)))))
-
-           (indent-to 48 1)
-           (princ defl)
-           (terpri)))
-      (set-buffer ob))))
-
-
-(defun sgml-print-position-in-model (element element-type buffer-pos parse-state)
-  (let ((u (sgml-element-content element))
-        (names nil))
-    (while (and u (>= buffer-pos (sgml-element-end u)))
-      (push (sgml-element-gi u) names)
-      (setq u (sgml-element-next u)))
-    (when names
-      (sgml-princ-names (nreverse names) " " ", ")
-      (princ "\n")))
-  (princ " ->")
-  (let* ((state parse-state)
-         (required-seq                  ; the seq of req el following point
-          (loop for required = (sgml-required-tokens state)
-                while (and required (null (cdr required)))
-                collect (sgml-eltype-name (car required))
-                do (setq state (sgml-get-move state (car required)))))
-         (last-alt
-          (mapcar 'sgml-eltype-name
-                  (append (sgml-optional-tokens state)
-                          (sgml-required-tokens state)))))
-    (cond
-     (required-seq
-      (when last-alt
-        (nconc required-seq
-               (list (concat "("
-                             (mapconcat (lambda (x) x)
-                                        last-alt " | ")
-                             (if (sgml-final state)
-                                 ")?" ")")))))
-      (sgml-princ-names required-seq " " ", "))
-
-     (last-alt
-      (sgml-princ-names last-alt " (" " | ")
-      (princ ")")
-      (when (sgml-final state)
-        (princ "?"))))))
-
-;;;; Adding appdata to element types
-;;; Candidate for PI PSGML processing
-
-(defvar sgml-psgml-pi-enable-outside-dtd nil)
-
-(defun sgml-eval-psgml-pi ()
-  (interactive)
-  (let ((sgml-psgml-pi-enable-outside-dtd t))
-    (sgml-parse-to-here)))
-
-(define-key sgml-mode-map "\e\C-x" 'sgml-eval-psgml-pi)
-
-(defun sgml--pi-element-handler ()
-  (sgml-skip-ps)
-  (let ((eltype (sgml-lookup-eltype (sgml-parse-name)))
-        name value)
-    (sgml-skip-ps)
-    (while (setq name (sgml-parse-name))
-      ;; FIXME: check name not reserved
-      (sgml-skip-ps)
-      (cond ((sgml-parse-delim "VI")
-             (sgml-skip-ps)
-             (setq value
-                   (if (looking-at "['\"]")
-                       (sgml-parse-literal)
-                     (read (current-buffer)))))
-            (t
-             (setq value t)))
-      (message "%s = %S" name value)
-      (setf (sgml-eltype-appdata eltype (intern (downcase name))) value)
-      (sgml-skip-ps))))
-
-
-(defun sgml-do-processing-instruction (in-declaration)
-  (let ((start (point)))
-    (when (and (or in-declaration
-                   sgml-psgml-pi-enable-outside-dtd)
-               (eq ?P (following-char))
-	       (looking-at "PSGML +\\(\\sw+\\) *"))
-      (let* ((command (format "%s" (downcase (match-string 1))))
-             (flag-command (assoc command
-                                  '(("nofill"      . nofill)
-                                    ("breakafter"  . break-after-stag)
-                                    ("breakbefore" . break-before-stag)
-                                    ("structure"   . structure)))))
-	(goto-char (match-end 0))
-	(cond (flag-command
-               (sgml-parse-set-appflag (cdr flag-command)))
-              ((equal command "element")
-               (sgml--pi-element-handler))
-              (t
-               (sgml-log-warning "Unknown processing instruction for PSGML: %s"
-                                 command)))))
-    (if sgml-xml-p
-	(sgml-skip-upto "XML-PIC")
-      (sgml-skip-upto "PIC"))
-    (when sgml-pi-function
-      (funcall sgml-pi-function
-	       (buffer-substring-no-properties start (point)))))
-  (if sgml-xml-p
-      (sgml-check-delim "XML-PIC")
-    (sgml-check-delim "PIC"))
-  (unless in-declaration
-    (sgml-set-markup-type 'pi))
-  t)
-
-;;;; Possible modification to allow setting face on content:
-
-(defun sgml-set-face-for (start end type)
-  (let ((face (cdr (assq type sgml-markup-faces))))
-    ;;++
-    (if (and (null type) sgml-current-tree)
-        (setq face (sgml-element-appdata sgml-current-tree 'face)))
-    ;;--
-    (cond
-     (sgml-use-text-properties
-      (let ((inhibit-read-only t)
-            (after-change-functions nil)
-            (before-change-functions nil)
-            (buffer-undo-list t)
-            (deactivate-mark nil))
-	(put-text-property start end 'face face)
-        (when (< start end)
-          (put-text-property (1- end) end 'rear-nonsticky '(face)))))
-     (t
-      (let ((current (overlays-at start))
-	    (pos start)
-	    old-overlay)
-	(while current
-	  (cond ((and (null old-overlay)
-                      type
-		      (eq type (overlay-get (car current) 'sgml-type)))
-		 (setq old-overlay (car current)))
-		((overlay-get (car current) 'sgml-type)
-		 ;;(message "delov: %s" (overlay-get (car current) 'sgml-type))
-		 (delete-overlay (car current))))
-	  (setq current (cdr current)))
-	(while (< (setq pos (next-overlay-change pos))
-		  end)
-	  (setq current (overlays-at pos))
-	  (while current
-	    (when (overlay-get (car current) 'sgml-type)
-	      (delete-overlay (car current)))
-	    (setq current (cdr current))))
-	(cond (old-overlay
-	       (move-overlay old-overlay start end)
-	       (if (null (overlay-get old-overlay 'face))
-		   (overlay-put old-overlay 'face face)))
-	      (face
-	       (setq old-overlay (make-overlay start end))
-	       (overlay-put old-overlay 'sgml-type type)
-	       (overlay-put old-overlay 'face face))))))))
-
-;;;; New Right Button Menu
-
-;; XEmacs change
-(if running-xemacs
-    (define-key sgml-mode-map [(shift button3)] 'sgml-right-menu)
-  (define-key sgml-mode-map [S-mouse-3] 'sgml-right-menu))
-
-(defun sgml-right-menu (event)
-  "Pop up a menu with valid tags and insert the choosen tag.
-If the variable `sgml-balanced-tag-edit' is t, also inserts the
-corresponding end tag. If `sgml-leave-point-after-insert' is t, the point
-is left after the inserted tag(s), unless the element has som required
-content.  If `sgml-leave-point-after-insert' is nil the point is left
-after the first tag inserted."
-  (interactive "*e")
-  (let ((end (sgml-mouse-region)))
-    (sgml-parse-to-here)
-    (cond
-     ((eq sgml-markup-type 'start-tag)
-      (sgml-right-stag-menu event))
-     (t
-      (let ((what
-	     (sgml-menu-ask event (if (or end sgml-balanced-tag-edit)
-                                      'element 'tags))))
-	(cond
-	 ((null what))
-	 (end
-	  (sgml-tag-region what (point) end))
-	 (sgml-balanced-tag-edit
-	  (sgml-insert-element what))
-	 (t
-	  (sgml-insert-tag what))))))))
-
-
-(defun sgml-right-stag-menu (event)
-  (let* ((el (sgml-find-attribute-element))
-         (attrib-menu (ignore-errors (sgml-make-attrib-menu el))))
-
-    (let* ((alt-gi (mapcar (function sgml-eltype-name)
-                           (progn
-                             (sgml-find-context-of (sgml-element-start el))
-                             (sgml-current-list-of-valid-eltypes))))
-           (change-menu
-            (cons "Change To"
-                  (loop for gi in alt-gi
-                        collect `(,gi (sgml-change-element-name ,gi))))))
-      (sgml-popup-multi-menu
-       event "Start Tag"
-       (list* change-menu
-             `("Misc"
-               ("Edit attributes" (sgml-edit-attributes))
-               ("Normalize" (sgml-normalize-element))
-               ("Fill" (sgml-fill-element
-                        (sgml-find-context-of (point))))
-               ("Splice" (sgml-untag-element))
-               ("Fold"   (sgml-fold-element)))
-             `("--" "--")
-             attrib-menu)))))
-
-
-
-
-(defun sgml--empty-is-nil (s)
-  (if (equal s "")
-      nil
-    s))
-
-(defun sgml-dl-to-table (border table-width first-col-width)
-  (interactive "sBorder: \nsTab Width: \nsFirst Col Width: \n")
-  (setq border (sgml--empty-is-nil border))
-  (setq table-width (sgml--empty-is-nil table-width))
-  (setq first-col-width (sgml--empty-is-nil first-col-width))
-  (let ((el (sgml-find-element-of (point))))
-    (goto-char (sgml-element-etag-start el))
-    (let ((end (point-marker)))
-      (goto-char (sgml-element-start el))
-      (sgml-change-element-name "TABLE")
-      (sgml-insert-attribute "BORDER" border)
-      (sgml-insert-attribute "WIDTH" table-width)
-      (while (search-forward "<" end t)
-        (cond
-         ((looking-at "dt")
-          (backward-char 1)
-          (insert "<tr>")
-          (sgml-change-element-name "TD")
-          (sgml-insert-attribute "WIDTH" first-col-width))
-         ((looking-at "tr>\\s-*<td")
-          (sgml-down-element)
-          (sgml-insert-attribute "WIDTH" first-col-width))
-         ((looking-at "dd")
-          (sgml-change-element-name "TD")
-          (sgml-up-element)
-          (insert "</tr>")))))))
-
-
 ;\end{codeseg}

File psgml-dtd.el

 		   (sgml-error "Parameter literal unterminated")))
 	      ((sgml-parse-parameter-entity-ref))
 	      ((setq temp (sgml-parse-character-reference dofunchar))
-	       (setq value (concat value (if (< temp 256)
-					     (format "%c" temp)
-					   (format "&#%d;" temp)))))
+	       (setq value
+                     (concat value
+                             (cond ((< temp 256)
+                                    ;; XEmacs: test if bound
+                                    (if (and
+                                         (boundp 'enable-multibyte-characters)
+                                         enable-multibyte-characters
+                                         (fboundp 'unibyte-char-to-multibyte))
+                                        (setq temp (unibyte-char-to-multibyte temp)))
+                                    (format "%c" temp))
+                                   (t
+                                    (format "&#%d;" temp))))))
 	      (t
 	       (setq value
 		     (concat value

File psgml-edit.el

 (provide 'psgml-edit)
 (require 'psgml)
 (require 'psgml-parse)
+(require 'psgml-ids)
 (require 'tempo) ;; XEmacs change
 (eval-when-compile (require 'cl))
 
 	 (attspec (sgml-element-attribute-specification-list element))
 	 (oldattlist (sgml-element-attlist element))
          (tagc (if (and sgml-xml-p (sgml-element-empty element))
-                   (sgml-delim "XML-TAGCE")
-                 (sgml-delim "TAGC")))
+                (sgml-delim "XML-TAGCE")
+              (sgml-delim "TAGC")))
          (tagc-len (length tagc)))
     (goto-char (sgml-element-end element))
-    (unless (sgml-element-empty element)
+    (unless  (sgml-element-empty element)
       (delete-char (- (sgml-element-etag-len element))))
     ;; XEmacs change: use tempo
     (tempo-process-and-insert-string (sgml-end-tag-of gi))
   (setq selective-display t)
   (let ((mp (buffer-modified-p))
 	(inhibit-read-only t)
-	(before-change-functions nil)
+        (before-change-functions nil)
 	(after-change-functions nil))
     (unwind-protect
         (subst-char-in-region beg end
 
 ;;;; SGML mode: indentation and movement
 
-(defvar sgml-content-indent-function 'sgml-indent-according-to-level)
-(defvar sgml-attribute-indent-function 'sgml-indent-according-to-stag)
 
 (defun sgml-indent-according-to-level (element)
   (* sgml-indent-step
   "Indent line, calling parser to determine level unless COL or ELEMENT
 is given.  If COL is given it should be the column to indent to.  If
 ELEMENT is given it should be a parse tree node, from which the level
-is determined."
+is determined.
+Deprecated: ELEMENT"
   (sgml-debug "-> sgml-indent-line %s %s"
-	      col (if element (sgml-element-gi element)))
+              col (if element (sgml-element-gi element)))
   (when sgml-indent-step
     (let ((here (point-marker))
-	  ;; Where the indentation goes, i.e., will this be data
-	  element-insert                
-	  ;; Where we compute indentation, where the thing we indent is.
-	  ;; Can be different from above if end-tag is omitted.
-	  element-level)
+          ;; Where the indentation goes, i.e., will this be data
+          element-insert                
+          ;; Where we compute indentation, where the thing we indent is.
+          ;; Can be different from above if end-tag is omitted.
+          element-level)
       (back-to-indentation)
       (unless col
 	;; Determine element
 		   (not (sgml-element-data-p sgml-last-element)))))
       (sgml-set-last-element))))
 
+
 (defun sgml-next-trouble-spot ()
   "Move forward to next point where something is amiss with the structure."
   (interactive)
 	    (princ str))
       (terpri))))
 
+
+(defun sgml-show-context-standard (el &optional markup-type)
+  (let* ((model (sgml-element-model el)))
+    (format "%s %s"
+            (cond (markup-type (format "%s" markup-type))
+                  ((sgml-element-mixed el)
+                   "#PCDATA")
+                  ((not (sgml-model-group-p model))
+                   model)
+                  (t ""))
+            (if (eq el sgml-top-tree)
+		      "in empty context"
+                      (sgml-element-context-string el)))))
+
+
+(defun sgml-show-context-backslash (el &optional markup-type)
+  (let ((gis nil))
+    (while (not (sgml-off-top-p el))
+      (push (sgml-element-gi el) gis)
+      (setq el (sgml-element-parent el)))
+    (mapconcat #'sgml-general-insert-case gis "\\")))
+
+
 (defun sgml-show-context (&optional element)
   "Display where the cursor is in the element hierarchy."
   (interactive)
-  (let* ((el (or element (sgml-last-element)))
-	 (model (sgml-element-model el)))
-    (sgml-message "%s %s" 
-		  (cond
-		   ((and (null element)	; Don't trust sgml-markup-type if
-					; explicit element is given as argument
-			 sgml-markup-type))
-		   ((sgml-element-mixed el)
-		    "#PCDATA")
-		   ((not (sgml-model-group-p model))
-		    model)
-		   (t ""))
-		  (if (eq el sgml-top-tree)
-		      "in empty context"
-		    (sgml-element-context-string el)))))
+  (message "%s" (funcall sgml-show-context-function
+                         (or element (sgml-last-element))
+                         (if element nil sgml-markup-type))))
+
 
 (defun sgml-what-element ()
   "Display what element is under the cursor."
 	 (dv (sgml-attdecl-declared-value attdecl))
 	 (tokens (sgml-declared-value-token-group dv))
 	 (notations (sgml-declared-value-notation dv))
+	 ; JDF's addition
+	 (ids (and (memq dv '(IDREF IDREFS)) (sgml-id-list)))
 	 (type (cond (tokens "token")
 		     (notations "NOTATION")
 		     (t (symbol-name dv))))
 	 (prompt
 	  (format "Value for %s in %s (%s%s): "
 		  name element type 
-		  (if curvalue
+		  (if (and curvalue (not (eq dv 'IDREFS)))
 		      (format " Default: %s" curvalue)
 		    "")))
 	 value)
     (setq value 
-	  (if (or tokens notations)
-	      (let ((completion-ignore-case sgml-namecase-general))
-		(completing-read prompt
-				 (mapcar 'list (or tokens notations))
-				 nil t))
-	    (read-string prompt)))
+	  (cond ((or tokens notations)
+		 (let ((completion-ignore-case sgml-namecase-general))
+		   (completing-read prompt
+				    (mapcar 'list (or tokens notations))
+				    nil t)))
+		(ids
+		 (let ((completion-ignore-case sgml-namecase-general)
+		       (minibuffer-local-completion-map sgml-edit-idrefs-map))
+		   (completing-read prompt
+				    'sgml-idrefs-completer
+				    nil nil
+				    (and curvalue
+					 (cons curvalue (length curvalue))))))
+		(t
+		 (read-string prompt))))
     (if (and curvalue (equal value ""))
 	curvalue value)))
 
+(defun sgml-idrefs-completer (fullstring pred action)
+  (let* ((start (string-match "\\(\\(:?-\\|\\w\\)*\\)$" fullstring))
+	 (string (match-string 0 fullstring))
+	 (prefix (substring fullstring 0 start)))
+    ;(message "prefix: %s string: %s" prefix string)
+    (cond ((null action)
+	   (let ((completion (try-completion string (sgml-id-alist) pred)))
+	     (if (eq completion t)
+		 t
+	       (concat prefix completion))))
+	  ((eq action t)
+	   (all-completions string (sgml-id-alist) pred))
+	  ((eq action 'lambda)
+	   (member string (sgml-id-alist))))))
+
 (defun sgml-non-fixed-attributes (attlist)
   (loop for attdecl in attlist
 	unless (sgml-default-value-type-p 'FIXED 
 			  (list 'sgml-insert-attribute name nil)))))))))
 
 
+;;;; New Right Button Menu
+
+(defun sgml-right-menu (event)
+  "Pop up a menu with valid tags and insert the choosen tag.
+If the variable sgml-balanced-tag-edit is t, also inserts the
+corresponding end tag. If sgml-leave-point-after-insert is t, the point
+is left after the inserted tag(s), unless the element has som required
+content.  If sgml-leave-point-after-insert is nil the point is left
+after the first tag inserted."
+  (interactive "*e")
+  (let ((end (sgml-mouse-region)))
+    (sgml-parse-to-here)
+    (cond
+     ((eq sgml-markup-type 'start-tag)
+      (sgml-right-stag-menu event))
+     (t
+      (let ((what
+	     (sgml-menu-ask event (if (or end sgml-balanced-tag-edit)
+                                      'element 'tags))))
+	(cond
+	 ((null what))
+	 (end
+	  (sgml-tag-region what (point) end))
+	 (sgml-balanced-tag-edit
+	  (sgml-insert-element what))
+	 (t
+	  (sgml-insert-tag what))))))))
+
+
+(defun sgml-right-stag-menu (event)
+  (let* ((el (sgml-find-attribute-element))
+         (attrib-menu (ignore-errors (sgml-make-attrib-menu el))))
+
+    (let* ((alt-gi (mapcar (function sgml-eltype-name)
+                           (progn
+                             (sgml-find-context-of (sgml-element-start el))
+                             (sgml-current-list-of-valid-eltypes))))
+           (change-menu
+            (cons "Change To"
+                  (loop for gi in alt-gi
+                        collect `(,gi (sgml-change-element-name ,gi))))))
+      (sgml-popup-multi-menu
+       event "Start Tag"
+       (list* `("Misc"
+                ("Edit attributes" (sgml-edit-attributes))
+                ("Normalize" (sgml-normalize-element))
+                ("Fill" (sgml-fill-element
+                         (sgml-find-context-of (point))))
+                ("Splice" (sgml-untag-element))
+                ("Fold"   (sgml-fold-element)))
+              change-menu
+              ;;`("--" "--")
+              attrib-menu)))))
+
+
+
 ;;;; SGML mode: Fill 
 
 (defun sgml-element-fillable (element)
 	  ((and (null cur-value)
 		(or (memq def-value '(IMPLIED CONREF CURRENT))
 		    (sgml-default-value-attval def-value)))
-	   (sgml-insert '(read-only t category sgml-form
-				    rear-nonsticky (read-only category))
-			" ")
+           (sgml-insert '(read-only t category sgml-form
+                                    rear-nonsticky (read-only category))
+                        " ")
 	   (sgml-insert '(category sgml-default rear-nonsticky (category))
 			"#DEFAULT"))
 	  (t
        (delete-region sgml-markup-start (point))
        (sgml-entity-insert-text entity)))))
 
+
+
+(defun sgml-trim-and-leave-element ()
+  "Remove blanks at end of current element and move point to after element."
+  (interactive)
+  (goto-char (sgml-element-etag-start (sgml-last-element)))
+  (while (progn (forward-char -1)
+		(looking-at "\\s-"))
+    (delete-char 1))
+  (sgml-up-element))
+
+
 (defvar sgml-notation-handlers 
   '((gif . "xv") 
     (jpeg . "xv"))
       (goto-char (point-max))
       (insert "\n" string))))
 
-;;;; NEW
-
-(defun sgml-trim-and-leave-element ()
-  (interactive)
-  (goto-char (sgml-element-etag-start (sgml-last-element)))
-  (while (progn (forward-char -1)
-		(looking-at "\\s-"))
-    (delete-char 1))
-  (sgml-up-element))
-
-(defun sgml-position ()
-  (interactive)
-  (let ((el (sgml-find-context-of (point)))
-        (gis nil))
-    (while (not (sgml-off-top-p el))
-      (push (sgml-element-gi el) gis)
-      (setq el (sgml-element-parent el)))
-    (message "%s" (mapconcat #'sgml-general-insert-case
-                             gis "\\"))))
-
-(define-key sgml-mode-map "\C-c\C-y" 'sgml-position)
-
+;;;; SGML mode: insert element where valid
 
 (defun sgml--add-before-p (tok state child)
   ;; Can TOK be added in STATE followed by CHILD 
             (t
              (error "A %s element is not valid in current element" gi))))))
 
+;;;; Show current element type
+;; Candidate for C-c C-t
+
+(autoload 'sgml-princ-names "psgml-info")
+(autoload 'sgml-eltype-refrenced-elements "psgml-info")
+
+(defun sgml-show-current-element-type ()
+  "Show information about the current element and its type."
+  (interactive)
+  (let* ((el (sgml-find-context-of (point)))
+         (et (sgml-element-eltype el)))
+    (with-output-to-temp-buffer "*Current Element Type*"
+      (princ (format "ELEMENT: %s%s\n" (sgml-eltype-name et)
+                     (let ((help-text (sgml-eltype-appdata et 'help-text)))
+                       (if help-text
+                           (format " -- %s" help-text)
+                           ""))))
+      (when sgml-omittag
+        (princ (format "\n Start-tag is %s.\n End-tag is %s.\n"
+                       (if (sgml-eltype-stag-optional et)
+                           "optional" "required")
+                       (if (sgml-eltype-etag-optional et)
+                           "optional" "required"))))
+      ;; ----
+      (princ "\nCONTENT: ")
+      (cond ((symbolp (sgml-eltype-model et)) (princ (sgml-eltype-model et)))
+	    (t
+	     (princ (if (sgml-eltype-mixed et)
+                        "mixed\n"
+                      "element\n"))
+             (sgml-print-position-in-model el et (point) sgml-current-state)
+             (princ "\n\n")
+	     (sgml-princ-names
+	      (mapcar #'symbol-name (sgml-eltype-refrenced-elements et))
+              "All: ")))
+      (let ((incl (sgml-eltype-includes et))
+            (excl (sgml-eltype-excludes et)))
+        (when (or incl excl)
+          (princ "\n\nEXCEPTIONS:"))
+        (when incl
+          (princ "\n + ")
+          (sgml-princ-names (mapcar #'symbol-name incl)))
+        (when excl
+          (princ "\n - ")
+          (sgml-princ-names (mapcar #'symbol-name excl))))
+      ;; ----
+      (princ "\n\nATTRIBUTES:\n")
+      (sgml-print-attlist et)
+      ;; ----
+      (let ((s (sgml-eltype-shortmap et)))
+	(when s
+	  (princ (format "\nUSEMAP: %s\n" s))))
+      ;; ----
+      (princ "\nOCCURS IN:\n")
+      (let ((occurs-in ()))
+	(sgml-map-eltypes
+	 (function (lambda (cand)
+		     (when (memq et (sgml-eltype-refrenced-elements cand))
+		       (push cand occurs-in))))
+	 (sgml-pstate-dtd sgml-buffer-parse-state))
+        (sgml-princ-names (mapcar 'sgml-eltype-name
+                                  (sort occurs-in (function string-lessp))))))))
+
+(defun sgml-print-attlist (et)
+  (let ((ob (current-buffer)))
+    (set-buffer standard-output)
+    (unwind-protect
+        (loop
+         for attdecl in (sgml-eltype-attlist et) do
+         (princ " ")
+         (princ (sgml-attdecl-name attdecl))
+         (let ((dval (sgml-attdecl-declared-value attdecl))
+               (defl (sgml-attdecl-default-value attdecl)))
+           (when (listp dval)
+             (setq dval (concat (if (eq (first dval)
+                                        'NOTATION)
+                                    "#NOTATION (" "(")
+                                (mapconcat (function identity)
+                                           (second dval)
+                                           "|")
+                                ")")))
+           (indent-to 15 1)
+           (princ dval)
+           (cond ((sgml-default-value-type-p 'FIXED defl)
+                  (setq defl (format "#FIXED '%s'"
+                                     (sgml-default-value-attval defl))))
+                 ((symbolp defl)
+                  (setq defl (upcase (format "#%s" defl))))
+                 (t
+                  (setq defl (format "'%s'"
+                                     (sgml-default-value-attval defl)))))
+
+           (indent-to 48 1)
+           (princ defl)
+           (terpri)))
+      (set-buffer ob))))
+
+
+(defun sgml-print-position-in-model (element element-type buffer-pos parse-state)
+  (let ((u (sgml-element-content element))
+        (names nil))
+    (while (and u (>= buffer-pos (sgml-element-end u)))
+      (push (sgml-element-gi u) names)
+      (setq u (sgml-element-next u)))
+    (when names
+      (sgml-princ-names (nreverse names) " " ", ")
+      (princ "\n")))
+  (princ " ->")
+  (let* ((state parse-state)
+         (required-seq                  ; the seq of req el following point
+          (loop for required = (sgml-required-tokens state)
+                while (and required (null (cdr required)))
+                collect (sgml-eltype-name (car required))
+                do (setq state (sgml-get-move state (car required)))))
+         (last-alt
+          (mapcar 'sgml-eltype-name
+                  (append (sgml-optional-tokens state)
+                          (sgml-required-tokens state)))))
+    (cond
+     (required-seq
+      (when last-alt
+        (nconc required-seq
+               (list (concat "("
+                             (mapconcat (lambda (x) x)
+                                        last-alt " | ")
+                             (if (sgml-final state)
+                                 ")?" ")")))))
+      (sgml-princ-names required-seq " " ", "))
+
+     (last-alt
+      (sgml-princ-names last-alt " (" " | ")
+      (princ ")")
+      (when (sgml-final state)
+        (princ "?"))))))
+
+
+;;;; Structure Viewing and Navigating
+
+
+(defun sgml-show-structure ()
+  "Show the document structure in a separate buffer."
+  (interactive)
+  (let ((source (current-buffer))
+        (result (get-buffer-create "*Document structure*")))
+    (set-buffer result)
+    (occur-mode)
+    (erase-buffer)
+    (let ((structure
+           (save-excursion
+             (set-buffer source)
+             (sgml-structure-elements (sgml-top-element)))))
+      (sgml-show-structure-insert structure))
+    (goto-char (point-min))
+    (display-buffer result)))
+
+
+(defun sgml-show-structure-insert (structure)
+  (loop for (gi level marker title) in structure do
+       (let ((start (point)))
+         (insert (make-string (* 2 level) ? ))
+         (sgml-insert `(face match mouse-face highlight) gi)
+         (sgml-insert `(mouse-face highlight) " %s" title)
+         (insert "\n")
+         (add-text-properties
+          start (point)
+          `(occur-target ,marker help-echo "mouse-2: go to this occurrence")))))
+  
+
+(defun sgml-show-struct-element-p (element)
+  (let ((configured (sgml-element-appdata element 'structure)))
+    (unless (eql configured 'ignore)
+      (or configured
+          (and (not (sgml-element-data-p element))
+               (not (sgml-element-empty element)))))))
+
+
+(defun sgml-structure-elements (element)
+  (when (sgml-show-struct-element-p element)
+    (let ((gi (sgml-element-gi element))
+          (level (sgml-element-level element))
+          (child1 (sgml-element-content element))
+          (marker nil)
+          (title ""))
+      (goto-char (sgml-element-start element))
+      (setq marker (copy-marker (point-marker)))
+      (when (and child1
+                 (not (sgml-show-struct-element-p child1))
+                 (sgml-element-data-p child1))
+        (let ((start-epos (sgml-element-stag-epos child1))
+              (end-epos (sgml-element-etag-epos child1)))
+          (when (and (sgml-bpos-p start-epos)
+                     (sgml-bpos-p end-epos))
+            (goto-char start-epos)
+            (forward-char (sgml-element-stag-len child1))
+            (when (looking-at "\\s-*$")
+              (forward-line 1))
+            (when (< (point) end-epos)
+              (setq title
+                    (buffer-substring (point)
+                                      ;; XEmacs: point-at-eol for < 21.4.20
+                                      (min (point-at-eol)
+                                           end-epos)))))))
+      (cons (list (sgml-general-insert-case gi)
+                  level marker title)
+            (loop for child = child1 then (sgml-element-next child)
+               while child
+               nconc (sgml-structure-elements child))))))
+
+
 ;;; psgml-edit.el ends here

File psgml-html.el

 (defun sgml-html-netscape-file ()
   "Preview the file for the current buffer in Netscape."
   (interactive)
-  (highlight-headers-follow-url-netscape
+  (browse-url-netscape
    (concat "file:" (buffer-file-name (current-buffer)))))
 
 (defun sgml-html-kfm-file ()
   "Preview the file for the current buffer in kfm."
   (interactive)
-  (highlight-headers-follow-url-kfm
+  (browse-url-kde
    (concat "file:" (buffer-file-name (current-buffer)))))
 
 ;;;###autoload(add-to-list 'auto-mode-alist '("\\.[sj]?html?\\'" . html-mode))

File psgml-ids.el

+;;; psgml-ids.el --- Management of ID/IDREFS for PSGML
+;; $Id$
+
+;; Copyright (C) 1999 Jean-Daniel Fekete
+
+;; Author: Jean-Daniel Fekete <Jean-Daniel.Fekete@emn.fr>
+
+;; This program 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
+;; of the License, or (at your option) any later version.
+;; 
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; Provides some extra functions to manage IDs and IDREFs in attibutes
+
+
+(provide 'psgml-ids)
+(require 'psgml)
+(require 'psgml-api)
+
+
+(defvar sgml-record-id-p t
+  "Set to non-nil, if you want to record all referenced IDS for completion.")
+
+(defvar sgml-id-list nil
+  "List of IDs available for completing IDREFs")
+;(make-variable-buffer-local 'sgml-id-list)
+
+(defvar sgml-id-alist nil
+  "Alist of IDs available for completing IDREFs")
+
+(defvar sgml-id-list-sorted-p nil
+  "Set to T when the sgml-id-list is sorted")
+
+(defvar sgml-edit-idrefs-map
+  (let ((map (make-sparse-keymap 'sgml-edit-idrefs-map)))
+    (set-keymap-parent map minibuffer-local-completion-map)
+    (define-key map " " 'self-insert-command)
+    map))
+
+
+(defun sgml-id-list ()
+  (unless sgml-id-list-sorted-p
+    (setq sgml-id-list (sort sgml-id-list #'string-lessp)
+	  sgml-id-list-sorted-p t
+	  sgml-id-alist nil))
+  sgml-id-list)
+
+(defun sgml-id-alist ()
+  (unless sgml-id-alist
+    (setq sgml-id-alist (mapcar #'(lambda (id) (cons id id)) (sgml-id-list))))
+  sgml-id-alist)
+
+(defun sgml-add-id (id)
+  (unless (or (not sgml-record-id-p) (member id sgml-id-list))
+    (push id sgml-id-list)
+    (setq sgml-id-list-sorted-p nil)))
+
+(defun sgml-ids-add-from (element)
+  "Find of all attributes of type ID in ELEMENT and add their value to the
+sgml-id-list."
+  (let ((asl (sgml-element-attribute-specification-list element))
+	(adl (sgml-element-attlist element)))
+
+    (dolist (as asl)
+      (let* ((aname (sgml-attspec-name as))
+	     (value (sgml-attspec-attval as))
+	     (dcl-value (sgml-attdecl-declared-value
+			 (sgml-lookup-attdecl aname adl))))
+	(if (and (eq dcl-value 'ID)
+		 value)
+	    (sgml-add-id value))))))
+
+
+(defun sgml-ids-add-current ()
+  (interactive)
+  (sgml-ids-add-from (sgml-find-context-of (point))))
+
+(defun sgml-ids-add-all (&optional element)
+  "Find all the ids of elements inside ELEMENT or the top element if not
+specified"
+  (interactive)
+  (let ((el (or element (sgml-top-element))))
+    (sgml-map-element-modify (function sgml-ids-add-from) el)))
+

File psgml-info.el

 			 "optional" "required")))
       (princ "\nATTRIBUTES:\n")
       (loop for attdecl in (sgml-eltype-attlist et) do
-        (let ((name (sgml-attdecl-name attdecl))
-              (dval (sgml-attdecl-declared-value attdecl))
-              (defl (sgml-attdecl-default-value attdecl)))
-          (when (listp dval)
-            (setq dval (concat (if (eq (first dval)
-                                       'NOTATION)
-                                   "#NOTATION (" "(")
-                               (mapconcat (function identity)
-                                          (second dval)
-                                          "|")
-                               ")")))
-          (cond ((sgml-default-value-type-p 'FIXED defl)
-                 (setq defl (format "#FIXED '%s'"
-                                    (sgml-default-value-attval defl))))
-                ((symbolp defl)
-                 (setq defl (upcase (format "#%s" defl))))
-                (t
-                 (setq defl (format "'%s'"
-                                    (sgml-default-value-attval defl)))))
-          (princ (format " %-9s %-30s %s\n" name dval defl))))
+	    (let ((name (sgml-attdecl-name attdecl))
+		  (dval (sgml-attdecl-declared-value attdecl))
+		  (defl (sgml-attdecl-default-value attdecl)))
+	      (when (listp dval)
+		(setq dval (concat (if (eq (first dval)
+					   'NOTATION)
+				       "#NOTATION (" "(")
+				   (mapconcat (function identity)
+					      (second dval)
+					      "|")
+				   ")")))
+	      (cond ((sgml-default-value-type-p 'FIXED defl)
+		     (setq defl (format "#FIXED '%s'"
+					(sgml-default-value-attval defl))))
+		    ((symbolp defl)
+		     (setq defl (upcase (format "#%s" defl))))
+		    (t
+		     (setq defl (format "'%s'"
+					(sgml-default-value-attval defl)))))
+	      (princ (format " %-9s %-30s %s\n" name dval defl))))
       ;; ----
       (let ((s (sgml-eltype-shortmap et)))
 	(when s
 
 ;;;; Print general info about the DTD.
 
-(defun sgml-general-dtd-info ()
+(defun sgml-describe-dtd ()
   "Display information about the current DTD."
   (interactive)
   (sgml-need-dtd)
 		     (princ (format fmt hdr (sgml-entity-name entity)))
 		     (setq hdr ""))))
        (sgml-dtd-parameters sgml-dtd-info)))))
+
+
+(defalias 'sgml-general-dtd-info 'sgml-describe-dtd)
+
 
 ;;; psgml-info.el ends here

File psgml-parse.el

 
 (require 'psgml)
 (require 'psgml-sysdep)
+(require 'psgml-ids)			; just for sgml-add-id
+
 
 ;;; Interface to psgml-dtd
 (eval-and-compile
 
 ;;;; Variables
 
+(defvar sgml-psgml-pi-enable-outside-dtd nil)
+
+
 ;;; Hooks
 
 (defvar sgml-open-element-hook nil
   "Function called with entity referenced at current point in parse.")
 
 (defvar sgml-pi-function nil
-  "Function called with parsed process instruction.")
+  "Function called with parsed processing instruction.")
 
 (defvar sgml-signal-data-function nil
   "Called when some data characters are conceptually parsed.
 The dtd will be constructed with the parameter entities set according
 to ENTS.  The bdtd will be left in the current buffer.  The current
 buffer is assumed to be empty to start with."
-  (sgml-log-message "Recompiling DTD file %s..." dtd-file)
+  (message "Recompiling DTD file %s..." dtd-file)
   (let* ((sgml-dtd-info (sgml-make-dtd nil))
 	 (parameters (sgml-dtd-parameters sgml-dtd-info))
 	 (sgml-parsing-dtd t))
 	  do (sgml-entity-declare name parameters 'text val))
     (sgml-push-to-entity dtd-file)
     (sgml-check-dtd-subset)
+    (sgml-debug "sgml-compile-dtd: poping entity")
     (sgml-pop-entity)
     (erase-buffer)
     (sgml-write-dtd sgml-dtd-info to-file)
 					    params2)))
 		   (unless (or (null other)
 			       (equal entity other))
-		     (sgml-log-message
+		     (message
 		      "Parameter %s in compiled DTD has wrong value;\
  is '%s' should be '%s'"
 		      (sgml-entity-name entity)
         for et = (sgml-lookup-eltype name)
         do (setf (sgml-eltype-appdata et flagsym) t)
         (message "Defining element %s as %s" name flagsym)
-        (sgml-skip-cs)))
+        (sgml-parse-s)))
 
 (defun sgml-do-processing-instruction (in-declaration)
-  (let ((start (point)))
-    (when (and (eq ?P (following-char))
-	       (looking-at "PSGML +\\(\\sw+\\) *"))
+  (let ((start (point))
+        (psgml-pi (and (eq ?P (following-char))
+                       (looking-at "PSGML +\\(\\sw+\\) *"))))
+    (if sgml-xml-p
+	(sgml-skip-upto "XML-PIC")
+      (sgml-skip-upto "PIC"))
+    (let ((end (point)))
+      (if sgml-xml-p
+          (sgml-check-delim "XML-PIC")
+        (sgml-check-delim "PIC"))
+      (let ((next (point)))
+        (cond (psgml-pi
+               (goto-char start)
+               (sgml--pi-psgml-handler in-declaration end))
+              (sgml-pi-function
+               (funcall sgml-pi-function
+                        (buffer-substring-no-properties start end))))
+        (goto-char next))))
+  (unless in-declaration
+    (sgml-set-markup-type 'pi))
+  t)
+
+
+(defun sgml--pi-psgml-handler (in-declaration end)
+  (when (or in-declaration
+            sgml-psgml-pi-enable-outside-dtd)
+    (save-restriction
+      (narrow-to-region (point) end)
       (let* ((command (downcase (match-string 1)))
              (flag-command (assoc command
                                   '(("nofill"      . nofill)
                                     ("breakafter"  . break-after-stag)
                                     ("breakbefore" . break-before-stag)
                                     ("structure"   . structure)))))
-	(goto-char (match-end 0))
-	(cond (flag-command
+        (goto-char (match-end 0))
+        (cond (flag-command
                (sgml-parse-set-appflag (cdr flag-command)))
+              ((equal command "element")
+               (sgml--pi-element-handler))
               (t
                (sgml-log-warning "Unknown processing instruction for PSGML: %s"
-                                 command)))))
-    (if sgml-xml-p
-	(sgml-skip-upto "XML-PIC")
-      (sgml-skip-upto "PIC"))
-    (when sgml-pi-function
-      (funcall sgml-pi-function
-	       (buffer-substring-no-properties start (point)))))
-  (if sgml-xml-p
-      (sgml-check-delim "XML-PIC")
-    (sgml-check-delim "PIC"))
-  (unless in-declaration
-    (sgml-set-markup-type 'pi))
-  t)
+                                 command)))))))
+
+
+(defun sgml--pi-element-handler ()
+  (sgml-parse-s)
+  (let ((eltype (sgml-lookup-eltype (sgml-parse-name)))
+        name value)
+    (sgml-parse-s)
+    (while (setq name (sgml-parse-name))
+      ;; FIXME: check name not reserved
+      (sgml-parse-s)
+      (cond ((sgml-parse-delim "VI")
+             (sgml-parse-s)
+             (setq value
+                   (if (looking-at "['\"]")
+                       (sgml-parse-literal)
+                     (read (current-buffer)))))
+            (t
+             (setq value t)))
+      (message "%s = %S" name value)
+      (setf (sgml-eltype-appdata eltype (intern (downcase name))) value)
+      (sgml-parse-s))))
 
 
 ;;[lenst/1998-03-09 19:52:08]  Perhaps not the right place
 	(let ((file (sgml-external-file extid type name)))
 	  (and file (insert-file-contents file)))
 	(progn
-	  (sgml-log-warning "External entity %s not found" name)
-	  (when pubid
-	    (sgml-log-warning "  Public identifier %s" pubid))
-	  (when sysid
-	    (sgml-log-warning "  System identifier %s" sysid))
+          (sgml-warn-external-entity-not-found name pubid sysid)
 	  nil))))
 
+(defun sgml-warn-external-entity-not-found (name pubid sysid)
+  (sgml-log-warning "External entity not found: %s%s%s"
+                    name                    
+                    (if pubid
+                        (format " PUBLIC \"%s\"" pubid)
+                      "")
+                    (if sysid
+                        (format " SYSTEM \"%s\"" sysid)
+                      "")))
+
 
 ;; Parse a buffer full of catalogue entries.
 (defun sgml-parse-catalog-buffer ()
 ENTITY can also be a file name.  Optional argument REF-START should be
 the start point of the entity reference.  Optional argument TYPE,
 overrides the entity type in entity look up."
-  (sgml-debug "Push to %s"
-	      (cond ((stringp entity)
-		     (format "string '%s'" entity))
-		    (t
-		     (sgml-entity-name entity))))
   (when ref-start
     ;; don't consider a RS shortref here again
     (setq sgml-rs-ignore-pos ref-start))
 	       (buffer-name sgml-scratch-buffer)
 	       ;; An existing buffer may have been left unibyte by
 	       ;; processing a cdtd.
+               ;; FIXME: looks strange, we haven't changed bufferw yet
 	       (sgml-set-buffer-multibyte t))
     (setq sgml-scratch-buffer (generate-new-buffer " *entity*")))
   (let ((cb (current-buffer))
     (erase-buffer)
     (sgml-set-buffer-multibyte 'default)
     (setq default-directory dd)
-    (make-local-variable 'sgml-current-file)
+    (set-visited-file-name nil t)
+    (set (make-local-variable 'sgml-current-file) nil)
     (make-local-variable 'sgml-current-eref)
     (setq sgml-current-eref eref)
     (set-syntax-table syntax-table)
     (cond
      ((stringp entity)			; a file name
       ;;(save-excursion ) test remove [lenst/1998-06-19 12:49:47]
+      (sgml-debug "Push to %s: FILE %s"
+                  (current-buffer) entity)
+
       (insert-file-contents entity)
       (setq sgml-current-file entity)
       ;; (goto-char (point-min)) ??
 	(when sgml-parsing-dtd
 	  (push (or file t)
 		(sgml-dtd-dependencies sgml-dtd-info)))
-	(sgml-debug "Push to %s = %s" extid file)
+	(sgml-debug "Push to %s: %s = %s" (current-buffer) extid file)
 	(cond
 	 ((and file sgml-parsing-dtd
 	       (sgml-try-merge-compiled-dtd (sgml-extid-pubid extid)
 		    ;; Mark entity as not found
                     (setf (sgml-entity-marked-undefined-p entity) t)
 		    (if sgml-warn-about-undefined-entities
-			(sgml-log-warning "External entity %s not found"
-					  (sgml-entity-name entity)))
-		    (when pubid
-		      (sgml-log-warning "  Public identifier %s" pubid))
-		    (when sysid
-		      (sgml-log-warning "  System identifier %s" sysid))
+			(sgml-warn-external-entity-not-found
+                         (sgml-entity-name entity) pubid sysid))
 		    nil))))))))
      (t ;; internal entity
+      (sgml-debug "Push to %s: string '%s'"
+                  (current-buffer) (sgml-entity-text entity))
       (save-excursion
 	(insert (sgml-entity-text entity)))))))
 
+
+
 (defun sgml-pop-entity ()
   (cond ((and (boundp 'sgml-previous-buffer)
 	      (bufferp sgml-previous-buffer))
-	 (sgml-debug "Exit entity")
+	 (sgml-debug "Exit entity %s => %s"
+                     (current-buffer) sgml-previous-buffer)
 	 (setq sgml-last-entity-buffer sgml-previous-buffer)
 	 (set-buffer sgml-previous-buffer)
 	 t)))
       (setq sgml-log-last-size (save-excursion (set-buffer buf)
 					       (point-max))))))
 
-(defun sgml-log-warning (format &rest things)
-  (when sgml-throw-on-warning
-    (apply 'message format things)
-    (throw sgml-throw-on-warning t))
-  (when (or sgml-show-warnings sgml-parsing-dtd)
-    (apply 'sgml-message format things)
-    (apply 'sgml-log-message format things)))
-
 (defun sgml-log-message (format &rest things)
   (let ((mess (apply 'format format things))
 	(buf (get-buffer-create sgml-log-buffer-name))
       (setq sgml-log-last-size  (point-max)))
     (set-buffer cb)))
 
-(defun sgml-error (format &rest things)
-  (when sgml-throw-on-error
-    (throw sgml-throw-on-error nil))
-  (sgml-log-entity-stack)
-  (apply 'sgml-log-warning format things)
-  (apply 'error format things))
+(defun sgml-reset-log ()
+  (let ((buf (get-buffer sgml-log-buffer-name)))
+    (when buf
+      (setq sgml-log-last-size
+	    (save-excursion (set-buffer buf)
+			    (point-max))))))
+
+(defun sgml-clear-log ()
+  (let ((b (get-buffer sgml-log-buffer-name)))
+    (when b
+      (delete-windows-on b)
+      (kill-buffer b)
+      (setq sgml-log-last-size 0))))
+
+(defun sgml-show-or-clear-log ()
+  "Show the *SGML LOG* buffer if it is not showing.
+clear and remove it if it is showing."
+  (interactive)
+  (cond ((and (get-buffer sgml-log-buffer-name)
+	      (null (get-buffer-window sgml-log-buffer-name)))
+	 (sgml-display-log))
+	(t
+	 (sgml-clear-log))))
+
+
 
 (defun sgml-log-entity-stack ()
   (save-excursion
      while (and (boundp 'sgml-previous-buffer) sgml-previous-buffer)
      do (set-buffer sgml-previous-buffer))))
 
+
+
+(defvar sgml-warning-message-flag nil
+  "True if a warning message has been displayed.
+To avoid clearing message with out showing previous warning.")
+
+
+(defun sgml-log-warning (format &rest things)
+  (when sgml-throw-on-warning
+    (apply 'message format things)
+    (throw sgml-throw-on-warning t))
+  (when (or sgml-show-warnings sgml-parsing-dtd)
+    (apply 'sgml-message format things)
+    (setq sgml-warning-message-flag t)))
+
+
+(defun sgml-error (format &rest things)
+  (when sgml-throw-on-error
+    (throw sgml-throw-on-error nil))
+  (setq sgml-warning-message-flag nil)
+  (error "%s%s" (apply 'format format things )
+         (sgml-entity-stack)))
+
+
+(defun sgml-entity-stack-1 ()
+  (format
+   "\n %s line %s col %s %s%s"
+   (or sgml-current-file (buffer-file-name) "-")
+   (count-lines (point-min) (point))
+   (current-column)
+   (let ((entity (if sgml-current-eref
+                     (sgml-eref-entity sgml-current-eref))))
+     (if (and entity (sgml-entity-type entity))
+         (format "entity %s" (sgml-entity-name entity))
+       ""))
+   (if (and (boundp 'sgml-previous-buffer) sgml-previous-buffer)
+       (progn (set-buffer sgml-previous-buffer)
+              (sgml-entity-stack-1))
+     "")))
+
+(defun sgml-entity-stack ()
+  (save-excursion (sgml-entity-stack-1)))
+
+
 (defun sgml-parse-warning (format &rest things)
-  (sgml-log-entity-stack)
-  (apply 'sgml-log-warning format things))
+  (message "%s%s" (apply 'format format things) (sgml-entity-stack))
+  (setq sgml-warning-message-flag t))
 
 (defun sgml-parse-error (format &rest things)
   (apply 'sgml-error
 			       (min (point-max) (+ (point) 12)))))))
 
 (defun sgml-message (format &rest things)
-  (let ((buf (get-buffer sgml-log-buffer-name)))
-    (when (and buf
-	       (> (save-excursion (set-buffer buf)
-				  (point-max))
-		  sgml-log-last-size))
-      (sgml-display-log)))
-  (apply 'message format things))
-
-(defun sgml-reset-log ()
-  (let ((buf (get-buffer sgml-log-buffer-name)))
-    (when buf
-      (setq sgml-log-last-size
-	    (save-excursion (set-buffer buf)
-			    (point-max))))))
-
-(defun sgml-clear-log ()
-  (let ((b (get-buffer sgml-log-buffer-name)))
-    (when b
-      (delete-windows-on b)
-      (kill-buffer b)
-      (setq sgml-log-last-size 0))))
-
-(defun sgml-show-or-clear-log ()
-  "Show the *SGML LOG* buffer if it is not showing.
-Clear and remove it if it is."
-  (interactive)
-  (cond ((and (get-buffer sgml-log-buffer-name)
-	      (null (get-buffer-window sgml-log-buffer-name)))
-	 (sgml-display-log))
-	(t
-	 (sgml-clear-log))))
+  (unless (and (or (equal format "")
+                 (string-match "\\.\\.done$" format))
+             sgml-warning-message-flag)
+    (apply 'message format things)
+    (setq sgml-warning-message-flag nil)))
 
 
 
 	   (sgml-check-dtd-subset)
 	   (sgml-check-end-of-entity "DTD subset")
 	   (sgml-pop-entity)))
-;;;    (loop for map in sgml-dtd-shortmaps do
-;;;	  (sgml-add-shortref-map
-;;;	   (sgml-dtd-shortmaps sgml-dtd-info)
-;;;	   (car map)
-;;;	   (sgml-make-shortmap (cdr map))))
+    (when sgml-xml-p
+      (let ((table (sgml-dtd-entities sgml-dtd-info)))
+        (sgml-entity-declare "lt" table 'text "&#60;")
+        (sgml-entity-declare "gt" table 'text ">")
+        (sgml-entity-declare "amp" table 'text "&#38;")
+        (sgml-entity-declare "apos" table 'text "'")
+        (sgml-entity-declare "quot" table 'text "\"")))
     (sgml-set-initial-state sgml-dtd-info)
     (run-hooks 'sgml-doctype-parsed-hook)))
 
       ;; FIXME: What happens when eltype is nil ??
       (cond
        (attdecl
+	;; JDF's addition 12/2001
+	(if (eq (sgml-attdecl-declared-value attdecl) 'ID)
+	    (sgml-add-id val))
 	(push (sgml-make-attspec (sgml-attdecl-name attdecl) val)
 	      asl)
 	(when (sgml-default-value-type-p 'CONREF
 
 
 (defun sgml-load-doctype ()
+  "Load the documents DTD.
+Either from parent document or by parsing the document prolog."
+  (interactive)
   (cond
    ;; Case of doctype in another file
    ((or sgml-parent-document sgml-doctype)
     (when (consp (cdr modifier))	; There are "seen" elements
       (sgml-open-element et nil (point-min) (point-min))
       (loop for seenel in (cadr modifier)
-	    do (setq sgml-current-state
-		     (sgml-get-move sgml-current-state
+	    do (let ((new-state (sgml-get-move sgml-current-state
 				    (sgml-lookup-eltype
-                                     (sgml-general-case seenel)))))))
+                                     (sgml-general-case seenel)))))
+                 (unless new-state
+                   (error
+                    "Illegal has-seen-element in sgml-parent-document: %s"
+                    seenel))
+                 (setq sgml-current-state new-state)))))
   
   (let ((top (sgml-pstate-top-tree sgml-buffer-parse-state)))
     (setf (sgml-tree-includes top) (sgml-tree-includes sgml-current-tree))
 		       (and (sgml-parse-markup-declaration 'prolog)
 			    (null sgml-dtd-info)))))
      (unless sgml-dtd-info		; Set up a default doctype
-       (let ((docname (or sgml-default-doctype-name
+       (let ((docname (or (and sgml-default-doctype-name
+                               (sgml-general-case sgml-default-doctype-name))
 			  (if (sgml-parse-delim "STAGO" gi)
 			      (sgml-parse-name)))))
 	 (when docname
   (sgml-with-parser-syntax-ro
    (sgml-goto-start-point (min sgml-goal (point-max)))
    (setq quiet (or quiet (< (- sgml-goal (sgml-mainbuf-point)) 500)))
-   (unless quiet
-     (sgml-message "Parsing..."))
+  (unless quiet
+    (sgml-message "Parsing..."))
    (sgml-parser-loop extra-cond)
-   (unless quiet
-     (sgml-message ""))))
+  (unless quiet
+    (sgml-message ""))))
 
 (defun sgml-parse-continue (sgml-goal &optional extra-cond quiet)
   "Parse until (at least) SGML-GOAL."
 (defun sgml-do-move (token type)
   (cond ((eq sgml-any sgml-current-state))
         (t
-         (let ((next-state (sgml-get-move sgml-current-state token)))
-           (cond (next-state
-                  (setq sgml-current-state next-state))
-                 (t
-                  (sgml-execute-implied (sgml-list-implications token type) type)
-                  (unless (eq sgml-any sgml-current-state)
-                    (sgml-move-current-state token))))))))
+         (sgml-execute-implied (sgml-list-implications token type) type)
+         (unless (eq sgml-any sgml-current-state)
+           (sgml-move-current-state token)))))
 
 
 (defun sgml-pcdata-move ()

File psgml-sysdep.el

 
 (require 'psgml)
 (cond
+ ;; XEmacs change
  (running-xemacs
   (require 'psgml-xemacs))
  (t

File psgml-xemacs.el

 
 ;;; Part of psgml.el
 
+;; XEmacs note: called psgml-lucid.el upstream.
+
 ;;; Menus for use with XEmacs
 
 
 ;;;; Key definitions
 
 (define-key sgml-mode-map [button3] 'sgml-tags-menu)
+;; XEmacs addition (previously in psgml-debug, upstream: psgml-other)
+(define-key sgml-mode-map [(shift button3)] 'sgml-right-menu)
 
 
 ;;;; Insert with properties
 
 ;;; Code:
 
-(defconst psgml-version "1.3.1"
+(defconst psgml-version "1.3.2"
   "Version of psgml package.")
 
 (defconst psgml-maintainer-address "lenst@lysator.liu.se")
 (defvar sgml-debug nil)
 
 (defmacro sgml-debug (&rest x)
-  (list 'if 'sgml-debug (cons 'sgml-log-message x)))
+  (list 'if 'sgml-debug (cons 'message x)))
 
 
 ;;;; Variables
 Setting this variable automatically makes it local to the current buffer.")
 (make-variable-buffer-local 'sgml-indent-data)
 
+(defvar sgml-content-indent-function 'sgml-indent-according-to-level)
+(defvar sgml-attribute-indent-function 'sgml-indent-according-to-stag)
+
 ;;; Wing addition
 (defcustom sgml-inhibit-indent-tags nil
   "*List of tags within which indentation is inhibited.
 (defvar sgml-mode-map nil
   "Keymap for SGML mode")
 
+(defvar sgml-show-context-function
+  'sgml-show-context-standard
+  "*Function to called to show context of and element.
+Should return a string suitable form printing in the echo area.")
+
 (defconst sgml-file-options
   '(
     sgml-omittag
 (defun sgml-mouse-region ()
   (let (start end)
     (cond
-     (running-xemacs
+     (running-xemacs ;; XEmacs change
       (cond
        ((null (mark-marker)) nil)
        (t (setq start (region-beginning)
 (defvar sgml-prefix-u-map (make-sparse-keymap))
 
 (define-key sgml-mode-map "\C-c\C-f" sgml-prefix-f-map)
-(define-key sgml-mode-map "\C-c\C-u" sgml-prefix-u-map)
+(define-key sgml-mode-map "\C-c\C-u" sgml-prefix-u-map) 
 
 ;;; Key commands
 
 (define-key sgml-mode-map "\C-c\C-f\C-x" 'sgml-expand-element)
 (define-key sgml-mode-map "\C-c\C-i" 'sgml-add-element-to-element)
 (define-key sgml-mode-map "\C-c\C-k" 'sgml-kill-markup)
-(define-key sgml-mode-map "\C-c\C-l" 'sgml-show-or-clear-log)
 (define-key sgml-mode-map "\C-c\r"   'sgml-split-element)
 (define-key sgml-mode-map "\C-c\C-n" 'sgml-up-element)
 (define-key sgml-mode-map "\C-c\C-o" 'sgml-next-trouble-spot)
-(define-key sgml-mode-map "\C-c\C-p" 'sgml-parse-prolog)
+(define-key sgml-mode-map "\C-c\C-p" 'sgml-load-doctype)
 (define-key sgml-mode-map "\C-c\C-q" 'sgml-fill-element)
 (define-key sgml-mode-map "\C-c\C-r" 'sgml-tag-region)
-(define-key sgml-mode-map "\C-c\C-s" 'sgml-unfold-line)
-(define-key sgml-mode-map "\C-c\C-t" 'sgml-list-valid-tags)
+(define-key sgml-mode-map "\C-c\C-s" 'sgml-show-structure)
+;(define-key sgml-mode-map "\C-c\C-t" 'sgml-list-valid-tags)
+(define-key sgml-mode-map "\C-c\C-t" 'sgml-show-current-element-type)
 (define-key sgml-mode-map "\C-c\C-u\C-a" 'sgml-unfold-all)
 (define-key sgml-mode-map "\C-c\C-u\C-d" 'sgml-custom-dtd)
 (define-key sgml-mode-map "\C-c\C-u\C-e" 'sgml-unfold-element)
 ;;;; Menu bar
 
 (easy-menu-define
- sgml-dtd-menu sgml-mode-map "DTD menu"
- '("DTD"
-    ["Parse DTD"  sgml-parse-prolog t]
-    ("Insert DTD")
-    ("Info"
-     ["General DTD info"	sgml-general-dtd-info           t]
-     ["Describe element type"	sgml-describe-element-type	t]
-     ["Describe entity"		sgml-describe-entity		t]
-     ["List elements" 		sgml-list-elements 		t]
-     ["List attributes" 	sgml-list-attributes 		t]
-     ["List terminals" 		sgml-list-terminals 		t]
-     ["List content elements" 	sgml-list-content-elements 	t]
-     ["List occur in elements" 	sgml-list-occur-in-elements 	t]
-     )
-    "--"
-    ["Load Parsed DTD"  sgml-load-dtd t]
-    ["Save Parsed DTD"  sgml-save-dtd t]
-   ))
-
-(easy-menu-define
- ;; XEmacs change: View -> Show
- sgml-view-menu sgml-mode-map "Show menu"
- '("Show"
-   ["Fold Element"	sgml-fold-element	t]
-   ["Fold Subelement"	sgml-fold-subelement	t]
-   ["Unfold Line"	sgml-unfold-line	t]
-   ["Unfold Element"	sgml-unfold-element	t]
-   ["Expand"		sgml-expand-element	t]
-   ["Fold Region"	sgml-fold-region	t]
-   ["Unfold All"	sgml-unfold-all		t]
-   ["Hide Tags"		sgml-hide-tags		t]
-   ["Hide Attributes"	sgml-hide-attributes	t]
-   ["Show All Tags"	sgml-show-tags		t]
-   ))
-
-
-(easy-menu-define
- sgml-markup-menu sgml-mode-map "Markup menu"
- '("Markup"
-   ["Insert Element"	sgml-element-menu	t]
-   ["Insert Start-Tag" sgml-start-tag-menu	t]
-   ["Insert End-Tag"	sgml-end-tag-menu	t]
-   ["End Current Element"	sgml-insert-end-tag t]
-   ["Tag Region"	sgml-tag-region-menu	t]
-   ["Insert Attribute"  sgml-attrib-menu	t]
-   ["Insert Entity"	sgml-entities-menu	t]
-   ["Add Element to Element"	sgml-add-element-menu	t]
-   ("Custom markup"   "---")
-   ))
-
-(easy-menu-define
- sgml-move-menu sgml-mode-map "Menu of move commands"
- '("Move"
-   ["Next trouble spot" sgml-next-trouble-spot t]
-   ["Next data field"   sgml-next-data-field   t]
-   ["Forward element"	sgml-forward-element t]
-   ["Backward element"  sgml-backward-element t]
-   ["Up element"	sgml-up-element t]
-   ["Down element"	sgml-down-element t]
-   ["Backward up element" sgml-backward-up-element t]
-   ["Beginning of element" sgml-beginning-of-element t]
-   ["End of element"	sgml-end-of-element t]
-   ))
-
-(easy-menu-define
- sgml-modify-menu sgml-mode-map "Menu of modification commands"
- '("Modify"