# -*- tcl -*-
#
# fmt.html
#
# Copyright (c) 2001-2008 Andreas Kupries <andreas_kupries@sourceforge.net>
#
# Definitions to convert a tcl based manpage definition into
# a manpage based upon HTML markup.
#
################################################################
################################################################

dt_source _common.tcl   ; # Shared code
dt_source _html.tcl     ; # HTML basic formatting

proc c_copyrightsymbol {} {return "[markup "&"]copy;"}

proc bgcolor {} {return ""}
proc border  {} {return 0}
proc Year    {} {clock format [clock seconds] -format %Y}

c_holdBuffers require synopsis

################################################################
## Backend for HTML markup

# --------------------------------------------------------------
# Handling of lists. Simplified, the global check of nesting and
# legality of list commands allows us to throw away most of the
# existing checks.

global liststack ; # stack of list tags to use in list_end
set    liststack {}

proc lpush {t class} {
    global  liststack 
    lappend liststack [list [tag/ $t] [litc_getandclear]]
    return [taga $t [list class $class]]
}

proc lpop {} {
    global liststack
    set t         [lindex   $liststack end]
    set liststack [lreplace $liststack end end]
    foreach {t l} $t break
    litc_set $l
    return $t
}

proc fmt_plain_text {text} {
    return $text
}

################################################################
# Formatting commands.

c_pass 1 fmt_manpage_begin {title section version} {c_cinit ; c_clrSections ; return}
c_pass 2 fmt_manpage_begin {title section version} {

    global sec_is_open      ; set sec_is_open      0
    global subsec_is_open   ; set subsec_is_open   0
    global prev_litem_close ; set prev_litem_close {}
    global para_is_open     ; set para_is_open     0
    global liststack        ; set liststack        {}
    global defaultstyle

    XrefInit
    c_cinit
    set module      [dt_module]
    set shortdesc   [c_get_module]
    set description [c_get_title]
    set copyright   [c_get_copyright]

    set hdr ""

    if {![Get raw]} {
	append  hdr [tag html] [tag head] \n
	append  hdr [tag_ title "$title - $shortdesc"] \n

	if {![Extend hdr ByParameter meta]} {
	    # Insert standard CSS definitions.
	    append hdr [tag_ style \
			    "[markup <]!--${defaultstyle}--[markup >]" \
			    type text/css] \n
	}

	append  hdr [tag/ head] \n
	append  hdr [ht_comment [c_provenance]]\n
	if {$copyright != {}} {
	    append  hdr [ht_comment $copyright]\n
	}
	append  hdr [ht_comment "CVS: \$Id\$ $title.$section"]
	append  hdr \n\n
	append  hdr [tag body]
    }
    append  hdr [tag* div class doctools] \n

    Extend hdr ByParameter header

    set thetitle "[string trimleft $title :]($section) $version $module \"$shortdesc\""
    append  hdr [tag_ h1 $thetitle class title] \n
    append  hdr [fmt_section Name name] \n
    append  hdr "[para_open] $title - $description"
    return $hdr
}

c_pass 1 fmt_moddesc   {desc} {c_set_module $desc}
c_pass 2 fmt_moddesc   {desc} NOP

c_pass 1 fmt_titledesc {desc} {c_set_title $desc}
c_pass 2 fmt_titledesc {desc} NOP

c_pass 1 fmt_copyright {desc} {c_set_copyright $desc}
c_pass 2 fmt_copyright {desc} NOP

c_pass 1 fmt_manpage_end {} {c_creset ; return}
c_pass 2 fmt_manpage_end {} {
    c_creset
    set res ""

    set sa [c_xref_seealso]
    set kw [c_xref_keywords]
    set ca [c_xref_category]
    set ct [c_get_copyright]

    if {[llength $sa] > 0} {
	append res [fmt_section {See Also} see-also] \n
	append res [join [XrefList [lsort $sa] sa] ", "] \n
    }
    if {[llength $kw] > 0} {
	append res [fmt_section Keywords keywords] \n
	append res [join [XrefList [lsort $kw] kw] ", "] \n
    }
    if {$ca ne ""} {
	append res [fmt_section Category category] \n
	append res $ca \n
    }
    if {$ct != {}} {
	append res [fmt_section Copyright copyright] \n
	append res [join [split $ct \n] [tag br]\n] [tag br]\n
    }

   # Close last paragraph, subsection, and section.
    append res [para_close][subsec_close][sec_close]

    Extend res ByParameter footer

    append res [tag/ div]
    if {![Get raw]} {
	append res [tag/ body] [tag/ html]
    }
    return $res
}

c_pass 1 fmt_section {name id} {c_newSection $name 1 end $id}
c_pass 2 fmt_section {name id} {
    return "[sec_open $id][tag_ h2 [anchor $id $name]]\n[para_open]"
}

c_pass 1 fmt_subsection {name id} {c_newSection $name 2 end $id}
c_pass 2 fmt_subsection {name id} {
    return "[subsec_open $id][tag_ h3 [anchor $id $name]]\n[para_open]"
}

# Para breaks inside and outside of lists are identical
proc fmt_nl   {} {para_open}
proc fmt_para {} {para_open}

c_pass 2 fmt_require {pkg {version {}}} NOP
c_pass 1 fmt_require {pkg {version {}}} {
    if {$version != {}} { append pkg " " $version }
    c_hold require [tag_ li "package require [bold $pkg pkgname]"]
    return
}

c_pass 2 fmt_usage {cmd args} NOP
c_pass 1 fmt_usage {cmd args} {
    if {[llength $args]} {
	set text "$cmd [join $args " "]"
    } else {
	set text $cmd
    }
    c_hold synopsis [tag_ li $text]
    return
}

c_pass 1 fmt_call {cmd args} {
    if {[llength $args]} {
	set text "$cmd [join $args " "]"
    } else {
	set text $cmd
    }
    c_hold synopsis [tag_ li [link $text "#[c_cnext]"]]
    return
}
c_pass 2 fmt_call {cmd args} {
    if {[llength $args]} {
	set text "$cmd [join $args " "]"
    } else {
	set text $cmd
    }
    return [fmt_lst_item [anchor [c_cnext] $text]]
}

c_pass 1 fmt_description {did} NOP
c_pass 2 fmt_description {did} {
    set result ""
    set syn [c_held synopsis]
    set req [c_held require]

    # Create the TOC.

    # Pass 1: We have a number of special sections which were not
    #         listed explicitly in the document sources. Add them
    #         now. Note the inverse order for the sections added
    #         at the beginning.

    c_newSection Description 1 0 $did
    if {$syn != {} || $req != {}} {c_newSection Synopsis 1 0 synopsis}
    c_newSection {Table Of Contents} 1 0 toc

    if {[llength [c_xref_seealso]]  > 0} {c_newSection {See Also} 1 end see-also}
    if {[llength [c_xref_keywords]] > 0} {c_newSection Keywords   1 end keywords}
    if {[c_xref_category]         ne ""} {c_newSection Category   1 end category}
    if {[c_get_copyright]         != {}} {c_newSection Copyright  1 end copyright}

    set sections $::SectionList

    # Pass 2: Generate the markup for the TOC, indenting the
    #         links according to the level of each section.

    append result [fmt_section {Table Of Contents} toc] [para_close] \n
    append result [taga ul {class toc}] \n
    set lastlevel 1
    set close 0
    foreach {name id level} $sections {
	# level in {1,2}, 1 = sectio n, 2 = subsection
	if {$level == $lastlevel} {
	    # Close previous item.
	    if {$close} { append result [tag/ li] \n }
	} elseif {$level > $lastlevel} {
	    # Start list of subsections
	    append result \n [tag ul] \n
	} else { # level < lastlevel
	    # End list of subsections, and of previous item (two
	    # actually, the subsection, and the section item).
	    append result [tag/ li] \n [tag/ ul] \n [tag/ li] \n
	}
	# Start entry
	if {$level == 1} {
	    append result [taga li {class section}] [link $name "#$id"]
	} else {
	    append result [taga li {class subsection}] [link $name "#$id"]
	}
	set close 1

	set lastlevel $level
    }
    if {$lastlevel > 1 } { append result [tag/ ul] \n }
    if {$close}          { append result [tag/ li] \n }

    append result [tag/ ul] \n

    # Implicit sections coming after the TOC (Synopsis, then the
    # description which starts the actual document). The other
    # implict sections are added at the end of the document and
    # are generated by 'fmt_manpage_end' in the second pass.

    if {$syn != {} || $req != {}} {
	append result [fmt_section Synopsis synopsis] [para_close] [taga div {class synopsis}] \n
	if {$req != {}} {
	    append result [tag_ ul \n$req\n class requirements] \n
	}
	if {$syn != {}} {
	    append result [tag_ ul \n$syn\n class syntax] \n
	}
	append result [tag/ div] \n
    }
    append result [fmt_section Description $did] \n
    return $result
}

################################################################

proc fmt_list_begin  {what {hint {}}} {
    # NOTE: The hint is ignored. Use stylesheet definitions to modify
    # item and general list spacing.
    switch -exact -- $what {
	enumerated  {set tag ol}
	itemized    {set tag ul}
	arguments -
	commands  -
	options   -
	tkoptions -
	definitions {set tag dl}
    }
    return [para_close][lpush $tag $what]
}

proc fmt_list_end {}        {
    set res [para_close][litc_getandclear]\n[lpop][para_open]
    return $res
}
proc fmt_lst_item {text}    {
    set res [para_close][litc_getandclear]\n[tag_ dt $text]\n[tag dd][para_open]
    litc_set [tag/ dd]
    return $res
}
proc fmt_bullet {} {
    set res [para_close][litc_getandclear]\n[tag li][para_open]
    litc_set [tag/ li]
    return $res
}
proc fmt_enum {} {
    set res [para_close][litc_getandclear]\n[tag li][para_open]
    litc_set [tag/ li]
    return $res
}

proc fmt_cmd_def {command} {
    fmt_lst_item [fmt_cmd $command]
}
proc fmt_arg_def {type name {mode {}}} {
    set    text ""
    append text $type " " [fmt_arg $name]
    if {$mode != {}} {
	append text " (" $mode ")"
    }
    fmt_lst_item $text
}
proc fmt_opt_def {name {arg {}}} {
    set text [fmt_option $name]
    if {$arg != {}} {append text " " $arg}
    fmt_lst_item $text
}
proc fmt_tkoption_def {name dbname dbclass} {
    set    text ""
    append text "Command-Line Switch:\t[fmt_option $name][tag br]\n"
    append text "Database Name:\t[bold $dbname optdbname][tag br]\n"
    append text "Database Class:\t[bold $dbclass optdbclass][tag br]\n"
    fmt_lst_item $text
}

################################################################

proc fmt_example_begin {} {
    return [para_close]\n[tag* pre class example]
}
proc fmt_example_end   {} {
    return [tag/ pre]\n[para_open]
}
proc fmt_example {code} {
    return "[fmt_example_begin][fmt_plain_text $code][fmt_example_end]"
}

################################################################

proc fmt_arg  {text} { italic $text                arg }
proc fmt_cmd  {text} { bold   [XrefMatch $text sa] cmd }
proc fmt_emph {text} { em     $text }
proc fmt_opt  {text} { span   "?$text?" opt }

proc fmt_comment {text} {ht_comment $text}
proc fmt_sectref {title {id {}}} {
    global SectionNames
    if {$id == {}} {
	set id [c_sectionId $title]
    }
    if {[info exists SectionNames($id)]} {
    	return [span [link $title "#$id"] sectref]
    } else {
	return [bold $title sectref]
    }
}

proc fmt_syscmd  {text} {bold [XrefMatch $text sa] syscmd}
proc fmt_method  {text} {bold $text method}
proc fmt_option  {text} {bold $text option}
proc fmt_widget  {text} {bold $text widget}
proc fmt_fun     {text} {bold $text function}
proc fmt_type    {text} {bold $text type}
proc fmt_package {text} {bold [XrefMatch $text sa kw] package}
proc fmt_class   {text} {bold $text class}
proc fmt_var     {text} {bold $text variable}
proc fmt_file    {text} {return "\"[bold $text file]\""}
proc fmt_namespace     {text} {bold $text namespace}
proc fmt_uri     {text {label {}}} {
    if {$label == {}} {set label $text}
    return [link $label $text]
}

proc fmt_image {text {label {}}} {
    # text = symbolic name of the image.

    set img [dt_imgdst $text {png gif jpg}]

    if {$label eq {}} {
	set label $text
    }

    if {$img ne {}} {
	return [imagelink $label [LinkTo $img [LinkHere]]]
    }

    if {[regexp -- {^http://} $text] ||
	[regexp -- {^ftp://}  $text]} {
	return [imagelink $label $text]
    }

    #puts_stderr here:\t[LinkHere]
    #puts_stderr dest:\t$img
    #puts_stderr rela:\t[LinkTo $img [LinkHere]]
    #puts_stderr

    return [strong "Image: $label"]
}

proc fmt_term    {text} {italic [XrefMatch $text kw sa] term}
proc fmt_const   {text} {bold $text const}

proc fmt_mdash {} { return "[markup &]mdash;" }
proc fmt_ndash {} { return "[markup &]ndash;" }

################################################################

global sec_is_open
set    sec_is_open 0

proc sec_open  {id} {
    global sec_is_open
    set res [para_close][subsec_close][sec_close][tag* div id $id class section]
    set sec_is_open 1
    return $res
}

proc sec_close {}   {
    global sec_is_open
    if {!$sec_is_open} {return ""}
    set sec_is_open 0
    return [tag/ div]\n
}

################################################################

global subsec_is_open
set    subsec_is_open 0

proc subsec_open  {id} {
    global subsec_is_open
    set res [para_close][subsec_close][tag* div id $id class subsection]
    set subsec_is_open 1
    return $res
}

proc subsec_close {}   {
    global subsec_is_open
    if {!$subsec_is_open} {return ""}
    set subsec_is_open 0
    return [tag/ div]\n
}

################################################################

# Piece of html to close the previous list element, if any.
# Saved on the list stack

global prev_litem_close
set    prev_litem_close   {}

proc litc_getandclear {} {
    global prev_litem_close
    set res $prev_litem_close
    set prev_litem_close {}
    return $res
}

proc litc_set {value} {
    global prev_litem_close
    set prev_litem_close $value
    return
}

################################################################

global para_is_open
set    para_is_open 0

proc para_open {} {
    global para_is_open
    set res [para_close][tag p]
    set para_is_open 1
    return $res
}

proc para_close {} {
    global para_is_open
    if {!$para_is_open} {return ""}
    set para_is_open 0
    return [tag/ p]
}

################################################################

global xref ; array set xref {}

global    __var
array set __var {
    meta   {}
    header {}
    footer {}
    xref   {}
    raw    0
}
proc Get               {varname}      {global __var ; return $__var($varname)}
proc fmt_listvariables {}             {global __var ; return [array names __var]}
proc fmt_varset        {varname text} {
    global __var
    if {![info exists __var($varname)]} {return -code error "Unknown engine variable \"$varname\""}
    set __var($varname) $text
    return
}

# Engine parameter handling
proc Extend {v _ by} {
    set html [Get $by]
    if {$html == {}} { return 0 }
    upvar 1 $v text
    append text [markup $html] \n
    return 1
}

global defaultstyle
set    defaultstyle {
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
}

################################################################

proc XrefInit {} {
    global xref __var
    foreach item $__var(xref) {
	foreach {pattern fname fragment} $item break
	set fname_ref [dt_fmap $fname]
	if {$fragment != {}} {append fname_ref #$fragment}
	set xref($pattern) $fname_ref
    }
    proc XrefInit {} {}
    return
}

proc XrefMatch {word args} {
    global xref

    foreach ext $args {
	if {$ext != {}} {
	    if {[info exists xref($ext,$word)]} {
		return [XrefLink $xref($ext,$word) $word]
	    }
	}
    }
    if {[info exists xref($word)]} {
	return [XrefLink $xref($word) $word]
    }

    # Convert the word to all-lower case and then try again.

    set lword [string tolower $word]

    foreach ext $args {
	if {$ext != {}} {
	    if {[info exists xref($ext,$lword)]} {
		return [XrefLink $xref($ext,$lword) $word]
	    }
	}
    }
    if {[info exists xref($lword)]} {
	return [XrefLink $xref($lword) $word]
    }

    return $word
}

proc XrefList {list {ext {}}} {
    set res [list]
    foreach w $list {lappend res [XrefMatch $w $ext]}
    return $res
}

proc LinkHere {} {
    return [dt_fmap [dt_mainfile]]
}

proc LinkTo {dest here} {
    # Ensure that the link is properly done relative to this file!

    set save $dest

    #puts_stderr "XrefLink $dest $label"

    set here [file split $here]
    set dest [file split $dest]

    #puts_stderr "XrefLink < $here"
    #puts_stderr "XrefLink > $dest"

    while {[string equal [lindex $dest 0] [lindex $here 0]]} {
	set dest [lrange $dest 1 end]
	set here [lrange $here 1 end]
	if {[llength $dest] == 0} {break}
    }
    set ul [llength $dest]
    set hl [llength $here]

    if {$ul == 0} {
	set dest [lindex [file split $save] end]
    } else {
	while {$hl > 1} {
	    set dest [linsert $dest 0 ..]
	    incr hl -1
	}
	set dest [eval file join $dest]
    }

    #puts_stderr "XrefLink --> $dest"
    return $dest
}

proc XrefLink {dest label} {
    # Ensure that the link is properly done relative to this file!

    set here [LinkHere]
    set dest [LinkTo $dest $here]

    if {[string equal $dest [lindex [file split $here] end]]} {
	# Suppress self-referential links, i.e. links made from the
	# current file to itself. Note that links to specific parts of
	# the current file are not suppressed, only exact links.
	return $label
    }
    return [link $label $dest]
}