;	####	RTF2XML version 0.9
;	####	Copyright (C) 1997-2000 Rick Geimer

;	####	This program is free software; you can redistribute it and/or
;	####	modify it under the terms of the GNU General Public Licence
;	####	as published by the Free Software Foundation; either version
;	####	2 of the licence, or (at your option) any later version.

;	####	This program is distributed in the hope that it will be useful,
;	####	but WITHOUT ANY WARRANTY; without even the implied warranty of
;	####	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See 
;	####	the GNU General Public Licence for more details.

;	####	You should have received a copy of the GNU General Public Licence
;	####	along with this program; if not, write to the Free Software
;	####	Foundation, Inc., 675 Mass Ave, Cambridge, MA, 02139, USA.
;	####	The above licence is also available online at "http://www.gnu.org/".

;	####	Rick Geimer
;	####	rtf2xml@xmeta.com
;	####	2401 Huran Drive
;	####	San Jose, CA, 95122
;	####	USA
	

include "library.xin"

define function zero-shelf(modifiable stream the-stream) as
	repeat over the-stream
		set the-stream to ""
	again

define function start-string(value stream the-contents) as
	output	"<string" || 
		format-stack key "current-char-style-name" ||
		format-stack key "current-font-name" ||
		format-stack key "current-font-size" ||
		format-stack key "is-bold" ||
		format-stack key "is-italic" ||
		format-stack key "is-underlined" ||
		format-stack key "is-subscript" ||
		format-stack key "is-superscript" ||
		format-stack key "is-hidden" ||
		format-stack key "current-charset" ||
		format-stack key "current-color" ||
		format-stack key "is-caps" ||
		format-stack key "is-scaps" ||
		format-stack key "is-strike" ||
		format-stack key "expand-twips" ||
		format-stack key "rev-status" ||
		format-stack key "rev-author" ||
		format-stack key "rev-time" ||
		">" when not string-close matches "</string>"
	set string-close to "</string>"
	output "%g(the-contents)"
	
define stream function save-fig(value stream fig-data) as
	local stream fig-file
	local counter byte-me
	increment fig-count
	open fig-file with binary-mode as "%g(fig-path)p%7fzd(fig-count).%g(fig-ext)"
	repeat scan fig-data
		match ul [digit or "ABCDEF"]{2} => a-byte
			set byte-me to a-byte base 16
			put fig-file "%b(byte-me)"
		match any
	again
	close fig-file
	return "p%7fzd(fig-count).%g(fig-ext)"

define function start-paragraph as
	increment para-cnt
;	output "<!-- start-para -->"
	output (referent "para-%d(para-cnt)") ; || "<!-- %g(debug-stream) -->"
	set referent "para-%d(para-cnt)" to ""
	activate in-para

define function end-paragraph (value stream eat-me, value stream print-after) as
	local stream format-buffer
	do when active in-para
		open format-buffer as referent "para-%d(para-cnt)" 
		using output as format-buffer
		do
			do when active table-switches key "in-table"
				output "<table>%n" when not active table-switches key "in-table-element"
				activate table-switches key "in-table-element"
				output	"<row type=%"%g(row-type)%"" ||
						table-border-styles key "trbrdrr" ||
						table-border-widths key "trbrdrr" ||
						table-border-styles key "trbrdrl" ||
						table-border-widths key "trbrdrl" ||
						table-border-styles key "trbrdrt" ||
						table-border-widths key "trbrdrt" ||
						table-border-styles key "trbrdrb" ||
						table-border-widths key "trbrdrb" ||
						table-border-styles key "trbrdrv" ||
						table-border-widths key "trbrdrv" ||
						table-border-styles key "trbrdrh" ||
						table-border-widths key "trbrdrh" ||
						">%n"  when not active table-switches key "in-row"
				set cell-counter to 0 when not active table-switches key "in-row"
				set cell-start to 0 when not active table-switches key "in-row"
				activate table-switches key "in-row"
				increment cell-counter when not active table-switches key "in-cell"
				output	"<cell cellstart=%"%d(cell-start)%" cellend=%"" || 
						cell-endings item cell-counter || 
						"%"" || 
						h-merge item cell-counter || 
						v-merge item cell-counter || 
						table-border-styles key "clbrdrr" ||
						table-border-widths key "clbrdrr" ||
						table-border-styles key "clbrdrl" ||
						table-border-widths key "clbrdrl" ||
						table-border-styles key "clbrdrt" ||
						table-border-widths key "clbrdrt" ||
						table-border-styles key "clbrdrb" ||
						table-border-widths key "clbrdrb" ||
						">%n" when not active table-switches key "in-cell"
				set cell-start to cell-endings item cell-counter when not active table-switches key "in-cell"
				activate table-switches key "in-cell"
			else
                do when active table-switches key "in-table-element"
				    output "</table>%n" 
				    deactivate table-switches key "in-table-element"
                done
			done
			output	"<p" ||
					format-stack key "current-style-name" ||
					format-stack key "current-alignment" ||
					format-stack key "current-font-name" ||
					format-stack key "current-font-size" ||
					format-stack key "is-bold" ||
					format-stack key "is-italic" ||
					format-stack key "is-underlined" ||
					format-stack key "is-subscript" ||
					format-stack key "is-superscript" ||
					format-stack key "is-hidden" ||
					format-stack key "current-charset" ||
					format-stack key "current-color" ||
					format-stack key "is-caps" ||
					format-stack key "is-scaps" ||
					format-stack key "is-strike" ||
		            format-stack key "expand-twips" ||
					format-stack key "rev-status" ||
					format-stack key "rev-author" ||
					format-stack key "rev-time" ||
					">"
		done
		close format-buffer
		deactivate in-para
	;	output "<!-- %g(debug-stream) -->"
		do when number of string-close > 0
			repeat over string-close
				output string-close
				set string-close to ""
			again
		done
		output "</p>"
		output "%n"  when not (element is (FOOTNOTE or ANNOTATION) or ancestor is (FOOTNOTE or ANNOTATION))
		activate field-has-paras when not active allow-nested-paras and ancestor is FIELD
	done
	output stream print-after
	
define function end-cell (value stream eat-me) as
;	set-debug-stream("END-PARA-1")
	end-paragraph("","</cell>%n")
	deactivate table-switches key "in-cell"
	
define function end-row (value stream eat-me) as
	local switch save-in-table-element
	end-cell("") when active table-switches key "in-cell"
	output "</row>%n"
	deactivate table-switches key "in-row"
	set save-in-table-element to table-switches key "in-table-element"
	copy table-element-switch-defaults to table-switches
	set table-switches key "in-table-element" to save-in-table-element
    
define function new-merges() as
	set new h-merge to ""
	set new v-merge to ""
    
define stream function get-local-url (value stream figpath) as
	local stream url
	set url to "file:\\\%g(figpath)"
		; SET THE DEFAULT RETURN VALUE TO A FILE URL
	do scan figpath
		match  ((letter ":") or ".." or win-filename-chars+ )? ("\\" or "\") (win-filename-chars* ("\\" or "\"))* win-filename-chars+=filepat
			; MATCHES FULL DOS PATH
			set url to filepat
		match ([any except ":"]* ":")* any+=filepat
			; MATCHES FULL MAC PATH OR ANY STANDALONE FILENAME
			set url to filepat
	done
	return url
    
define stream function hex-to-dec( value stream hex-string ) as
	local counter decimal-value
	set decimal-value to stream hex-string base 16
	return "%d(decimal-value)"

GROUP IGNORE-IT

element #implied
	suppress

GROUP GROUP-TEXT-ONLY

	element GROUP
		output "%c"
		
	element #implied
		suppress
	
GROUP parse-rtf
	
translate entity named ("char-" [digit or "abcdef"]{1 to 2}= the-ent)
	output "&#" || hex-to-dec("%x(the-ent)") || ";" when not active escape-ansichars or ancestor is (STYLESHEET or FONTTBL or FLDINST)
	output	"<ansichar value=%"" || hex-to-dec("%x(the-ent)") || "%"" ||
				format-stack key "current-font-name" || 
				format-stack key "current-charset" ||
				"/>" when active escape-ansichars and not (ancestor is (STYLESHEET or FONTTBL or FLDINST))
		
translate entity named any+ = the-ent
    do when the-ent = "quot" and ( element is FLDINST or ancestor is FLDINST )
        output '"'
    else when escape-entities = false or ancestor is (STYLESHEET or FONTTBL)
	    output "&%x(the-ent);" 
    else
	    output "<escape entval=%"%x(the-ent)%"/>"
    done
		
translate "%n"
   
element RTFDOC
	set marked-section-controls to "%n<!ENTITY %% xml-ents %"IGNORE%" >%n<!ENTITY %% sdata-ents %"INCLUDE%" >%n" when active (no-unicode or escape-unicode or sdata-entities)
	output	"<?xml version=%"1.0%"?>%n" || 
		"<!DOCTYPE transdoc PUBLIC '-//Rick Geimer//DTD for spiffy RTF to SGML conversion and stuff 0.9//EN' 'transdoc.dtd' [%g(marked-section-controls)]>%n" || 
		"<transdoc>%n%c</transdoc>"
	
element RTFFILE
	doc-saves
	copy format-stack-defaults to format-stack
	set format-stack key "current-style-name" to default-para-style
	clear font-name-stack
	clear font-charset-stack
	clear style-name-stack
	using nested-referents
	do
		set referent "info-header-ref" to ""
		set referent "template-header-ref" to ""
		set referent "userprops-header-ref" to ""
		output	"<file" ||  (referent "file-charset-ref")  || ">%n<meta>%n" || 
				(referent "info-header-ref") || 
				(referent "template-header-ref") || 
				(referent "userprops-header-ref") ||
				"</meta>%n<section>%n%c"
        do when active table-switches key "in-table-element"
            end-paragraph("","</table>%n</section>%n</file>%n")
            deactivate table-switches key "in-table-element"
        else
		    end-paragraph("","</section>%n</file>%n")
        done
		set referent "file-charset-ref" to file-charset
	done
	
element INFO
	set referent "info-header-ref" to "%c"
	
element TITLE when parent is INFO
	output "<title>%c</title>%n"	
	
element AUTHOR when parent is INFO
	output  "<author>%c</author>%n"		
	
element SUBJECT when parent is INFO
	output  "<subject>%c</subject>%n"		
	
element KEYWORDS when parent is INFO
	output  "<keywords>%c</keywords>%n"		
	
element DOCCOMM when parent is INFO
	output  "<doc-comments>%c</doc-comments>%n"	
	
element CREATIM when parent is INFO
	output  "<creation-date>%n%c</creation-date>%n"
	
element REVTIM when parent is INFO
	output  "<revision-date>%n%c</revision-date>%n"
	
element YR when parent is (CREATIM or REVTIM) and preparent is INFO
	output  "<year>%v(VALUE)%c</year>%n"
	
element MO when parent is (CREATIM or REVTIM) and preparent is INFO
	output  "<month>%v(VALUE)%c</month>%n"
	
element DY when parent is (CREATIM or REVTIM) and preparent is INFO
	output  "<day>%v(VALUE)%c</day>%n"
	
element HR when parent is (CREATIM or REVTIM) and preparent is INFO
	output  "<hour>%v(VALUE)%c</hour>%n"
	
element MIN when parent is (CREATIM or REVTIM) and preparent is INFO
	output  "<minute>%v(VALUE)%c</minute>%n"
	
element COMPANY when parent is INFO
	output  "<company>%c</company>%n"
	
global stream current-propname
global counter current-proptype
	
element USERPROPS when parent is RTFFILE
	save current-propname
	save current-proptype
	set referent "userprops-header-ref" to  "<userprops>%n%c</userprops>%n"
	
element PROPNAME
	set current-propname to "%c"
	
element PROPTYPE
	set current-proptype to "%v(VALUE)%c"
	
element STATICVAL
	output "<property name=%"%g(current-propname)%" type=%"%d(current-proptype)%">%c</property>%n"
	
element TEMPLATE when parent is RTFFILE
	set referent "template-header-ref" to  "<template>" || get-local-url("%c") || "</template>%n"
		
element (ANSI or MAC or PC or PCA)
	set file-charset to " charset=%"%q%c%""
	
element FONTTBL
	clear font-name-stack
	clear font-charset-stack
	suppress
	
element FONTSPEC
	local stream font-name
	group-saves
	save in-para
	save font-charset
	set font-name to "%c"
	set new font-name-stack key "%d(font-num)" to "%g(font-name)"
	set new font-charset-stack key "%d(font-num)" to "%g(font-charset)"

element STYLESHEET when not ancestor is (DEST or UD)
	suppress
	set default-para-style to " stylename=%"" || style-name-stack key "0" || "%"" when style-name-stack has key "0"

element STYLESHEET when ancestor is UD and not active ansi-stylenames
	clear style-name-stack
	suppress
	set default-para-style to " stylename=%"" || style-name-stack key "0" || "%"" when style-name-stack has key "0"
	
element STYLESHEET when ancestor is UD and active ansi-stylenames
	save style-name-stack
	clear style-name-stack 
	suppress

element STYLSPEC when not ancestor is DEST
	local stream style-name
	group-saves
	save in-para
	set style-name to "%c"
	do when style-name-stack hasnt key "%d(style-num)" 
		set new style-name-stack key "%d(style-num)" to style-name
	done
    
	
element F when attribute VALUE is specified and ancestor is FONTTBL
	set font-num to "%v(VALUE)%c"
	
element F when attribute VALUE is specified and element is STYLSPEC
	set font-num to "%v(VALUE)%c"
	
element F when attribute VALUE is specified and not ancestor is FONTTBL and not element is STYLSPEC
	set new font-name-stack key "%v(VALUE)" to "" when not font-name-stack has key "%v(VALUE)"
	set format-stack key "current-font-name" to " fontname=%"" || font-name-stack key "%v(VALUE)%c" || "%""
	set format-stack key "current-charset" to font-charset-stack key "%v(VALUE)" when font-charset-stack has key "%v(VALUE)"
	
element FS when attribute VALUE is specified and not ancestor is STYLESHEET
	set format-stack key "current-font-size" to " fontsize=%"%v(VALUE)%c%""
	
element FCHARSET when not attribute VALUE matches "0"
	set font-charset to " charset=%"%v(VALUE)%c%""

element S when attribute VALUE is specified and ancestor is STYLESHEET and not ancestor is DEST
	set style-num to "%v(VALUE)%c"
	
element S when attribute VALUE is specified and not ancestor is STYLESHEET
	set new style-name-stack key "%v(VALUE)" to "" when not style-name-stack has key "%v(VALUE)"
	set format-stack key "current-style-name" to " stylename=%"" || stream style-name-stack key "%v(VALUE)%c" || "%""
	
element CS when attribute VALUE is specified and ancestor is STYLESHEET and not ancestor is DEST
	set style-num to "%v(VALUE)%c"
	
element CS when attribute VALUE is specified and not ancestor is STYLESHEET
	set new style-name-stack key "%v(VALUE)" to "" when not style-name-stack has key "%v(VALUE)"
	set format-stack key "current-char-style-name" to " charstyname=%"" || stream style-name-stack key "%v(VALUE)%c" || "%""
	
define function format-stack-on-off(value stream the-key, value stream the-att , value stream boolean ) as
	set format-stack key the-key to " %g(the-att)=%"on%""
	set format-stack key the-key to " %g(the-att)=%"off%"" when "%g(boolean)" matches "0"
	
element B when attribute VALUE is specified
	format-stack-on-off( "is-bold" , "bold" , "%v(VALUE)%c" )
	
element B when not attribute VALUE is specified
	format-stack-on-off( "is-bold" , "bold" , "1%c" )
	
element I when attribute VALUE is specified
	format-stack-on-off( "is-italic" , "italic" , "%v(VALUE)%c" )
		
element I when not attribute VALUE is specified
	format-stack-on-off( "is-italic" , "italic" , "1%c" )
	
element UL when attribute VALUE is specified
	format-stack-on-off( "is-underlined" , "underline" , "%v(VALUE)%c" )
	
element UL when not attribute VALUE is specified
	format-stack-on-off( "is-underlined" , "underline" , "1%c" )
	
element SUB
	set format-stack key "is-subscript" to " subscript=%"on%c%""
	
element DN
	set format-stack key "is-subscript" to " subscript=%"on%c%""
	
element SUPER
	set format-stack key "is-superscript" to " superscript=%"on%c%""
	
element UP
	set format-stack key "is-superscript" to " superscript=%"on%c%""
	
element V
	set format-stack key "is-hidden" to " hidden=%"on%c%""
	
element QL
	set format-stack key "current-alignment" to " align=%"left%c%""

element QR
	set format-stack key "current-alignment" to " align=%"right%c%""
	
element QJ
	set format-stack key "current-alignment" to " align=%"justify%c%""

element QC
	set format-stack key "current-alignment" to " align=%"center%c%""

element CF when attribute VALUE is specified
	set format-stack key "current-color" to " color=%"%v(value)%c%""

element XE
	start-paragraph when not active in-para
	using group just-the-text
		output "<index-entry category=%"%c%"/>"
        
element TROWD
;    end-row("") when active table-switches key "in-row"
    clear cell-endings
    clear h-merge
    clear v-merge
    new-merges()
    zero-shelf(table-border-styles)
    zero-shelf(table-border-widths)
	set row-type to "tbody"
    suppress
	
element CELLX
	new-merges()
	set new cell-endings to "%v(VALUE)%c"
	
element CLMGF
	set h-merge to " h.merge=%"first%c%""

element CLMRG
	set h-merge to " h.merge=%"continued%c%""

element CLVMGF
	set v-merge to " v.merge=%"first%c%""

element CLVMRG
	set v-merge to " v.merge=%"continued%c%""
	
element TRHDR
	set row-type to "thead%c"
	
element ROW
	end-row("%c")
	
element CELL
	set-debug-stream("2")
	activate table-switches key "in-table"
	start-paragraph when parent is para-parents and not ancestor is FLDINST and not active in-para
	end-cell("%c")
	
element ( TRBRDRT or TRBRDRB or TRBRDRL or TRBRDRR or TRBRDRV or TRBRDRH or CLBRDRT or CLBRDRB or CLBRDRR or CLBRDRL )
	set current-border-type to "%lq%c"
	
element BRDRHAIR when table-border-styles has key "%g(current-border-type)"
	set table-border-styles key "%g(current-border-type)" to " " || border-names key "%g(current-border-type)" || "=%"hairline-thickness%c%""
	
element BRDRS when table-border-styles has key "%g(current-border-type)"
	set table-border-styles key "%g(current-border-type)" to " " || border-names key "%g(current-border-type)" || "=%"single-thickness%c%""
	
element BRDRTH when table-border-styles has key "%g(current-border-type)"
	set table-border-styles key "%g(current-border-type)" to " " || border-names key "%g(current-border-type)" || "=%"double-thickness%c%""
	
element BRDRSH when table-border-styles has key "%g(current-border-type)"
	set table-border-styles key "%g(current-border-type)" to " " || border-names key "%g(current-border-type)" || "=%"shadowed-border%c%""
	
element BRDRDB when table-border-styles has key "%g(current-border-type)"
	set table-border-styles key "%g(current-border-type)" to " " || border-names key "%g(current-border-type)" || "=%"double-border%c%""
	
element BRDRDOT when table-border-styles has key "%g(current-border-type)"
	set table-border-styles key "%g(current-border-type)" to " " || border-names key "%g(current-border-type)" || "=%"dotted-border%c%""
	
element BRDRDASH when table-border-styles has key "%g(current-border-type)"
	set table-border-styles key "%g(current-border-type)" to " " || border-names key "%g(current-border-type)" || "=%"dotted-border%c%""
	
element BRDRW when table-border-widths has key "%g(current-border-type)"
	set table-border-widths key "%g(current-border-type)" to " " || border-names key "%g(current-border-type)" || ".width=%"%v(VALUE)%c%""
	
element PARD
	set format-stack key "current-style-name" to ""
	set format-stack key "current-alignment" to ""
	set format-stack key "current-style-name" to default-para-style
	suppress
	
element PLAIN
    set format-stack key "current-char-style-name" to ""
    set format-stack key "current-font-name" to ""
    set format-stack key "is-bold" to ""
    set format-stack key "is-italic" to ""
    set format-stack key "is-underlined" to ""
    set format-stack key "is-subscript" to ""
    set format-stack key "is-superscript" to ""
    set format-stack key "is-hidden" to ""
    set format-stack key "current-charset" to ""
    set format-stack key "current-font-size" to ""
    set format-stack key "current-color" to ""
    set format-stack key "is-caps" to ""
    set format-stack key "is-scaps" to ""
    suppress
    
    
element INTBL
	activate table-switches key "in-table"
    suppress

element SECT
;	set-debug-stream("END-PARA-2")
	end-paragraph("","%c")
    do when active table-switches key "in-table-element"
        output "</table>%n"
        deactivate table-switches key "in-table-element"
    done
    output "</section>%n<section>%n"
	
element PAGE
	end-paragraph("","%c")
    do when active table-switches key "in-table-element"
        output "</table>%n"
        deactivate table-switches key "in-table-element"
    done
    output "<page-break/>%n"
	
element PAR
	set-debug-stream("3")
	start-paragraph when parent is para-parents and not preparent is no-para-or-string-elements and not active in-para
;	set-debug-stream("END-PARA-3")
	end-paragraph("%c","")
	
element GROUP 
	group-saves
	set new string-close to ""
	output "%c"
	output string-close
	remove string-close
	
element (SHPPICT or NONSHPPICT) when active in-para
	group-saves
	save extract-unlinked-figures
	output "<%lq>%c</%lq>"
	
element (SHPPICT or NONSHPPICT) when not active in-para
	group-saves
	set-debug-stream("%q")
	start-paragraph when parent is para-parents and not ancestor is no-para-or-string-elements
	output "<%lq>%c</%lq>"
	
element FIELD
	local stream field-buffer
	group-saves
	save extract-unlinked-figures
	save field-has-paras
	using nested-referents
		set field-buffer with referents-allowed to "%c"
	do when not active field-has-paras
		set-debug-stream("5")
		start-paragraph when parent is para-parents and not ancestor is no-para-or-string-elements and not active in-para
		start-string("") when parent is group
	done
	output "<%lq>%g(field-buffer)</%lq>"

global stream form-field-label initial {""}

define function clear-strings-and-paras() as
	clear string-close
	deactivate in-para
    
define stream function remove-escaped-entities ( value stream the-stream ) as
    local stream return-value
    open return-value as buffer
    using output as return-value
    repeat scan the-stream
        match ( '<escape entval="amp"/>')
            output "&amp;"
        match [any except "<"]+ => data-strings
            output data-strings
        match any => data-char
            output data-char
    again
    close return-value
    return return-value

element FLDINST
    local stream temp-stuff
	local stream fldinst-contents
	save in-para
	save para-cnt
	save escape-ansichars
	save string-close
	save form-field-label
	clear-strings-and-paras()
	deactivate escape-ansichars
	output "<fldinst>"
	using nested-referents
    do
        set temp-stuff with referents-allowed to "%c"
    done
    set fldinst-contents to remove-escaped-entities(temp-stuff)
	repeat scan fldinst-contents
		match white-space* "INCLUDEPICTURE" white-space+ "&quot;" upto("&quot;") = fig-path-pattern "&quot;" white-space + ("\" any-line-break? ("*" or "d"))* "MERGEFORMAT"? any*
			output "<figure figpath=%"%x(fig-path-pattern)%" xml:link=%"simple%" href=%"" || get-local-url(fig-path-pattern) || "%" inline=%"true%" show=%"embed%"/>"
			deactivate extract-unlinked-figures
		match white-space* "INCLUDEPICTURE" white-space+ ([any except white-space or "%""][any except white-space]+) = fig-path-pattern white-space + ("\" any-line-break? ("*" or "d"))* "MERGEFORMAT"? any*
			output "<figure figpath=%"%x(fig-path-pattern)%" xml:link=%"simple%" href=%"" || get-local-url(fig-path-pattern) || "%" inline=%"true%" show=%"embed%"/>"
			deactivate extract-unlinked-figures
		match white-space* "INCLUDEPICTURE" white-space+ "%"" [any except "%""]+=fig-path-pattern "%"" white-space + ("\" any-line-break? ("*" or "d"))* "MERGEFORMAT"? any*
			output "<figure figpath=%"%x(fig-path-pattern)%" xml:link=%"simple%" href=%"" || get-local-url(fig-path-pattern) || "%" inline=%"true%" show=%"embed%"/>"
			deactivate extract-unlinked-figures
		match white-space* ul "SYMBOL" white-space+ digit+=sym-num white-space+ "\f" white-space+ '"' [any except '"']+=font-name '"' white-space+ "\s" white-space+ digit+=font-size any*
			output "<symbol num=%"%x(sym-num)%" font=%"%x(font-name)%" size=%"%x(font-size)%"/>"
		match white-space* "date \@ %"" [any except "%""]+ => date-format "%""
			output "<autodate format=%"%x(date-format)%"/>"
		match white-space* "REF" white-space+ [any except white-space]+ => ref-name any*
			output "<cross-ref name=%"%x(ref-name)%"/>"
        match '&amp;' when active escape-entities
            output '<escape entval="amp"/>'
		match any => some-data
			output some-data
	again
	output "</fldinst>"
	
translate white-space* ("FORMTEXT" or "FORMCHECKBOX" or "FORMDROPDOWN") => form-label white-space* when element is FLDINST or parent is FLDINST or ancestor is FLDINST
	set form-field-label to " label=%"%x(form-label)%""
	
global stream form-field-name initial {""}
global stream form-field-result initial {""}
global stream form-field-type initial {""}
global stream form-field-listbox initial {""}
global stream form-field-deftext initial {""}
global stream form-field-format initial {""}
global counter form-field-list-counter initial {"0"}
	
element FORMFIELD
	local stream form-field-buffer
	save form-field-name
	save form-field-result
	save form-field-type
	save form-field-listbox
	save form-field-deftext
	save form-field-format
	save form-field-list-counter
	set form-field-buffer to "%c"
	output "<formfield" ||
			form-field-name ||
			form-field-label ||
			form-field-type ||
			form-field-result ||
			form-field-listbox ||
			form-field-deftext ||
			form-field-format ||
			">%g(form-field-buffer)</formfield>"
	
element FFNAME
	set form-field-name to " name=%"%c%""
			
element FFRES
	set form-field-result to " result=%"%v(VALUE)%c%""
	
element FFDEFRES when not "%g(form-field-result)" matches any+
	set form-field-result to " result=%"%v(VALUE)%c%""
	
element FFTYPE
	set form-field-type to " type=%"%v(VALUE)%c%""
	
element FFHASLISTBOX
	set form-field-listbox to " haslistbox=%"YES%c%""
	
element FFDEFTEXT
	set form-field-deftext to " deftext=%"%c%""
	
element FFFORMAT
	set form-field-format to " format=%"%c%""
	
element FFL
	output "<formfieldlist number=%"%d(form-field-list-counter)%">%c</formfieldlist>"
	increment form-field-list-counter
	
element FLDRSLT
	save in-para
	save para-cnt
	save string-close
	clear-strings-and-paras()
	using nested-referents
		output "<fldrslt>%c</fldrslt>"
		
element PNTEXT
	group-saves
	set new string-close to ""
	set-debug-stream("START-PARA-10")
	start-paragraph when parent is para-parents and not ancestor is no-para-or-string-elements and not active in-para
	output "<%lq>%c"
	output string-close
	remove string-close
	output "</%lq>"
	
macro nested-para-saves is
	group-saves
	save in-para
	save para-cnt
	save cell-counter
	save table-switches
	save string-close	
	save font-name-stack
	save font-charset-stack	
	save-clear cell-endings
	save-clear h-merge
	save-clear v-merge
macro-end

global counter attribute-refs-counter initial {"0"}

define function nested-para-helper (value stream element-name, value stream att-list) as
	local stream line-breaks initial {"%n"}
	nested-para-saves
	save attribute-refs-counter
	copy table-switch-defaults to table-switches
	set line-breaks to "" when active in-para
	clear-strings-and-paras()
	set new string-close to ""
	set referent "attribute-refs-%d(attribute-refs-counter)" to ""
	output "<%g(element-name)%g(att-list)" || (referent "attribute-refs-%d(attribute-refs-counter)")  || ">%g(line-breaks)"
	using nested-referents
	do
		output "%c"
		end-paragraph("","")
        do when active table-switches key "in-table-element"
            output "</table>%n"
            deactivate table-switches key "in-table-element"
        done
        output "</%g(element-name)>%g(line-breaks)"
	done
	
	
define function output-nested-para-element (value stream element-name, value stream att-list) as
	set cell-counter to 0
	set-debug-stream("output-nested-para-element(%"%g(element-name)%",%"%g(att-list)%")")
	start-paragraph when (not active in-para) and (element isnt (HEADER or FOOTER or HEADERR or FOOTERR or HEADERL or FOOTERL or HEADERF or FOOTERF) )
	increment attribute-refs-counter
	nested-para-helper(element-name,att-list)


	
element FOOTNOTE
	output-nested-para-element("%lq","")
	
	
element ANNOTATION
	save annotation-refs
	output-nested-para-element("%lq","")
	set referent "attribute-refs-%d(attribute-refs-counter)" to "%g(annotation-refs)"
	
element ATNREF
	using group GROUP-TEXT-ONLY
		set annotation-refs to " atnref=%"%c%"%g(atn-author)"
		
element (ATRFSTART or ATRFEND)
    start-paragraph when parent is para-parents and not ancestor is no-para-or-string-elements and not active in-para
	using group GROUP-TEXT-ONLY
		output "<%lq atnref=%"%c%"/>"
		
element ATNAUTHOR
	using group GROUP-TEXT-ONLY
		set atn-author to " author=%"%c%""
		
element (HEADER or FOOTER)
	output-nested-para-element("%lq","")

element HEADERR
	output-nested-para-element("header"," page=%"right%"")

element FOOTERR
	output-nested-para-element("footer"," page=%"right%"")

element HEADERL
	output-nested-para-element("header"," page=%"left%"")

element FOOTERL
	output-nested-para-element("footer"," page=%"left%"")

element HEADERF
	output-nested-para-element("header"," page=%"first%"")

element FOOTERF
	output-nested-para-element("footer"," page=%"first%"")
		
element PNTXTA
	group-saves
	output "<pntxta>%c</pntxta>"
		
element PNTXTB
	group-saves
	output "<pntxta>%c</pntxta>"
	
element PICT when (extract-figures = true) or ((extract-figures = false) and (extract-unlinked-figures = true))
;	#### place "-a extract-figures" on the command line to extract embedded figures
;	#### place "-a extract-unlinked-figures" on the command line to extract embedded figures when no INCLUDEPICTURE link is specified
	set-debug-stream("%q")
	start-paragraph when not active in-para and not ancestor is no-para-or-string-elements
	output "<figdata filename=%"" || save-fig("%c") || "%"%g(fig-prev-type)%g(fig-width)%g(fig-height)%g(fig-width-goal)%g(fig-height-goal)%g(fig-scale-x)%g(fig-scale-y)%g(fig-pos-x)%g(fig-pos-y)/>"
	

element DO
	save do-type
	save do-size-x
	save do-size-y
	save do-pos-x
	save do-pos-y
	output-nested-para-element("drawing-object","") when active output-drawing-objects
	set referent "attribute-refs-%d(attribute-refs-counter)" to "%g(do-type)%g(do-size-x)%g(do-size-y)%g(do-pos-x)%g(do-pos-y)" when active output-drawing-objects
	using group ignore-it
		suppress when not active output-drawing-objects
		
	
element DPTXBX
	set do-type to " type=%"textbox%"" when "%c" matches ""	
	
element DPXSIZE
	set do-size-x to " size.x=%"%v(value)%"" when "%c" matches ""
;	put #error "DPXSIZE"
	
element DPYSIZE
	set do-size-y to " size.y=%"%v(value)%""	when "%c" matches ""
	
element DPX
	set do-pos-x to " pos.x=%"%v(value)%"" when "%c" matches ""
	
element DPY
	set do-pos-y to " pos.y=%"%v(value)%"" when "%c" matches ""
		
element ( WMETAFILE or DIBITMAP or WBITMAP )
	set fig-prev-type to " prev.type=%"%lq%v(VALUE)%"%c"
		
element ( MACPICT or EMFBLIP or PNGBLIP or JPEGBLIP )
	set fig-prev-type to " prev.type=%"%lq%"%c"
		
element PICW
	set fig-width to " width=%"%v(VALUE)%"%c"
		
element PICH
	set fig-height to " height=%"%v(VALUE)%"%c"
		
element PICWGOAL
	set fig-width-goal to " width.goal=%"%v(VALUE)%"%c"
		
element PICHGOAL
	set fig-height-goal to " height.goal=%"%v(VALUE)%"%c"
		
element PICSCALEX
	set fig-scale-x to " scale.x=%"%v(VALUE)%"%c"
		
element PICSCALEY
	set fig-scale-y to " scale.y=%"%v(VALUE)%"%c"
		
element POSX
	set fig-pos-x to " pos.x=%"%v(VALUE)%"%c"
		
element POSY
	set fig-pos-y to " pos.y=%"%v(VALUE)%"%c"
		
element POSNEGX
	set fig-pos-x to " pos.x=%"-%v(VALUE)%"%c"
		
element POSNEGY
	set fig-pos-y to " pos.y=%"-%v(VALUE)%"%c"
	
element FILE
	local stream file-path
	save file-id
	set file-path to "%c"
	set new file-table key file-id to file-path
	set new file-name-table key file-id to get-local-url(file-path)
	set new doclink-stack key file-id to "<doclink docpath=%"%g(file-path)%" xml:link=%"simple%" href=%"%g(file-name-table)%"inline=%"true%" show=%"replace%">"

element FID
	set file-id to "%v(VALUE)%c"
	
element SUBDOCUMENT
	output "<doclink docpath=%"" || file-table key "%v(VALUE)" || "%" xml:link=%"simple%" href=%"" || file-name-table key "%v(VALUE)" || "%" inline=%"true%" show=%"replace%">%c"

global counter trailing-unicode-characters 

translate "\u" digit+=unicode-char splb (("\'" [digit or "ABCDEFabcdef"]{2} splb) or [any-text except "\{}"] or ("\\" or "\{" or "\}" splb)){"%d(trailing-unicode-characters)"}=ansi-char when element is UNICODE
	local stream ansi-temp
	local stream ansi-alt-val
	local counter unicode-value
	set unicode-value to unicode-char
	open ansi-temp as buffer
	open ansi-alt-val as buffer
		repeat scan ansi-char
			match "\'" [digit or "ABCDEFabcdef"]{2} = hex-char splb
				put ansi-alt-val "&#" || hex-to-dec("%x(hex-char)") || ";"
				put ansi-temp "&#" || hex-to-dec("%x(hex-char)") || ";" when (not active escape-ansichars) or (active escape-ansichars and (ancestor is (STYLESHEET or FONTTBL or FLDINST)))
				put ansi-temp	"<ansichar value=%"" || hex-to-dec("%x(hex-char)") || "%"" ||
								format-stack key "current-font-name" || 
								format-stack key "current-charset" ||
								"/>" when active escape-ansichars and not (ancestor is (STYLESHEET or FONTTBL))
			match (("\" ("\" or "{" or "}")) or any)= normal-char
				put (ansi-temp and ansi-alt-val) normal-char
		again
	close ansi-alt-val
	close ansi-temp
	do when active no-unicode
		output ansi-temp
	else when not active escape-unicode or ancestor is STYLESHEET
		output "&#x%16rd(unicode-value);" 
	else
		output "<unichar value=%"x%16rd(unicode-value)%" alt=%"%g(ansi-alt-val)%"/>"
	done
		
element UNICODE
	set trailing-unicode-characters to "%v(TRAIL)"
	start-paragraph when parent is para-parents and not preparent is no-para-or-string-elements and not active in-para
	start-string("") when parent is (GROUP or PNTEXT or FOOTNOTE) and not parent is no-para-or-string-elements and not ancestor is no-para-or-string-elements
	output "%c"
	
element (BKMKSTART or BKMKEND)
	set-debug-stream("%q")
	start-paragraph when parent is para-parents and not ancestor is no-para-or-string-elements and not active in-para
	start-string("") when parent is (GROUP or PNTEXT or FOOTNOTE) and not parent is no-para-or-string-elements and not ancestor is no-para-or-string-elements
	output "<%lq name=%"%c%"/>"
	
data-content when (element is para-parents and not parent is no-para-or-string-elements and not ancestor is no-para-or-string-elements)
	set-debug-stream("4")
	start-paragraph when not active in-para
	start-string("%c") when not element is (UNICODE or RTFFILE or FLDRSLT)
	output "%c" when element is (UNICODE or RTFFILE or FLDRSLT)
	
element DEST
	group-saves
	save string-close
	save in-para
	save font-name-stack
	save font-charset-stack
	save debug-messages
;	set debug-messages to "%v(LABEL)"
	using group ignore-it
		suppress
		
element CAPS when attribute VALUE is specified
	format-stack-on-off( "is-caps" , "caps" , "%v(VALUE)%c" )
		
element CAPS when attribute VALUE isnt specified
	set format-stack key "is-caps" to " caps=%"on%c%""
		
element SCAPS when attribute VALUE is specified
	format-stack-on-off( "is-scaps" , "scaps" , "%v(VALUE)%c" )
		
element SCAPS when attribute VALUE isnt specified
	set format-stack key "is-scaps" to " scaps=%"on%c%""
		
element STRIKE
	set format-stack key "is-strike" to " strike=%"on%c%""
		
element EXPND
    ;   Default value for expand is in quarter points. Convert to twips.
    local counter twips
    set twips to ("%v(value)" * 5)
	set format-stack key "expand-twips" to ' expandtwips="%d(twips)%c"'
		
element EXPNDTW
	set format-stack key "expand-twips" to ' expandtwips="%v(value)%c"'

element REVTBL
	using group revision-table
		suppress
		
element DELETED
	set format-stack key "rev-status" to " rev-status=%"%lq%c%""
		
element REVISED
	set format-stack key "rev-status" to " rev-status=%"%lq%c%""
	
element (CRAUTH or REVAUTH or REVAUTHDEL)
	do when number of revision-authors > "%v(VALUE)"
		set format-stack key "rev-author" to " rev-author=%"" || (revision-authors item ("%v(VALUE)" + 1)) || "%""
	done
	suppress
		
element CRDATE
	set format-stack key "rev-time" to " rev-time=%"%v(VALUE)%c%""
		
element REVDTTM
	set format-stack key "rev-time" to " rev-time=%"%v(VALUE)%c%""
		
element REVDTTMDEL
	set format-stack key "rev-time" to " rev-time=%"%v(VALUE)%c%""
		
element #implied
	group-saves
	save string-close
	save in-para
	save font-name-stack
	save font-charset-stack
	using group ignore-it
		suppress
		
group just-the-text

	element GROUP
		output "%c"
		
	element #implied
		suppress

group revision-table

	translate ";" when element is GROUP and parent is REVTBL

	element GROUP when parent is REVTBL
		set new revision-authors to "%c"
		
	element #implied
		suppress