#############################################################
# HTMLLIB, 0.6
# A library of SGML-to-HTML conversion utilities for Cost
#
# NOTE: Work in progress, I don't recommend using this just yet...
#
# htmllib.tcl,v 1.8 1999/07/26 01:44:14 joe Exp
# 1999/07/26 01:44:14
#############################################################

package provide Cost-HTML 0.6

############################################################
#
# Options:
#
environment HTMLEnv {
    doctype	"-//W3C//DTD HTML 4.0 Transitional//EN"
    outputDir	""

    filePrefix		"node"
    fileExtension	".html"
    sourceSpec		NoSourceSpec
    verbose		1

    headScript		{}

    outfile	stdout
    filename	"-"
}

# List of elements whose end-tags should be omitted:
# These are those with EMPTY declared content (BR, IMG, etc),
# and those with optional end-tags that are frequently
# accidentally terminated (P, LI, etc.)
#
global HTMLOmitEnd;	# Array
foreach _omitEnd {
    BR AREA LINK IMG PARAM HR INPUT COL META
    FRAME ISINDEX BASE
    P DT DD LI
} {
    set HTMLOmitEnd($_omitEnd) 1
}

# html:configure { -option value ... }
#
#	Sets options [%%% document me ]
#
proc html:configure {args} {
    if {[llength $args] == 1} { set args [lindex $args 0]}
    foreach {key val} $args {
	regsub {^-*} $key {} key
	HTMLEnv get $key	;# signals an error if $key does not exist
	HTMLEnv set $key $val
    }
}

############################################################
#
# Low-level utilities:
#

# Text substitution for HTML character data:
#
substitution html:escape {
    &	&
    <	&lt;
    >	&gt;
    @	&#64;
}

# Text substitution for HTML attribute values:
#
substitution html:escapeAttval {
    &	&amp;
    <	&lt;
    >	&gt;
    \"	&quot;
    \'  &squot;
    @	&#64;
}

# html:write text --
#	Insert 'text' literally into the output stream
#
#
proc html:write {text} {
    puts [HTMLEnv get outfile] $text nonewline
}

# html:text {cdata} --
#	Insert character data into the output stream
#	after escaping special characters
#
proc html:text {cdata} {
    html:write [html:escape $cdata]
}

# html:startTag gi [ attspecs ... ]
#
#  Emit a start-tag for element 'gi'.
#
#  'attspecs...' is a paired list of attribute-name/attribute-value pairs.
#
proc html:startTag {gi args} {
    html:write "<$gi"
    if {[llength $args] == 1} {
	set args [lindex $args 0]
    }
    if {[llength $args] % 2} {
    	return -code error "Odd number of attribute-value pairs: $gi $args"
    }
    foreach {attname attval} $args {
	if {$attname == $attval} {
	    # Handle HTML-style 'ATTNAME=ATTNAME' minimization:
	    html:write " $attname"
	} else {
	    html:write " $attname=\"[html:escapeAttval $attval]\""
	}
    }
    html:write "\n>"
}

# html:endTag gi
#
#	Emit an end-tag for element 'gi',
#	unless end-tag omission is specified for element type 'gi'.
#
proc html:endTag {gi} {
    global HTMLOmitEnd
    if {![info exists HTMLOmitEnd([string toupper $gi])]} {
	html:write "</$gi>"
    }
}

# html:element  gi ?attname attval...? script
#
# 	Convenience function: Emit start tag, evaluate script,
#	then emit end tag.
#
proc html:element {gi args} {
    set script [lindex $args end]
    set atts [lrange $args 0 [expr [llength $args] - 2]]
    html:startTag $gi $atts
    uplevel 1 $script
    html:endTag $gi
}

############################################################
#
# File management routines:
#
# html:createFile filename --
#	Creates new file 'filename', and diverts subsequent
#	output to that file.
#
# html:closeFile --
#	Closes current output file, returns to previous file.
#
proc html:createFile {filename} {
    set filename [file join [HTMLEnv get outputDir] $filename]
    set fp [open $filename "w"]
    fconfigure $fp -buffering full
    html:message "Writing $filename..."
    HTMLEnv save outfile $fp filename $filename
}

proc html:closeFile {} {
    if {[HTMLEnv get output] == "stdout"} {
	error "cannot close stdout"
    }
    close [HTMLEnv get outfile]
    HTMLEnv restore
}

#
# html:startDocument [options...]
#
#	Start an HTML document:	<!DOCTYPE ...> declaration and HEAD element.
#
proc html:startDocument {args} {
    array set defaults [list \
    	head		[HTMLEnv get headScript {}] \
	title		{} \
	stylesheet	[HTMLEnv get stylesheet ""] \
	doctype		[HTMLEnv get doctype] \
    ]
    foreach {option value} $args {
	regsub {^-*} $option {} opt;	# trim leading "-"
	if {![info exists defaults($opt)]} {
	    error "Bad option $opt: legal values are [array names defaults]"
	}
	set defaults($opt) $value
    }

    if {$defaults(head) == "" && $defaults(title) == ""} {
	warning "html:startDocument: No title specified"
    }

    fconfigure [HTMLEnv get outfile] -buffering full
    HTMLEnv save
    html:write "<!DOCTYPE HTML PUBLIC \"$defaults(doctype)\">\n"
    html:write "<!-- This file was automatically generated -->\n"
    html:startTag HTML
    html:startTag HEAD
    global COST; html:startTag META NAME Creator CONTENT "Cost $COST(VERSION)"
    if {[string length $defaults(title)]} {
    	html:element TITLE { html:text $defaults(title) }
    }
    uplevel 1 $defaults(head)
    html:endTag HEAD
}

proc html:endDocument {} {
    html:endTag HTML
    html:write "\n"
    HTMLEnv restore
}

############################################################
#
# High-level utilities:
#

# %%% Describe this...
# %%% which specs are used, which props are set.
# %%% allow configuration options (?)
# %%% Check: make sure that if HTMLNode is specified, html == #NODE*
# %%% Check: in processNode, vice versa.
#
proc html:preprocess {} {
    set spec 	[HTMLEnv get sourceSpec]
    set prefix 	[HTMLEnv get filePrefix]
    set ext 	[HTMLEnv get fileExtension]
    set counter	0
    foreachNode doctree el {
	set nodeName   [subst [$spec get nodeName   #IMPLIED]]
	set anchorName [subst [$spec get anchorName #IMPLIED]]
	switch -- $nodeName {
	    #IMPLIED	{ }
	    #AUTO       { setprop HTMLNode \
	    			"$prefix[format %03d [incr counter]]$ext" }
	    default	{ setprop HTMLNode "${nodeName}$ext" }
	}
	switch -- $anchorName {
	    #IMPLIED	{ }
	    #AUTO	{ setprop HTMLAnchor \
	    			"[q gi][format %04d [elementNumber]]" }
	    default	{ setprop HTMLAnchor $anchorName }
	}
    }
}

############################################################
#
# Cross-reference management:
#
# html:hrefpos [query ... ]
#	Returns a (relative) URL which will link to node specified
#	by 'query...', or to the current node if 'query' is omitted.
#
#	If the node isn't directly addressable in the HTML output,
#	returns a link to the nearest ancestor which is.
#
# %%% Also need: convenient way to generate <A NAME="..."> elements
# %%% at appropriate places.
#
proc html:hrefpos {args} {
    set anchor ""
    set node ""
    withNode ! {
	if {![eval selectNode $args]} {
	    warning "query $args failed"
	    return ""
	}
	foreachNode ancestor {
	    if {[query? hasprop HTMLAnchor] && $anchor == ""} {
		set anchor [query propval HTMLAnchor]
	    }
	    if {[query? hasprop HTMLNode]} {
		set node [query propval HTMLNode]
		break;
	    }
	}
	if {[string length $anchor]} {
	    return "$node#$anchor"
	} elseif {[string length $node]} {
	    return $node
	} ;# else
	warning \
 	 "Cannot find HTML locator for node [q gi].[elementNumber]"
    }
    return ""
}

#
# html:anchorName --
#	%%% Describe
#
proc html:anchorName {} {
    return [query ancestor propval HTMLAnchor]
}

############################################################
#
# SGML-to-HTML conversion.
#
# html:processNode --
#	Process the current source node, depending on
#	options specified in current sourceSpec.
#
# %%% TODO: allow configuration options on processNode, processChildren
#
proc html:processNode {} {
    switch -- [query nodetype] {
	EL	{ #see below }
	CDATA	{ html:text [query content]; return }
	SDATA	{ cost:undefined SDATA [query content]
		  html:text "{SDATA [query content]}";
		  return }
	RE	{ html:write "\n" ; return; }
	PEL	-
	SD	{ foreachNode child html:processNode ; return }
	DATAENT -
	ENTREF  -
	PI	-
	default	{ cost:undefined NODETYPE [query nodetype]; return }
    }

    # Processing for EL nodes:
    #
    set spec [HTMLEnv get sourceSpec]
    uplevel #0 $spec do startAction
    set result [subst [$spec get html #UNDEFINED]]
    set gi [lindex $result 0]
    set atts [lrange $result 1 end]
    switch $gi {
    	#IGNORE		{ # no-op }
	#NODE		{ error "NYI" }
	#TEMPLATE	{ error "NYI" }
	#UNDEFINED	{ cost:undefined GI [query gi];
			  html:processChildren }
	#IMPLIED 	-
	default		{
	    set implied [string match "#IMPLIED*" $result]
	    if {!$implied} { 
		set atts [concat $atts [subst [$spec get attributes {}]]]
	    	html:startTag $gi $atts 
	    }
	    html:write [subst [$spec get prefix ""]]
	    uplevel #0 [list $spec do content {
		foreachNode child html:processNode
	    }]
	    html:write [subst [$spec get suffix ""]]
	    if {!$implied} { html:endTag $gi }
	}
    }
    uplevel #0 $spec do endAction
    return;
}

proc html:processChildren {} {
    foreachNode child html:processNode
}

############################################################
#
# Miscellaneous utilities:
#
proc html:message {msg} {
    if {[HTMLEnv get verbose]} {
    	puts stderr $msg
    }
}

############################################################
#
# Default main routine:
#

proc html:main {args} {
    if {[HTMLEnv get sourceSpec] == "NoSourceSpec"} {
    	return -code error \
	    "No source specification.  Use html:configure -sourceSpec ..."
    }
    html:preprocess
    html:startDocument
    withNode docroot html:processNode
    html:endDocument
}

proc main {args} [info body html:main]

#*EOF*