OUTPUT BUFFER:
# -*- tcl -*- # # _text.tcl -- Core support for text engines. ################################################################ if {0} { catch {rename proc proc__} msg ; puts_stderr >>$msg proc__ proc {cmd argl body} { puts_stderr "proc $cmd $argl ..." uplevel [list proc__ $cmd $argl $body] } } dt_package textutil::string ; # for adjust dt_package textutil::repeat dt_package textutil::adjust if {0} { puts_stderr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ rename proc {} rename proc__ proc puts_stderr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } ################################################################ # Formatting constants ... Might be engine variables in the future. global lmarginIncrement ; set lmarginIncrement 4 global rmarginThreshold ; set rmarginThreshold 20 global bulleting ; set bulleting {* - # @ ~ %} global enumeration ; set enumeration {[%] (%) <%>} proc Bullet {ivar} { global bulleting ; upvar $ivar i set res [lindex $bulleting $i] set i [expr {($i + 1) % [llength $bulleting]}] return $res } proc EnumBullet {ivar} { global enumeration ; upvar $ivar i set res [lindex $enumeration $i] set i [expr {($i + 1) % [llength $enumeration]}] return $res } ################################################################ # # The engine maintains several data structures per document and pass. # Most important is an internal representation of the text better # suited to perform the final layouting, the display list. Elements of # the display list are lists containing 2 elements, an operation, and # its arguments, in this order. The arguments are a list again, its # contents are specific to the operation. # # The operations are: # # - SECT Section. Title. # - SUBSECT Subsection. Title. # - PARA Paragraph. Environment reference and text. # # The PARA operation is the workhorse of the engine, dooing all the # formatting, using the information in an "environment" as the guide # for doing so. The environments themselves are generated during the # second pass through the contents. They contain the information about # nesting (i.e. indentation), bulleting and the like. # global cmds ; set cmds [list] ; # Display list global pEnv ; array set pEnv {} ; # Defined paragraph environments (bulleting, indentation, other). global para ; set para "" ; # Text buffer for paragraphs. global nextId ; set nextId 0 ; # Counter for environment generation. global currentId ; set currentId {} ; # Id of current environment in 'pEnv' global currentEnv ; array set currentEnv {} ; # Current environment, expanded form. global contexts ; set contexts [list] ; # Stack of saved environments. global off ; set off 1 ; # Supression of plain text in some places. ################################################################ # Management of the current context. proc Text {text} {global para ; append para $text ; return} proc Store {op args} {global cmds ; lappend cmds [list $op $args] ; return} proc Off {} {global off ; set off 1 ; return} proc On {} {global off para ; set off 0 ; set para "" ; return} proc IsOff {} {global off ; return [expr {$off == 1}]} # Debugging ... #proc Text {text} {puts_stderr "TXT \{$text\}"; global para; append para $text ; return} #proc Store {op args} {puts_stderr "STO $op $args"; global cmds; lappend cmds [list $op $args]; return} #proc Off {} {puts_stderr OFF ; global off ; set off 1 ; return} #proc On {} {puts_stderr ON_ ; global off para ; set off 0 ; set para "" ; return} proc NewEnv {name script} { global currentId nextId currentEnv #puts_stderr "NewEnv ($name)" set parentId $currentId set currentId $nextId incr nextId append currentEnv(NAME) -$parentId-$name set currentEnv(parent) $parentId set currentEnv(id) $currentId # Always squash a verbatim environment inherited from the previous # environment ... catch {unset currentEnv(verbenv)} uplevel $script SaveEnv return $currentId } ################################################################ proc TextInitialize {} { global off ; set off 1 global cmds ; set cmds [list] ; # Display list global pEnv ; array set pEnv {} ; # Defined paragraph environments (bulleting, indentation, other). global para ; set para "" ; # Text buffer for paragraphs. global nextId ; set nextId 0 ; # Counter for environment generation. global currentId ; set currentId {} ; # Id of current environment in 'pEnv' global currentEnv ; array set currentEnv {} ; # Current environment, expanded form. global contexts ; set contexts [list] ; # Stack of saved environments. # lmargin = location of left margin for text. # prefix = prefix string to use for all lines. # wspfx = whitespace prefix for all but the first line # listtype = type of list, if any # bullet = bullet to use for unordered, bullet template for ordered. # verbatim = flag if verbatim formatting requested. # next = if present the environment to use after closing the paragraph using this one. NewEnv Base { array set currentEnv { lmargin 0 prefix {} wspfx {} listtype {} bullet {} verbatim 0 bulleting 0 enumeration 0 } } return } ################################################################ proc Section {name} {Store SECT $name ; return} proc Subsection {name} {Store SUBSECT $name ; return} proc CloseParagraph {{id {}}} { global para currentId if {$para != {}} { if {$id == {}} {set id $currentId} Store PARA $id $para #puts_stderr "CloseParagraph $id" } set para "" return } proc SaveContext {} { global contexts currentId lappend contexts $currentId #global currentEnv ; puts_stderr "Save>> $currentId ($currentEnv(NAME))" return } proc RestoreContext {} { global contexts SetContext [lindex $contexts end] set contexts [lrange $contexts 0 end-1] #global currentId currentEnv ; puts_stderr "<