diff lisp/psgml/psgml-xemacs.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 131b0175ea99
line wrap: on
line diff
--- a/lisp/psgml/psgml-xemacs.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/psgml/psgml-xemacs.el	Mon Aug 13 08:46:35 2007 +0200
@@ -1,10 +1,12 @@
 ;;;; psgml-xemacs.el --- Part of SGML-editing mode with parsing support
-;; $Id: psgml-xemacs.el,v 1.1.1.1 1996/12/18 03:35:23 steve Exp $
+;; $Id: psgml-xemacs.el,v 1.1.1.2 1996/12/18 03:47:15 steve Exp $
 
 ;; Copyright (C) 1994 Lennart Staflin
 
 ;; Author: Lennart Staflin <lenst@lysator.liu.se>
 ;;	   William M. Perry <wmperry@indiana.edu>
+;; Synced up with Ben Wing's changes for XEmacs 19.14 by
+;;	   Steven L Baur <steve@miranova.com>
 
 ;; 
 ;; This program is free software; you can redistribute it and/or
@@ -90,6 +92,7 @@
 	       (eval (event-object event)))))
 	    ((button-release-event-p event) ; don't beep twice
 	     nil)
+	    ;; [sb] added condition
 	    ((and (fboundp 'event-matches-key-specifier-p)
 		  (event-matches-key-specifier-p event (quit-char)))
 	     (signal 'quit nil))
@@ -115,81 +118,6 @@
 
 ;;;; XEmacs menu bar
 
-(defvar sgml-dtd-menu
-  '("DTD"
-    ["Parse DTD" sgml-parse-prolog t]
-    ("Info"
-	 ["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]
-    ))
-
-(defvar sgml-fold-menu
-  '("Fold"
-    ["Fold Element" sgml-fold-element t]
-    ["Fold Subelement" sgml-fold-subelement t]
-    ["Fold Region" sgml-fold-region t]
-    ["Unfold Line" sgml-unfold-line t]
-    ["Unfold Element" sgml-unfold-element t]
-    ["Unfold All" sgml-unfold-all t]
-    ["Expand" sgml-expand-element t]
-    ))
-
-(defvar sgml-markup-menu
-  '("Markup"
-    ["Insert Element" (sgml-element-menu last-command-event) t]
-    ["Insert Start-Tag" (sgml-start-tag-menu last-command-event) t]
-    ["Insert End-Tag" (sgml-end-tag-menu last-command-event) t]
-    ["Tag Region" (sgml-tag-region-menu last-command-event) t]
-    ["Insert Attribute" (sgml-attrib-menu last-command-event) t]
-    ["Insert Entity" (sgml-entities-menu last-command-event) t]
-    ))
-
-(defvar
- sgml-move-menu
- '("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]
-   )
- "Menu of move commands"
- )
-
-(defvar
- sgml-modify-menu
- '("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]
-   ["Decode Character Entities"  sgml-charent-to-display-char t]
-   ["Encode Characters"		sgml-display-char-to-charent t]
-   )
- "Menu of modification commands"
- )
-
 (defun sgml-make-options-menu (vars)
   (loop for var in vars 
 	for type = (sgml-variable-type var)
@@ -216,62 +144,21 @@
 		  (`(sgml-do-set-option '(, var)))
 		  t)))))
 
-(defvar sgml-sgml-menu
-  (append
-   '("SGML"
-     ["Reset Buffer"  normal-mode t]
-     ["Show Context" sgml-show-context t]
-     ["What Element" sgml-what-element t]
-     ["Show Valid Tags" sgml-list-valid-tags t]
-     ["Show/Hide Warning Log" sgml-show-or-clear-log t]
-     ["Validate" sgml-validate t])
-   (if (or (not (boundp 'emacs-major-version))
-	   (and (boundp 'emacs-minor-version)
-		(< emacs-minor-version 10)))
-       '(
-	 ["File Options" sgml-file-options-menu t]
-	 ["User Options" sgml-user-options-menu t]
-	 )
-     (list
-      (cons "File Options" (sgml-make-options-menu sgml-file-options))
-      (cons "User Options" (sgml-make-options-menu sgml-user-options))))
-   '(["Save File Options" sgml-save-options t]
-     ["Submit Bug Report" sgml-submit-bug-report t]
-     )))
 
-(defun sgml-install-xemacs-menus ()
-  "Install xemacs menus for psgml mode"
-  (set-buffer-menubar (copy-sequence current-menubar))
-  (add-menu nil (car sgml-sgml-menu) (cdr sgml-sgml-menu))
-  (add-menu nil (car sgml-markup-menu) (copy-sequence (cdr sgml-markup-menu)))
-  (add-menu nil (car sgml-modify-menu) (cdr sgml-modify-menu))
-  (add-menu nil (car sgml-move-menu) (cdr sgml-move-menu))
-  (add-menu nil (car sgml-fold-menu) (cdr sgml-fold-menu))
-  (add-menu nil (car sgml-dtd-menu) (cdr sgml-dtd-menu))
-)
-
-
-;;;; Custom menus
-
-(defun sgml-build-custom-menus ()
-  (and sgml-custom-markup (add-menu-item '("Markup") "------------" nil t
-					 "Insert Element"))
-  (mapcar (function
-	   (lambda (x)
-	     (add-menu-item '("Markup") (nth 0 x)
-			    (list 'sgml-insert-markup (nth 1 x))
-			    t
-			    "------------")))
-	  sgml-custom-markup)
-  (and sgml-custom-dtd (add-menu-item '("DTD") "-------------" nil t))
-  (mapcar (function
-	   (lambda (x)
-	     (add-menu-item '("DTD") (nth 0 x)
-			    (list 'apply ''sgml-doctype-insert
-				  (cadr x)
-				  (list 'quote (cddr x)))
-			    t)))
-	  sgml-custom-dtd))
+(unless (or (not (boundp 'emacs-major-version))
+	    (and (boundp 'emacs-minor-version)
+		 (< emacs-minor-version 10)))
+  (loop for ent on sgml-main-menu
+	if (vectorp (car ent))
+	do (cond
+	    ((equal (aref (car ent) 0) "File Options >")
+	     (setcar ent
+		     (cons "File Options"
+			   (sgml-make-options-menu sgml-file-options))))
+	    ((equal (aref (car ent) 0) "User Options >")
+	     (setcar ent
+		     (cons "User Options"
+			   (sgml-make-options-menu sgml-user-options)))))))
 
 
 ;;;; Key definitions
@@ -311,9 +198,9 @@
   (let ((face (cdr (assq type sgml-markup-faces)))
 	o)
     (loop for e being the extents from start to end
-	  do (when (extent-property e 'type)
+	  do (when (extent-property e 'sgml-type)
 	       (cond ((and (null o)
-			   (eq type (extent-property e 'type)))
+			   (eq type (extent-property e 'sgml-type)))
 		      (setq o e))
 		     (t (delete-extent e)))))
 
@@ -321,13 +208,15 @@
 	   (set-extent-endpoints o start end))
 	  (face
 	   (setq o (make-extent start end))
-	   (set-extent-property o 'type type)
+	   (set-extent-property o 'sgml-type type)
 	   (set-extent-property o 'face face)
+	   (set-extent-property o 'start-open t)
 	   (set-extent-face o face)))))
 
 (defun sgml-set-face-after-change (start end &optional pre-len)
+  ;; This should not be needed with start-open t
   (when sgml-set-face
-    (let ((o (extent-at start nil 'type)))
+    (let ((o (extent-at start nil 'sgml-type)))
       (cond
        ((null o))
        ((= start (extent-start-position o))