--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/psgml/psgml-edit.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,1693 @@
+;;; psgml-edit.el --- Editing commands for SGML-mode with parsing support
+;; $Id: psgml-edit.el,v 1.1.1.1 1996/12/18 03:35:19 steve Exp $
+
+;; Copyright (C) 1994, 1995, 1996 Lennart Staflin
+
+;; Author: Lennart Staflin <lenst@lysator.liu.se>
+
+;; 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:
+
+;; Part of major mode for editing the SGML document-markup language.
+
+
+;;;; Code:
+
+(provide 'psgml-edit)
+(require 'psgml)
+(require 'psgml-parse)
+
+
+;;;; Variables
+
+(defvar sgml-split-level nil
+  "Used by sgml-split-element")
+
+
+;;;; SGML mode: structure editing
+
+(defun sgml-last-element ()
+  "Return the element where last command left point.
+This either uses the save value in `sgml-last-element' or parses the buffer
+to find current open element."
+  (setq sgml-markup-type nil)
+  (if (and (memq last-command sgml-users-of-last-element)
+	   sgml-last-element)		; Don't return nil
+      sgml-last-element
+    (setq sgml-last-element (sgml-find-context-of (point))))  )
+
+(defun sgml-set-last-element (&optional el)
+  (if el (setq sgml-last-element el))
+  (sgml-show-context sgml-last-element))
+
+(defun sgml-beginning-of-element ()
+  "Move to after the start-tag of the current element.
+If the start-tag is implied, move to the start of the element."
+  (interactive)
+  (goto-char (sgml-element-stag-end (sgml-last-element)))
+  (sgml-set-last-element (if (sgml-element-empty sgml-last-element)
+			     (sgml-element-parent sgml-last-element))))
+
+(defun sgml-end-of-element ()
+  "Move to before the end-tag of the current element."
+  (interactive)
+  (goto-char (sgml-element-etag-start (sgml-last-element)))
+  (sgml-set-last-element (if (sgml-element-empty sgml-last-element)
+			     (sgml-element-parent sgml-last-element))))
+
+(defun sgml-backward-up-element ()
+  "Move backward out of this element level.
+That is move to before the start-tag or where a start-tag is implied."
+  (interactive)
+  (goto-char (sgml-element-start (sgml-last-element)))
+  (sgml-set-last-element (sgml-element-parent sgml-last-element)))
+
+(defun sgml-up-element ()
+  "Move forward out of this element level.
+That is move to after the end-tag or where an end-tag is implied."
+  (interactive)
+  (goto-char (sgml-element-end (sgml-last-element)))
+  (sgml-set-last-element (sgml-element-parent sgml-last-element)))
+
+(defun sgml-forward-element ()
+  "Move forward over next element."
+  (interactive)
+  (let ((next
+	 (sgml-find-element-after (point) (sgml-last-element))))
+    (goto-char (sgml-element-end next))
+    (sgml-set-last-element (sgml-element-parent next))))
+
+(defun sgml-backward-element ()
+  "Move backward over previous element at this level.
+With implied tags this is ambigous."
+  (interactive)
+  (let ((prev				; previous element
+	 (sgml-find-previous-element (point) (sgml-last-element))))
+    (goto-char (sgml-element-start prev))
+    (sgml-set-last-element (sgml-element-parent prev))))
+
+(defun sgml-down-element ()
+  "Move forward and down one level in the element structure."
+  (interactive)
+  (let ((to
+	 (sgml-find-element-after (point) (sgml-last-element))))
+    (goto-char (sgml-element-stag-end to))
+    (sgml-set-last-element (if (sgml-element-empty to)
+			       (sgml-element-parent to)
+			     to))))
+
+
+(defun sgml-kill-element ()
+  "Kill the element following the cursor."
+  (interactive "*")
+  (sgml-parse-to-here)
+  (when sgml-markup-type
+    (error "Point is inside markup"))
+  (kill-region (point)
+	       (sgml-element-end (sgml-find-element-after (point)))))
+
+(defun sgml-transpose-element ()
+  "Interchange element before point with element after point, leave point after."
+  (interactive "*")
+  (let ((pre (sgml-find-previous-element (point)))
+	(next (sgml-find-element-after (point)))
+	s1 s2 m2)
+    (goto-char (sgml-element-start next))
+    (setq m2 (point-marker))
+    (setq s2 (buffer-substring (point)
+			       (sgml-element-end next)))
+    (delete-region (point) (sgml-element-end next))
+    (goto-char (sgml-element-start pre))
+    (setq s1 (buffer-substring (point) (sgml-element-end pre)))
+    (delete-region (point) (sgml-element-end pre))
+    (insert-before-markers s2)
+    (goto-char m2)
+    (insert s1)
+    (sgml-message "")))
+
+(defun sgml-mark-element ()
+  "Set mark after next element."
+  (interactive)
+  (push-mark (sgml-element-end (sgml-find-element-after (point))) nil t))
+
+(defun sgml-mark-current-element ()
+  "Set mark at end of current element, and leave point before current element."
+  (interactive)
+  (let ((el (sgml-find-element-of (point))))
+    (goto-char (sgml-element-start el))
+    (push-mark (sgml-element-end el) nil t)))
+
+
+(defun sgml-change-element-name (gi)
+  "Replace the name of the current element with a new name.
+Eventual attributes of the current element will be translated if 
+possible."
+  (interactive
+   (list (let ((el (sgml-find-element-of (point))))
+	   (goto-char (sgml-element-start el))
+	   (sgml-read-element-name
+	    (format "Change %s to: " (sgml-element-name el))))))
+  (when (or (null gi) (equal gi ""))
+    (error "Illegal name"))
+  (let* ((element (sgml-find-element-of (point)))
+	 (attspec (sgml-element-attribute-specification-list element))
+	 (oldattlist (sgml-element-attlist element)))
+    (unless (sgml-element-empty element)
+      (goto-char (sgml-element-end element))
+      (delete-char (- (sgml-element-etag-len element)))
+      (insert (sgml-end-tag-of gi)))
+    (goto-char (sgml-element-start element))
+    (delete-char (sgml-element-stag-len element))
+    (insert (sgml-start-tag-of gi))
+    (forward-char -1)
+    (let* ((newel (sgml-find-element-of (point)))
+	   (newattlist (sgml-element-attlist newel))
+	   (newasl (sgml-translate-attribute-specification-list
+		    attspec oldattlist newattlist)))
+      (sgml-insert-attributes newasl newattlist))))
+
+(defun sgml-translate-attribute-specification-list (values from to)
+  "Translate attribute specification from one element type to another.
+Input attribute values in VALUES using attlist FROM is translated into
+a list using attlist TO."
+  (let ((new-values nil)
+	(sgml-show-warnings t)
+	tem)
+    (loop for attspec in values 
+	  as from-decl = (sgml-lookup-attdecl (sgml-attspec-name attspec) from)
+	  as to-decl   = (sgml-lookup-attdecl (sgml-attspec-name attspec) to)
+	  do
+	  (cond
+	   ;; Special case ID attribute
+	   ((and (eq 'id (sgml-attdecl-declared-value from-decl))
+		 (setq tem (sgml-attribute-with-declared-value to 'id)))
+	    (push
+	     (sgml-make-attspec (sgml-attdecl-name tem)
+				(sgml-attspec-attval attspec))
+	     new-values))
+	   ;; Use attribute with same name if compatible type
+	   ((equal (sgml-attdecl-declared-value from-decl)
+		   (sgml-attdecl-declared-value to-decl))
+	    (push attspec new-values))
+	   (to-decl
+	    (sgml-log-warning
+	     "Attribute %s has new declared-value"
+	     (sgml-attspec-name attspec))
+	    (push attspec new-values))
+	   (t
+	    (sgml-log-warning "Can't translate attribute %s = %s"
+			      (sgml-attspec-name attspec)
+			      (sgml-attspec-attval attspec)))))
+    new-values))
+
+(defun sgml-untag-element ()
+  "Remove tags from current element."
+  (interactive "*")
+  (let ((el (sgml-find-element-of (point))))
+    (when (or (sgml-strict-epos-p (sgml-element-stag-epos el))
+	      (sgml-strict-epos-p (sgml-element-etag-epos el)))
+      (error "Current element has some tag inside an entity reference"))
+    (goto-char (sgml-element-etag-start el))
+    (delete-char (sgml-element-etag-len el))
+    (goto-char (sgml-element-start el))
+    (delete-char (sgml-element-stag-len el))))
+
+(defun sgml-kill-markup ()
+  "Kill next tag, markup declaration or process instruction."
+  (interactive "*")
+  (let ((start (point)))
+    (sgml-with-parser-syntax
+     (sgml-parse-s)
+     (setq sgml-markup-start (point))
+     (cond ((sgml-parse-markup-declaration 'ignore))
+	   ((sgml-parse-processing-instruction))
+	   ((sgml-skip-tag)))
+     (kill-region start (point)))))
+
+
+;;;; SGML mode: folding
+
+(defun sgml-fold-region (beg end &optional unhide)
+  "Hide (or if prefixarg unhide) region.
+If called from a program first two arguments are start and end of
+region. And optional third argument true unhides."
+  (interactive "r\nP")
+  (let ((mp (buffer-modified-p))
+	(inhibit-read-only t)		;
+	(buffer-read-only nil)		; should not need this, but
+					; perhaps some old version of
+					; emacs does not understand
+					; inhibit-read-only
+	(before-change-function nil)
+	(after-change-function nil))
+    (setq selective-display t)
+    (unwind-protect
+	(subst-char-in-region beg end
+			      (if unhide ?\r ?\n)
+			      (if unhide ?\n ?\r)
+			      'noundo)
+      (when sgml-buggy-subst-char-in-region
+	(set-buffer-modified-p mp)))))
+
+(defun sgml-fold-element ()
+  "Fold the lines comprising the current element, leaving the first line visible.
+This uses the selective display feature."
+  (interactive)
+  (sgml-parse-to-here)
+  (cond ((and (eq sgml-current-tree sgml-top-tree) ; outside document element
+	      sgml-markup-type)
+	 (sgml-fold-region sgml-markup-start
+			   (save-excursion
+			     (sgml-parse-to (point))
+			     (point))))
+	((and (eq sgml-current-tree sgml-top-tree) ; outside document element
+	      (looking-at " *<!"))
+	 (sgml-fold-region (point)
+			   (save-excursion
+			     (skip-chars-forward " \t")
+			     (sgml-parse-to (1+ (point)))
+			     (point))))
+
+	(t
+	 (let ((el (sgml-find-element-of (point))))
+	   (when (eq el sgml-top-tree)
+	     (error "No element here"))
+	   (save-excursion
+	     (goto-char (sgml-element-end el))
+	     (when (zerop (sgml-element-etag-len el))
+	       (skip-chars-backward " \t\n"))
+	     (sgml-fold-region (sgml-element-start el)
+			       (point)))))))
+
+(defun sgml-fold-subelement ()
+  "Fold all elements current elements content, leaving the first lines visible.
+This uses the selective display feature."
+  (interactive)
+  (let* ((el (sgml-find-element-of (point)))
+	 (start (sgml-element-start el))
+	 (end (sgml-element-end el))
+	 (c (sgml-element-content el)))
+    (while c
+      (sgml-fold-region (sgml-element-start c)
+			(sgml-element-end c))
+      (setq c (sgml-element-next c)))))
+
+(defun sgml-unfold-line ()
+  "Show hidden lines in current line."
+  (interactive)
+  (let ((op (point)))
+    (beginning-of-line)
+    (push-mark)
+    (end-of-line)
+    (exchange-point-and-mark)
+    (sgml-fold-region (point) (mark) 'unhide)
+    (goto-char op)))
+
+(defun sgml-unfold-element ()
+  "Show all hidden lines in current element."
+  (interactive)
+  (let* ((element (sgml-find-element-of (point))))
+    (sgml-fold-region (sgml-element-start element)
+		      (sgml-element-end element)
+		      'unfold)))
+
+(defun sgml-expand-element ()
+  "As sgml-fold-subelement, but unfold first."
+  (interactive)
+  (sgml-unfold-element)
+  (sgml-fold-subelement))
+
+(defun sgml-unfold-all ()
+  "Show all hidden lines in buffer."
+  (interactive)
+  (sgml-fold-region (point-min)
+		    (point-max)
+		    'unfold))
+
+;;;; SGML mode: indentation and movement
+
+(defun sgml-indent-line (&optional col element)
+  "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."
+  (when sgml-indent-step
+    (let ((here (point-marker)))
+      (back-to-indentation)
+      (unless (or col element)
+	;; Determine element
+	(setq element
+	      (let ((sgml-throw-on-error 'parse-error))
+		(catch sgml-throw-on-error
+		  (if (eobp)
+		      (sgml-find-context-of (point))
+		    (sgml-find-element-of (point)))))))
+      (when (eq element sgml-top-tree)	; not in a element at all
+	(setq element nil)		; forget element
+	(goto-char here))		; insert normal tab insted)
+      (when element
+	(sgml-with-parser-syntax
+	 (let ((stag (sgml-is-start-tag))
+	       (etag (sgml-is-end-tag)))
+	   (when (and
+		  (not (member* (sgml-element-gi
+				 (if (or stag etag)
+				     (sgml-element-parent element)
+				   element))
+				sgml-inhibit-indent-tags
+				:test #'equalp))
+		  (or sgml-indent-data
+		      (not (sgml-element-data-p
+			    (if stag
+				(sgml-element-parent element)
+			      element)))))
+	     (setq col
+		   (* sgml-indent-step
+		      (+ (if (or stag etag) -1 0)
+			 (sgml-element-level element))))))))
+      (when (and col (/= col (current-column)))
+	(beginning-of-line 1)    
+	(delete-horizontal-space)
+	(indent-to col))
+      (when (< (point) here)
+	(goto-char here))
+      col)))
+
+(defun sgml-next-data-field ()
+  "Move forward to next point where data is allowed."
+  (interactive)
+  (when (eobp)
+    (error "End of buffer"))
+  (let ((sgml-throw-on-warning 'next-data)
+	(avoid-el (sgml-last-element)))
+    ;; Avoid stopping in current element, unless point is in the start
+    ;; tag of the element
+    (when (< (point) (sgml-element-stag-end avoid-el))
+      (setq avoid-el nil))
+    (catch sgml-throw-on-warning
+      (while (progn
+	       (sgml-parse-to (1+ (point)))
+	       (setq sgml-last-element
+		     (if (not (eq ?< (following-char)))
+			 (sgml-find-element-of (point))
+		       sgml-current-tree))
+	       (or (eq sgml-last-element avoid-el)
+		   (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)
+  (push-mark)
+  (sgml-note-change-at (point))		; Prune the parse tree
+  (sgml-parse-to (point))
+  (let ((sgml-last-trouble-spot (point))
+	(sgml-throw-on-warning 'trouble))
+    (or (catch sgml-throw-on-warning
+	  (sgml-parse-until-end-of nil t))
+	(message "Ok"))))
+
+
+
+;;;; SGML mode: information display
+
+(defun sgml-list-valid-tags ()
+  "Display a list of the contextually valid tags."
+  (interactive)
+  (sgml-parse-to-here)
+  (let ((model (sgml-element-model sgml-current-tree)))
+    (with-output-to-temp-buffer "*Tags*"
+      (princ (format "Current element: %s  %s\n"
+		     (sgml-element-name sgml-current-tree)
+		     (if (sgml-eltype-defined
+			  (sgml-element-eltype sgml-current-tree))
+			 ""
+		       "[UNDEFINED]")))
+      (princ (format "Element content: %s  %s\n"
+		     (cond ((or (sgml-current-mixed-p) (eq model sgml-any))
+			    "mixed")
+			   ((sgml-model-group-p model)
+			    "element")
+			   (t
+			    model))
+		     (if (eq model sgml-any)
+			 "[ANY]" "")))
+      
+      (cond ((sgml-final-p sgml-current-state)
+	     (princ "Valid end-tags : ")
+	     (loop for e in (sgml-current-list-of-endable-eltypes)
+		   do (princ (sgml-end-tag-of e)) (princ " "))
+	     (terpri))
+	    (t
+	     (princ "Current element can not end here\n")))
+;;;      (let ((s (sgml-tree-shortmap sgml-current-tree)))
+;;;	(when s
+;;;	  (princ (format "Current shortref map: %s\n" s))))
+      (princ "Valid start-tags\n")
+      (sgml-print-valid-tags "In current element:"
+			     sgml-current-tree sgml-current-state))))
+
+(defun sgml-print-valid-tags (prompt tree state &optional exclude omitted-stag)
+  (if (not (sgml-model-group-p state))
+      (princ (format "%s (in %s)\n" prompt state))
+    (let* ((req (sgml-required-tokens state))
+	   (elems (nconc req
+			 (delq sgml-pcdata-token
+			       (sgml-optional-tokens state))))
+	   (in (sgml-tree-includes tree))
+	   (ex (append exclude (sgml-tree-excludes tree))))
+      ;; Modify for exceptions
+      (while in
+	(unless (memq (car in) elems)
+	  (setq elems (nconc elems (list (car in)))))
+	(setq in (cdr in)))
+      (while ex
+	(setq elems (delq (car ex) elems))
+	(setq ex (cdr ex)))
+      ;; 
+      (setq elems (sort elems (function string-lessp)))
+      (sgml-print-list-of-tags prompt elems)
+      ;; Check for omissable start-tags
+      (when (and req (null (cdr req)))
+	;; *** Assumes tokens are eltypes
+	(let ((el (sgml-fake-open-element tree (car req))))
+	  (when (sgml-element-stag-optional el)
+	    (sgml-print-valid-tags
+	     (format "If omitting %s:" (sgml-start-tag-of el))
+	     el
+	     (sgml-element-model el)
+	     (append exclude elems)
+	     'omitted-stag))))
+      ;; Check for omissable end-tag
+      (when (and (not omitted-stag)
+		 (sgml-final-p state)
+		 (sgml-element-etag-optional tree))
+	(sgml-print-valid-tags
+	 (format "If omitting %s:" (sgml-end-tag-of tree))
+	 (sgml-element-parent tree)
+	 (sgml-element-pstate tree)
+	 (append exclude elems))))))
+
+(defun sgml-print-list-of-tags (prompt list)
+  (when list
+    (princ prompt)
+    (let ((col (length prompt))
+	  (w   (1- (frame-width))))
+      (loop for e in list
+	    as str = (sgml-start-tag-of e)
+	    do
+	    (setq col (+ col (length str) 2))
+	    (cond ((>= col w)
+		   (setq col (+ (length str) 2))
+		   (terpri)))
+	    (princ "  ")
+	    (princ str))
+      (terpri))))
+
+(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)))))
+
+(defun sgml-what-element ()
+  "Display what element is under the cursor."
+  (interactive)
+  (let ((el (sgml-find-element-of (point))))
+    (assert (not (null el)))
+    (message "%s %s"
+	     (cond ((eq el sgml-top-tree)
+		    "outside document element")
+		   ((< (point) (sgml-element-stag-end el))
+		    "start-tag")
+		   ((>= (point) (sgml-element-etag-start el))
+		    "end-tag")
+		   (t
+		    "content"))
+	     (sgml-element-context-string el))))
+
+;;;; SGML mode: keyboard inserting
+
+(defun sgml-insert-tag (tag &optional silent no-nl-after)
+  "Insert a tag, reading tag name in minibuffer with completion.
+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 
+   (list
+    (completing-read "Tag: " (sgml-completion-table) nil t "<" )))
+  (sgml-find-context-of (point))
+  (assert (null sgml-markup-type))
+  ;; Fix white-space before tag
+  (unless (sgml-element-data-p (sgml-parse-to-here))
+    (skip-chars-backward " \t")
+    (cond ((bolp)
+	   (if (looking-at "^\\s-*$")
+	       (fixup-whitespace)))
+	  (t
+	   (insert "\n"))))
+  (insert tag)
+  (sgml-indent-line)  
+  (unless no-nl-after
+    (save-excursion
+      (unless (sgml-element-data-p (sgml-parse-to-here))
+	(unless (eolp)
+	  (save-excursion (insert "\n"))))))
+  (or silent (sgml-show-context)))
+
+(defvar sgml-new-attribute-list-function
+  (function sgml-default-asl))
+
+(defun sgml-insert-element (name &optional after silent)
+  "Reads element name from minibuffer and inserts start and end tags."
+  (interactive (list (sgml-read-element-name "Element: ")
+		     sgml-leave-point-after-insert))
+  (let (newpos				; position to leave cursor at
+	element				; inserted element
+	(sgml-show-warnings nil))
+    (when (and name (not (equal name "")))
+      (sgml-insert-tag (sgml-start-tag-of name) 'silent)
+      (forward-char -1)
+      (setq element (sgml-find-element-of (point)))
+      (sgml-insert-attributes (funcall sgml-new-attribute-list-function
+				       element)
+			      (sgml-element-attlist element))
+      (forward-char 1)
+      (when (not (sgml-element-empty element))
+	(when (and sgml-auto-insert-required-elements
+		   (sgml-model-group-p sgml-current-state))
+	  (let (tem)
+	    (while (and (setq tem (sgml-required-tokens sgml-current-state))
+			(null (cdr tem)))
+	      (setq tem (sgml-insert-element (car tem) t t))
+	      (setq newpos (or newpos tem))
+	      (sgml-parse-to-here))
+	    (when tem			; more than one req elem
+	      (insert "\n")
+	      (when sgml-insert-missing-element-comment
+		(insert (format "<!-- one of %s -->" tem))
+		(sgml-indent-line nil element)))))
+	(setq newpos (or newpos (point)))
+	(when sgml-insert-end-tag-on-new-line
+	  (insert "\n"))
+	(sgml-insert-tag (sgml-end-tag-of name) 'silent)
+	(unless after
+	  (goto-char newpos))
+	(unless silent (sgml-show-context)))
+      newpos)))
+
+(defun sgml-default-asl (element)
+  (loop for attdecl in (sgml-element-attlist element)
+	when (sgml-default-value-type-p (sgml-attdecl-default-value attdecl)
+					'required)
+	collect
+	(sgml-make-attspec
+	 (sgml-attdecl-name attdecl)
+	 (sgml-read-attribute-value attdecl nil))))
+
+(defun sgml-tag-region (element start end)
+  "Reads element name from minibuffer and inserts start and end tags."
+  (interactive
+   (list
+    (save-excursion (goto-char (region-beginning))
+		    (sgml-read-element-name "Tag region with element: "))
+    (region-beginning)
+    (region-end)))
+  (save-excursion
+    (when (and element (not (equal element "")))
+      (goto-char end)
+      (insert (sgml-end-tag-of element))
+      (goto-char start)
+      (sgml-insert-tag (sgml-start-tag-of element)))))
+
+(defun sgml-insert-attributes (avl attlist)
+  "Insert the attributes with values AVL and declarations ATTLIST.
+AVL should be a assoc list mapping symbols to strings."
+  (let (name val dcl def tem)
+    (loop for attspec in attlist do
+	  (setq name (sgml-attspec-name attspec)
+		val (cdr-safe (sgml-lookup-attspec name avl))
+		dcl (sgml-attdecl-declared-value attspec)
+		def (sgml-attdecl-default-value attspec))
+	  (unless val			; no value given
+	    ;; Supply the default value if a value is needed
+	    (cond ((sgml-default-value-type-p 'required def)
+		   (setq val ""))
+		  ((and (not (or sgml-omittag sgml-shorttag))
+			(consp def))
+		   (setq val (sgml-default-value-attval def)))))
+	  (cond 
+	   ((null val))			; Ignore
+	   ;; Ignore attributes with default value
+	   ((and (consp def)		
+		 (eq sgml-minimize-attributes 'max)
+		 (or sgml-omittag sgml-shorttag)
+		 (equal val (sgml-default-value-attval def))))
+	   ;; No attribute name for token groups
+	   ((and sgml-minimize-attributes sgml-shorttag
+		 (member (sgml-general-case val)
+			 (sgml-declared-value-token-group dcl)))
+	    (insert " " val))
+	   (t
+	    (insert " " name "=" (sgml-quote-attribute-value val)))))
+    (when auto-fill-function
+      (funcall auto-fill-function))))
+
+
+(defun sgml-quote-attribute-value (value)
+  "Add quotes to the string VALUE unless minimization is on."
+  (let ((quote ""))
+	(cond ((and (not sgml-always-quote-attributes)
+		    sgml-shorttag
+		    (string-match "\\`[.A-Za-z0-9---]+\\'" value))
+	       ) ; no need to quote
+	      ((not (string-match "\"" value)) ; can use "" quotes
+	       (setq quote "\""))
+	      (t			; use '' quotes
+	       (setq quote "'")))
+	(concat quote value quote)))
+
+(defun sgml-completion-table (&optional avoid-tags-in-cdata)
+  (sgml-parse-to-here)
+  (when sgml-markup-type
+    (error "No tags allowed"))
+  (cond ((or (sgml-model-group-p sgml-current-state)
+	     (eq sgml-current-state sgml-any))
+	 (append
+	  (mapcar (function (lambda (x) (cons (sgml-end-tag-of x) x)))
+		  (sgml-current-list-of-endable-eltypes))
+	  (mapcar (function (lambda (x) (cons (sgml-start-tag-of x) x)))
+		  (sgml-current-list-of-valid-eltypes))))
+	(t
+	 (sgml-message "%s" sgml-current-state)
+	 nil)))
+
+(defun sgml-insert-end-tag ()
+  "Insert end-tag for the current open element."
+  (interactive "*")
+  (sgml-parse-to-here)
+  (cond
+   ((eq sgml-current-tree sgml-top-tree)
+    (sgml-error "No open element"))
+   ((not (sgml-final-p sgml-current-state))
+    (sgml-error "Can`t end element here"))
+   (t
+    (when (and sgml-indent-step
+	       (not (sgml-element-data-p sgml-current-tree)))
+      (delete-horizontal-space)
+      (unless (bolp)
+	(insert "\n")))
+    (when (prog1 (bolp)
+	    (insert (if (eq t (sgml-element-net-enabled sgml-current-tree))
+			"/"
+		      ;; wing change: If there is more than one endable
+		      ;; tag, we probably want the outermost one rather
+		      ;; than the innermost one.  Thus, we end a </ul>
+		      ;; even when a </li> is possible.
+		      (sgml-end-tag-of
+		       (car (last (sgml-current-list-of-endable-eltypes)))))))
+      (sgml-indent-line)))))
+
+(defun sgml-insert-start-tag (name asl attlist &optional net)
+  (insert "<" name)
+  (sgml-insert-attributes asl attlist)
+  (insert (if net "/" ">")))
+
+(defun sgml-change-start-tag (element asl)
+  (let ((name (sgml-element-gi element))
+	(attlist (sgml-element-attlist element)))
+    (assert (sgml-bpos-p (sgml-element-stag-epos element)))
+    (goto-char (sgml-element-start element))
+    (delete-char (sgml-element-stag-len element))
+    (sgml-insert-start-tag name asl attlist
+			   (eq t (sgml-element-net-enabled element)))))
+
+(defun sgml-read-attribute-value (attdecl curvalue)
+  "Return the attribute value read from user.
+ATTDECL is the attribute declaration for the attribute to read.
+CURVALUE is nil or a string that will be used as default value."
+  (assert attdecl)
+  (let* ((name (sgml-attdecl-name attdecl))
+	 (dv (sgml-attdecl-declared-value attdecl))
+	 (tokens (sgml-declared-value-token-group dv))
+	 (notations (sgml-declared-value-notation dv))
+	 (type (cond (tokens "token")
+		     (notations "notation")
+		     (t (symbol-name dv))))
+	 (prompt
+	  (format "Value for %s (%s%s): "
+		  name type
+		  (if curvalue
+		      (format " Default: %s" curvalue)
+		    "")))
+	 value)
+    (setq value 
+	  (if (or tokens notations)
+	      (completing-read prompt
+			       (mapcar 'list (or tokens notations))
+			       nil t)
+	    (read-string prompt)))
+    (if (and curvalue (equal value ""))
+	curvalue value)))
+
+(defun sgml-non-fixed-attributes (attlist)
+  (loop for attdecl in attlist
+	unless (sgml-default-value-type-p 'fixed 
+					  (sgml-attdecl-default-value attdecl))
+	collect attdecl))
+
+(defun sgml-insert-attribute (name value)
+  "Read attribute name and value from minibuffer and insert attribute spec."
+  (interactive
+   (let* ((el (sgml-find-attribute-element))
+	  (name
+	   (completing-read
+	    "Attribute name: "
+	    (mapcar (function (lambda (a) (list (sgml-attdecl-name a))))
+		    (sgml-non-fixed-attributes (sgml-element-attlist el)))
+	    nil t)))
+     (list name
+	   (sgml-read-attribute-value
+	    (sgml-lookup-attdecl name (sgml-element-attlist el))
+	    (sgml-element-attval el name)))))
+  ;; Body
+  (assert (stringp name))
+  (assert (or (null value) (stringp value)))
+  (let* ((el (sgml-find-attribute-element))
+	 (asl (cons (sgml-make-attspec name value)
+		    (sgml-element-attribute-specification-list el)))
+	 (in-tag (< (point) (sgml-element-stag-end el))))
+    (sgml-change-start-tag el asl)
+    (when in-tag (forward-char -1))))
+
+(defun sgml-split-element ()
+  "Split the current element at point.
+If repeated, the containing element will be split before the beginning
+of then current element."
+  (interactive "*")
+  (setq sgml-split-level
+	(if (eq this-command last-command)
+	    (1+ sgml-split-level)
+	  0))
+  (let ((u (sgml-find-context-of (point)))
+	(start (point-marker))
+	before)
+    (loop repeat sgml-split-level do
+	  (goto-char (sgml-element-start u))
+	  (setq u (sgml-element-parent u)))
+    ;; Verify that a new element can be started
+    (unless (and (sgml-element-pstate u) ; in case of top element
+		 (sgml-get-move (sgml-element-pstate u)
+				(sgml-element-name u)))
+      
+      (sgml-error "The %s element can't be split"
+		  (sgml-element-name u)))
+    ;; Do the split
+    (sgml-insert-end-tag)
+    (sgml-insert-tag (sgml-start-tag-of u) 'silent)
+    (skip-chars-forward " \t\n")
+    (sgml-indent-line)
+    (when (> sgml-split-level 0)
+      (goto-char start))
+    (or (eq sgml-top-tree
+	    (setq u (sgml-element-parent u)))
+	(sgml-message
+	 "Repeat the command to split the containing %s element"
+	 (sgml-element-name u)))))
+
+;;; David Megginson's custom menus for keys
+
+(defun sgml-custom-dtd (doctype)
+  "Insert a DTD declaration from the sgml-custom-dtd alist."
+  (interactive
+   (list (completing-read "Insert DTD: " sgml-custom-dtd nil t)))
+  (let ((entry (assoc doctype sgml-custom-dtd)))
+    (sgml-doctype-insert (second entry) (cddr entry))))
+
+(defun sgml-custom-markup (markup)
+  "Insert markup from the sgml-custom-markup alist."
+  (interactive
+   (list (completing-read "Insert Markup: " sgml-custom-markup nil t)))
+  (sgml-insert-markup (cadr (assoc markup sgml-custom-markup))))
+
+
+;;;; SGML mode: Menu inserting
+
+(defun sgml-tags-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-attrib-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-element-menu (event)
+  "Pop up a menu with valid elements and insert choice.
+If sgml-leave-point-after-insert is nil the point is left after the first 
+tag inserted."
+  (interactive "*e")
+  (let ((what (sgml-menu-ask event 'element)))
+    (and what (sgml-insert-element what))))
+
+(defun sgml-start-tag-menu (event)
+  "Pop up a menu with valid start-tags and insert choice."
+  (interactive "*e")
+  (let ((what (sgml-menu-ask event 'start-tag)))
+    (and what (sgml-insert-tag what))))
+
+(defun sgml-end-tag-menu (event)
+  "Pop up a menu with valid end-tags and insert choice."
+  (interactive "*e")
+  (let ((what (sgml-menu-ask event 'end-tag)))
+    (and what (sgml-insert-tag what))))
+
+(defun sgml-tag-region-menu (event)
+  "Pop up a menu with valid elements and tag current region with the choice."
+  (interactive "*e")
+  (let ((what (sgml-menu-ask event 'element)))
+    (and what (sgml-tag-region what
+			       (region-beginning)
+			       (region-end)))))
+
+(defun sgml-menu-ask (event type)
+  (sgml-parse-to-here)
+  (let (tab
+	(title (capitalize (symbol-name type))))
+    (cond
+     (sgml-markup-type)
+     ((eq type 'element)
+      (setq tab
+	    (mapcar (function symbol-name)
+		    (sgml-current-list-of-valid-eltypes))))
+     (t
+      (unless (eq type 'start-tag)
+	(setq tab
+	      (mapcar (function sgml-end-tag-of)
+		      (sgml-current-list-of-endable-eltypes))))
+      (unless (eq type 'end-tag)
+	(setq tab
+	      (nconc tab
+		     (mapcar (function sgml-start-tag-of)
+			     (sgml-current-list-of-valid-eltypes)))))))
+    (or tab
+	(error "No valid %s at this point" type))
+    (or
+     (sgml-popup-menu event
+		      title
+		      (mapcar (function (lambda (x) (cons x x)))
+			      tab))
+     (message nil))))
+
+(defun sgml-entities-menu (event)
+  (interactive "*e")
+  (sgml-need-dtd)
+  (let ((menu
+	 (mapcar (function (lambda (x) (cons x x)))
+		 (sort (sgml-map-entities (function sgml-entity-name)
+					  (sgml-dtd-entities sgml-dtd-info)
+					  t)
+		       (function string-lessp))))
+	choice)
+    (unless menu
+      (error "No entities defined"))
+    (setq choice (sgml-popup-menu event "Entities" menu))
+    (when choice
+      (insert "&" choice ";"))))
+
+(defun sgml-doctype-insert (doctype vars)
+  "Insert string DOCTYPE (ignored if nil) and set variables in &rest VARS.
+VARS should be a list of variables and values.
+For backward compatibility a singel string instead of a variable is 
+assigned to sgml-default-dtd-file.
+All variables are made buffer local and are also added to the
+buffers local variables list."
+  (when doctype
+    (unless (bolp)
+      (insert "\n"))
+    (unless (eolp)
+      (insert "\n")
+      (forward-char -1))
+    (sgml-insert-markup doctype))
+  (while vars
+    (cond ((stringp (car vars))
+	   (sgml-set-local-variable 'sgml-default-dtd-file (car vars))
+	   (setq vars (cdr vars)))
+	  ((car vars)			; Avoid nil
+	   (sgml-set-local-variable (car vars) (cadr vars))
+	   (setq vars (cddr vars)))))
+  (setq sgml-top-tree nil))
+
+(defun sgml-attrib-menu (event)
+  "Pop up a menu of the attributes of the current element
+\(or the element whith start-tag before point)."
+  (interactive "e")
+  (let* ((el (sgml-find-attribute-element))
+	 (attlist (sgml-non-fixed-attributes (sgml-element-attlist el)))
+	 tokens menu other)
+    (or attlist
+	(error "No non-fixed attributes for element"))
+    (setq menu
+	  (loop for attdecl in attlist
+		for name = (sgml-attdecl-name attdecl)
+		for defval = (sgml-attdecl-default-value attdecl)
+		for tokens = (or (sgml-declared-value-token-group
+				  (sgml-attdecl-declared-value attdecl))
+				 (sgml-declared-value-notation
+				  (sgml-attdecl-declared-value attdecl)))
+		collect
+		(cons
+		 (sgml-attdecl-name attdecl)
+		 (nconc
+		  (if tokens
+		      (loop for val in tokens collect
+			    (list val
+				  (list 'sgml-insert-attribute name val)))
+		    (list
+		     (list "Set attribute value"
+			   (list 'sgml-insert-attribute
+				 (sgml-attdecl-name attdecl) 
+				 (list 'sgml-read-attribute-value
+				       (list 'quote attdecl)
+				       (sgml-element-attval el name))))))
+		  (if (sgml-default-value-type-p 'required defval)
+		      nil
+		    (list "--"
+			  (list (if (sgml-default-value-type-p nil defval)
+				    (format "Default: %s"
+					    (sgml-default-value-attval defval))
+				  "#IMPLIED")
+				(list 'sgml-insert-attribute name nil))))))))
+    (sgml-popup-multi-menu event "Attributes" menu)))
+
+;;;; SGML mode: Fill 
+
+(defun sgml-fill-element (element)
+  "Fill bigest enclosing element with mixed content.
+If current element has pure element content, recursively fill the
+subelements."
+  (interactive (list (sgml-find-element-of (point))))
+  ;;
+  (message "Filling...")
+  (when (sgml-element-mixed element)
+    ;; Find bigest enclosing element with mixed content
+    (while (sgml-element-mixed (sgml-element-parent element))
+      (setq element (sgml-element-parent element))))
+  ;; 
+  (sgml-do-fill element)
+  (sgml-message "Done"))
+
+(defun sgml-do-fill (element)
+  (when sgml-debug
+    (goto-char (sgml-element-start element))
+    (sit-for 0))
+  (save-excursion
+    (cond
+     ((sgml-element-mixed element)
+      (let (last-pos
+	    (c (sgml-element-content element))
+	    (agenda nil))		; regions to fill later
+	(goto-char (sgml-element-stag-end element))
+	(when (eolp) (forward-char 1))
+	(setq last-pos (point))
+	(while c
+	  (cond
+	   ((sgml-element-mixed c))
+	   (t
+	    ;; Put region before element on agenda.  Can't fill it now
+	    ;; that would mangel the parse tree that is beeing traversed.
+	    (push (cons last-pos (sgml-element-start c))
+		  agenda)
+	    (goto-char (sgml-element-start c))
+	    (sgml-do-fill c)
+	    ;; Fill may change parse tree, get a fresh
+	    (setq c (sgml-find-element-of (point)))
+	    (setq last-pos (sgml-element-end c))))
+	  (setq c (sgml-element-next c)))
+	;; Fill the last region in content of element,
+	;; but get a fresh parse tree, if it has change due to other fills.
+	(sgml-fill-region last-pos
+			  (sgml-element-etag-start
+			   (sgml-find-element-of
+			    (sgml-element-start element))))
+	(while agenda
+	  (sgml-fill-region (caar agenda) (cdar agenda))
+	  (setq agenda (cdr agenda)))))
+     (t
+      ;; If element is not mixed, fill subelements recursively
+      (let ((c (sgml-element-content element)))
+	(while c
+	  (goto-char (sgml-element-start c))
+	  (sgml-do-fill c)
+	  (setq c (sgml-element-next (sgml-find-element-of (point))))))))))
+
+(defun sgml-fill-region (start end)
+  (sgml-message "Filling...")
+  (save-excursion
+    (goto-char end)
+    (skip-chars-backward " \t\n")
+    (while (progn (beginning-of-line 1)
+		  (< start (point)))
+      (delete-horizontal-space)
+      (delete-char -1)
+      (insert " "))
+    (end-of-line 1)
+    (let (give-up prev-column opoint)
+      (while (and (not give-up) (> (current-column) fill-column))
+	(setq prev-column (current-column))
+	(setq opoint (point))
+	(move-to-column (1+ fill-column))
+	(skip-chars-backward "^ \t\n")
+	(if (bolp)
+	    (re-search-forward "[ \t]" opoint t))
+	(setq opoint (point))
+	(skip-chars-backward " \t")
+	(if (bolp)
+	    (setq give-up t)
+	(delete-region (point) opoint)
+	(newline)
+	(sgml-indent-line)
+	(end-of-line 1)
+	(setq give-up (>= (current-column) prev-column)))))))
+
+;;;; SGML mode: Attribute editing
+
+(defvar sgml-start-attributes nil)
+(defvar sgml-main-buffer nil)
+(defvar sgml-attlist nil)
+
+(defun sgml-edit-attributes ()
+  "Edit attributes of current element.
+Editing is done in a separate window."
+  (interactive)
+  (let ((element (sgml-find-attribute-element)))
+    (unless (sgml-bpos-p (sgml-element-stag-epos element))
+      (error "Element's start-tag is not in the buffer"))
+    (push-mark)
+    (goto-char (sgml-element-start element))
+    (let* ((start (point-marker))
+	   (asl (sgml-element-attribute-specification-list element))
+	   (cb (current-buffer))
+	   (quote sgml-always-quote-attributes))
+       (switch-to-buffer-other-window
+	(sgml-attribute-buffer element asl))
+       (sgml-edit-attrib-mode)
+       (make-local-variable 'sgml-attlist)
+       (setq sgml-attlist (sgml-element-attlist element))
+       (make-local-variable 'sgml-start-attributes)
+       (setq sgml-start-attributes start)
+       (make-local-variable 'sgml-always-quote-attributes)
+       (setq sgml-always-quote-attributes quote)
+       (make-local-variable 'sgml-main-buffer)
+       (setq sgml-main-buffer cb))))
+
+(defun sgml-attribute-buffer (element asl)
+  (let ((bname "*Edit attributes*")
+	(buf nil)
+	(inhibit-read-only t))
+    (save-excursion
+      (when (setq buf (get-buffer bname))
+	(kill-buffer buf))
+      (setq buf (get-buffer-create bname))
+      (set-buffer buf)
+      (erase-buffer)
+      (sgml-insert '(read-only t rear-nonsticky (read-only))
+		   "<%s  -- Edit values and finish with C-c C-c --\n"
+		   (sgml-element-name element))
+      (loop
+       for attr in (sgml-element-attlist element) do
+       ;; Produce text like
+       ;;  name = value
+       ;;  -- declaration : default --
+       (let* ((aname (sgml-attdecl-name attr))
+	      (dcl-value (sgml-attdecl-declared-value attr))
+	      (def-value (sgml-attdecl-default-value attr))
+	      (cur-value (sgml-lookup-attspec aname asl)))
+	 (sgml-insert			; atribute name
+	  '(read-only t rear-nonsticky (read-only))
+	  " %s = " aname)
+	 (cond				; attribute value
+	  ((sgml-default-value-type-p 'fixed def-value)
+	   (sgml-insert '(read-only t category sgml-fixed
+				    rear-nonsticky (category))
+			"#FIXED %s"
+			(sgml-default-value-attval def-value)))
+	  ((and (null cur-value)
+		(or (memq def-value '(implied conref current))
+		    (sgml-default-value-attval def-value)))
+	   (sgml-insert '(category sgml-default rear-nonsticky (category))
+			"#DEFAULT"))
+	  ((not (null cur-value))
+	   (sgml-insert nil "%s" (sgml-attspec-attval cur-value))))
+	 (sgml-insert
+	  '(read-only 1)
+	  "\n\t-- %s: %s --\n"
+	  (cond ((sgml-declared-value-token-group dcl-value))
+		((sgml-declared-value-notation dcl-value)
+		 (format "NOTATION %s"
+			 (sgml-declared-value-notation dcl-value)))
+		(t
+		 dcl-value))
+	  (cond ((sgml-default-value-attval def-value))
+		(t
+		 (concat "#" (upcase (symbol-name def-value))))))))
+      (sgml-insert '(read-only t) ">")
+      (goto-char (point-min))
+      (sgml-edit-attrib-next))
+    buf))
+
+(defvar sgml-edit-attrib-mode-map (make-sparse-keymap))
+(define-key sgml-edit-attrib-mode-map "\C-c\C-c" 'sgml-edit-attrib-finish)
+(define-key sgml-edit-attrib-mode-map "\C-c\C-d" 'sgml-edit-attrib-default)
+(define-key sgml-edit-attrib-mode-map "\C-c\C-k" 'sgml-edit-attrib-clear)
+
+(define-key sgml-edit-attrib-mode-map "\C-a"  'sgml-edit-attrib-field-start)
+(define-key sgml-edit-attrib-mode-map "\C-e"  'sgml-edit-attrib-field-end)
+(define-key sgml-edit-attrib-mode-map "\t"  'sgml-edit-attrib-next)
+
+(defun sgml-edit-attrib-mode ()
+  "Major mode to edit attribute specification list.\\<sgml-edit-attrib-mode-map>
+Use \\[sgml-edit-attrib-next] to move between input fields.  Use
+\\[sgml-edit-attrib-default] to make an attribute have its default
+value.  To abort edit kill buffer (\\[kill-buffer]) and remove window
+(\\[delete-window]).  To finsh edit use \\[sgml-edit-attrib-finish].
+
+\\{sgml-edit-attrib-mode-map}"
+  (kill-all-local-variables)
+  (setq mode-name "SGML edit attributes"
+	major-mode 'sgml-edit-attrib-mode)
+  (use-local-map sgml-edit-attrib-mode-map)
+  (run-hooks 'text-mode-hook 'sgml-edit-attrib-mode-hook))
+
+(defun sgml-edit-attrib-finish ()
+  "Finish editing and insert attribute values in original buffer."
+  (interactive)
+  (let ((cb (current-buffer))
+	(asl (sgml-edit-attrib-specification-list))
+	;; save buffer local variables
+	(start sgml-start-attributes))
+    (when (markerp start)
+      (delete-windows-on cb)
+      (switch-to-buffer (marker-buffer start))
+      (kill-buffer cb)
+      (goto-char start)
+      (let ((element (sgml-find-element-of start)))
+	;; *** Should the it be verified that this element
+	;; is the one edited?
+	(sgml-change-start-tag element asl)))))
+
+
+(defun sgml-edit-attrib-specification-list ()
+  (goto-char (point-min))
+  (forward-line 1)
+  (sgml-with-parser-syntax
+   (let ((asl nil)
+	 (al sgml-attlist))
+     (while (not (eq ?> (following-char)))
+       (sgml-parse-s)
+       (let ((name (sgml-check-nametoken)))
+	 (forward-char 3)
+	 (unless (memq (get-text-property (point) 'category)
+		       '(sgml-default sgml-fixed))
+	   (push
+	    (sgml-make-attspec (sgml-attdecl-name (car al))
+			       (sgml-extract-attribute-value
+				(sgml-attdecl-declared-value (car al))))
+	    asl))
+	 (while (progn (beginning-of-line 2)
+		       (or (eolp)
+			   (not (get-text-property (point) 'read-only))))))
+					; was (eq t)
+       (forward-line 1)
+       (setq al (cdr al)))
+     asl)))
+
+
+(defun sgml-extract-attribute-value (type)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region (point)
+			(progn (sgml-edit-attrib-field-end)
+			       (point)))
+      (unless (eq type 'cdata)
+	(subst-char-in-region (point-min) (point-max) ?\n ? )
+	(goto-char (point-min))
+	(delete-horizontal-space))
+      (goto-char (point-min))
+      (when (search-forward "\"" nil t)	; don't allow both " and '
+	(goto-char (point-min))
+	(while (search-forward "'" nil t) ; replace ' with char ref
+	  (replace-match "&#39;")))
+      (buffer-string))))
+
+(defun sgml-edit-attrib-default ()
+  "Set current attribute value to default."
+  (interactive)
+  (sgml-edit-attrib-clear)
+  (save-excursion
+    (sgml-insert '(category sgml-default)
+		 "#DEFAULT")))
+
+(defun sgml-edit-attrib-clear ()
+  "Kill the value of current attribute."
+  (interactive)
+  (kill-region
+   (progn (sgml-edit-attrib-field-start) (point))
+   (progn (sgml-edit-attrib-field-end) (point))))
+
+(defun sgml-edit-attrib-field-start ()
+  "Go to the start of the attribute value field."
+  (interactive)
+  (let (start)
+        (beginning-of-line 1)
+    (while (not (eq t (get-text-property (point) 'read-only)))
+      (beginning-of-line 0))
+    (setq start (next-single-property-change (point) 'read-only))
+    (unless start (error "No attribute value here"))
+    (assert (number-or-marker-p start))
+    (goto-char start)))
+
+(defun sgml-edit-attrib-field-end ()
+  "Go to the end of the attribute value field."
+  (interactive)
+  (sgml-edit-attrib-field-start)
+  (let ((end (if (and (eolp)
+		      (get-text-property (1+ (point)) 'read-only))
+		 (point)
+	       (next-single-property-change (point) 'read-only))))
+    (assert (number-or-marker-p end))
+    (goto-char end)))
+
+(defun sgml-edit-attrib-next ()
+  "Move to next attribute value."
+  (interactive)
+  (or (search-forward-regexp "^ *[.A-Za-z0-9---]+ *= ?" nil t)
+      (goto-char (point-min))))
+
+
+;;;; SGML mode: Hiding tags/attributes
+
+(defconst sgml-tag-regexp
+  "\\(</?>\\|</?[A-Za-z][---A-Za-z0-9.]*\\(\\([^'\"></]\\|'[^']*'\\|\"[^\"]*\"\\)*\\)>?\\)")
+
+(defun sgml-operate-on-tags (action &optional attr-p)
+  (let ((buffer-modified-p (buffer-modified-p))
+	(inhibit-read-only t)
+	(buffer-read-only nil)
+	(before-change-function nil)
+	(markup-index			; match-data index in tag regexp
+	 (if attr-p 2 1))
+	(tagcount			; number tags to give them uniq
+					; invisible properties
+	 1))
+    (unwind-protect
+	(save-excursion
+	  (goto-char (point-min))
+	  (while (re-search-forward sgml-tag-regexp nil t)
+	    (cond
+	     ((eq action 'hide)
+	      (let ((tag (downcase
+			  (buffer-substring (1+ (match-beginning 0))
+					    (match-beginning 1)))))
+		(if (or attr-p (not (member tag sgml-exposed-tags)))
+		    (add-text-properties
+		     (match-beginning markup-index) (match-end markup-index)
+		     (list 'invisible tagcount
+			   'rear-nonsticky '(invisible face))))))
+	     ((eq action 'show)		; ignore markup-index
+	      (remove-text-properties (match-beginning 0) (match-end 0)
+				      '(invisible nil)))
+	     (t (error "Invalid action: %s" action)))
+	    (incf tagcount)))
+      (set-buffer-modified-p buffer-modified-p))))
+
+(defun sgml-hide-tags ()
+  "Hide all tags in buffer."
+  (interactive)
+  (sgml-operate-on-tags 'hide))
+
+(defun sgml-show-tags ()
+  "Show hidden tags in buffer."
+  (interactive)
+  (sgml-operate-on-tags 'show))
+
+(defun sgml-hide-attributes ()
+  "Hide all attribute specifications in the buffer."
+  (interactive)
+  (sgml-operate-on-tags 'hide 'attributes))
+
+(defun sgml-show-attributes ()
+  "Show all attribute specifications in the buffer."
+  (interactive)
+  (sgml-operate-on-tags 'show 'attributes))
+
+
+;;;; SGML mode: Normalize (and misc manipulations)
+
+(defun sgml-expand-shortref-to-text (name)
+  (let (before-change-function
+	(entity (sgml-lookup-entity name (sgml-dtd-entities sgml-dtd-info))))
+    (cond
+     ((null entity) (sgml-error "Undefined entity %s" name))
+     ((sgml-entity-data-p entity)
+      (sgml-expand-shortref-to-entity name))
+     (t
+      (delete-region sgml-markup-start (point))
+      (sgml-entity-insert-text entity)
+      (setq sgml-goal (point-max))	; May have changed size of buffer
+      ;; now parse the entity text
+      (goto-char (setq sgml-rs-ignore-pos sgml-markup-start))))))
+
+(defun sgml-expand-shortref-to-entity (name)
+  (let ((end (point))
+	(re-found nil)
+	before-change-function)
+    (goto-char sgml-markup-start)
+    (setq re-found (search-forward "\n" end t))
+    (delete-region sgml-markup-start end)	   
+    (insert "&" name (if re-found "\n" ";"))
+    (setq sgml-goal (point-max))	; May have changed size of buffer
+    (goto-char (setq sgml-rs-ignore-pos sgml-markup-start))))
+
+(defun sgml-expand-all-shortrefs (to-entity)
+  "Expand all short references in the buffer.
+Short references to text entities are expanded to the replacement text
+of the entity other short references are expanded into general entity
+references.  If argument, TO-ENTITY, is non-nil, or if called
+interactive with numeric prefix argument, all short references are
+replaced by generaly entity references."
+  (interactive "*P")
+  (sgml-reparse-buffer
+   (if to-entity
+       (function sgml-expand-shortref-to-entity)
+     (function sgml-expand-shortref-to-text))))
+
+(defun sgml-normalize (to-entity &optional element)
+  "Normalize buffer by filling in omitted tags and expanding empty tags.
+Argument TO-ENTITY controls how short references are expanded as with
+`sgml-expand-all-shortrefs'.  An optional argument ELEMENT can be the
+element to normalize insted of the whole buffer, if used no short
+references will be expanded."
+  (interactive "*P")
+  (unless element
+    (sgml-expand-all-shortrefs to-entity))
+  (let ((only-one (not (null element))))
+    (setq element (or element (sgml-top-element)))
+    (goto-char (sgml-element-end element)) 
+    (let ((before-change-function nil))
+      (sgml-normalize-content element only-one)))
+  (sgml-note-change-at (sgml-element-start element))
+  (sgml-message "Done"))
+
+(defun sgml-normalize-element ()
+  (interactive "*")
+  (sgml-normalize nil (sgml-find-element-of (point))))
+
+(defun sgml-normalize-content (element only-first)
+  "Normalize all elements in a content where ELEMENT is first element.
+If sgml-normalize-trims is non-nil, trim off white space from ends of
+elements with omitted end-tags."
+  (let ((content nil))
+    (while element			; Build list of content elements
+      (push element content)
+      (setq element (if only-first
+			nil
+		      (sgml-element-next element))))
+    (while content
+      (setq element (car content))
+      ;; Progress report
+      (sgml-lazy-message "Normalizing %d%% left"
+			 (/ (point) (/ (+ (point-max) 100) 100)))
+      ;; Fix the end-tag
+      (sgml-normalize-end-tag element)
+      ;; Fix tags of content
+      (sgml-normalize-content (sgml-tree-content element) nil)
+      ;; Fix the start-tag
+      (sgml-normalize-start-tag element)
+      ;; Next content element
+      (setq content (cdr content)))))
+
+(defun sgml-normalize-start-tag (element)
+  (when (sgml-bpos-p (sgml-element-stag-epos element))
+    (goto-char (min (point) (sgml-element-start element)))
+    (let ((name (sgml-element-gi element))
+	  (attlist (sgml-element-attlist element))
+	  (asl (sgml-element-attribute-specification-list element)))
+      (save-excursion
+	(assert (or (zerop (sgml-element-stag-len element))
+		    (= (point) (sgml-element-start element))))
+	(delete-char (sgml-element-stag-len element))
+	(sgml-insert-start-tag name asl attlist nil)))))
+
+(defun sgml-normalize-end-tag (element)
+  (unless (sgml-element-empty element)
+    (when (sgml-bpos-p (sgml-element-etag-epos element))
+      (goto-char (min (point) (sgml-element-etag-start element)))    
+      (if (and (zerop (sgml-element-etag-len element))
+	       sgml-normalize-trims)
+	  (skip-chars-backward " \t\n\r"))
+      (delete-char (sgml-tree-etag-len element))
+      (save-excursion (insert (sgml-end-tag-of element))))))
+
+
+(defun sgml-make-character-reference (&optional invert)
+  "Convert character after point into a character reference.
+If called with a numeric argument, convert a character reference back
+to a normal character.  If called from a program, set optional
+argument INVERT to non-nil."
+  (interactive "*P")
+  (cond
+   (invert
+    (or (looking-at "&#\\([0-9]+\\)[;\n]?")
+	(error "No character reference after point"))
+    (let ((c (string-to-int (buffer-substring (match-beginning 1)
+					      (match-end 1)))))
+      (delete-region (match-beginning 0)
+		     (match-end 0))
+      (insert c)))
+   ;; Convert character to &#nn;
+   (t
+    (let ((c (following-char)))
+      (delete-char 1)
+      (insert (format "&#%d;" c))))))
+
+(defun sgml-expand-entity-reference ()
+  "Insert the text of the entity referenced at point."
+  (interactive)
+  (sgml-with-parser-syntax
+   (setq sgml-markup-start (point))
+   (sgml-check-delim "ERO")
+   (let* ((ename (sgml-check-name t))
+	  (entity (sgml-lookup-entity ename
+				      (sgml-dtd-entities
+				       (sgml-pstate-dtd
+					sgml-buffer-parse-state)))))
+     (unless entity
+       (error "Undefined entity %s" ename))
+     (or (sgml-parse-delim "REFC")
+	 (sgml-parse-RE))
+     (delete-region sgml-markup-start (point))
+     (sgml-entity-insert-text entity))))
+
+
+;;;; SGML mode: TAB completion
+
+(defun sgml-complete ()
+  "Complete the word/tag/entity before point.
+If it is a tag (starts with < or </) complete with valid tags.
+If it is an entity (starts with &) complete with declared entities.
+If it is a markup declaration (starts with <!) complete with markup 
+declaration names.
+If it is something else complete with ispell-complete-word."
+  (interactive "*")
+  (let ((tab				; The completion table
+	 nil)
+	(pattern nil)
+	(c nil)
+	(here (point)))
+    (skip-chars-backward "^ \n\t</!&%")
+    (setq pattern (buffer-substring (point) here))
+    (setq c (char-after (1- (point))))
+    (cond
+     ;; entitiy
+     ((eq c ?&)
+      (sgml-need-dtd)
+      (setq tab
+	    (sgml-entity-completion-table
+	     (sgml-dtd-entities (sgml-pstate-dtd sgml-buffer-parse-state)))))
+     ;; start-tag
+     ((eq c ?<)
+      (save-excursion
+	(backward-char 1)
+	(sgml-parse-to-here)
+	(setq tab (sgml-eltype-completion-table
+		   (sgml-current-list-of-valid-eltypes)))))
+     ;; end-tag
+     ((eq c ?/)
+      (save-excursion
+	(backward-char 2)
+	(sgml-parse-to-here)
+	(setq tab (sgml-eltype-completion-table
+		   (sgml-current-list-of-endable-eltypes)))))
+     ;; markup declaration
+     ((eq c ?!)
+      (setq tab sgml-markup-declaration-table))
+     (t
+      (goto-char here)
+      (ispell-complete-word)))
+    (when tab
+      (let ((completion (try-completion pattern tab)))
+	(cond ((null completion)
+	       (goto-char here)
+	       (message "Can't find completion for \"%s\"" pattern)
+	       (ding))
+	      ((eq completion t)
+	       (goto-char here)
+	       (message "[Complete]"))
+	      ((not (string= pattern completion))
+	       (delete-char (length pattern))
+	       (insert completion))
+	      (t
+	       (goto-char here)
+	       (message "Making completion list...")
+	       (let ((list (all-completions pattern tab)))
+		 (with-output-to-temp-buffer " *Completions*"
+		   (display-completion-list list)))
+	       (message "Making completion list...%s" "done")))))))
+
+
+;;;; SGML mode: Options menu
+
+(defun sgml-file-options-menu (&optional event)
+  (interactive "e")
+  (sgml-options-menu event sgml-file-options))
+
+(defun sgml-user-options-menu (&optional event)
+  (interactive "e")
+  (sgml-options-menu event sgml-user-options))
+
+(defun sgml-options-menu (event vars)
+  (let ((var
+	 (let ((maxlen 
+		(loop for var in vars
+		      maximize (length (sgml-variable-description var)))))
+	   (sgml-popup-menu
+	    event "Options"
+	    (loop for var in vars
+		  for desc = (sgml-variable-description var)
+		  collect
+		  (cons
+		   (format "%s%s [%s]"
+			   desc
+			   (make-string (- maxlen (length desc)) ? )
+			   (sgml-option-value-indicator var))
+		   var))))))
+    (when var
+      (sgml-do-set-option var event))))
+
+(defun sgml-do-set-option (var &optional event)
+  (let ((type (sgml-variable-type var))
+	(val (symbol-value var)))
+    (cond
+     ((eq 'toggle type)
+      (message "%s set to %s" var (not val))
+      (set var (not val)))
+     ((eq 'string type)
+      (describe-variable var)
+      (setq val (read-string (concat (sgml-variable-description var) ": ")))
+      (when (stringp val)
+	(set var val)))
+     ((consp type)
+      (let ((val
+	     (sgml-popup-menu event
+			      (sgml-variable-description var)
+			      (loop for c in type collect
+				    (cons
+				     (if (consp c) (car c) (format "%s" c))
+				     (if (consp c) (cdr c) c))))))
+	(set var val)
+	(message "%s set to %s" var val)))
+     (t
+      (describe-variable var)
+      (setq val (read-string (concat (sgml-variable-description var)
+				     " (sexp): ")))
+      (when (stringp val)
+	(set var (car (read-from-string val)))))))
+  (force-mode-line-update))
+
+(defun sgml-option-value-indicator (var)
+  (let ((type (sgml-variable-type var))
+	(val (symbol-value var)))
+    (cond
+     ((eq type 'toggle)
+      (if val "Yes" "No"))
+     ((eq type 'string)
+      (if (stringp val)
+	  (substring val 0 4)
+	"-"))
+     ((and (atom type) val)
+      "...")
+     ((consp type)
+      (or (car (rassq val type))
+	  val))
+     (t
+      "-"))))
+
+;;;; 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))
+
+
+;;; psgml-edit.el ends here