1# -*- tcl -*-
2# Copyright (c) 2009 Andreas Kupries <andreas_kupries@sourceforge.net>
3
4# Support package. Basic text generation commands.
5
6# # ## ### ##### ######## ############# #####################
7## Requirements
8
9package require Tcl 8.4 ; # Required Core
10
11namespace eval ::doctools::text {}
12
13# # ## ### ##### ######## ############# #####################
14
15proc ::doctools::text::begin {} {
16    variable state
17    array unset state *
18    array set   state {
19	stack     {}
20	buffer    {}
21	prefix    {}
22	pstack    {}
23	underl    {}
24	break     0
25	newlines  1
26	indenting 1
27    }
28    return
29}
30
31proc ::doctools::text::done {} {
32    variable state
33    return $state(buffer)
34}
35
36proc ::doctools::text::save {} {
37    variable state
38    set current [array get state]
39    begin
40    set state(stack) $current
41    return
42}
43
44proc ::doctools::text::restore {} {
45    variable state
46    set text [done]
47    array set state $state(stack)
48    return $text
49}
50
51proc ::doctools::text::collect {script} {
52    save
53    uplevel 1 $script
54    return [restore]
55}
56
57# # ## ### ##### ######## ############# #####################
58
59proc ::doctools::text::+ {text} {
60    variable state
61    if {$state(break)} {
62	+++ [string repeat \n $state(break)]
63	+++ $state(prefix)
64	set state(break) 0
65    }
66    +++ $text
67    set state(underl) [string length $text]
68    return
69}
70
71proc ::doctools::text::underline {char} {
72    variable state
73    newline
74    + [string repeat [string index $char 0] $state(underl)]
75    newline
76    return
77}
78
79proc ::doctools::text::+++ {text} {
80    variable state
81    append   state(buffer) $text
82    return
83}
84
85# # ## ### ##### ######## ############# #####################
86
87proc ::doctools::text::newline {{increment 1}} {
88    variable state
89    if {!$state(newlines)} { return 0 }
90    incr state(break) $increment
91    return 1
92}
93
94proc ::doctools::text::newline? {} {
95    variable state
96    if {!$state(newlines)} { return 0 }
97    if {$state(break)} { return 1 }
98    if {![string length $state(buffer)]} { return 1 }
99    if {[string index   $state(buffer) end] eq "\n"} { return 1 }
100    incr state(break)
101    return 1
102}
103
104# # ## ### ##### ######## ############# #####################
105
106proc ::doctools::text::prefix {text} {
107    variable state
108    if {!$state(indenting)} return
109    set state(prefix) $text
110    return
111}
112
113proc ::doctools::text::indent {{increment 2}} {
114    variable state
115    if {!$state(indenting)} return
116    lappend state(pstack) $state(prefix)
117    set     state(prefix) [string repeat { } $increment]$state(prefix)
118    return
119}
120
121proc ::doctools::text::dedent {} {
122    variable state
123    if {!$state(indenting)} return
124    set state(prefix) [lindex   $state(pstack) end]
125    set state(pstack) [lreplace $state(pstack) end end]
126    return
127}
128
129proc ::doctools::text::indented {increment script} {
130    indent $increment
131    uplevel 1 $script
132    dedent
133    return
134}
135
136# # ## ### ##### ######## ############# #####################
137
138proc ::doctools::text::indenting {enable} {
139    variable state
140    set state(indenting) $enable
141    return
142}
143
144proc ::doctools::text::newlines {enable} {
145    variable state
146    set state(newlines) $enable
147    return
148}
149
150# # ## ### ##### ######## ############# #####################
151
152proc ::doctools::text::field {wvar elements {index {}}} {
153    upvar 1 $wvar width
154    set width 0
155    #puts @!$width
156    if {$index ne {}} {
157	foreach e $elements {
158	    #puts stdout @/$e
159	    set e [lindex $e $index]
160	    #puts stdout @^$e
161	    set l [string length $e]
162	    if {$l <= $width} continue
163	    set width $l
164	}
165    } else {
166	foreach e $elements {
167	    #puts stdout @/$e
168	    set l [string length $e]
169	    if {$l <= $width} continue
170	    set width $l
171	}
172    }
173    #puts stdout @=$width
174    return
175}
176
177proc ::doctools::text::right {wvar str} {
178    upvar $wvar width
179    return [format %${width}s $str]
180}
181
182proc ::doctools::text::left {wvar str} {
183    upvar $wvar width
184    return [format %-${width}s $str]
185}
186
187# # ## ### ##### ######## ############# #####################
188
189proc ::doctools::text::import {{namespace {}}} {
190    uplevel 1 [list namespace eval ${namespace}::text {
191	namespace import ::doctools::text::*
192    }]
193    return
194}
195
196proc ::doctools::text::importhere {{namespace ::}} {
197    uplevel 1 [list namespace eval ${namespace} {
198	namespace import ::doctools::text::*
199    }]
200    return
201}
202
203# # ## ### ##### ######## ############# #####################
204
205namespace eval ::doctools::text {
206    variable  state
207    array set state {}
208
209    namespace export begin done save restore collect + underline +++ \
210	prefix indent dedent indented indenting newline newlines \
211	field right left newline?
212}
213
214# # ## ### ##### ######## ############# #####################
215package provide doctools::text 0.1
216return
217