if {[next-op-is .RS rest]} { while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest switch -exact -- $code { .RE { break } .SH - .SS { manerror "unbalanced .RS at section end" backup-text 1 break } default { output-directive $line } } } else { man-puts $line } } } } man-puts
$rest output-IP-list .RS .IP $rest2 } if {[match-text .RE .sp .RS @rest .RE]} { man-puts
$rest return } if {[next-op-is .RE rest]} { return } } man-puts
" continue } if {$code in {.br .DS .RS}} { output-directive $line } else { backup-text 1 break } } else { man-puts $line } } man-puts
} set dl "
$rest
$rest" incr accept_RE -1 } } elseif {$accept_RE} { output-directive $line } else { backup-text 1 break } } .RE { if {!$accept_RE} { backup-text 1 break } incr accept_RE -1 } default { backup-text 1 break } } } else { man-puts $line } set para
} man-puts "$para
continue
}
set more [next-text]
if {[is-a-directive $more]} {
manerror "in SYNOPSIS found $more"
backup-text 1
break
}
foreach more [split $more \n] {
regexp {^(\s*)(.*)} $more -> spaces more
set spaces [string map {" " " "} $spaces]
if {[string length $spaces]} {
set spaces $spaces
}
man-puts $spaces$more
if {$manual(wing-file) in {TclLib TkLib}} {
lappend manual(section-toc)
}
.RS {
output-RS-list
return
}
.RE {
manerror "unexpected .RE"
return
}
.br {
man-puts
return
}
.DE {
manerror "unexpected .DE"
return
}
.DS {
if {[next-op-is .ta rest]} {
# skip the leading .ta directive if it is there
}
if {[match-text @stuff .DE]} {
set td "
" set bodyText [string map [list \n
$stuff} elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} { man-puts "
[lindex $ul1 1][lindex $ul2 1]\n$stuff" } else { manerror "unexpected .DS format:\n[expand-next-text 2]" } return } .CS { if {[next-op-is .ta rest]} { # ??? } if {[match-text @stuff .CE]} { man-puts
$stuff} else { manerror "unexpected .CS format:\n[expand-next-text 2]" } return } .CE { manerror "unexpected .CE" return } .sp { man-puts
}
.ta {
manerror "ignoring $line"
}
.nf {
if {[match-text @more .fi]} {
foreach more [split $more \n] {
man-puts $more
}
} elseif {[match-text .RS @more .RE .fi]} {
man-puts
} elseif {[match-text .RS .sp @more .sp .RE .fi]} { man-puts
} else { manerror "ignoring $line" } } .fi { manerror "ignoring $line" } .na - .ad - .UL - .ne { manerror "ignoring $line" } default { manerror "unrecognized format directive: $line" } } } ## ## merge copyright listings ## proc merge-copyrights {l1 l2} { set merge {} set re1 {^Copyright +(?:\(c\)|\\\(co|©) +(\w.*?)(?:all rights reserved)?(?:\. )*$} set re2 {^(\d+) +(?:by +)?(\w.*)$} ;# date who set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$} ;# from to who set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who foreach copyright [concat $l1 $l2] { if {[regexp -nocase -- $re1 $copyright -> info]} { set info [string trimright $info ". "] ; # remove extra period if {[regexp -- $re2 $info -> date who]} { lappend dates($who) $date continue } elseif {[regexp -- $re3 $info -> from to who]} { for {set date $from} {$date <= $to} {incr date} { lappend dates($who) $date } continue } elseif {[regexp -- $re3 $info -> date1 date2 who]} { lappend dates($who) $date1 $date2 continue } } puts "oops: $copyright" } foreach who [array names dates] { set list [lsort -dictionary $dates($who)] if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} { lappend merge "Copyright © [lindex $list 0] $who" } else { lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who" } } return [lsort -dictionary $merge] } proc makedirhier {dir} { try { if {![file isdirectory $dir]} { file mkdir $dir } } on error msg { return -code error "cannot create directory $dir: $msg" } } proc addbuffer {args} { global manual if {$manual(partial-text) ne ""} { append manual(partial-text) \n } append manual(partial-text) [join $args ""] } proc flushbuffer {} { global manual if {$manual(partial-text) ne ""} { lappend manual(text) [process-text $manual(partial-text)] set manual(partial-text) "" } } return