--- a/lisp/psgml/psgml-other.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/psgml/psgml-other.el	Mon Aug 13 08:46:35 2007 +0200
@@ -1,5 +1,5 @@
 ;;;; psgml-other.el --- Part of SGML-editing mode with parsing support
-;; $Id: psgml-other.el,v 1.1.1.1 1996/12/18 03:35:21 steve Exp $
+;; $Id: psgml-other.el,v 1.1.1.2 1996/12/18 03:47:14 steve Exp $
 
 ;; Copyright (C) 1994 Lennart Staflin
 
@@ -23,9 +23,7 @@
 
 ;;;; Commentary:
 
-;;; Part of psgml.el
-
-;;; Menus for use with FSF Emacs 19
+;;; Part of psgml.el. Code not compatible with XEmacs.
 
 
 ;;;; Code:
@@ -38,115 +36,6 @@
 into several panes.")
 
 
-;;;; Menu bar
-
-(easy-menu-define
- sgml-dtd-menu sgml-mode-map "DTD menu"
- '("DTD"))
-
-(defconst sgml-dtd-root-menu
-  '("DTD"
-    ["Parse DTD"  sgml-parse-prolog t]
-    ("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
- sgml-view-menu sgml-mode-map "View menu"
- '("View"
-   ["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")
-)
-
-(defconst sgml-markup-root-menu
-  '("Markup"
-    ["Insert Element"	sgml-element-menu	t]
-    ["Insert Start-Tag" sgml-start-tag-menu	t]
-    ["Insert End-Tag"	sgml-end-tag-menu	t]
-    ["Tag Region"	sgml-tag-region-menu	t]
-    ["Insert Attribute" sgml-attrib-menu	t]
-    ["Insert Entity"	sgml-entities-menu	t]
-    ))
-
-(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"
-   ["Normalize"			sgml-normalize	t]
-   ["Expand All Short References"	sgml-expand-all-shortrefs t]
-   ["Expand Entity Reference"	sgml-expand-entity-reference t]
-   ["Normalize Element"		sgml-normalize-element t]
-   ["Make Character Reference"	sgml-make-character-reference t]
-   ["Unmake Character Reference"	(sgml-make-character-reference t) t]
-   ["Fill Element"		sgml-fill-element t]
-   ["Change Element Name..."	sgml-change-element-name t]
-   ["Edit Attributes..."	sgml-edit-attributes t]
-   ["Kill Markup"		sgml-kill-markup t]
-   ["Kill Element"		sgml-kill-element t]
-   ["Untag Element"		sgml-untag-element t]
-   ["Trim and leave element"	sgml-trim-and-leave-element t]
-   ["Decode Character Entities"  sgml-charent-to-display-char t]
-   ["Encode Characters"		sgml-display-char-to-charent t]
-   )
- )
-
-(easy-menu-define
- sgml-main-menu sgml-mode-map "Main menu"
- '("SGML"
-   ["Reset Buffer"	normal-mode t]
-   ["End Element"	sgml-insert-end-tag t]
-   ["Show Context"	sgml-show-context t]
-   ["What Element"	sgml-what-element t]
-   ["List Valid Tags"	sgml-list-valid-tags t]
-   ["Show/Hide Warning Log"  sgml-show-or-clear-log t]
-   ["Validate"		sgml-validate t]
-   ["File Options >"	sgml-file-options-menu t]
-   ["User Options >"	sgml-user-options-menu t]
-   ["Save File Options"  sgml-save-options t]
-   ["Submit Bug Report"  sgml-submit-bug-report t]
-   )
- )
-
-
 ;;;; Key Commands
 
 ;; Doesn't this work in Lucid? ***
@@ -164,22 +53,21 @@
   (x-popup-menu
    event
    (let ((menus (list (cons title entries))))
-     (cond ((> (length entries)
-	       sgml-max-menu-size)
-	    (setq menus
-		  (loop for i from 1 while entries
-			collect
-			(let ((submenu
-			       (subseq entries 0 (min (length entries)
-						      sgml-max-menu-size))))
-			  (setq entries (nthcdr sgml-max-menu-size
-						entries))
-			  (cons
-			   (format "%s '%s'-'%s'"
-				   title
-				   (sgml-range-indicator (caar submenu))
-				   (sgml-range-indicator (caar (last submenu))))
-			   submenu))))))
+     (cond
+      ((> (length entries) sgml-max-menu-size)
+       (setq menus
+	     (loop for i from 1 while entries
+		   collect
+		   (let ((submenu
+			  (subseq entries 0 (min (length entries)
+						 sgml-max-menu-size))))
+		     (setq entries (nthcdr sgml-max-menu-size entries))
+		     (cons
+		      (format "%s '%s'-'%s'"
+			      title
+			      (sgml-range-indicator (caar submenu))
+			      (sgml-range-indicator (caar (last submenu))))
+		      submenu))))))
      (cons title menus))))
 
 (defun sgml-range-indicator (string)
@@ -197,61 +85,6 @@
 					; on the first level
   (eval (car (x-popup-menu event (cons title menus)))))
 
-
-
-;;;; Build Custom Menus
-
-(defun sgml-build-custom-menus ()
-  ;; Build custom menus
-;;  (sgml-add-custom-entries
-;;   sgml-markup-menu
-;;   (mapcar (function (lambda (e)
-;;		       (sgml-markup (car e) (cadr e))))
-;;	   sgml-custom-markup))
-  (easy-menu-define
-   sgml-markup-menu sgml-mode-map "Markup menu"
-   (append sgml-markup-root-menu
-	   (list "----")
-	   (loop for e in sgml-custom-markup collect
-		 (vector (first e)
-			 (` (sgml-insert-markup  (, (cadr e))))
-			 t))))
-  (easy-menu-define
-   sgml-dtd-menu sgml-mode-map "DTD menu"
-   (append sgml-dtd-root-menu
-	   (list "----")
-	   (loop for e in sgml-custom-dtd collect
-		 (vector (first e)
-			 (` (sgml-doctype-insert (, (cadr e))
-						 '(, (cddr e))))
-			 t)))))
-
-
-;(defun sgml-add-custom-entries (keymap entries)
-;  "Add to KEYMAP the ENTRIES, a list of (name . command) pairs.
-;The entries are added last in keymap and a blank line precede it."
-;  (let ((l keymap)
-;	(last (last keymap)))		; cons with keymap name
-;    ;; Find the cons before 'blank-c' event, or last cons.
-;    (while (and (cdr l)
-;		(consp (cadr l))
-;		(not (eq 'blank-c (caadr l))))
-;      (setq l (cdr l)))
-;    ;; Delete entries after
-;    (setcdr l nil)
-;    (when entries			; now add the entries
-;      (setcdr l
-;	      (cons
-;	       '(blank-c "")		; a blank line before custom entries
-;	       (loop for i from 0 as e in entries
-;		     collect (cons (intern (concat "custom" i)) e)))))
-;    ;; add keymap name to keymap
-;    (setcdr (last keymap) last)))
-
-
-
-
-
 
 ;;;; Insert with properties
 
@@ -271,42 +104,61 @@
 
 ;;;; Set face of markup
 
+(defvar sgml-use-text-properties nil)
+
 (defun sgml-set-face-for (start end type)
-  (let ((current (overlays-at start))
-	(face (cdr (assq type sgml-markup-faces)))
-	(pos start)
-	o)
-    (while current
-      (cond ((and (null o)
-		  (eq type (overlay-get (car current) 'sgml-type)))
-	     (setq o (car current)))
-	    ((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 (o
-	   (move-overlay o start end)
-	   (if (null (overlay-get o 'face))
-	       (overlay-put o 'face face)))
-	  (face
-	   (setq o (make-overlay start end))
-	   (overlay-put o 'sgml-type type)
-	   (overlay-put o 'face face)))))
+  (let ((face (cdr (assq type sgml-markup-faces))))
+    (cond
+     (sgml-use-text-properties
+      (let ((inhibit-read-only t)
+	    (after-change-function nil)
+	    (before-change-function nil))
+	(put-text-property start end 'face face)))
+     (t
+      (let ((current (overlays-at start))
+	    (pos start)
+	    old-overlay)
+	(while current
+	  (cond ((and (null old-overlay)
+		      (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))))))))
 
 (defun sgml-set-face-after-change (start end &optional pre-len)
-  (when sgml-set-face
+  ;; If inserting in front of an markup overlay, move that overlay.
+  ;; this avoids the overlay beeing deleted and recreated by
+  ;; sgml-set-face-for.
+  (when (and sgml-set-face (not sgml-use-text-properties))
     (loop for o in (overlays-at start)
 	  do (cond
 	      ((not (overlay-get o 'sgml-type)))
 	      ((= start (overlay-start o))
 	       (move-overlay o end (overlay-end o)))))))
 
+(defun sgml-fix-overlay-after-change (overlay flag start end &optional size)
+  (message "sfix(%s): %d-%d (%s)" flag start end size)
+  (overlay-put overlay 'front-nonsticky t)
+  (when nil
+    (move-overlay overlay end (overlay-end overlay))))
+
 (defalias 'next-overlay-at 'next-overlay-change) ; fix bug in cl.el
 
 (defun sgml-clear-faces ()
@@ -316,6 +168,12 @@
 	do (delete-overlay o)))
 
 
+;;;; Emacs before 19.29
+
+(unless (fboundp 'buffer-substring-no-properties)
+  (defalias 'buffer-substring-no-properties 'buffer-substring))
+
+
 ;;;; Provide
 
 (provide 'psgml-other)