#! /usr/local/bin/tclsh
#==========================================================================
# gendocs -- very simple documentation preparation tool (like "nroff")
#            for use with TclVSrpt user documentation preparation.
#
# Copyright (c) 1995, Steven B. Wahl
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#==========================================================================
#
# -- load the TclVSrpt facility and get report type, input and output 
#     file names
source TclVSrpt.tcl
global RPT
puts -nonewline stdout "Create (A) ASCII or (P) Postscript documentation?  "
if {"p" == [string tolower [string index [gets stdin] 0]]} {
    set RPTTYPE "Postscript"
} else {
    set RPTTYPE "ASCII"
}
puts stdout "\n Patience....This may take a while.\n"
set SRCFILE "TclVSrpt.gen"
set DOCFILE "TclVSrpt"
#
# -- Interesting Postscript character codes (for reference):
if {$RPTTYPE != "ASCII"} {
    set bullet "\245";             # solid circle bullet character
    set pound "\243";              # British pound symbol
    set cent "\242";               # American cents symbol
    set yen "\264";                # Japanese yen symbol
	set copyright "\251";          # copyright symbol
    set trademark "\252";          # trademark symbol
    set rtrademark "\250";         # registered trademark symbol
} else {
	set bullet "*"
    set pound "(Pound)"
    set cent " cents"
    set yen " (Yen)"
    set copyright "(C)"
    set trademark "TM"
    set rtrademark "(R)"
}
#
# -- Set the document output file name
if {$RPTTYPE == "ASCII"} {
    set DOCFILE "${DOCFILE}.txt"
} else {
    set DOCFILE "${DOCFILE}.ps"
}
# -- Initialize TclVSrpt, set paper and page options
rptInitialize -type $RPTTYPE -encoding Diacritic

rptDefPaper -pagesize letter -orientation portrait \
	-leftmargin 1i -rightmargin 1i -topmargin .5i -bottommargin .5i

rptDefPage -title TclVSrpt v1.0 \
	-titlefont Helvetica -titlesize 10 -titlebold -titleunderline \
	-titlegap 2p \
	-subtitle Tcl Very Simple Report Writer \
	-subtitlefont helvetica -subtitlesize 8 -subtitlebold -subtitlegap 4p \
	-titlebar -titlebarthick .5p -titlebarindent 0p -titlebargap .5i \
	-footerbar -footerbarthick .5p -footerbarindent 0p -footerbargap .5i \
	-footergap 4p -footerleft TclVSrpt v1.0 -footerright User Guide \
	-footerfont times -footersize 8p -footeritalic -footerbold \
	-pagenoloc bottom center -pagenoprefix "Page " \
	-pagenocallback displaypageno 

# -- Create text style definitions
rptDefStyle -name author -font Times -size 10 -gap 0 -italic -align center
rptDefStyle -name body -wrap -align justify -font Times -size 10 -gap 1p
rptDefStyle -name body-c -wrap -align justify -font Courier -size 10 -gap 1p
rptDefStyle -name body-co -wrap -align justify -font Courier -italic \
    -size 10 -gap 1p
rptDefStyle -name body-e -wrap -align justify -font Times -italic \
    -size 10 -gap 1p
rptDefStyle -name bullets  -lineprefix "${bullet}\t" -align left -wrap \
    -wrapindent .25i -tabs .25i 2i 3.5i 4i -tabstyle absolute \
    -font times -size 10 -gap 2p
rptDefStyle -name c-bullets  -lineprefix "${bullet}\t" -align left -wrap \
    -wrapindent .25i -tabs .25i 2i 3.5i 4i -tabstyle absolute \
    -font Courier -size 10 -gap 2p
rptDefStyle -name code -align left -nowrap -tabstyle nearest \
    -tabs .5i 1i 1.5i 2i 2.5i 3i 3.5i 4i 4.5i 5i 5.5i 6i 6.5i \
    -font Courier -size 10 -gap 1
rptDefStyle -name header -align left -gap 8p -underline \
    -font Times -size 14 -bold
rptDefStyle -name neobullets  -lineprefix "${bullet}\t" -align left -wrap \
    -wrapindent 2i -tabs .25i 2i -tabstyle absolute \
    -font times -size 10 -gap 2
if {$RPTTYPE == "ASCII"} {
	rptDefStyle -name procname -underline -gap 6p
} else {
	rptDefStyle -name procname -font Courier -size 14 -bold -gap 6p
}
rptDefStyle -name summary -align left -nowrap -tabstyle absolute \
    -tabs .5i 2i 3.5i -font Courier -size 10 -gap 1
rptDefStyle -name summary-option -align left -nowrap -tabstyle absolute \
    -tabs .5i 2i 3.5i -font Courier -italic -size 10 -gap 1
rptDefStyle -name summary-comment -align left -nowrap -tabstyle absolute \
    -tabs .5i 2i 3.5i -font Times -italic -size 10 -gap 1
rptDefStyle -name summary-heading -align left -nowrap -tabstyle absolute \
    -tabs .5i 2i 3.5i -font Times -bold -size 10 -gap 1
rptDefStyle -name title -font Times -bold -italic -size 18 -align Center \
    -gap 2p -nowrap
rptDefStyle -name figure -font Times -bold -italic -align center \
	-size 10 -gap 2

# -- procedures for processing style changes 
set style ""
proc displaypageno {pno} {
        puts stdout "\nPage $pno\n"
}
proc author {} {
    global style
    set style "author"
    rptNewLine 0
    rptSetStyle author
    rptNewLine 1
}
proc body {} {
    global style
    set style "body"
    rptNewLine 0
    rptSetStyle body
    rptNewPage -guardline 3
}
proc bullets {} {
    global style
    set style "bullets"
    rptNewLine 0
    rptSetStyle bullets
    rptNewPage -guardline 3
}
proc neobullets {} {
    global style
    set style "neobullets"
    rptNewLine 0
    rptSetStyle neobullets
    rptNewPage -guardline 3
}
proc code {} {
    global style "code"
    set style "code"
    rptNewLine 0
    rptSetStyle code
    rptNewPage -guardline 3
}
proc summary {} {
    global style 
    set style "summary"
    rptNewLine 0
    rptSetStyle summary
    rptNewPage -guardline 3
}
proc header {} {
    global style 
    set style "header"
    rptNewLine 0
    rptSetStyle header
    if {![rptNewPage -guardlines 6]} {
        rptAddLine ""
    }
}
proc procname {} {
    global style
    set style "procname"
    rptNewLine 2
    rptSetStyle procname
    rptNewPage -guardlines 5
}
proc title {} {
    global style
    set style "title"
    rptNewLine 3
    rptSetStyle title
}
proc figure {} {
    global style 
    set style "figure"
    rptNewLine 0
    rptSetStyle figure
	rptNewLine 0
}
#
# -- procedure to process documentation input file
proc processdocs {} {
    global style RPTTYPE SRCFILE DOCFILE
    set fd [open $SRCFILE r]
    set newparagraphf 1
    while {![eof $fd]} {
        set line [gets $fd]
        set first [string index $line 0]
        set command ""
        set command [string range $line 1 end]
        if {$first == "#"} {
            # -- noop
        } elseif {$first == "%"} {
            if {-1 != [lsearch [info procs] [lindex $command 0]]} {
                eval "$command" 
            }
        } else {
            if {$style == "body"} {
                # -- if style is "body", first remove any trailing blanks 
                # -- on the line unless the last character is a ".", then
                # -- add a blank (a trailing blank becomes double blank 
                # -- internally in TclVSrpt).  Also, any leading blanks
                # -- will be removed.  Then, simply add text into 
                # -- input stream.  However, if the line is empty, force 
                # -- a newline to separate paragraphs and start a new line 
                # -- of text (and to handle any line indent or prefix)
                if {[string length $line] == 0} {
                    set newparagraphf 1
                    rptNewLine 1
                    rptNewPage -guardline 4
                } else {
                    set linestart 0
                    set lineend [expr [string length "$line"] - 1]
                    set slineend $lineend
                    while {$lineend > -1 && [string index "$line" $lineend] == " "} {
                        incr lineend -1
                    }
                    if {$lineend > -1 && [string index "$line" $lineend] == "."} {
                        set line "[string range "$line" 0 $lineend] "
                    }
                    while {$linestart <= $lineend && \
                            [string index "$line" $linestart] == " "} {
                        incr linestart
                    }
                    if {$linestart != 0 || $lineend != $slineend} {
                        set line "[string range "$line" $linestart $lineend]"
                    }
                    if {"$line" == "" || "$line" == " "} {
                        rptNewLine 1
                        set newparagraphf 1
                    } else {
                        if {$newparagraphf} {
                            rptAddLine "$line"
                        } else {
                            rptAddText "$line"
                        }
                        set newparagraphf 0
                    }
                }
            } elseif {$style == "summary"} {
                # -- handle style changes within "summary" as 
                # -- indicated by the delimiting characters "<", ">", 
                # -- "(", and ")"
                set i -1
                set si 0
                set changef 0
                set stylemodifier "summary"
                set fontstack $stylemodifier
                set fflag 1
                set iexact 0
                set firstc [string index "$line" 0]
                set lastc [expr [string length "$line"] - 1]
                if {$firstc != "\t" && $firstc != " " && $firstc != ""} {
                    set stylemodifier "summary-heading"
                    rptSetStyle $stylemodifier
                    lappend fontstack $stylemodifier
                    set changef 0
                }
                foreach c [split "$line" ""] {
                    incr i
                    if {$c == "<"} {
                        set stylemodifier "summary-option"
                        lappend fontstack $stylemodifier
                        set changef 1
                        set iexact 0
                    }
                    if {$c == "("} {
                        set stylemodifier "summary-comment"
                        lappend fontstack $stylemodifier
                        set changef 1
                        set iexact 0
                    }
                    if {$c == ">" || $c == ")"} {
                        set pop [expr [llength $fontstack] - 2]
                        set fontstack [lrange $fontstack 0 $pop]
                        set stylemodifier [lindex $fontstack $pop]
                        set changef 1
                        set iexact 1
                    }
                    if {$changef} {
                        if {$iexact} {
                            set text "[string range "$line" $si $i]"
                            set si [expr $i + 1]
                        } else {
                            set text "[string range "$line" $si [expr $i - 1]]"
                            set si $i
                        }
                        if {$fflag} {
                            rptAddLine "$text"
                            set fflag 0
                        } else {
                            rptAddText "$text"
                        }
                        rptSetStyle $stylemodifier
                        set changef 0
                    }
                }
                if {$si <= $lastc} {
                    set text "[string range "$line" $si $lastc]"
                    if {$fflag} {
                        rptAddLine "$text"
                        set fflag 0
                    } else {
                        rptAddText "$text"
                    }
                }
                if {$stylemodifier != "summary"} {
                    rptSetStyle summary
                }
                rptNewLine 0
            } else {
                # -- add all other styles, simply add as a line of text
                rptAddLine "$line"
                rptNewLine 0
                set newparagraphf 1
            }
        }
    }
    rptNewLine 0
    # -- all input processed, finish the document.
    close $fd
    rptDone -f $DOCFILE
    # -- tidy up on our way out
    rename author {}
    rename body {}
    rename bullets {}
    rename code {}
    rename summary {}
    rename header {}
    rename procname {}
    puts stdout "Find the formatted documentation in $DOCFILE"
    unset RPTTYPE
    unset SRCFILE
    unset DOCFILE
    unset style
}
# -- do the job
processdocs
rename processdocs {}



