--- a/lisp/psgml/psgml-edit.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/psgml/psgml-edit.el	Mon Aug 13 08:46:35 2007 +0200
@@ -1,5 +1,6 @@
 ;;; 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 $
+;;-*-byte-compile-warnings:(free-vars unused-vars unresolved callargs redefine)-*-
+;; $Id: psgml-edit.el,v 1.1.1.2 1996/12/18 03:47:14 steve Exp $
 
 ;; Copyright (C) 1994, 1995, 1996 Lennart Staflin
 
@@ -30,6 +31,7 @@
 (provide 'psgml-edit)
 (require 'psgml)
 (require 'psgml-parse)
+(require 'tempo)
 
 
 ;;;; Variables
@@ -105,6 +107,8 @@
   (interactive)
   (let ((to
 	 (sgml-find-element-after (point) (sgml-last-element))))
+    (when (sgml-strict-epos-p (sgml-element-stag-epos to))
+      (error "Sub-element in other entity"))
     (goto-char (sgml-element-stag-end to))
     (sgml-set-last-element (if (sgml-element-empty to)
 			       (sgml-element-parent to)
@@ -169,10 +173,10 @@
     (unless (sgml-element-empty element)
       (goto-char (sgml-element-end element))
       (delete-char (- (sgml-element-etag-len element)))
-      (insert (sgml-end-tag-of gi)))
+      (tempo-process-and-insert-string (sgml-end-tag-of gi)))
     (goto-char (sgml-element-start element))
     (delete-char (sgml-element-stag-len element))
-    (insert (sgml-start-tag-of gi))
+    (tempo-process-and-insert-string (sgml-start-tag-of gi))
     (forward-char -1)
     (let* ((newel (sgml-find-element-of (point)))
 	   (newattlist (sgml-element-attlist newel))
@@ -298,8 +302,6 @@
 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)
@@ -363,6 +365,7 @@
 	(sgml-with-parser-syntax
 	 (let ((stag (sgml-is-start-tag))
 	       (etag (sgml-is-end-tag)))
+	   ;; Wing change
 	   (when (and
 		  (not (member* (sgml-element-gi
 				 (if (or stag etag)
@@ -415,8 +418,7 @@
   (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))
+  (let ((sgml-throw-on-warning 'trouble))
     (or (catch sgml-throw-on-warning
 	  (sgml-parse-until-end-of nil t))
 	(message "Ok"))))
@@ -429,7 +431,10 @@
   "Display a list of the contextually valid tags."
   (interactive)
   (sgml-parse-to-here)
-  (let ((model (sgml-element-model sgml-current-tree)))
+  (let ((model (sgml-element-model sgml-current-tree))
+	(smap-name (sgml-lookup-shortref-name
+		    (sgml-dtd-shortmaps sgml-dtd-info)
+		    sgml-current-shortmap)))
     (with-output-to-temp-buffer "*Tags*"
       (princ (format "Current element: %s  %s\n"
 		     (sgml-element-name sgml-current-tree)
@@ -447,6 +452,9 @@
 		     (if (eq model sgml-any)
 			 "[ANY]" "")))
       
+      (when smap-name
+	(princ (format "Current short reference map: %s\n" smap-name)))
+      
       (cond ((sgml-final-p sgml-current-state)
 	     (princ "Valid end-tags : ")
 	     (loop for e in (sgml-current-list-of-endable-eltypes)
@@ -540,7 +548,12 @@
 (defun sgml-what-element ()
   "Display what element is under the cursor."
   (interactive)
-  (let ((el (sgml-find-element-of (point))))
+  (let* ((pos (point))
+	 (nobol (eq (point) sgml-rs-ignore-pos))
+	 (sref (sgml-deref-shortmap sgml-current-shortmap nobol))
+	 (el nil))
+    (goto-char pos)
+    (setq el (sgml-find-element-of pos))
     (assert (not (null el)))
     (message "%s %s"
 	     (cond ((eq el sgml-top-tree)
@@ -549,6 +562,8 @@
 		    "start-tag")
 		   ((>= (point) (sgml-element-etag-start el))
 		    "end-tag")
+		   (sref
+		    "shortref")
 		   (t
 		    "content"))
 	     (sgml-element-context-string el))))
@@ -575,7 +590,7 @@
 	       (fixup-whitespace)))
 	  (t
 	   (insert "\n"))))
-  (insert tag)
+  (tempo-process-and-insert-string tag)
   (sgml-indent-line)  
   (unless no-nl-after
     (save-excursion
@@ -645,14 +660,14 @@
   (save-excursion
     (when (and element (not (equal element "")))
       (goto-char end)
-      (insert (sgml-end-tag-of element))
+      (tempo-process-and-insert-string (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)
+  (let (name val dcl def)
     (loop for attspec in attlist do
 	  (setq name (sgml-attspec-name attspec)
 		val (cdr-safe (sgml-lookup-attspec name avl))
@@ -676,9 +691,10 @@
 	   ((and sgml-minimize-attributes sgml-shorttag
 		 (member (sgml-general-case val)
 			 (sgml-declared-value-token-group dcl)))
-	    (insert " " val))
+	    (tempo-process-and-insert-string (concat " " val)))
 	   (t
-	    (insert " " name "=" (sgml-quote-attribute-value val)))))
+	    (tempo-process-and-insert-string (concat " " name "="))
+	    (insert (sgml-quote-attribute-value val)))))
     (when auto-fill-function
       (funcall auto-fill-function))))
 
@@ -711,6 +727,11 @@
 	 (sgml-message "%s" sgml-current-state)
 	 nil)))
 
+(defun sgml-element-endable-p ()
+  (sgml-parse-to-here)
+  (and (not (eq sgml-current-tree sgml-top-tree))
+       (sgml-final-p sgml-current-state)))
+
 (defun sgml-insert-end-tag ()
   "Insert end-tag for the current open element."
   (interactive "*")
@@ -727,18 +748,19 @@
       (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)))))))
+	    (tempo-process-and-insert-string
+	      (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)
+  (tempo-process-and-insert-string (concat "<" name))
   (sgml-insert-attributes asl attlist)
   (insert (if net "/" ">")))
 
@@ -819,8 +841,7 @@
 	    (1+ sgml-split-level)
 	  0))
   (let ((u (sgml-find-context-of (point)))
-	(start (point-marker))
-	before)
+	(start (point-marker)))
     (loop repeat sgml-split-level do
 	  (goto-char (sgml-element-start u))
 	  (setq u (sgml-element-parent u)))
@@ -964,7 +985,7 @@
 (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 
+For backward compatibility a single 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."
@@ -988,43 +1009,44 @@
   "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)
+    (let ((menu (sgml-make-attrib-menu (sgml-find-attribute-element))))
+      (sgml-popup-multi-menu event "Attributes" menu)))
+
+(defun sgml-make-attrib-menu (el)
+  (let ((attlist (sgml-non-fixed-attributes (sgml-element-attlist el))))
     (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)))
+    (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 mode: Fill 
 
@@ -1251,19 +1273,19 @@
 	 (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)
+       (sgml-check-nametoken)		; attribute name, should match head of al
+       (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)))))
+
        (forward-line 1)
        (setq al (cdr al)))
      asl)))
@@ -1353,8 +1375,9 @@
 	    (cond
 	     ((eq action 'hide)
 	      (let ((tag (downcase
-			  (buffer-substring (1+ (match-beginning 0))
-					    (match-beginning 1)))))
+			  (buffer-substring-no-properties
+			   (1+ (match-beginning 0))
+			   (match-beginning 2)))))
 		(if (or attr-p (not (member tag sgml-exposed-tags)))
 		    (add-text-properties
 		     (match-beginning markup-index) (match-end markup-index)
@@ -1402,7 +1425,8 @@
       (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))))))
+      (setq sgml-rs-ignore-pos sgml-markup-start)
+      (goto-char sgml-markup-start)))))
 
 (defun sgml-expand-shortref-to-entity (name)
   (let ((end (point))
@@ -1493,7 +1517,7 @@
 	       sgml-normalize-trims)
 	  (skip-chars-backward " \t\n\r"))
       (delete-char (sgml-tree-etag-len element))
-      (save-excursion (insert (sgml-end-tag-of element))))))
+      (save-excursion (tempo-process-and-insert-string (sgml-end-tag-of element))))))
 
 
 (defun sgml-make-character-reference (&optional invert)