1# -*- tcl -*-
2#
3# _text.tcl -- Core support for text engines.
4
5
6################################################################
7
8if {0} {
9    catch {rename proc proc__} msg ; puts_stderr >>$msg
10    proc__ proc {cmd argl body} {
11	puts_stderr "proc $cmd $argl ..."
12	uplevel [list proc__ $cmd $argl $body]
13    }
14}
15
16dt_package textutil::string ; # for adjust
17dt_package textutil::repeat
18dt_package textutil::adjust
19
20if {0} {
21    puts_stderr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
22    rename proc {}
23    rename proc__ proc
24    puts_stderr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
25}
26
27
28################################################################
29# Formatting constants ... Might be engine variables in the future.
30
31global lmarginIncrement ; set lmarginIncrement 4
32global rmarginThreshold ; set rmarginThreshold 20
33global bulleting        ; set bulleting        {* - # @ ~ %}
34global enumeration      ; set enumeration      {[%] (%) <%>}
35
36proc Bullet {ivar} {
37    global bulleting ; upvar $ivar i
38    set res [lindex $bulleting $i]
39    set i [expr {($i + 1) % [llength $bulleting]}]
40    return $res
41}
42
43proc EnumBullet {ivar} {
44    global enumeration ; upvar $ivar i
45    set res [lindex $enumeration $i]
46    set i [expr {($i + 1) % [llength $enumeration]}]
47    return $res
48}
49
50################################################################
51
52#
53# The engine maintains several data structures per document and pass.
54# Most important is an internal representation of the text better
55# suited to perform the final layouting, the display list. Elements of
56# the display list are lists containing 2 elements, an operation, and
57# its arguments, in this order. The arguments are a list again, its
58# contents are specific to the operation.
59#
60# The operations are:
61#
62# - SECT	Section.    Title.
63# - SUBSECT     Subsection. Title.
64# - PARA	Paragraph.  Environment reference and text.
65#
66# The PARA operation is the workhorse of the engine, dooing all the
67# formatting, using the information in an "environment" as the guide
68# for doing so. The environments themselves are generated during the
69# second pass through the contents. They contain the information about
70# nesting (i.e. indentation), bulleting and the like.
71#
72
73global cmds ; set cmds [list]   ; # Display list
74global pEnv ; array set pEnv {} ; # Defined paragraph environments (bulleting, indentation, other).
75global para ; set para ""       ; # Text buffer for paragraphs.
76
77global nextId     ; set       nextId     0      ; # Counter for environment generation.
78global currentId  ; set       currentId  {}     ; # Id of current environment in 'pEnv'
79global currentEnv ; array set currentEnv {}     ; # Current environment, expanded form.
80global contexts   ; set       contexts   [list] ; # Stack of saved environments.
81global off        ; set off   1                 ; # Supression of plain text in some places.
82
83################################################################
84# Management of the current context.
85
86proc Text  {text}    {global para ; append para $text ; return}
87proc Store {op args} {global cmds ; lappend cmds [list $op $args] ; return}
88proc Off   {}        {global off ; set off 1 ; return}
89proc On    {}        {global off para ; set off 0 ; set para "" ; return}
90proc IsOff {}        {global off ; return [expr {$off == 1}]}
91
92# Debugging ...
93#proc Text  {text}    {puts_stderr "TXT \{$text\}"; global para; append para $text ; return}
94#proc Store {op args} {puts_stderr "STO $op $args"; global cmds; lappend cmds [list $op $args]; return}
95#proc Off   {}        {puts_stderr OFF ; global off ; set off 1 ; return}
96#proc On    {}        {puts_stderr ON_ ; global off para ; set off 0 ; set para "" ; return}
97
98
99proc NewEnv {name script} {
100    global currentId  nextId currentEnv
101
102    #puts_stderr "NewEnv ($name)"
103
104    set    parentId  $currentId
105    set    currentId $nextId
106    incr              nextId
107
108    append currentEnv(NAME) -$parentId-$name
109    set currentEnv(parent) $parentId
110    set currentEnv(id)     $currentId
111
112    # Always squash a verbatim environment inherited from the previous
113    # environment ...
114    catch {unset currentEnv(verbenv)}
115
116    uplevel $script
117    SaveEnv
118    return $currentId
119}
120
121################################################################
122
123proc TextInitialize {} {
124    global off  ; set off 1
125    global cmds ; set cmds [list]   ; # Display list
126    global pEnv ; array set pEnv {} ; # Defined paragraph environments (bulleting, indentation, other).
127    global para ; set para ""       ; # Text buffer for paragraphs.
128
129    global nextId     ; set       nextId     0      ; # Counter for environment generation.
130    global currentId  ; set       currentId  {}     ; # Id of current environment in 'pEnv'
131    global currentEnv ; array set currentEnv {}     ; # Current environment, expanded form.
132    global contexts   ; set       contexts   [list] ; # Stack of saved environments.
133
134    # lmargin  = location of left margin for text.
135    # prefix   = prefix string to use for all lines.
136    # wspfx    = whitespace prefix for all but the first line
137    # listtype = type of list, if any
138    # bullet   = bullet to use for unordered, bullet template for ordered.
139    # verbatim = flag if verbatim formatting requested.
140    # next     = if present the environment to use after closing the paragraph using this one.
141
142    NewEnv Base {
143	array set currentEnv {
144	    lmargin     0
145	    prefix      {}
146	    wspfx       {}
147	    listtype    {}
148	    bullet      {}
149	    verbatim    0
150	    bulleting   0
151	    enumeration 0
152	}
153    }
154    return
155}
156
157################################################################
158
159proc Section    {name} {Store SECT    $name ; return}
160proc Subsection {name} {Store SUBSECT $name ; return}
161
162proc CloseParagraph {{id {}}} {
163    global para currentId
164    if {$para != {}} {
165	if {$id == {}} {set id $currentId}
166	Store PARA $id $para
167	#puts_stderr "CloseParagraph $id"
168    }
169    set para ""
170    return
171}
172
173proc SaveContext {} {
174    global  contexts  currentId
175    lappend contexts $currentId
176
177    #global currentEnv ; puts_stderr "Save>> $currentId ($currentEnv(NAME))"
178    return
179}
180
181proc RestoreContext {} {
182    global                contexts
183    SetContext   [lindex $contexts end]
184    set contexts [lrange $contexts 0 end-1]
185
186    #global currentId currentEnv ; puts_stderr "<<Restored $currentId ($currentEnv(NAME))"
187    return
188}
189
190proc SetContext {id} {
191    global    currentId currentEnv pEnv
192    set       currentId $id
193
194    # Ensure that array is clean before setting hte new block of
195    # information.
196    unset     currentEnv
197    array set currentEnv $pEnv($currentId)
198
199    #puts_stderr "--Set $currentId ($currentEnv(NAME))"
200    return
201}
202
203proc SaveEnv {} {
204    global pEnv  currentId             currentEnv
205    set    pEnv($currentId) [array get currentEnv]
206    return
207}
208
209################################################################
210
211proc NewVerbatim {} {
212    global currentEnv
213    return [NewEnv Verbatim {set currentEnv(verbatim) 1}]
214}
215
216proc Verbatim {} {
217    global currentEnv
218    if {![info exists currentEnv(verbenv)]} {
219	SaveContext
220	set verb [NewVerbatim]
221	RestoreContext
222
223	# Remember verbatim mode in the base environment
224	set currentEnv(verbenv) $verb
225	SaveEnv
226    }
227    return $currentEnv(verbenv)
228}
229
230################################################################
231
232proc text_plain_text {text} {
233    #puts_stderr "<<text_plain_text>>"
234
235    if  {[IsOff]} {return}
236
237    # Note: Whenever we get plain text it is possible that a macro for
238    # visual markup actually generated output before the expander got
239    # to the current text. This output was captured by the expander in
240    # its current context. Given the current organization of the
241    # engine we have to retrieve this formatted text from the expander
242    # or it will be lost. This is the purpose of the 'ctopandclear',
243    # which retrieves the data and also clears the capture buffer. The
244    # latter to prevent us from retrieving it again later, after the
245    # next macro added more data.
246
247    set text [ex_ctopandclear]$text
248
249    # ... TODO ... Handling of example => verbatim
250
251    if {[string length [string trim $text]] == 0} return
252
253    Text $text
254    return
255}
256
257################################################################
258
259proc text_postprocess {text} {
260
261    #puts_stderr XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
262    #puts_stderr <<$text>>
263    #puts_stderr XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
264
265    global cmds
266    # The argument is not relevant. Access the display list, perform
267    # the final layouting and return its result.
268
269    set linebuffer [list]
270    array set state {lmargin 0 rmargin 0}
271    foreach cmd $cmds {
272	foreach {op arguments} $cmd break
273	$op $arguments
274    }
275
276    #puts_stderr XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
277
278    return [join $linebuffer \n]
279}
280
281
282proc SECT {text} {
283    upvar linebuffer linebuffer
284
285    # text is actually the list of arguments, having one element, the text.
286    set text [lindex $text 0]
287    #puts_stderr "SECT $text"
288    #puts_stderr ""
289
290    # Write section title, underline it
291
292    lappend linebuffer ""
293    lappend linebuffer $text
294    lappend linebuffer [textutil::repeat::strRepeat = [string length $text]]
295    return
296}
297
298proc SUBSECT {text} {
299    upvar linebuffer linebuffer
300
301    # text is actually the list of arguments, having one element, the text.
302    set text [lindex $text 0]
303    #puts_stderr "SUBSECT $text"
304    #puts_stderr ""
305
306    # Write subsection title, underline it (with less emphasis)
307
308    lappend linebuffer ""
309    lappend linebuffer $text
310    lappend linebuffer [textutil::repeat::strRepeat - [string length $text]]
311    return
312}
313
314proc PARA {arguments} {
315    global pEnv
316    upvar linebuffer linebuffer
317
318    foreach {env text} $arguments break
319    array set para $pEnv($env)
320
321    #puts_stderr "PARA $env"
322    #parray_stderr para
323    #puts_stderr "     \{$text\}"
324    #puts_stderr ""
325
326    # Use the information in the referenced environment to format the paragraph.
327
328    if {$para(verbatim)} {
329	set text [textutil::adjust::undent $text]
330    } else {
331	# The size is determined through the set left and right margins
332	# right margin is fixed at 80, left margin is variable. Size
333	# is at least 20. I.e. when left margin > 60 right margin is
334	# shifted out to the right.
335
336	set size [expr {80 - $para(lmargin)}]
337	if {$size < 20} {set size 20}
338
339	set text [textutil::adjust::adjust $text -length $size]
340    }
341
342    # Now apply prefixes, (ws prefixes bulleting), at last indentation.
343
344    if {[string length $para(prefix)] > 0} {
345	set text [textutil::adjust::indent $text $para(prefix)]
346    }
347
348    if {$para(listtype) != {}} {
349	switch -exact $para(listtype) {
350	    bullet {
351		# Indent for bullet, but not the first line. This is
352		# prefixed by the bullet itself.
353
354		set thebullet $para(bullet)
355	    }
356	    enum {
357		# Handling the enumeration counter. Special case: An
358		# example as first paragraph in an item has to use the
359		# counter in environment it is derived from to prevent
360		# miscounting.
361
362		if {[info exists para(example)]} {
363		    set parent $para(parent)
364		    array set __ $pEnv($parent)
365		    if {![info exists __(counter)]} {
366			set __(counter) 1
367		    } else {
368			incr __(counter)
369		    }
370		    set pEnv($parent) [array get __] ; # Save context change ...
371		    set n $__(counter)
372		} else {
373		    if {![info exists para(counter)]} {
374			set para(counter) 1
375		    } else {
376			incr para(counter)
377		    }
378		    set pEnv($env) [array get para] ; # Save context change ...
379		    set n $para(counter)
380		}
381
382		set thebullet [string map [list % $n] $para(bullet)]
383	    }
384	}
385
386	set blen [string length $thebullet]
387	if {$blen >= [string length $para(wspfx)]} {
388	    set text    "$thebullet\n[textutil::adjust::indent $text $para(wspfx)]"
389	} else {
390	    set fprefix $thebullet[string range $para(wspfx) $blen end]
391	    set text    "${fprefix}[textutil::adjust::indent $text $para(wspfx) 1]"
392	}
393    }
394
395    if {$para(lmargin) > 0} {
396	set text [textutil::adjust::indent $text \
397		      [textutil::repeat::strRepeat " " $para(lmargin)]]
398    }
399
400    lappend linebuffer ""
401    lappend linebuffer $text
402    return
403}
404
405################################################################
406
407proc strong      {text} {return *${text}*}
408proc em          {text} {return _${text}_}
409
410################################################################
411
412proc parray_stderr {a {pattern *}} {
413    upvar 1 $a array
414    if {![array exists array]} {
415        error "\"$a\" isn't an array"
416    }
417    set maxl 0
418    foreach name [lsort [array names array $pattern]] {
419        if {[string length $name] > $maxl} {
420            set maxl [string length $name]
421        }
422    }
423    set maxl [expr {$maxl + [string length $a] + 2}]
424    foreach name [lsort [array names array $pattern]] {
425        set nameString [format %s(%s) $a $name]
426        puts_stderr "    [format "%-*s = {%s}" $maxl $nameString $array($name)]"
427    }
428}
429
430################################################################
431