path: root/src/DrawResources/tdoc

#!/bin/sh
# The next line is executed by /bin/sh, but not Tcl \
  exec tclsh $0 ${1+"$@"}

source $env(DRAWHOME)/Documentation.tcl

#
# format a documentation for troff
#

# proc ot manage keeping of lines together
proc keep {} {
    global theFile keeping
    if {! $keeping} {
	puts $theFile ".KS"
    }
    set keeping 1
}

proc endkeep {} {
    global theFile keeping
    if {$keeping} {
	puts $theFile ".KE"
    }
    set keeping 0
}

proc troffTitle {title level} {
    global theFile

    endkeep

    # set the header
    puts $theFile ".ds LH $title"

    # try to keep command titles with their synopsis
    if {$level == 3} keep

    puts $theFile ".NH $level"
    puts $theFile $title
    puts $theFile ".XS"
    for {set i 1} {$i <= $level} {incr i} {puts -nonewline $theFile "  "}
    puts $theFile $title
    puts $theFile ".XE"
}

proc putText {aText} {
    global theFile
    foreach line $aText {
	regsub -all {\\} $line "\\e" l
	puts $theFile $l
    }
}

proc troffSection {aSection aText} {
    global theFile ExNumber fill

    # check if text is empty
    set empty 1
    foreach line $aText {
	if {![regexp {^[ \t]*$} $line]} {
	    set empty 0
	    break
	}
    }
    if $empty return

    if {$aSection == ""} {
	if {$fill} {puts $theFile ".PP"} else {puts $theFile ".LD\n.R"}
	putText $aText
	if {! $fill} {puts $theFile ".DE"}
	return
    }

    switch $aSection {
		
	.Synopsis  {
	    puts $theFile ".LD\n.R"
	    putText $aText
	    puts $theFile ".DE"
	}
	
	.Purpose   {
	    puts $theFile ".B Purpose\n.PP"
	    putText $aText
	    # Synopsis and purpose are kept with command title
	    endkeep
	}
	
	.Example    {
	    endkeep
	    incr ExNumber
	    puts $theFile ".sp\n.B1\n.DS"         
	    for {set i 1} {$i <= 80} {incr i} {puts -nonewline $theFile " "}
	    puts $theFile " "
	    puts $theFile ".B \"Example $ExNumber\""
	    putText $aText
	    puts $theFile ".DE"
	    puts $theFile ".B2"
	}
	
	".See also" {
	    puts $theFile ".sp\n.B \"See also\"\n.PP"
	    putText $aText
	}
	
	.Warning    {
	    puts $theFile ".sp\n.B Warnings\n.PP"
	    putText $aText
	}
	
	.Text   {
	    if {$fill} {puts $theFile ".PP"} else {puts $theFile ".LD\n.R"}
	    putText $aText
	    if {! $fill} {puts $theFile ".DE"}
	}
	
	.Index      {
	    foreach word $aText {
		if {$word != ""} {puts $theFile ".IX $word"}
	    }
	}
    }
}

proc troffText {aText} {
	sectionText $aText troffSection
}

proc troff {} {
    global theFile texts ExNumber title
    set ExNumber 0

    puts $theFile ".RP"
    puts $theFile ".TL\n$title"
    puts $theFile ".AU\nThe CAS.CADE Software Factory"
    puts $theFile ".AI\nMatra-Datavision"

    if [info exists texts(Top)] {
	# Abstract
	puts $theFile ".AB"
	putText $texts(Top)
	puts $theFile ".AE"
	set text(Top) {}
    }

    # header and footer
    puts $theFile ".ds CH "
    puts $theFile ".ds RH $title"
    puts $theFile ".ds CF -%-"
    puts $theFile ".ds LF Copyright Matra-Datavision"

    dump troffTitle troffText

    puts $theFile ".ds RH Contents"
    puts $theFile ".bp\n.TL\nTable of contents\n.PX no"
}

# compare without case, used for sorting the index
proc cmp {s1 s2} {
    return [string compare [string tolower $s1] [string tolower $s2]]
}

proc processIndex {fileindex filetr} {
    # read the index file and create the index
    # Try to keep together the letter an the first line

    set f [open $fileindex r]
    set sindex {}
    while {[gets $f line] >= 0} {
	if [regexp {^(.*[^ 	])[ 	]*\.\.\. ([0-9]*)$} $line dummy word page] {
	    lappend sindex "$word $page"
	}
    }
    close $f
    set f [open $filetr w]
    puts $f ".TL\nIndex"
    puts $f ".2C\n.LD"
    set letter ""
    set count 0
    foreach line [lsort -command cmp $sindex] {
	set l [string toupper [string index $line 0]]
	if {$l != $letter} {
	    set letter $l
	    puts $f "\n.KS\n.LG 2\n.B $letter\n.NL\n"
	    set count 0
	}
	puts $f $line
	incr count
	if {$count == 1} {puts $f ".KE"}
    }
    close $f
}

#
# process arguments
#

if {$argc < 1} {
    puts "tdoc docfile title [nofill]"
    puts "format a doc file for printing in postscript"
    puts "if nofill text are not justified"
    exit
}

set file   [lindex $argv 0]
set title  "CAS.CADE Documentation"
if {$argc > 1} {set title [lindex $argv 1]}
set fill 1
if {$argc > 2} {set fill 0}


if [file readable $file] {
    readFile $file
    set file [file rootname $file]
    set filetr    F[pid]
    set fileout   O[pid]
    set fileindex I[pid]
    set theFile [open $filetr w]
    set keeping 0
    troff
    close $theFile
    exec troff -ms $filetr > $fileout 2> $fileindex
    set fileindextr IT[pid]
    processIndex $fileindex $fileindextr
    exec troff -ms $fileindextr >> $fileout
    exec /usr/lib/lp/postscript/dpost $fileout > $file.ps
    exec rm -f $filetr $fileout $fileindex $fileindextr
    puts "$file.ps created"
} else {
	puts "Cannot open $file for reading"
}