1. xemacs
  2. psgml


andreasj  committed 0762976

Added missing patches for psgml 1.2.1.

  • Participants
  • Parent commits 9756c18
  • Branches default

Comments (0)

Files changed (16)

File ChangeLog

View file
+2000-03-06  Jerry James  <james@eecs.ukans.edu>
+	* Makefile: Update version info.
+	* Change sgml-running-xemacs to running-xemacs everywhere.
+	* Numerous miscellaneous spelling corrections.
+	* psgml-edit.el (sgml-change-element-name): Use tempo.
+	(sgml-insert-start-tag): Ditto.
+	* psgml-html.el (html-helper-types-to-install): Add table and special.
+	(html-mode): Replace string-match form with running-xemacs.
+	* psgml-parse.el (sgml-check-case): Give more information in warning.
+	(sgml-compile-all-dtds): New function.
+	(sgml-setup-doctype): Set sgml-declaration if a DTDDECL entry in the
+	catalog applies.
+	* psgml.el (sgml-public-map): Remove extraneous "/".
+	(sgml-validate-command): Ditto, by using expand-file-name.
+2000-02-29  Gerd Boerrigter  <gerd.boerrigter@i2c-systems.com>
+	* psgml-html.el (html-helper-use-expert-menu): New variable.
+	(html-helper-user-menu): New variable.
+	(html-helper-imenu-regexp): New variable.
+	(html-helper-completion-finder): New variable.
+	(html-mode): Use imenu with html-helper.
+	(html-helper-imenu-index): New function.
+	(html-helper-rebuild-menu): New function.
+	(html-helper-toggle-expert-menu): New function.
+	(html-helper-expert-menu): New function.
+	(html3-mode): Remove.
+	Change keybinding of html-helper-head-menu to avoid collision.
+2000-02-21  Jerry James  <james@eecs.ukans.edu>
+	* Remove ancient HTML DTDs; add DocBook and some XML DTDs.
+	* Update DTDs and character entity sets from www.w3.org.
+	* Remove psgml-other, which is an FSF Emacs only file.
+	* ISOlat1.sgml, Wing.ISOlat1.sgml, webtechs.catalog: Remove unused
+	files.
+	* psgml.el (sgml-menu-name): New variable.
+	(sgml-main-menu): Use it.
+	(sgml-update-options-menu): Use it.
+	(sgml-options-menu-items): Check for XEmacs.
+	(sgml-mode): Make activate-menubar-hook local.
+	(sgml-normalize-trims): Customize.
+	(sgml-general-insert-case): Ditto.
+	(sgml-public-transliterations): Ditto.
+	(sgml-custom-markup): Ditto.
+	(sgml-validate-files): Ditto.
+	(sgml-xml-declaration): Ditto.
+	(sgml-declaration): Change custom type to file.
+	* psgml-html.el: Add definition for html-mode-hook.
+	(html-helper-htmldtd-version): Changed to HTML 4.01 Transitional.
+	(html-mode): Use sgml-menu-name.
+	(html-helper-install-type): Remove unusued variable menu-string.
+	(html-helper-string-to-symbol): Reduce number of junk strings.
+	created.  Check first character for space.
+	(html-helper-add-tag): Update to HTML 3.2.
+	* psgml-edit.el (sgml-indent-line): Adapt Wing change to official
+	update.
+	(sgml-insert-end-tag): Remove erroneous Wing change.
+	* psgml-xemacs.el: Clarify toplevel XEmacs version number test.
+2000-02-07  Jerry James  <james@eecs.ukans.edu>
+	* Synched up with psgml 1.2.1.
 1999-07-23  Jerry James  <jerry@cs.ucsb.edu>
 	* psgml.el: Don't set sgml-buggy-subst-char-in-region for

File README.psgml

View file
-This is the READ ME file for psgml.el version 1.0       -*- text -*-
+This is the READ ME file for psgml.el version 1.2.1.       -*- text -*-
-   PSGML is a major mode for editing SGML documents.  It works with
-GNU Emacs 19.19 and later or with XEmacs 19.13.
+This is a BETA releas of PSGML.  
-This distribution should contain the following source files:
-	psgml.el
-	psgml.texi
-	psgml-other.el
-	psgml-lucid.el
-	psgml-edit.el
-	psgml-parse.el
-	psgml-dtd.el
-	psgml-info.el
-        psgml-charent.el
-	psgml-api.texi	-- internals documentation
-	psgml-api.el	-- Extra functions for the API
-	iso88591.map
-	Makefile.in
+PSGML is a major mode for editing SGML and XML documents.  It works with
+GNU Emacs 19.34, 20.3 and later or with XEmacs 19.9 and later.  PSGML
+contains a simple SGML parser and can work with any DTD.  Functions
+provided includes menus and commands for inserting tags with only the
+contextually valid tags, identification of structural errors, editing of
+attribute values in a separate window with information about types and
+defaults, and structure based editing.
-In addition the distribution contains the formatted versions of the
-documentation files (psgml.info, ...). But the compiled elisp code is
-no longer supplied. You will have to byte compile the files before
-PSGML will achieve usable speed.
+To install PSGML you first need to uncompress and unpack the source
+archive.  This is done with the `gunzip' and `tar' commands.
-PSGML now comes with autoconf support. See INSTALL for generic
-instructions. Run
+     gunzip psgml-1.2.1.tar.gz; tar xf psgml-1.2.1.tar
-	sh configure
-	make
+This should create a subdirectory to the current directory with the
+source code. This directory contains a `configure' command (see the file
+INSTALL for more information about configure).  You can use the
+`configure' command to configure the package or you can load the file
+`psgml-maint' and execute the `psgml-compile-files' command.
-and possibly
+Place the `*.el' and the `*.elc' files in a directory where Emacs can
+find it (i.e. one of the directories in the `load-path' variable, you
+can add a directory to this variable in your `.emacs'.)
-	make install
+If you use the `configure' approach, compile psgml with `make' and the
+you can run `make install' to install it in the system library
+`site-lisp'.  The files are installed in a subdirectory named `psgml'.
+The location of `site-lisp' is figured out by `configure', but you can
+change it in the `Makefile'.  You need to make sure that this
+subdirectory is in Emacs `load-path'.
-If you are using xemacs, you can run give the argument `--with-xemacs'
-to configure, or use `make xemacs'.
+Put the following line in your .emacs:
-Instead of using configure you can load the psgml-main.el file and run
-the command psgml-compile-files. Then you have to set load-path or
-move the .elc files.
+     (autoload 'sgml-mode "psgml" "Major mode to edit SGML files." t)
+     (autoload 'xml-mode "psgml" "Major mode to edit XML files." t)
-Send bug reports, comments and suggestions to lenst@lysator.liu.se.
-New in version 1.0
+You may also want to set up search paths for external entities,
+See the section Entity manager in the psgml.info manual.
-* Main changes
+The `psgml.info' is the documentation for PSGML in the info format.  You
+can read this with the Emacs command `C-u C-h i'.  You can also install
+the file in your systems info directory and edit the `dir' file to
+include `psgml.info' in the menu.
-** Support for general entities
+The info file `psgml.info' is created from the texinfo file
+`psgml.texi'.  The texinfo file can also be used to create a hard copy
+of the documentation.  To do this you need the TeX program and a copy of
-** Support for short reference
-** Support for catalog files
-** New mechanism for caching parsed DTD
-** Includes commands to list various aspects of the DTD
-* Entity support
-PSGML will recognize entity references (except in attribute values). If
-the entity is a general text entity, PSGML will also parse the content
-of the entity. To support this PSGML has a new entity manager with a
-new mechanism for looking up entities (see belove).
-Short references are also supported, for the short reference delimiters
-from the concrete reference syntax.
-There are some new and changed commands to complete the entity support:
-** Command: `sgml-expand-entity-reference'
-Insert the text of the entity referenced at point.
-** Command: `sgml-expand-all-shortrefs'
-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 generally
-entity references.
-** Command: `sgml-normalize'
-Changed to expand short references also. 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'.
-* Fontification
-If `sgml-set-face' is true and the DTD has been activated, PSGML will
-automatically set the face of markup in the buffer.
-First the current line is parsed and fontified. If this would mean
-parsing more than 500 chars, wait 1 second first.
-The rest of the buffer is fontified after 6 seconds idle time.
-Fontification can be interrupted by any input event.
-The buffer can be fontified initially if `sgml-auto-activate-dtd' is
-* New entity manager
-The new entity manager will handle an entity reference thus:
-** If the entity has a system identifier, the entity manager will first
-try and call the functions on `sgml-sysid-resolve-functions' with the
-system identifier as argument, and if any function returns non-nil
-assume that the function has handled the entity.
-** If the entity has a system identifier and
-`sgml-system-identifiers-are-preferred' is non-nil, the system
-identifier will be used as a file name relative to the file containing
-the entity declaration.
-** Next the entity manager will try the catalog, and
-** if not found there use the `sgml-public-map'.
-** Finally if the entity has not been found and it has a system
-identifier, this will be used as a file name.
-Note: `sgml-system-path' is no longer used for entity lookup.
-The catalog files searched is given by the variable
-`sgml-local-catalogs' and `sgml-catalog-files'. The
-`sgml-catalog-files' variable is initialized from the environment
-variable `SGML_CATALOG_FILES' (should be a colon separated list of
-files). The `sgml-local-catalogs' variable is assumed to be set in a
-files local variables.
-File names for external entities (e.g system identifiers) are relative
-to the directory containing the file declaring the entity.
-The `sgml-public-map' is initialized from the environment variable
-`sgml-system-path' defaults to nil.
-Supports most of sgmls substitutions for sgml-public-map. Supported:
-%%, %N, %P, %S, %Y, %C, %L, %O, %T, %V. Unsupported: %D, %X, %A, %E,
-%I, %R, %U. Note: that %D is and alias for %C in PSGML (historical
-* New and changed options
-** `sgml-recompile-out-of-date-cdtd'
-** New options for insert-element:
-`sgml-insert-missing-element-comment' and
-** `sgml-validate-files' and slight change of `sgml-validate-command'
-The variable `sgml-validate-command' can now be a list of strings. The
-strings can contain %-sequences that will be expanded: %b to buffer
-file name, %s to SGML Declaration file, either the value of
-sgml-declaration variable or SGML Declaration file for parent document
-or DOCTYPE file or SGMLDECL from catalog. %d value of `sgml-doctype'.
-** `sgml-set-face'
-Now automatically sets faces for all visible text, with a delay of 1s.
-** `sgml-exposed-tags'
-The list of tag names that remain visible, despite `M-x
-sgml-hide-tags'. Each name is a lowercase string, and start-tags and
-end-tags must be listed individually.
-** `sgml-auto-activate-dtd'
-PSGML was behaving inconsistent when a new file was loaded. If the
-variable `sgml-set-face' was true the DTD would automatically be
-activated (loaded or parsed), but only if psgml-parse already loaded.
-Rather than let `sgml-set-face' decide if the DTD is activated, there
-is now a distinct option for this. This option works even the first
-If non-nil, loading a sgml-file will automatically try to activate its
-DTD. Activation means either to parse the document type declaration or
-to load a previously saved parsed DTD. The name of the activated DTD
-will be shown in the mode line.
-* Various
-** Tracing catalog lookup
-To help debug entity lookup there is a new option
-`sgml-trace-entity-lookup'. If this option is t messages will be logged
-in *SGML LOG* buffer when external entities are looked up. These
-messages shows entity, catalogs searched, and entry type in catalog
-where entity was found.
-** Translating between characters and entity references
-Set the variable `sgml-display-char-list-filename' to a file that
-contains mappings between all characters present in the presentation
-character set, and their "standard replacement text" names, e.g. "�" ->
-"[aring ]", e.t.c. The default value for this variable is
-Use the functions (also in the Modify menu)
-`sgml-charent-to-display-char' and `sgml-display-char-to-charent' to
-translate between entities and characters.
-** Handling of missing DOCTYPE
-If the document prolog does not contain a document type declaration,
-PSGML will try to supply one on the form `<!DOCTYPE DocTypeName
-SYSTEM>' If the variable `sgml-default-doctype-name' is defined this
-will be used for the document type name, otherwise the GI of the first
-start tag will be used. I.e., if the document starts with `<book>', a
-document type declaration `<!DOCTYPE book SYSTEM>' will be assumed.
-** Handling of tags for undefined elements
-*** Start-tags for undefined elements will either be ignored, if
-`sgml-ignore-undefined-elements' is `t', or assumed to be acceptable in
-the current element and defined with `O O ANY'.
-*** An end-tag for an element that is not currently open will be
-** Cleaned up Markup menu
-The removed entries can be added with sgml-custom-markup:
-(setq sgml-custom-markup
-      '(("<!entity ... >" "<!entity \r>\n")
-        ("<!attlist ... >" "<!attlist \r>\n")
-        ("<!element ... >" "<!element \r>\n")
-        ("<!doctype ...>" "<!doctype \r -- public or system --\n[\n]>\n")
-        ("Local variables comment" "<!--\nLocal variables:\n\rEnd:\n-->\n")
-        ("Comment" "<!-- \r -->\n") ))
-** New commands
-Thanks to David Megginson the custom menus are now reachable from the
-`C-c C-u C-d' (`sgml-custom-dtd')
-`C-c C-u C-m' (`sgml-custom-markup')
-* Changes to API
-** New hooks
-*** `sgml-close-element-hook'
-The hook run by `sgml-close-element'. These functions are invoked with
-`sgml-current-tree' bound to the element just parsed.
-*** `sgml-new-attribute-list-function'
-This hook is run when a new element is inserted to construct the
-attribute specification list. The default function prompts for the
-required attributes.
-*** `sgml-doctype-parsed-hook'
-This hook is called after the doctype has been parsed. It can be used
-to load any additional information into the DTD structure.
-Example: add description to element types
-(defun set-help-info ()
-  (let ((help '(("para" "A Paragraph")
-		("q"    "A Quotation")
-		("date" "A Date")))
-	(dtd (sgml-pstate-dtd sgml-buffer-parse-state)))
-    (loop for h in help do
-	  (setf (sgml-eltype-appdata (sgml-lookup-eltype (first h) dtd)
-				     'help-string)
-		(second h)))))
-(add-hook 'sgml-doctype-parsed-hook 'set-help-info)
-(defun sgml-help-for-element ()
-  (interactive)
-  (let* ((el (sgml-find-element-of (point)))
-	 (help (sgml-element-appdata el 'help-string)))
-    (and help
-	 (message "%s" help))))
-*** sgml-sysid-resolve-functions
-This variable should contain a list of functions. Each function should
-take one argument, the system identifier of an entity. If the function
-can handle that identifier, it should insert the text of the entity
-into the current buffer at point and return t. If the system identifier
-is not handled the function should return nil.
-Example use: Support URLs as system identifiers
-(defun sgml-url-sysid (sysid)
-  (cond ((string-match "^\\([a-z]+\\):" sysid) ; looks like url
-	 (require 'url)
-	 (set-buffer (prog1 (current-buffer)
-		       (url-retrieve sysid)))
-	 (insert-buffer url-working-buffer)
-	 t)))
-(add-hook 'sgml-sysid-resolve-functions 'sgml-url-sysid)
-** New file psgml-api.el
-This file contain API-functions that are not used by other parts of
-psgml. Use `(require 'psgml-api)' to use the API functions (psgml-api
-includes the rest of the psgml files).
-Local variables:
-mode: text
-mode: outline

File psgml-charent.el

View file
       (goto-char (point-min))
-       (while (re-search-forward "&\\(\\w\\(\\w\\|\\s_\\)+\\);?" nil t)
+       (while (re-search-forward "&\\(\\w\\(\\w\\|\\s_\\)*\\);?" nil t)
 	 (setq charent (buffer-substring (match-beginning 1) (match-end 1)))
 	 (if (setq replacement (cdr (assoc charent charent-to-char)))
 	     (replace-match replacement t t)))))))

File psgml-debug.el

View file
 ;;;;\filename dump.el
-;;;\Last edited: Sun Mar 24 19:17:42 1996 by lenst@triton.lstaflin.pp.se (Lennart Staflin)
+;;;\Last edited: 1999-08-09 23:38:43 lenst
 ;;;\RCS $Id$
 ;;;\author {Lennart Staflin}
 (eval-when (load)
-  (unless sgml-running-xemacs
+  (unless running-xemacs
     (def-edebug-spec sgml-with-parser-syntax (&rest form))
     (def-edebug-spec sgml-skip-upto (sexp))
     (def-edebug-spec sgml-check-delim (sexp &optional sexp))
     (with-output-to-temp-buffer "*Testing psgml*"
-	    (setq file (format "/usr/local/src/sgmls-1.1/test/test%03d.sgm"
+	    (setq file (format "/ni/src/sgmls-1.1/test/test%03d.sgm"
 	    (file-exists-p file))
 	(princ (format "*** File test%03d ***\n" start))
 (defun profile-sgml (&optional file)
-  (or file (setq file (expand-file-name "~/src/psgml/0/test/shortref.sgml")))
+  (or file (setq file (expand-file-name "~/work/config/metaspec.xml")))
   (find-file file)
-  (dotimes (i 20)
+  (dotimes (i 10)
     (sgml-reparse-buffer (function sgml-handle-shortref)))
+	  sgml-parse-attribute-specification-list
+	  sgml-check-tag-close
+	  sgml-do-move
+	  sgml-open-element
+	  sgml-list-implications
+	  sgml-move-current-state
+          sgml-do-empty-start-tag
+          sgml-lookup-eltype
+          sgml-startnm-char-next
+          sgml-eltype-defined
+          sgml-execute-implied
+          sgml-next-sub-and
+          sgml-get-and-move
+          format
+;;;; 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
+      (switch-to-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))))))

File psgml-dtd.el

View file
       (prog1 (if (sgml-is-delim "NULL" digit)
 		 (string-to-int (sgml-check-nametoken))
 	       (let ((spec (sgml-check-name)))
-		 (or (cdr (assoc spec '(("re" . 10)
-					("rs" . 1)
-					("tab" . 9)
-					("space" . 32))))
+		 (or (cdr (assoc spec '(("RE" . 10)
+					("RS" . 1)
+					("TAB" . 9)
+					("SPACE" . 32))))
 		     ;; *** What to do with other names?
 	(or (sgml-parse-delim "REFC")
-(defun sgml-check-external ()
-  (or (sgml-parse-external)
+(defun sgml-check-external (&optional pubid-ok)
+  (or (sgml-parse-external pubid-ok)
       (sgml-parse-error "Expecting a PUBLIC or SYSTEM")))
 ;;;; Parse doctype: notation
-  (sgml-check-external))
+  (sgml-check-external t))
 ;;;; Parse doctype: Element
 (defun sgml-parse-modifier ()
-  (cond ((sgml-parse-delim PLUS)
+  (cond ((sgml-parse-delim "PLUS")
 	 (function sgml-make-+))
-	((sgml-parse-delim REP)
+	((sgml-parse-delim "REP")
 	 (function sgml-make-*))
-	((sgml-parse-delim OPT)
+	((sgml-parse-delim "OPT")
 	 (function sgml-make-opt))))
 (defun sgml-check-primitive-content-token ()
 	(setq el (if con1
 		     (funcall con1 subs)
 		   (car subs)))))
-     ((sgml-parse-rni "pcdata")		; #PCDATA
+     ((sgml-parse-rni "PCDATA")         ; #PCDATA (FIXME: when changing case)
       (setq sgml-used-pcdata t)
       (setq el (sgml-make-pcdata)))
      ((sgml-parse-delim "DTGO")			; data tag group
-	 (let ((dc (intern (upcase (sgml-check-name))))) 
+	 (let ((dc (intern (sgml-check-name)))) 
 	   (cond ((eq dc 'ANY)
 		  (setq sgml-used-pcdata t))
 		 ((eq dc 'CDATA)
 		    (sgml-error "XML forbids CDATA declared content.")))
 		 ((eq dc 'RCDATA)
 		  (when sgml-xml-p
-		    (sgml-error "XML forbids RCDATA declared content"))))
+		    (sgml-error "XML forbids RCDATA declared content")))
+                 ((eq dc 'EMPTY))
+                 (t
+                  (sgml-error "Exptected content model group or one of %s"
+                              (if sgml-xml-p
+                                  "ANY or EMPTY"
+                                  "ANY, CDATA, RCDATA or EMPTY"))))
 (defun sgml-parse-exeption (type)
   (let (name				; Name of entity
 	dest				; Entity table
 	(type 'text)			; Type of entity
+	(notation nil)                  ; Notation of entity
 	text				; Text of entity
 	extid				; External id 
       (setq name (sgml-check-name t))
       (setq dest (sgml-dtd-parameters sgml-dtd-info)))
      (t					; normal entity declaration
-      (or (sgml-parse-rni "default")
+      (or (sgml-parse-rni "DEFAULT")
 	  (setq name (sgml-check-name t)))
       (setq dest (sgml-dtd-entities sgml-dtd-info))))
 					; 73 external identifier,
 					; (65 ps+, 109+ entity type)?
-	    (setq type (or (sgml-parse-entity-type) 'text))
+	    (let ((tn (sgml-parse-entity-type)))
+	      (setq type (or (car tn) 'text))
+	      (unless (eq (cdr tn) "")
+		(setq notation (cdr tn))))
-	    (let ((token (intern (sgml-check-name))))
+	    (let ((token (intern (sgml-check-case (sgml-check-name)))))
 	      (when (and sgml-xml-p
 			 (memq token '(cdata sdata pi starttag endtag ms md)))
 		(sgml-error "XML forbids %s entities."
 			    (upcase (symbol-name token))))
-	       ((memq token '(cdata sdata)) ; data text ***
+	       ((memq token '(CDATA SDATA)) ; data text ***
 		(setq type token)
-	       ((eq token 'pi)
+	       ((eq token 'PI)
 		(concat "<?" (sgml-check-parameter-literal) ">"))
-	       ((eq token 'starttag)
+	       ((eq token 'STARTTAG)
 		(sgml-start-tag-of (sgml-check-parameter-literal)))
-	       ((eq token 'endtag)
+	       ((eq token 'ENDTAG)
 		(sgml-end-tag-of (sgml-check-parameter-literal)))	
-	       ((eq token 'ms)		; marked section
+	       ((eq token 'MS)		; marked section
 		(concat "<![" (sgml-check-parameter-literal) "]]>"))
-	       ((eq token 'md)		; Markup declaration
+	       ((eq token 'MD)		; Markup declaration
 		(concat "<!" (sgml-check-parameter-literal) ">")))))
     (when dest
-      (sgml-entity-declare name dest type text))))
+      (sgml-entity-declare name dest type text notation))))
 (defun sgml-parse-entity-type ()
   ;;                             65 ps+,
   ;;                             41 notation name,
   ;;                             149.2+ data attribute specification?)
-  (let ((type (sgml-parse-name)))
+  (let ((type (sgml-parse-name))
+	(notation nil))
     (when type
-      (setq type (intern (sgml-check-case type)))
+      (setq type (intern (downcase (sgml-check-case type))))
       (when (and sgml-xml-p (memq type '(subdoc cdata sdata)))
 	(sgml-error "XML forbids %s entities."
 		    (upcase (symbol-name type))))
       (cond ((eq type 'subdoc))
 	    ((memq type '(cdata ndata sdata))
-	     (sgml-check-name)
+	     (setq notation (sgml-parse-name))
+	     (when notation
+	       (setq notation (intern (downcase (sgml-check-case notation)))))
 	     ;;149.2+ data attribute specification
 	     ;;                      = 65 ps+, DSO,
 	     ;;                        31 attribute specification list,
 	       (sgml-check-delim DSC)))
 	    (t (sgml-error "Illegal entity type: %s" type))))
-    type))
+    (cons type notation)
+    ))
 ;;;; Parse doctype: Attlist
 (defun sgml-declare-attlist ()
-  (let* ((assnot (cond ((sgml-parse-rni "notation")
+  (let* ((assnot (cond ((sgml-parse-rni "NOTATION")
 			(when sgml-xml-p
 			  (sgml-error "XML forbids data attribute declarations"))
 	 (assel (sgml-check-name-group))
-	 (attlist nil)			; the list
+	 (attlist nil)
 	 (attdef nil))
     (when (and sgml-xml-p (> (length assel) 1))
       (sgml-error "XML forbids name groups for an associated element type."))
 (defun sgml-merge-attlists (old new)
+  (setq old (nreverse (copy-list old)))
   (loop for att in new do
 	(unless (assoc (car att) old)
 	  (setq old (cons att old))))
-  old)
+  (nreverse old))
 (defun sgml-parse-attribute-definition ()
-  (if (sgml-is-delim MDC) ; End of attlist?
+  (if (sgml-is-delim "MDC") ; End of attlist?
     (sgml-make-attdecl (sgml-check-name)
       (setq type (intern (sgml-check-case (sgml-check-name))))
       (sgml-validate-declared-value type)
-    (when (memq type '(name-token-group notation))
+    (when (memq type '(name-token-group NOTATION))
       (setq names (sgml-check-nametoken-group)))
     (sgml-make-declared-value type names)))
 (defun sgml-validate-declared-value (type)
   (unless (memq type
-		'(cdata
-		  entity
-		  entities
-		  id
-		  idref
-		  idrefs
-		  name
-		  names
-		  nmtoken
-		  nmtokens
-		  notation
-		  number
-		  numbers
-		  nutoken
-		  nutokens))
+		'(CDATA
+		  ID
+		  IDREF
+		  NAME
+		  NAMES
     (sgml-error "Invalid attribute declared value: %s" type))
   (when (and sgml-xml-p (memq type
-			      '(name names number numbers nutoken nutokens)))
     (sgml-error "XML forbids %s attributes." (upcase (symbol-name type)))))
 (defun sgml-check-default-value ()
-     (if (or (not rni) (eq key 'fixed))
+     (if (or (not rni) (eq key 'FIXED))
 (defun sgml-validate-default-value-rn (rn)
-  (unless (memq rn '(required fixed current conref implied))
     (sgml-error "Unknown reserved name: %s."
 		(upcase (symbol-name rn))))
-  (when (and sgml-xml-p (memq rn '(current conref)))
+  (when (and sgml-xml-p (memq rn '(CURRENT CONREF)))
     (sgml-error "XML forbids #%s attributes."
 		(upcase (symbol-name rn)))))
 ;;;; Parse doctype: Shortref
 ;;;150  short reference mapping declaration = MDO, "SHORTREF",
 (defun sgml-write-dtd (dtd file)
   "Save the parsed dtd on FILE.
 Construct the binary coded DTD (bdtd) in the current buffer."
+  (when (fboundp 'set-buffer-multibyte)
+    (setq buffer-file-coding-system 'no-conversion)
+    (set-buffer-multibyte nil))
    ";;; This file was created by psgml on " (current-time-string) "\n"
-   "(sgml-saved-dtd-version 6)\n")
+   "(sgml-saved-dtd-version 7)\n")
   (sgml-code-dtd dtd)
-  (setq file-type 1)
+  (set 'file-type 1)
   (write-region (point-min) (point-max) file))

File psgml-edit.el

View file
 ;;; psgml-edit.el --- Editing commands for SGML-mode with parsing support
-;;-*-byte-compile-warnings:(free-vars unused-vars unresolved callargs redefine)-*-
 ;; $Id$
 ;; Copyright (C) 1994, 1995, 1996 Lennart Staflin
 (require 'psgml-parse)
 (require 'tempo)
+  (setq byte-compile-warnings '(free-vars unresolved callargs redefine)))
 ;;;; Variables
 			       (sgml-element-parent to)
 (defun sgml-kill-element ()
   "Kill the element following the cursor."
   (interactive "*")
       (tempo-process-and-insert-string (sgml-end-tag-of gi)))
     (goto-char (sgml-element-start element))
     (delete-char (sgml-element-stag-len element))
-    (tempo-process-and-insert-string (sgml-start-tag-of gi))
-    (forward-char -1)
+    (tempo-process-and-insert-string (concat (sgml-delim "STAGO")
+					     (sgml-general-insert-case gi)))
     (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))))
+      (sgml-insert-attributes newasl newattlist))
+    (tempo-process-and-insert-string
+     (if (and sgml-xml-p (sgml-element-empty element))
+	 (sgml-delim "XML-TAGCE")
+       (sgml-delim "TAGC")))))
 (defun sgml-translate-attribute-specification-list (values from to)
   "Translate attribute specification from one element type to another.
 	   ;; Special case ID attribute
-	   ((and (eq 'id (sgml-attdecl-declared-value from-decl))
-		 (setq tem (sgml-attribute-with-declared-value to 'id)))
+	   ((and (eq 'ID (sgml-attdecl-declared-value from-decl))
+		 (setq tem (sgml-attribute-with-declared-value to 'ID)))
 	     (sgml-make-attspec (sgml-attdecl-name tem)
 				(sgml-attspec-attval attspec))
 	 (let ((stag (sgml-is-start-tag))
 	       (etag (sgml-is-end-tag)))
-	   ;; Wing change
-	   (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))))))))
+           (cond ((and (> (point) (sgml-element-start element))
+                       (< (point) (sgml-element-stag-end element)))
+                  (setq col
+                        (+ (save-excursion
+                             (goto-char (sgml-element-start element))
+                             (current-column))
+                           (length (sgml-element-gi element))
+                           2)))
+                 ((and
+		   ;; Wing change, adapted by James
+		   (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)    
 	(goto-char here))
 (defun sgml-next-data-field ()
   "Move forward to next point where data is allowed."
   (let* ((pos (point))
 	 (nobol (eq (point) sgml-rs-ignore-pos))
-	 (sref (sgml-deref-shortmap sgml-current-shortmap nobol))
+	 (sref (and sgml-current-shortmap
+                    (sgml-deref-shortmap sgml-current-shortmap nobol)))
 	 (el nil))
     (goto-char pos)
     (setq el (sgml-find-element-of pos))
 ;;;; SGML mode: keyboard inserting
+(defun sgml-coerce-element-type (obj)
+  (when (stringp obj)
+    (setq obj (sgml-lookup-eltype (sgml-general-case obj))))
+  (when nil                             ;FIXME: need predicate
+    (setq obj (sgml-tree-eltype obj)))
+  obj)
+(defun sgml-break-brefore-stag-p (element)
+  (sgml-eltype-appdata (sgml-coerce-element-type element)
+                       'break-brefore-stag))
+(defun sgml-break-after-stag-p (element)
+  (sgml-eltype-appdata (sgml-coerce-element-type element)
+                       'break-after-stag))
+(defun sgml-insert-break ()
+  (skip-chars-backward " \t")
+  (cond ((bolp)
+         (if (looking-at "^\\s-*$")
+             (fixup-whitespace)))
+        (t
+         ;; FIXME: fixup-whitespace ??
+         (insert "\n"))))
 (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
 after the first tag inserted."
-    (completing-read "Tag: " (sgml-completion-table) nil t "<" )))
+    (let ((completion-ignore-case sgml-namecase-general))
+      (completing-read "Tag: " (sgml-completion-table) nil t "<" ))))
   (sgml-find-context-of (point))
   (assert (null sgml-markup-type))
   ;; Fix white-space before tag
 	element				; inserted element
 	(sgml-show-warnings nil))
     (when (and name (not (equal name "")))
+      (when (sgml-break-brefore-stag-p name)
+        (sgml-insert-break))
       (sgml-insert-tag (sgml-start-tag-of name) 'silent)
       (if (and sgml-xml-p (sgml-check-empty name))
 	  (forward-char -2)
       (if (and sgml-xml-p (sgml-check-empty name))
 	  (forward-char 2)
 	(forward-char 1))
+      (when (sgml-break-after-stag-p name)
+        (sgml-insert-break))
       (when (not (sgml-element-empty element))
 	(when (and sgml-auto-insert-required-elements
 		   (sgml-model-group-p sgml-current-state))
 (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)
+					'REQUIRED)
 	 (sgml-attdecl-name attdecl)
 		val (cdr-safe (sgml-lookup-attspec name avl))
 		dcl (sgml-attdecl-declared-value attspec)
 		def (sgml-attdecl-default-value attspec))
+          (setq name (sgml-general-insert-case name))
 	  (unless val			; no value given
 	    ;; Supply the default value if a value is needed
-	    (cond ((sgml-default-value-type-p 'required def)
+	    (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)))))
+          (when val
+            (cond ((eq dcl 'CDATA))
+                  ((eq dcl 'ENTITY) (setq val (sgml-entity-insert-case val)))
+                  (t (setq val (sgml-general-insert-case val)))))
 	   ((null val))			; Ignore
 	   ;; Ignore attributes with default value
 	      (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-end-tag-of sgml-current-tree))))
 (defun sgml-insert-start-tag (name asl attlist &optional net)
-  (tempo-process-and-insert-string (concat "<" name))
+  ;; Insert a start-tag with attributes
+  ;; if NET is true end with NESTC unless XML then end with NESTC NET
+  ;; (aka XML-TAGCE).
+  (tempo-process-and-insert-string (concat (sgml-delim "STAGO")
+					   (sgml-general-insert-case name)))
   (sgml-insert-attributes asl attlist)
-  (if (and sgml-xml-p (sgml-check-empty name))
-      (insert "/>")
-    (insert (if net "/" ">"))))
+  ;; In XML, force net if element is always empty
+  (when (and sgml-xml-p (sgml-check-empty name))
+    (setq net t))
+  (tempo-process-and-insert-string
+   (if net (if sgml-xml-p
+	       (sgml-delim "XML-TAGCE")
+	     (sgml-delim "NESTC"))
+     (sgml-delim "TAGC"))))
 (defun sgml-change-start-tag (element asl)
   (let ((name (sgml-element-gi 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)))))
+                           (if sgml-xml-p
+                               (sgml-element-empty element)
+                             (eq t (sgml-element-net-enabled element))))))
 (defun sgml-read-attribute-value (attdecl curvalue)
   "Return the attribute value read from user.
 	 (tokens (sgml-declared-value-token-group dv))
 	 (notations (sgml-declared-value-notation dv))
 	 (type (cond (tokens "token")
-		     (notations "notation")
+		     (notations "NOTATION")
 		     (t (symbol-name dv))))
 	  (format "Value for %s (%s%s): "
     (setq value 
 	  (if (or tokens notations)
-	      (completing-read prompt
-			       (mapcar 'list (or tokens notations))
-			       nil t)
+	      (let ((completion-ignore-case sgml-namecase-general))
+		(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 
+	unless (sgml-default-value-type-p 'FIXED 
 					  (sgml-attdecl-default-value attdecl))
 	collect attdecl))
    (let* ((el (sgml-find-attribute-element))
-	   (completing-read
-	    "Attribute name: "
-	    (mapcar (function (lambda (a) (list (sgml-attdecl-name a))))
-		    (sgml-non-fixed-attributes (sgml-element-attlist el)))
-	    nil t)))
+           (sgml-general-case
+            (let ((completion-ignore-case sgml-namecase-general))
+              (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-lookup-attdecl name (sgml-element-attlist el))
 		  (sgml-element-name u)))
     ;; Do the split
+    (insert ?\n)
     (sgml-insert-tag (sgml-start-tag-of u) 'silent)
     (skip-chars-forward " \t\n")
 (defun sgml-custom-markup (markup)
   "Insert markup from the sgml-custom-markup alist."
-   (list (completing-read "Insert Markup: " sgml-custom-markup nil t)))
+   (let ((completion-ignore-case sgml-namecase-general))
+     (list (completing-read "Insert Markup: " sgml-custom-markup nil t))))
   (sgml-insert-markup (cadr (assoc markup sgml-custom-markup))))
   (let ((what (sgml-menu-ask event 'element)))
     (and what (sgml-insert-element what))))
+(defun sgml-add-element-menu (event)
+  (interactive "*e")
+  (let ((what (sgml-menu-ask event 'add-element)))
+    (and what (sgml-add-element-to-element what nil))))
 (defun sgml-start-tag-menu (event)
   "Pop up a menu with valid start-tags and insert choice."
   (interactive "*e")
   (let (tab
 	(title (capitalize (symbol-name type))))
+     ((eq type 'add-element)
+      (setq tab
+            (mapcar #'sgml-eltype-name
+                    (sgml--all-possible-elements
+                     (sgml-find-context-of (point))))))
      ((eq type 'element)
       (setq tab
 			   (list 'sgml-read-attribute-value
 				 (list 'quote attdecl)
 				 (sgml-element-attval el name))))))
-	    (if (sgml-default-value-type-p 'required defval)
+	    (if (sgml-default-value-type-p 'REQUIRED defval)
 	      (list "--"
 		    (list (if (sgml-default-value-type-p nil defval)
 ;;;; SGML mode: Fill 
+(defun sgml-element-fillable (element)
+  (and (sgml-element-mixed element)
+       (not (sgml-element-appdata element 'nofill))))
 (defun sgml-fill-element (element)
   "Fill bigest enclosing element with mixed content.
 If current element has pure element content, recursively fill the
   (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))
+  (when (sgml-element-fillable element)
+    ;; Find bigest enclosing fillable element
+    (while (sgml-element-fillable (sgml-element-parent element))
       (setq element (sgml-element-parent element))))
   (sgml-do-fill element)
     (sit-for 0))
-     ((sgml-element-mixed element)
+     ((sgml-element-fillable element)
       (let (last-pos
 	    (c (sgml-element-content element))
 	    (agenda nil))		; regions to fill later
 	(setq last-pos (point))
 	(while c
-	   ((sgml-element-mixed c))
+	   ((sgml-element-fillable c))
 	    ;; Put region before element on agenda.  Can't fill it now
-	    ;; that would mangel the parse tree that is being traversed.
+	    ;; that would mangle the parse tree that is being traversed.
 	    (push (cons last-pos (sgml-element-start c))
 	    (goto-char (sgml-element-start c))
     (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))))
+	   (quote sgml-always-quote-attributes)
+	   (xml-p sgml-xml-p))
+      (switch-to-buffer-other-window
+       (sgml-attribute-buffer element asl))
+      (sgml-edit-attrib-mode)
+      (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)
+      (make-local-variable 'sgml-xml-p)
+      (setq sgml-xml-p xml-p))))
+(defun sgml-effective-attlist (eltype)
+  (let ((effective-attlist nil)
+        (attlist (sgml-eltype-attlist eltype))
+        (attnames (or (sgml-eltype-appdata eltype 'attnames)
+                      '(*))))
+    (while (and attnames (not (eq '* (car attnames))))
+      (let ((attdecl (sgml-lookup-attdecl (car attnames) attlist)))
+        (if attdecl 
+            (push attdecl effective-attlist)
+          (message "Attnames specefication error: no %s attribute in %s"
+                   (car attnames) eltype)))
+      (setq attnames (cdr attnames)))
+    (when (eq '* (car attnames))
+      (while attlist
+        (let ((attdecl (sgml-lookup-attdecl (sgml-attdecl-name (car attlist))
+                                            effective-attlist)))
+          (unless attdecl
+            (push (car attlist) effective-attlist)))
+        (setq attlist (cdr attlist))))
+    (nreverse effective-attlist)))
 (defun sgml-attribute-buffer (element asl)
   (let ((bname "*Edit attributes*")
       (setq buf (get-buffer-create bname))
       (set-buffer buf)
-      (sgml-insert '(read-only t rear-nonsticky (read-only))
+      (make-local-variable 'sgml-attlist)
+      (setq sgml-attlist (sgml-effective-attlist
+                          (sgml-element-eltype element)))
+      (sgml-insert '(read-only t)
 		   "<%s  -- Edit values and finish with C-c C-c --\n"
 		   (sgml-element-name element))
-       for attr in (sgml-element-attlist element) do
+       for attr in sgml-attlist do
        ;; Produce text like
        ;;  name = value
        ;;  -- declaration : default --
 	      (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)
+	  '(read-only t category sgml-form) " %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-type-p 'FIXED def-value)
+	   (sgml-insert '(read-only t category sgml-fixed)
+			" #FIXED %s"
 			(sgml-default-value-attval def-value)))
 	  ((and (null cur-value)
-		(or (memq def-value '(implied conref current))
+		(or (memq def-value '(IMPLIED CONREF CURRENT))
 		    (sgml-default-value-attval def-value)))
-	   (sgml-insert '(category sgml-default rear-nonsticky (category))
+           (sgml-insert '(read-only t category sgml-form) " ")
+	   (sgml-insert '(category sgml-default rear-nonsticky (category)
+                                   read-only sgml-default)
 	  ((not (null cur-value))
+           (sgml-insert '(read-only t category sgml-form
+                                    rear-nonsticky (read-only category))
+                        " ")
 	   (sgml-insert nil "%s" (sgml-attspec-attval cur-value))))
 	  '(read-only 1)
 (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)
 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].
+\(\\[delete-window]).  To finish edit use \\[sgml-edit-attrib-finish].
-  (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."
       (narrow-to-region (point)
 			(progn (sgml-edit-attrib-field-end)
-      (unless (eq type 'cdata)
+      (unless (eq type 'CDATA)
 	(subst-char-in-region (point-min) (point-max) ?\n ? )
 	(goto-char (point-min))
-    (sgml-insert '(category sgml-default)
-		 "#DEFAULT")))
+    (sgml-insert '(category sgml-default read-only sgml-default)
+		 "#DEFAULT"))
+  (let ((inhibit-read-only t))
+    (put-text-property (1- (point)) (point)
+                       'rear-nonsticky '(category))))
 (defun sgml-edit-attrib-clear ()
   "Kill the value of current attribute."
-  (kill-region
-   (progn (sgml-edit-attrib-field-start) (point))
-   (progn (sgml-edit-attrib-field-end) (point))))
+  (let ((inhibit-read-only '(sgml-default)))
+    (sgml-edit-attrib-field-start)
+    (let ((end (save-excursion (sgml-edit-attrib-field-end) (point))))
+      (put-text-property (point) end 'read-only nil)
+      (let ((inhibit-read-only t))
+        (put-text-property (1- (point)) (point)
+                           'rear-nonsticky '(read-only category)))
+      (kill-region (point) end))))
 (defun sgml-edit-attrib-field-start ()
   "Go to the start of the attribute value field."
   (let (start)
-        (beginning-of-line 1)
+    (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)))
+    (while (eq 'sgml-form (get-text-property (point) 'category))
+      (setq start (next-single-property-change (point) 'category))
+      (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."
 (defun sgml-edit-attrib-next ()
   "Move to next attribute value."
-  (or (search-forward-regexp "^ *[.A-Za-z0-9---]+ *= ?" nil t)
+  (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.]*\\(\\([^'\"></]\\|'[^']*'\\|\"[^\"]*\"\\)*\\)>?\\)")
+  "\\(</?>\\|</?[_A-Za-z][---_:A-Za-z0-9.]*\\(\\([^'\"></]\\|'[^']*'\\|\"[^\"]*\"\\)*\\)/?>?\\)")
 (defun sgml-operate-on-tags (action &optional attr-p)
   (let ((buffer-modified-p (buffer-modified-p))
 (defun sgml-expand-entity-reference ()
   "Insert the text of the entity referenced at point."
-  (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))))
+  (save-excursion
+    (sgml-with-parser-syntax
+     (setq sgml-markup-start (point))
+     (or (sgml-parse-delim "ERO")
+	 (progn
+	   (skip-syntax-backward "w_")
+	   (forward-char -1)		; @@ Really length of ERO
+	   (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)))))
+(defvar sgml-notation-handlers 
+  '((gif . "xv") 
+    (jpeg . "xv"))
+  "*An alist mapping notations to programs handling them")
+;; Function contributed by Matthias Clasen <clasen@netzservice.de>
+(defun sgml-edit-external-entity ()
+  "Open	a new window and display the external entity at the point."
+  (interactive)
+  (sgml-need-dtd)
+  (save-excursion                     
+    (sgml-with-parser-syntax  
+     (setq sgml-markup-start (point))
+     (unless (sgml-parse-delim "ERO")
+       (search-backward-regexp "[&>;]")
+       (setq sgml-markup-start (point))
+       (sgml-check-delim "ERO"))
+     (sgml-parse-to-here)		; get an up-to-date parse tree
+     (let* ( (parent (buffer-file-name)) ; used to be (sgml-file)
+	     (ename (sgml-check-name t))
+	     (entity (sgml-lookup-entity ename       
+					 (sgml-dtd-entities
+					  (sgml-pstate-dtd
+					   sgml-buffer-parse-state))))
+	     (buffer nil)
+	     (ppos nil))
+       (unless entity
+	 (error "Undefined entity %s" ename))
+       (let* ((type (sgml-entity-type entity))
+	      (notation (sgml-entity-notation entity))
+	      (handler (cdr (assoc notation sgml-notation-handlers))))
+	 (case type
+	   (ndata 
+	    (if handler 
+		(progn
+		  (message (format "Using '%s' to handle notation '%s'."
+				   handler notation))
+		  (save-excursion
+		    (set-buffer (get-buffer-create "*SGML background*"))
+		    (erase-buffer)
+		    (let* ((file (sgml-external-file 
+				  (sgml-entity-text entity)
+				  type
+				  (sgml-entity-name entity)))
+			   (process (start-process 
+				     (format "%s background" handler)
+				     nil handler file)))
+		      (process-kill-without-query process))))
+	      (error "Don't know how to handle notation '%s'." notation)))
+	   (text (progn
+	    ;; here I try to construct a useful value for
+	    ;; `sgml-parent-element'.
+	    ;; find sensible values for the HAS-SEEN-ELEMENT part
+	    (let ((seen nil)
+		  (child (sgml-tree-content sgml-current-tree)))
+	      (while (and child
+			  (sgml-tree-etag-epos child)
+			  (<= (sgml-tree-end child) (point)))
+		(push (sgml-element-gi child) seen)
+		(setq child (sgml-tree-next child)))
+	      (push (nreverse seen) ppos))
+	    ;; find ancestors
+	    (let ((rover sgml-current-tree))
+	      (while (not (eq rover sgml-top-tree))
+		(push (sgml-element-gi rover) ppos)
+		(setq rover (sgml-tree-parent rover))))
+	    (find-file-other-window
+	     (sgml-external-file (sgml-entity-text entity)
+				 (sgml-entity-type entity)
+				 (sgml-entity-name entity)))
+	    (goto-char (point-min))
+	    (sgml-mode)
+	    (setq sgml-parent-document (cons parent ppos))
+	    ;; update the live element indicator of the new window
+	    (sgml-parse-to-here)))
+	   (t (error "Can't edit entities of type '%s'." type))))))))
 ;;;; SGML mode: TAB completion
 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.
+declaration names. If it is a reserved word starting with # complete
+reserved words.
 If it is something else complete with ispell-complete-word."
   (interactive "*")
   (let ((tab				; The completion table
+        (ignore-case                    ; If ignore case in matching completion
+         sgml-namecase-general)
 	(pattern nil)
 	(c nil)
 	(here (point)))
-    (skip-chars-backward "^ \n\t</!&%")
+    (skip-chars-backward "^ \n\t</!&%#")
     (setq pattern (buffer-substring (point) here))
     (setq c (char-after (1- (point))))
      ;; markup declaration
      ((eq c ?!)
-      (setq tab sgml-markup-declaration-table))
+      (setq tab sgml-markup-declaration-table
+            ignore-case t))
+     ;; Reserved words with '#' prefix
+     ((eq c ?#)
+      (setq tab '(("PCDATA") ("NOTATION") ("IMPLIED") ("REQUIRED")
+                  ("FIXED") ("EMPTY"))
+            ignore-case t))
       (goto-char here)
     (when tab
-      (let ((completion (try-completion pattern tab)))
+      (let* ((completion-ignore-case ignore-case)
+             (completion (try-completion pattern tab)))
 	(cond ((null completion)
 	       (goto-char here)
 	       (message "Can't find completion for \"%s\"" pattern)
       (setq val (read-string (concat (sgml-variable-description var) ": ")))
       (when (stringp val)
 	(set var val)))
+     ((eq 'file-list  type)
+      (describe-variable var)
+      (sgml-append-to-help-buffer "\
+Enter as many filenames as you want. Entering a directory 
+or non-existing filename will exit the loop.")
+      (setq val nil)
+      (while (let ((next
+		    (expand-file-name
+		     (read-file-name
+		      (concat (sgml-variable-description var) ": ")
+		      nil "" nil nil))))
+	       (if (and (file-exists-p next) (not (file-directory-p next)))
+		   (setq val (cons next val)))))
+      (set var val))
+     ((eq 'file-or-nil type) 
+      (describe-variable var)
+      (sgml-append-to-help-buffer "\
+Entering a directory or non-existing filename here
+will reset the variable.")
+      (setq val (expand-file-name
+		 (read-file-name
+		  (concat (sgml-variable-description var) ": ") 
+		  nil (if (stringp val) (file-name-nondirectory val)) 
+		  nil (if (stringp val) (file-name-nondirectory val)) )))
+      (if (and (file-exists-p val) (not (file-directory-p val))) 
+	  (set var val) 
+	(set var nil)))   
      ((consp type)
       (let ((val
 	     (sgml-popup-menu event
 	(set var (car (read-from-string val)))))))
-(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
-      "-"))))
+(defun sgml-append-to-help-buffer (string)
+  (save-excursion
+    (set-buffer "*Help*")
+    (let ((inhibit-read-only t))
+      (goto-char (point-max))
+      (insert "\n" string))))
 ;;;; NEW
     (delete-char 1))
+(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)
+(defun sgml--add-before-p (tok state child)
+  ;; Can TOK be added in STATE followed by CHILD 
+  (let ((snext (sgml-get-move state tok))
+        (c child))
+    (when snext
+      (while c
+        (setq snext (sgml-get-move snext
+                                   (sgml-eltype-token
+                                    (sgml-element-eltype c))))
+        (setq c (and snext (sgml-element-next c)))))
+    ;; If snext is still non nill it can be inserted 
+    snext))
+(defun sgml--all-possible-elements (el)
+  (let ((c (sgml-element-content el))
+        (s (sgml-element-model el))
+        (found nil))
+    (loop do
+          (dolist (tok (nconc (sgml-optional-tokens s)
+                              (sgml-required-tokens s)))
+            (unless (memq tok found)
+              ;; tok is optional here and not already found -- check that
+              ;; it would not make the content invalid
+              (when (sgml--add-before-p tok s c)
+                  (push tok found))))
+          while c do
+          (setq s (sgml-element-pstate c))
+          (setq c (sgml-element-next c)))
+    (mapcar #'sgml-token-eltype found)))
+(defun sgml-add-element-to-element (gi first)
+  "Add an element of type GI to the current element.
+The element will be added at the last legal position if FIRST is `nil',
+otherwise it will be added at the first legal position."
+  (interactive
+   (let ((tab
+          (mapcar (function (lambda (et) (cons (sgml-eltype-name et) nil)))
+                  (sgml--all-possible-elements
+                   (sgml-find-context-of (point))))))
+     (cond ((null tab)
+            (error "No element possible"))
+           (t
+            (let ((completion-ignore-case sgml-namecase-general))
+              (list (completing-read "Element: " tab nil t
+                                     (and (null (cdr tab)) (caar tab)))
+                    current-prefix-arg))))))
+  (let ((el (sgml-find-context-of (point)))
+        (et (sgml-lookup-eltype (sgml-general-case gi))))
+    ;; First expand empty tag
+    (when (and sgml-xml-p (sgml-element-empty el))
+      (save-excursion
+	(goto-char (sgml-element-stag-end el))
+	(delete-char -2)
+	(insert ">\n" (sgml-end-tag-of sgml-current-tree))
+	(sgml-indent-line))
+      (setq el (sgml-find-context-of (point))))
+    (let ((c (sgml-element-content el))
+          (s (sgml-element-model el))
+          (tok (sgml-eltype-token et))
+          (last nil))
+      ;; Find legal position for new element
+      (while (and (not (cond
+                        ((sgml--add-before-p tok s c)
+                         (setq last (if c (sgml-element-start c)
+                                      (sgml-element-etag-start el)))
+                         first)))
+                  (cond
+                   (c (setq s (sgml-element-pstate c))
+                      (setq c (sgml-element-next c))
+                      t))))
+      (cond (last
+             (goto-char last)
+             (sgml-insert-element gi))
+            (t
+             (error "A %s element is not valid in current element" gi))))))
 ;;; psgml-edit.el ends here

File psgml-fs.el

View file
 ;; Author: Lennart Staflin <lenst@lysator.liu.se>
 ;; Version: $Id$
 ;; Keywords: 
-;; Last edited: Thu Mar 21 22:32:27 1996 by lenst@triton.lstaflin.pp.se (Lennart Staflin)
+;; Last edited: 1999-08-02 20:55:20 lenst
 ;;; 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
 ;;; Commentary:
-;; The function `style-format' formats the SGML-file in the current
-;; buffer according to the style defined in the file `psgml-style.fs'
-;; (or the file given by the variable `fs-style').
+;; The function `style-format' formats the SGML-file in the current buffer
+;; according to the style defined in the file `style.fs' (or the file given
+;; by the variable `fs-style').
 ;; To try it load this file and open the test file example.sgml. Then
 ;; run the emacs command `M-x style-format'.
     (literal . nil)))
 (defvar fs-special-styles
-  '(top bottom before after hang-from text)
+  '(top bottom before after hang-from text sub-style)
   "Style attribues that should not be entered in the characteristics table.")
+;;; Dynamic variables
+(defvar fs-current-element nil)
+(defvar fs-buffer)
 ;;;; Formatting engine
 (defun fs-char (p)
   (cdr (assq p fs-char)))
+(defun fs-set-char (p val)
+  (setcdr (assq p fs-char) val))
+(defsetf fs-char fs-set-char)
 (defvar fs-para-acc ""
   "Accumulate text of paragraph")
 (defvar fs-vspace 0
   "Vertical space after last paragraph")
+(defun fs-add-output (str &optional just)
+  (save-excursion
+    (set-buffer fs-buffer)
+    (goto-char (point-max))
+    (let ((start (point)))
+      (insert str)
+      (when just
+        (set-justification start (point) just)))))
 (defun fs-addvspace (n)
   (when (> n fs-vspace)
-    (princ (make-string (- n fs-vspace) ?\n))
+    (fs-add-output (make-string (- n fs-vspace) ?\n))
     (setq fs-vspace n)))
 (defun fs-para ()
-  (when (if (fs-char 'ignore-epmty-para)
+  (when (if (fs-char 'ignore-empty-para)
 	    (string-match "[^\t\n ]" fs-para-acc)
     (assert fs-left-indent)
   (unless fs-left-indent
     (setq fs-left-indent (fs-char 'left)
 	  fs-first-indent (fs-char 'first)))
-  (setq fs-para-acc (concat fs-para-acc data)))
+  (let ((face (fs-char 'face)))
+    (when face
+      (setq data (copy-sequence data))
+      (put-text-property 0 (length data)
+                         'face face data))
+    (setq fs-para-acc (concat fs-para-acc data))))
 (defun fs-output-para (text first-indent indent hang-from literal)
   (sgml-push-to-string text)
 	 (make-string (or first-indent indent) ? )))
       (fill-region-as-paragraph (point-min) (point-max))
-      ))
-    (princ (buffer-string)))
-  (sgml-pop-entity))
+      (goto-char (point-max))
+      (unless (bolp)
+        (insert ?\n))))
+    (fs-add-output (buffer-string) (fs-char 'justification)))
+  (sgml-pop-entity)
+  (sit-for 0))
 (defun fs-element-content (e)
-  (let ((fs-para-acc ""))
+  (let ((fs-para-acc "") fs-first-indent fs-left-indent)
     (sgml-map-content e
 		      (function fs-paraform-phrase)
 		      (function fs-paraform-data)
 ;;;; Style driven engine
-(defvar fs-style "psgml-style.fs"
+(defvar fs-style "style.fs"
   "*Style sheet to use for `style-format'.
 The value can be the style-sheet list, or it can be a file name
 \(string) of a file containing the style sheet or it can be the name
 	       (cdr (or (assoc (sgml-element-gi e) fs-style)
 			(assq t fs-style)))))
-(defun fs-do-style (e style)
+(defun fs-do-style (fs-current-element style)
   (let ((hang-from (getf style 'hang-from)))
     (when hang-from
       (setq fs-hang-from 
 	    (format "%s%s "
-		    (make-string (fs-char 'left) ? )
+		    (make-string 
+		     (or (fs-char 'hang-left) (fs-char 'left))
+		     ? )
 		    (eval hang-from)))))
   (let ((fs-char (nconc
 		  (loop for st on style by 'cddr
       (when before
 	(fs-do-style e before)))
     (cond ((getf style 'text)
-	   (fs-paraform-data (eval (getf style 'text))))
+	   (let ((text (eval (getf style 'text))))
+	     (when (stringp text)
+	       (fs-paraform-data text))))
-	   (sgml-map-content e
-			     (function fs-engine)
-			     (function fs-paraform-data)
-			     nil
-			     (function fs-paraform-entity))))
+           (let ((fs-style
+                  (append (getf style 'sub-style)
+                          fs-style)))
+             (sgml-map-content e
+                               (function fs-engine)
+                               (function fs-paraform-data)
+                               nil
+                               (function fs-paraform-entity)))))
     (let ((after (getf style 'after)))
       (when after
 	(fs-do-style e after)))
 (defun style-format ()
-  (setq fs-para-acc "")
-  (let ((fs-style (fs-get-style fs-style)))
-    (with-output-to-temp-buffer "*Formatted*"
-      (fs-engine (sgml-top-element))
-      (fs-para))))
+  (setq fs-para-acc ""
+        fs-hang-from nil
+        fs-first-indent nil
+        fs-left-indent nil
+        fs-vspace 0)
+  (let ((fs-style (fs-get-style fs-style))
+        (fs-buffer (get-buffer-create "*Formatted*")))
+    (save-excursion
+      (set-buffer fs-buffer)
+      (erase-buffer))
+    (display-buffer fs-buffer)
+    (fs-engine (sgml-top-element))
+    (fs-para)
+    (save-excursion
+      (set-buffer fs-buffer)
+      (goto-char (point-min)))))
 ;;;; Helper functions for use in style sheet
-(defun fs-attval (name)
-  (sgml-element-attval e name))
+(defun fs-element (&rest moves)
+  "Find current or related element."
+  (let ((element fs-current-element))
+    (while moves
+      (case (pop moves)
+        (parent (setq element (sgml-element-parent element)))
+        (next   (setq element (sgml-element-next element)))
+        (child  (setq element (sgml-element-content element)))))
+    element))
+(defun fs-attval (name &optional element)
+  (sgml-element-attval (if element element (fs-element))
+                       name))
+(defun fs-child-number (&optional element)
+  (let* ((element (or element (fs-element)))
+         (parent (sgml-element-parent element))
+         (child  (sgml-element-content parent))
+         (number 0))
+    (while (and child (not (eq child element)))
+      (incf number)
+      (setq child (sgml-element-next child)))
+    number))
+(defun fs-element-with-id (id)
+  (block func
+    (let ((element (sgml-top-element)))
+      (while (not (sgml-off-top-p element))
+        (let ((attlist (sgml-element-attlist element)))
+          (loop for attdecl in attlist
+                if (eq 'ID (sgml-attdecl-declared-value attdecl))
+                do (if (equalp id (sgml-element-attval element
+                                                       (sgml-attdecl-name attdecl)))
+                       (return-from func element))))
+        ;; Next element
+        (if (sgml-element-content element)
+            (setq element (sgml-element-content element))
+          (while (null (sgml-element-next element))
+            (setq element (sgml-element-parent element))
+            (if (sgml-off-top-p element)
+                (return-from func nil)))
+          (setq element (sgml-element-next element)))))
+    nil))
-;;; psgml-fs.el ends here
+;;; fs.el ends here

File psgml-html.el

View file
   :type 'string
   :group 'psgml-html)
-(defcustom html-helper-htmldtd-version "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">\n"
+(defcustom html-helper-htmldtd-version "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n"
   "*Version of HTML DTD you're using."
   :type 'string
   :group 'psgml-html)
 ;; ones we know of.
 (defcustom html-helper-types-to-install
-  '(anchor header logical phys list textel entity image head form)
+  '(anchor header logical phys list textel entity image head form table
+	   special)
   "*List of tag types to install when html-helper-mode is first loaded.
 If you want to not install some type of tag, override this variable.
 Order is significant: menus go in this order."
   :type '(repeat symbol)
   :group 'psgml-html)
+(defcustom html-helper-use-expert-menu nil
+  "*If not nil, then use the full HTML menu."
+  :type 'boolean
+  :group 'psgml-html)
+(defcustom html-helper-user-menu nil
+  "*Extra items to put in the HTML expert menu.
+The value of this symbol is appended to the beginning of the expert
+menu that is handed off to easymenu for definition. It should be a
+list of vectors or lists which themselves are vectors (for submenus)."
+  :type 'sexp
+  :group 'psgml-html)
 ;;}}} end of user variables
 ;;{{{ type based keymap and menu variable and function setup
   ;; font-lock setup for various emacsen: XEmacs, Emacs 19.29+, Emacs <19.29.
   ;; By Ulrik Dickow <dickow@nbi.dk>.  (Last update: 05-Sep-1995).
-  (cond	((string-match "XEmacs\\|Lucid" (emacs-version)) ; XEmacs/Lucid
+  (cond	(running-xemacs ; XEmacs/Lucid
 	 (put major-mode 'font-lock-keywords-case-fold-search t))
 	;; XEmacs (19.13, at least) guesses the rest correctly.
 	;; If any older XEmacsen don't, then tell me.
   (modify-syntax-entry ?\\ ".   " html-mode-syntax-table)
   (modify-syntax-entry ?'  "w   " html-mode-syntax-table)
+  (tempo-use-tag-list 'html-helper-tempo-tags html-helper-completion-finder)
+  (setq imenu-create-index-function 'html-helper-imenu-index)
+  (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
   ; sigh ...  need to call this now to get things working.
   ;; (add-submenu nil sgml-html-menu "SGML")
+  (setq sgml-menu-name "HTML")
   (easy-menu-add sgml-html-menu)
+  (html-helper-rebuild-menu)
   (unless (featurep 'infodock)
     (delete-menu-item '("SGML"))))
+(defvar html-helper-imenu-regexp
+  "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
+  "*A regular expression matching a head line to be added to the menu.
+The first `match-string' should be a number from 1-9.
+The second `match-string' matches extra tags and is ignored.
+The third `match-string' will be the used in the menu.")
+;; Make an index for imenu
+(defun html-helper-imenu-index ()
+  "Return an table of contents for an html buffer for use with Imenu."
+  (let ((space ?\ ) ; a char
+	(toc-index '())
+	toc-str)
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward html-helper-imenu-regexp nil t)
+	(setq toc-str
+	      (concat
+	       (make-string
+		(* 2 (- (string-to-number (match-string 1)) 1))
+		space)
+	       (match-string 3)))
+	(beginning-of-line)
+	(setq toc-index (cons (cons toc-str (point)) toc-index))
+	(end-of-line)))
+    (nreverse toc-index)))
 (defun html-helper-add-type-to-alist (type)
   "Add a type specification to the alist.
 The spec goes (type . (keymap-symbol keyprefix menu-symbol menu-string)).
 (mapcar 'html-helper-add-type-to-alist
   '((entity  . (nil nil html-helper-entity-menu "Insert Character Entities"))
     (textel  . (nil nil html-helper-textel-menu "Insert Text Elements"))
-    (head    . (html-helper-head-map "\C-zb" html-helper-head-menu "Insert Structural Elements"))
+    (head    . (html-helper-head-map "\C-zw" html-helper-head-menu "Insert Structural Elements"))
     (header  . (html-helper-base-map "\C-z" html-helper-header-menu "Insert Headers"))
     (anchor  . (html-helper-base-map "\C-z" html-helper-anchor-menu "Insert Hyperlinks"))
     (logical . (html-helper-base-map "\C-z" html-helper-logical-menu "Insert Logical Styles"))
     (phys    . (html-helper-base-map "\C-z" html-helper-phys-menu "Insert Physical Styles"))
     (list    . (html-helper-list-map "\C-zl" html-helper-list-menu "Insert List Elements"))
     (form    . (html-helper-form-map "\C-zf" html-helper-form-menu "Insert Form Elements"))
-    (image   . (html-helper-image-map "\C-zm" html-helper-image-menu "Insert Inlined Images"))))
+    (table   . (html-helper-table-map "\C-zt" html-helper-table-menu "Insert Table Elements"))
+    (image   . (html-helper-image-map "\C-zm" html-helper-image-menu "Insert Inlined Images"))
+    (special . (html-helper-base-map "\C-z" html-helper-special-menu "Insert Specials"))))
 ;; Once html-helper-mode is aware of a type, it can then install the
 ;; type: arrange for keybindings, menus, etc.
   "Given a string, downcase it and replace spaces with -.
 We use this to turn menu entries into good symbols for functions.
 It's not entirely successful, but fortunately emacs lisp is forgiving."
-  (let* ((s (copy-sequence input-string))
+  (let* ((s (downcase input-string))
 	 (l (1- (length s))))
-    (while (> l 0)
+    (while (>= l 0)
       (if (char-equal (aref s l) ?\ )
 	  (aset s l ?\-))
       (setq l (1- l)))
-    (concat "html-" (downcase s))))
+    (concat "html-" s)))
 (defun html-helper-add-tag (l)
 ;;{{{ most of the HTML tags
-;; These tags are an attempt to be HTML/2.0 compliant, with the exception
-;; of container <p>, <li>, <dd>, <dt> (we adopt 3.0 behaviour).
-;; For reference see <URL:http://www.w3.org/hypertext/WWW/MarkUp/MarkUp.html>
+;; These tags are an attempt to be HTML 3.2 compliant
+;; For reference see <URL:http://www.w3.org/TR/REC-html32.html>
 ;; order here is significant: within a tag type, menus and mode help
 ;; go in the reverse order of what you see here. Sorry about that, it's
-   (entity  "\C-c#"   "&#"              "Ascii Code"      ("&#" (r "Ascii: ") ";"))
-   (entity  "\C-c\""  "&quot;"          "Quotation mark"  ("&quot;"))
-   (entity  "\C-c$"   "&reg;"           "Registered"      ("&reg;"))