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