# -*- tcl -*-
#
# fmt.html
#
# Copyright (c) 2001-2003 Andreas Kupries 
#
# 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 {} {markup "©"}
proc bgcolor {} {return ""}
proc border  {} {return 0}
proc Year    {} {clock format [clock seconds] -format %Y}
# possibleReference text gi --
#	Check if $text is a potential cross-reference;
#	if so, format as a reference;
#	otherwise format as a $gi element.
#
proc c_possibleReference {text gi} {
    global SectionNames
    set id [c_sectionId $text]
    if {[info exists SectionNames($id)]} {
	return [taga a [list href #$id]]$text[tag/ a]
    } else {
	return [tag $gi]$text[tag/ $gi]
    }
}
c_holdBuffers require
################################################################
## 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
global hintstack ; # stack of hint information.
global chint     ; # current hint settings
global lmark     ; # boolean flag, 1 = list item command was last
#                ; #               0 = something other than a list item command
set    liststack [list]
set    hintstack [list]
set    chint     ""
set    lmark     0
proc llevel {} {global liststack ; return [llength $liststack]}
proc lpush {t hint} {
    global  liststack hintstack chint
    lappend liststack [tag/ $t]
    lappend hintstack $chint
    set     chint $hint
    return [tag $t]
}
proc lpop {} {
    global liststack hintstack chint
    set t         [lindex   $liststack end]
    set liststack [lreplace $liststack end end]
    set chint     [lindex   $hintstack end]
    set hintstack [lreplace $hintstack end end]
    return $t
}
proc lsmark {value} {
    global lmark ; set lmark $value ; return
}
proc limark {} {
    # hint and mark processing.
    # hint: compact list, do not create additional whitespace
    if {[lcompact]} {return ""}
    # hint: wide list, create additional whitespace.
    # mark: exception: two list items following each other have no whitespace.
    global lmark ; if {$lmark} {return ""}
    return [tag br][tag br]\n
}
proc lcompact {} {global chint ; string equal $chint compact}
proc fmt_plain_text {text} {
    # Control list state
    set redux [string map [list " " "" "\t" "" "\n" ""] $text]
    if {$redux != {}} {lsmark 0}
    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} {
    XrefInit
    c_cinit
    set module      [dt_module]
    set shortdesc   [c_get_module]
    set description [c_get_title]
    set copyright   [c_get_copyright]
    set     hdr ""
    append  hdr "[markup ]\n"
    append  hdr "[markup ]$title - $shortdesc [markup ]\n"
    # Engine parameter - insert 'meta'
    if {[set meta [Get meta]] != {}} {append hdr [markup $meta]\n}
    append  hdr "[markup ]\n"
    append  hdr [ht_comment [c_provenance]]\n
    if {$copyright != {}} {
	append  hdr [ht_comment $copyright]\n
    }
    append  hdr [ht_comment "CVS: \$Id\$ $title.$section"]\n
    append  hdr \n
    append  hdr [markup ]\n
    # Engine parameter - insert 'header'
    if {[set header [Get header]] != {}} {append hdr [markup $header]\n}
    append  hdr "[markup ] [string trimleft $title :]($section) $version $module \"$shortdesc\"[markup 
]\n"
    append  hdr [fmt_section NAME]\n
    append  hdr "[fmt_para] $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 ct [c_get_copyright]
    if {[llength $sa] > 0} {
	append res [fmt_section {SEE ALSO}] \n
	append res [join [XrefList [lsort $sa] sa] ", "] \n
    }
    if {[llength $kw] > 0} {
	append res [fmt_section KEYWORDS] \n
	append res [join [XrefList [lsort $kw] kw] ", "] \n
    }
    if {$ct != {}} {
	append res [fmt_section COPYRIGHT] \n
	append res [join [split $ct \n] [tag br]\n] [tag br]\n
    }
    # Engine parameter - insert 'footer'
    if {[set footer [Get footer]] != {}} {append res [markup $footer]\n}
    append res [markup ]
    return $res
}
c_pass 1 fmt_section {name} {c_newSection $name 1 end}
c_pass 2 fmt_section {name} {
    set id [c_sectionId $name]
    return "[markup <]a name=[markup \"]$id[markup \">]$name[markup 
\n]"
}
c_pass 1 fmt_subsection {name} {c_newSection $name 2 end}
c_pass 2 fmt_subsection {name} {
    set id [c_sectionId $name]
    return "[markup 
<]a name=[markup \"]$id[markup \">]$name[markup 
\n]"
}
proc fmt_para {} {return [markup 
]}
c_pass 2 fmt_require {pkg {version {}}} NOP
c_pass 1 fmt_require {pkg {version {}}} {
    set result "package require [markup ]$pkg"
    if {$version != {}} {
	append result " $version"
    }
    append result [markup "
"]
    c_hold require $result
    return
}
c_pass 2 fmt_usage {cmd args} NOP
c_pass 1 fmt_usage {cmd args} {c_hold synopsis "[trtop][td]$cmd [join $args " "][markup ]"}
c_pass 1 fmt_call {cmd args} {
    c_hold synopsis "[trtop][td][markup ""]$cmd [join $args " "][markup ]"
}
c_pass 2 fmt_call {cmd args} {
    return "[fmt_lst_item "[markup ""]$cmd [join $args " "][markup ]"]\n"
}
c_pass 1 fmt_description {} NOP
c_pass 2 fmt_description {} {
    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 section added
    #         at the beginning.
    c_newSection DESCRIPTION 1 0
    if {$syn != {} || $req != {}} {c_newSection SYNOPSIS 1 0}
    c_newSection {TABLE OF CONTENTS} 1 0
    if {[llength [c_xref_seealso]] > 0}  {c_newSection {SEE ALSO} 1 end}
    if {[llength [c_xref_keywords]] > 0} {c_newSection KEYWORDS   1 end}
    if {[c_get_copyright]         != {}} {c_newSection COPYRIGHT  1 end}
    set sections $::SectionList
    # Pass 2: Generate the markup for the TOC, indenting the
    #         links according to the level of the section.
    append result [fmt_section {TABLE OF CONTENTS}]
    foreach {name id level} $sections {
	append result \
		[markup [string repeat "    " $level]] \
		[taga a [list href #$id]] \
		$name \
		[tag/ a][tag br]\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]\n
    }
    if {$req != {}} {
	append result $req \n
	append result [markup 
]
    }
    if {$syn != {}} {
	proc bgcolor {} {return lightyellow}
	append result [btable][tr][td][table]${syn}\n[markup ]\n
	proc bgcolor {} {return ""}
    }
    append result [fmt_section DESCRIPTION]
    return $result
}
################################################################
proc fmt_list_begin  {what {hint {}}} {
    switch -exact -- $what {
	enumerated  {set tag ol}
	itemized    {set tag ul}
	arguments -
	commands  -
	options   -
	tkoptions -
	definitions {set tag dl}
    }
    return [if {[llevel]} {limark} else {}][lpush $tag $hint][lsmark 1]
}
proc fmt_list_end {}        {return [lpop][lsmark 1]}
proc fmt_lst_item {text}    {return [limark][tag dt]$text[tag dd][lsmark 1]}
proc fmt_bullet   {}        {return [limark][tag li][lsmark 1]}
proc fmt_enum     {}        {return [limark][tag li][lsmark 1]}
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][markup 
]\n"
    append text "Database Name:\t[strong $dbname][markup 
]\n"
    append text "Database Class:\t[strong $dbclass][markup 
]\n"
    fmt_lst_item $text
}
################################################################
proc fmt_example_begin {} {
    lsmark 0
    return [markup "
|  | "]
}
proc fmt_example_end   {} {
    return [markup " | 
"]
}
proc fmt_example {code} {
    return "[fmt_example_begin][fmt_plain_text $code][fmt_example_end]"
}
proc fmt_nl {} {
    if {[lcompact]} {return [tag br]}
    return [tag br][tag br]
}
proc fmt_arg    {text} {return "[markup ""]$text[markup ]" }
proc fmt_cmd    {text} {return "[markup ""][XrefMatch $text sa][markup ]" }
proc fmt_emph	{text}	{ em $text }
proc strong {text} {return "[markup ]$text[markup ]"}
proc em     {text} {return "[markup ]$text[markup ]"}
proc fmt_opt     {text} {return "?$text?" }
proc fmt_comment {text} {ht_comment $text}
proc fmt_sectref {text {label {}}} {
    global SectionNames
    if {![string length $label]} {set label $text}
    set id [c_sectionId $text]
    if {[info exists SectionNames($id)]} {
    	return "[markup <]a href=[markup \"]#$id[markup \">]$label[markup ]"
    } else {
    	return "[markup ]$label[markup ]"
    }
}
proc fmt_syscmd  {text} {strong [XrefMatch $text sa]}
proc fmt_method  {text} {strong $text}
proc fmt_option  {text} {strong $text}
proc fmt_widget  {text} {strong $text}
proc fmt_fun     {text} {strong $text}
proc fmt_type    {text} {strong $text}
proc fmt_package {text} {strong [XrefMatch $text sa kw]}
proc fmt_class   {text} {strong $text}
proc fmt_var     {text} {strong $text}
proc fmt_file    {text} {return "\"[strong $text]\""}
proc fmt_namespace     {text} {strong $text}
proc fmt_uri     {text {label {}}} {
    if {$label == {}} {set label $text}
    return "[markup <]a href=[markup \"]$text[markup \">]$label[markup ]"
}
proc fmt_term    {text} {em [XrefMatch $text kw sa]}
proc fmt_const   {text} {strong $text}
################################################################
global xref ; array set xref {}
global    __var
array set __var {
    meta   {}
    header {}
    footer {}
    xref   {}
}
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
}
################################################################
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 XrefLink {dest label} {
    # Ensure that the link is properly done relative to this file!
    set save $dest
    #puts_stderr "XrefLink $dest $label"
    set here [file split [dt_fmap [dt_file]]]
    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 "[markup ""] $label [markup ]" ; # "
}