# -*- tcl -*-
#
# fmt.nroff
#
# (c) 2001 Andreas Kupries <andreas_kupries@sourceforge.net>
#
# [expand] definitions to convert a tcl based manpage definition into
# a manpage based upon *roff markup. Additional definition files allow
# the conversion into HTML and TMML.
#
################################################################

proc here {} [list return [__file dirname [info script]]]
proc this {} [list return [__file tail    [info script]]]

source [__file join [here] _common.tcl]   ; # Shared code

################################################################
## Backend for *roff markup

proc manpage_begin {title section version} {
    if {[mp_pass] == 1} {return}

    set module      [mp_module]
    set shortdesc   [GetDesc mdesc]
    set description [GetDesc tdesc]

    cpush mp
    set     hdr ""
    append  hdr "[nr_comment {}]\n"
    append  hdr "[nr_comment "Generated from [mp_file] by mpexpand with [this]"]\n"
    append  hdr "[nr_comment {}]\n"
    append  hdr ".so man.macros\n"
    append  hdr ".TH \"[string trimleft $title :]\" $section $version $module \"$shortdesc\"\n"
    append  hdr ".BS\n"
    append  hdr ".SH NAME\n"
    append  hdr "$title \\- $description"
    return $hdr
}

proc moddesc {desc} {
    if {[mp_pass] == 2} {return}
    SetDesc mdesc $desc
    return
}
proc titledesc {desc} {
    if {[mp_pass] == 2} {return}
    SetDesc tdesc $desc
    return
}

proc manpage_end {} {
    # Strip empty lines out of the generated nroff source
    # and trim leading blanks, except in code samples.
    #
    if {[mp_pass] == 1} {return}
    set nfMode [list .nf .CS]	;# requests which start no-fill mode
    set fiMode [list .fi .CE]	;# requests which terminate no-fill mode
    set lines [list]
    set trimblanks 1
    foreach line [split [cpop mp] "\n"] {
	if {$trimblanks} {
	    if {[lsearch -exact $nfMode [split $line]] >= 0} { set trimblanks 0 }
	    if {![string length $line]} { continue }
	    set line [string trim $line]
	    if {0 == [string length $line]} {
		continue
	    }
	} else {
	    if {[lsearch -exact $fiMode [split $line]] >= 0} { set trimblanks 1 }
	}
	lappend lines $line
    } 
    return [join $lines "\n"]
}

proc section {name} {return ".SH \"$name\""}
proc para    {}     {nr_p}

proc require {pkg {version {}}} {
    if {$version != {}} {
	return "[x_synopsis]package require [nr_bld]$pkg $version[nr_rst]\n[nl]"
    }
    return "[x_synopsis]package require [nr_bld]$pkg[nr_rst]\n[nl]"
}

proc usage {cmd args} {
    if {[mp_pass] == 1} {
	AddCall "$cmd [join $args " "][nr_rst]\n[nl]\n"
	return
    }
    return ""
}

proc call {cmd args} {
    if {[mp_pass] == 1} {
	AddCall "$cmd [join $args " "][nr_rst]\n[nl]\n"
	return
    }
    return "[lst_item "$cmd [join $args " "][nr_rst]"]"
}

proc description {} {
    if {[GetCall] == {}} {
	return .BE\n[section DESCRIPTION]
    }
    return [x_synopsis][GetCall].BE\n[section DESCRIPTION]
}

proc x_synopsis {} {
    if {![Syn]} {
	return [section SYNOPSIS]\n
    }
    return ""
}

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

global    list_state
array set list_state {level -1}

proc list_begin {what {hint {}}} {
    # ignoring hints.
    global list_state

    switch -exact -- $what {
	enum - bullet - definitions - arg - cmd -
	opt - tkoption {}
	default {return -code error "Unknown list type $what"}
    }

    incr list_state(level)
    set  list_state(l,$list_state(level)) $what
    set  list_state(l,$list_state(level),id) 0

    if {$list_state(level) > 0} {
	return [nr_in]
    }
    return {}
}

proc list_end {} {
    global list_state

    catch {unset list_state(l,$list_state(level))}
    catch {unset list_state(l,$list_state(level),id)}

    incr list_state(level) -1

    if {$list_state(level) >= 0} {
	return [nr_out]
    }
    return {}
}

proc bullet {} {
    global list_state

    switch -exact -- $list_state(l,$list_state(level)) {
	bullet  {return ".IP \\(bu"}
	default {return -code error "Illegal use of bullet in non-bullet list"}
    }
}

proc enum {} {
    global list_state

    switch -exact -- $list_state(l,$list_state(level)) {
	enum    {return ".IP \[[incr list_state(l,$list_state(level),id)]\]\n"}
	default {return -code error "Illegal use of bullet in non-bullet list"}
    }
}

proc lst_item {text} {
    global list_state

    switch -exact -- $list_state(l,$list_state(level)) {
	definitions {return ".TP\n$text"}
	default     {return -code error "Illegal use of bullet in non-bullet list"}
    }
}

proc arg_def {type name {mode {}}} {
    global list_state

    switch -exact -- $list_state(l,$list_state(level)) {
	arg     {
	    set text ".TP\n"
	    append text [arg $name]
	    append text " $type"
	    if {$mode != {}} {
		append text " ($mode)"
	    }
	    return $text
	}
	default {return -code error "Illegal use of arg_def in non-argument list"}
    }
}

proc cmd_def {command} {
    global list_state

    switch -exact -- $list_state(l,$list_state(level)) {
	cmd     {return ".TP\n[cmd $command]"}
	default {return -code error "Illegal use of cmd_def in non-command list"}
    }
}

proc opt_def {name {arg {}}} {
    global list_state

    switch -exact -- $list_state(l,$list_state(level)) {
	opt {
	    if {[string match -* $name]} {set    name \\-$name}
	    set name [option $name]
	    if {$arg != {}}              {append name " $arg"}
	    return ".TP\n$name"
	}
	default {return -code error "Illegal use of opt_def in non-option list"}
    }
}

proc tkoption_def {name dbname dbclass} {
    global list_state

    switch -exact -- $list_state(l,$list_state(level)) {
	tkoption {
	    set    text ""
	    append text ".LP\n"
	    append text ".nf\n"
	    append text ".ta 6c\n"
	    append text "Command-Line Switch:\t[nr_bld]$name[nr_rst]\n"
	    append text "Database Name:\t[nr_bld]$dbname[nr_rst]\n"
	    append text "Database Class:\t[nr_bld]$dbclass[nr_rst]\n"
	    append text ".fi\n"
	    append text ".IP\n"
	    return $text
	}
	default {return -code error "Illegal use of tkoption_def in non-tkoption list"}
    }
}

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

proc see_also {args} {return "[section {SEE ALSO}]\n[join $args ", "]"}
proc keywords {args} {return "[section KEYWORDS]\n[join $args ", "]"}

proc example_begin {} { return "\n.nf" }
proc example_end   {} { return ".fi" }
proc example {code} { 
    set lines [list "" ".nf"] 
    foreach line [split $code "\n"] {
    	lappend lines [HandleText $line]
    }
    lappend lines ".fi" ""
    return [join $lines "\n"]
}

proc nl     {}     {nr_vspace}
proc arg    {text} {return [nr_ul]$text[nr_rst]}
proc cmd    {text} {return [nr_bld]$text[nr_rst]}
proc emph   {text} {return [nr_ul]$text[nr_rst]}
proc strong {text} {return [nr_bld]$text[nr_rst]}
proc opt    {text} {return ?$text?}

proc comment {text} {
    set res [list]
    foreach l [split $text \n] {
	lappend res [nr_comment $l]
    }
    return [join $res \n]
}
proc sectref {text} {strong $text}
proc syscmd  {text} {strong $text}
proc method  {text} {strong $text}
proc option  {text} {strong $text}
proc widget  {text} {strong $text}
proc fun     {text} {strong $text}
proc type    {text} {strong $text}
proc package {text} {strong $text}
proc class   {text} {strong $text}
proc var     {text} {strong $text}
proc file    {text} {return "\"[emph $text]\""}
proc uri     {text} {emph $text}
proc term    {text} {emph $text}
proc const   {text} {strong $text}

################################################################
# nroff specific commands

proc nr_bld     {}       {return \\fB}
proc nr_ul      {}       {return \\fI}
proc nr_rst     {}       {return \\fR}
proc nr_p       {}       {return \n.PP\n}
proc nr_comment {text}   {return "'\\\" $text"}
proc nr_enum    {num}    {return ".IP \[$num\]"}
proc nr_vspace  {}       {return .sp}
proc nr_blt     {text}   {return "\n.TP\n$text"}
proc nr_bltn    {n text} {return "\n.TP $n\n$text"}

proc nr_in      {}       {return \n.RS}
proc nr_out     {}       {return \n.RE}

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

proc setx {v string} {
    upvar $v _
    set _ $string
    return
}

proc appendx {v string} {
    upvar $v _
    append _ $string
    return
}

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