# -*- tcl -*-
#
# $Id: fmt.tmml,v 1.13 2002/05/15 20:54:33 jenglish Exp $
#
# [expand] definitions to convert a tcl based manpage definition
# into TMML.
#
# Copyright (C) 2001 Joe English <jenglish@sourceforge.net>.
# Freely redistributable.
#
# See also <URL: http://tmml.sourceforge.net>
#
# BUGS:
#	+ Text must be preceded by [para] or one of the
#	  list item macros, or else the output will be invalid.
#
######################################################################

source [__file join [__file dirname [info script]] _xml.tcl]
set this [__file tail [info script]]

######################################################################
# mpexpand(n) interface.
#
proc NumPasses {}	{ return 2 }
proc PassSetup {}	{ setPassProcs [mp_pass] }

######################################################################
# Utilities.
#

proc NOP {args} { }		;# do nothing
proc NYI {{message {}}} {
    return -code error [append message " Not Yet Implemented"]
}

proc provenance {} {
    variable this
    return "Generated from [mp_file] by tcllib/doctools/mpexpand with $this"
}

######################################################################
# Cross-reference tracking.
#

global SectionNames	;# array mapping section name to refid

# sectionId --
#	Format section name as an XML ID.
#
proc sectionId {name} {
    regsub -all {[^[:alnum:]]} $name {} name
    return [string tolower $name]
}

# possibleReference text gi --
#	Check if $text is a potential cross-reference;
#	if so, format as a reference;
#	otherwise format as a $gi element.
#
proc possibleReference {text gi} {
    global SectionNames
    if {[info exists SectionNames($text)]} {
    	return "[startTag ref refid $SectionNames($text)]$text[endTag ref]"
    } else {
    	return [wrap $text $gi]
    }
}

######################################################################
# Conversion specification.
#
# Two-pass processing.  The first pass collects text for the
# SYNOPSIS, SEE ALSO, and KEYWORDS sections, and the second pass
# produces output.
#

holdBuffers synopsis see_also keywords

variable block {section dd li}	;# block context elements

proc nl  	{}	{ emptyElement br }
proc arg 	{text}	{ wrap $text m }
proc cmd	{text}	{ wrap $text cmd }
proc emph	{text}	{ possibleReference $text emph }
proc strong	{text}	{ possibleReference $text emph }
proc opt 	{text}	{ wrap $text o }

pass 1 example_begin {}	NOP
pass 1 example_end {} 	NOP
pass 1 example {code}	NOP
pass 2 example_begin {}	{ sequence [xmlContext $::block] [start example] }
pass 2 example_end   {}	{ end example }
pass 2 example {code} 	{ sequence [xmlContext $::block] [wrap $code example] }

proc comment {text} {xmlComment $text}
proc sectref {text} {possibleReference $text emph}
proc syscmd  {text} {wrap $text syscmd}
proc method  {text} {wrap $text method}
proc option  {text} {wrap $text option}
proc widget  {text} {wrap $text widget}
proc fun     {text} {wrap $text fun}
proc type    {text} {wrap $text type}
proc package {text} {wrap $text package}
proc class   {text} {wrap $text class}
proc var     {text} {wrap $text variable}
proc file    {text} {wrap $text file}
proc uri     {text} {wrap $text url}
proc term    {text} {wrap $text term}
proc const   {text} {wrap $text l}

global    state
array set state {mdesc {}}

pass 1 manpage_begin {args} NOP
pass 2 manpage_begin {title section version} {
    global state
    if {[catch {set description $state(tdesc)}]} {
	set description $state(mdesc)
    }

    sequence \
	[xmlComment [provenance]] \
	[start manpage \
	    id  	[__file rootname [__file tail [mp_file]]] \
	    cat 	cmd \
	    title	$title \
	    version	$version \
	    package	[mp_module]] \
	[start namesection] \
	[wrap $title name] \
	[wrap $description desc] \
	[end namesection] \
	;
}

pass 1 moddesc     {desc} {global state ; set state(mesc)  $desc}
pass 1 titledesc   {desc} {global state ; set state(tdesc) $desc}

pass 2 moddesc     {args} NOP
pass 2 titledesc   {args} NOP

pass 1 description {} NOP
pass 2 description {} {
    sequence \
	[xmlContext manpage] \
	[wrapLines? [held synopsis] syntax synopsis] \
	[start section] \
	[wrap "DESCRIPTION" title] \
	;
}

pass 1 section {name} { set ::SectionNames($name) [sectionId $name] }
pass 2 section {name} {
    sequence \
	[xmlContext manpage] \
    	[start section id [sectionId $name]] \
	[wrap [string toupper $name] title] \
	;
}
pass 1 para {} NOP
pass 2 para {} { sequence [xmlContext section] [start p] }

foreach {type gi} {
    bullet	ul
    enum	ol
    definitions	dl
    arg		arglist
    cmd		commandlist
    opt		optlist
    tkoption	optionlist
} {
    set listTypes($type) $gi
    lappend listGIs $gi
}

pass 1 list_begin {what {hint {}}} NOP
pass 1 list_end {} NOP
pass 2 list_begin {what {hint {}}} {
    variable listTypes
    sequence \
    	[xmlContext {section dd li}] \
	[start $listTypes($what)] \
	;
}
pass 2 list_end {} {
    variable listGIs
    sequence \
	[xmlContext $listGIs] \
	[end] \
	;
}

pass 1 bullet {}	NOP
pass 1 enum {} 		NOP
pass 2 bullet {} 	{ sequence [xmlContext {ul ol}] [start li] }
pass 2 enum {} 		{ sequence [xmlContext {ul ol}] [start li] }

pass 1 lst_item {text} NOP
pass 2 lst_item {text} {
    sequence \
    	[xmlContext dl] \
	[start dle] \
	[wrap $text dt] \
	[start dd] \
	;
}

pass 1 arg_def {type name {mode {}}} NOP
pass 2 arg_def {type name {mode {}}} {
    sequence \
    	[xmlContext arglist] \
	[start argdef] \
	[wrap $type argtype] \
	[wrap $name name] \
	[wrap? $mode argmode] \
	[start desc] \
	;
}

pass 1 cmd_def {command} NOP
pass 2 cmd_def {command} {
    sequence \
    	[xmlContext commandlist] \
	[start commanddef] \
	[wrap $command command] \
	[start desc] \
	;
}

pass 1 opt_def {name {arg {}}} NOP
pass 2 opt_def {name {arg {}}} {
    sequence \
    	[xmlContext optlist] \
	[start optdef] \
	[wrap $name optname] \
	[wrap? $arg optarg] \
	[start desc] \
	;
}

pass 1 tkoption_def {name dbname dbclass}  NOP
pass 2 tkoption_def {name dbname dbclass} {
    sequence \
    	[xmlContext optionlist] \
	[start optiondef] \
	[wrap $name name] \
	[wrap $dbname dbname] \
	[wrap $dbclass dbclass] \
	[start desc] \
	;
}

pass 1 usage {cmd args} { hold synopsis [formatCall $cmd $args] }
pass 2 usage {cmd args} NOP

pass 1 call {cmd args} { hold synopsis [formatCall $cmd $args] }
pass 2 call {cmd args} {
    sequence \
    	[xmlContext dl] \
	[start dle] \
	[wrap [formatCall $cmd $args] dt] \
	[start dd] \
	;
}
proc formatCall {cmd arglist} {
    return "$cmd [join $arglist { }]"	;# OR: wrap "..." command
}

pass 1 require {pkg {version {}}} {
    hold synopsis [formatRequire $pkg $version]
}
pass 2 require {pkg {version {}}} NOP
proc formatRequire {pkg version} {
    return "package require [wrap $pkg package] $version"
}

pass 1 see_also	{args} { holdWrapped see_also  $args ref }
pass 1 keywords {args} { holdWrapped keywords $args keyword }
pass 2 see_also	{args} NOP
pass 2 keywords	{args} NOP

# holdWrapped --
#	Common factor of [see_also] and [keywords].
#
proc holdWrapped {buffer arglist gi} {
    foreach arg $arglist { hold $buffer [wrap $arg $gi] }
    return
}

pass 1 manpage_end {} NOP
pass 2 manpage_end {} {
    sequence \
	[xmlContext manpage] \
	[wrapLines? [held see_also] seealso] \
	[wrapLines? [held keywords] keywords] \
	[end manpage] \
	;
}

#*EOF*

