summaryrefslogtreecommitdiffstats
path: root/tcllib/modules/doctools/mpformats/_text.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tcllib/modules/doctools/mpformats/_text.tcl')
-rw-r--r--tcllib/modules/doctools/mpformats/_text.tcl430
1 files changed, 430 insertions, 0 deletions
diff --git a/tcllib/modules/doctools/mpformats/_text.tcl b/tcllib/modules/doctools/mpformats/_text.tcl
new file mode 100644
index 0000000..6541e35
--- /dev/null
+++ b/tcllib/modules/doctools/mpformats/_text.tcl
@@ -0,0 +1,430 @@
+# -*- 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 "<<Restored $currentId ($currentEnv(NAME))"
+ return
+}
+
+proc SetContext {id} {
+ global currentId currentEnv pEnv
+ set currentId $id
+
+ # Ensure that array is clean before setting hte new block of
+ # information.
+ unset currentEnv
+ array set currentEnv $pEnv($currentId)
+
+ #puts_stderr "--Set $currentId ($currentEnv(NAME))"
+ return
+}
+
+proc SaveEnv {} {
+ global pEnv currentId currentEnv
+ set pEnv($currentId) [array get currentEnv]
+ return
+}
+
+################################################################
+
+proc NewVerbatim {} {
+ global currentEnv
+ return [NewEnv Verbatim {set currentEnv(verbatim) 1}]
+}
+
+proc Verbatim {} {
+ global currentEnv
+ if {![info exists currentEnv(verbenv)]} {
+ SaveContext
+ set verb [NewVerbatim]
+ RestoreContext
+
+ # Remember verbatim mode in the base environment
+ set currentEnv(verbenv) $verb
+ SaveEnv
+ }
+ return $currentEnv(verbenv)
+}
+
+################################################################
+
+proc text_plain_text {text} {
+ #puts_stderr "<<text_plain_text>>"
+
+ if {[IsOff]} {return}
+
+ # Note: Whenever we get plain text it is possible that a macro for
+ # visual markup actually generated output before the expander got
+ # to the current text. This output was captured by the expander in
+ # its current context. Given the current organization of the
+ # engine we have to retrieve this formatted text from the expander
+ # or it will be lost. This is the purpose of the 'ctopandclear',
+ # which retrieves the data and also clears the capture buffer. The
+ # latter to prevent us from retrieving it again later, after the
+ # next macro added more data.
+
+ set text [ex_ctopandclear]$text
+
+ # ... TODO ... Handling of example => verbatim
+
+ if {[string length [string trim $text]] == 0} return
+
+ Text $text
+ return
+}
+
+################################################################
+
+proc text_postprocess {text} {
+
+ #puts_stderr XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+ #puts_stderr <<$text>>
+ #puts_stderr XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+
+ global cmds
+ # The argument is not relevant. Access the display list, perform
+ # the final layouting and return its result.
+
+ set linebuffer [list]
+ array set state {lmargin 0 rmargin 0}
+ foreach cmd $cmds {
+ foreach {op arguments} $cmd break
+ $op $arguments
+ }
+
+ #puts_stderr XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+
+ return [join $linebuffer \n]
+}
+
+
+proc SECT {text} {
+ upvar linebuffer linebuffer
+
+ # text is actually the list of arguments, having one element, the text.
+ set text [lindex $text 0]
+ #puts_stderr "SECT $text"
+ #puts_stderr ""
+
+ # Write section title, underline it
+
+ lappend linebuffer ""
+ lappend linebuffer $text
+ lappend linebuffer [textutil::repeat::strRepeat = [string length $text]]
+ return
+}
+
+proc SUBSECT {text} {
+ upvar linebuffer linebuffer
+
+ # text is actually the list of arguments, having one element, the text.
+ set text [lindex $text 0]
+ #puts_stderr "SUBSECT $text"
+ #puts_stderr ""
+
+ # Write subsection title, underline it (with less emphasis)
+
+ lappend linebuffer ""
+ lappend linebuffer $text
+ lappend linebuffer [textutil::repeat::strRepeat - [string length $text]]
+ return
+}
+
+proc PARA {arguments} {
+ global pEnv
+ upvar linebuffer linebuffer
+
+ foreach {env text} $arguments break
+ array set para $pEnv($env)
+
+ #puts_stderr "PARA $env"
+ #parray_stderr para
+ #puts_stderr " \{$text\}"
+ #puts_stderr ""
+
+ # Use the information in the referenced environment to format the paragraph.
+
+ if {$para(verbatim)} {
+ set text [textutil::adjust::undent $text]
+ } else {
+ # The size is determined through the set left and right margins
+ # right margin is fixed at 80, left margin is variable. Size
+ # is at least 20. I.e. when left margin > 60 right margin is
+ # shifted out to the right.
+
+ set size [expr {80 - $para(lmargin)}]
+ if {$size < 20} {set size 20}
+
+ set text [textutil::adjust::adjust $text -length $size]
+ }
+
+ # Now apply prefixes, (ws prefixes bulleting), at last indentation.
+
+ if {[string length $para(prefix)] > 0} {
+ set text [textutil::adjust::indent $text $para(prefix)]
+ }
+
+ if {$para(listtype) != {}} {
+ switch -exact $para(listtype) {
+ bullet {
+ # Indent for bullet, but not the first line. This is
+ # prefixed by the bullet itself.
+
+ set thebullet $para(bullet)
+ }
+ enum {
+ # Handling the enumeration counter. Special case: An
+ # example as first paragraph in an item has to use the
+ # counter in environment it is derived from to prevent
+ # miscounting.
+
+ if {[info exists para(example)]} {
+ set parent $para(parent)
+ array set __ $pEnv($parent)
+ if {![info exists __(counter)]} {
+ set __(counter) 1
+ } else {
+ incr __(counter)
+ }
+ set pEnv($parent) [array get __] ; # Save context change ...
+ set n $__(counter)
+ } else {
+ if {![info exists para(counter)]} {
+ set para(counter) 1
+ } else {
+ incr para(counter)
+ }
+ set pEnv($env) [array get para] ; # Save context change ...
+ set n $para(counter)
+ }
+
+ set thebullet [string map [list % $n] $para(bullet)]
+ }
+ }
+
+ set blen [string length $thebullet]
+ if {$blen >= [string length $para(wspfx)]} {
+ set text "$thebullet\n[textutil::adjust::indent $text $para(wspfx)]"
+ } else {
+ set fprefix $thebullet[string range $para(wspfx) $blen end]
+ set text "${fprefix}[textutil::adjust::indent $text $para(wspfx) 1]"
+ }
+ }
+
+ if {$para(lmargin) > 0} {
+ set text [textutil::adjust::indent $text \
+ [textutil::repeat::strRepeat " " $para(lmargin)]]
+ }
+
+ lappend linebuffer ""
+ lappend linebuffer $text
+ return
+}
+
+################################################################
+
+proc strong {text} {return *${text}*}
+proc em {text} {return _${text}_}
+
+################################################################
+
+proc parray_stderr {a {pattern *}} {
+ upvar 1 $a array
+ if {![array exists array]} {
+ error "\"$a\" isn't an array"
+ }
+ set maxl 0
+ foreach name [lsort [array names array $pattern]] {
+ if {[string length $name] > $maxl} {
+ set maxl [string length $name]
+ }
+ }
+ set maxl [expr {$maxl + [string length $a] + 2}]
+ foreach name [lsort [array names array $pattern]] {
+ set nameString [format %s(%s) $a $name]
+ puts_stderr " [format "%-*s = {%s}" $maxl $nameString $array($name)]"
+ }
+}
+
+################################################################
generated by cgit v0.12 at 2025-01-26 00:53:42 (GMT)