summaryrefslogtreecommitdiff
path: root/support/dinbrief-gui/dinbrief.vfs/tabs2tex.tcl
blob: db63c4aba9b553d014fe4072d6e7e45a1ddfaf49 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
comment {
    Bereiche mit Tabulatoren werden zum TeX-Makro \halign{...} umgesetzt.
    Tabulator-Bereiche werden so behandelt:
    (1) Die Zeilen werden eingesammelt und auf gleiche Tab-Zahl gebracht.
    (2) Die Felder werden in Spalten einsortiert.
    (3) Die Spalten werden auf Fließkomma- oder Ganzzahl untersucht.
    (4) Reine Fließkommaspalten werden durch
    Vorkomma- und Nachkommaspalten ersetzt.
    (5) Fließkomma- und Ganzzahlspalten werden rechtsbündig ausgerichtet.
}

proc getTabulatorIndices {txt} {
    set tabPat {(?:(?:[^\n]*\t)+[^\n]*\n)+}
    regexp -inline -all -indices $tabPat $txt
}

proc getTextTabSequence {txt} {
    set indexPairs [getTabulatorIndices $txt]
    set tabParts {}
    foreach {indexPair} $indexPairs {
	let {from to} $indexPair
	lappend tabParts [string range $txt $from $to]
    }
    set textIndices {}
    lappend textIndices -1
    foreach indexPair $indexPairs {
	let {from to} $indexPair
	lappend textIndices [expr {$from-1}] [expr {$to+1}]
    }
    lappend textIndices [string length $txt]
    set textParts {}
    foreach {from to} $textIndices {
	lappend textParts [string range $txt $from $to]
    }
    set result {}
    foreach textPart $textParts tabPart $tabParts {
	lappend result $textPart $tabPart
    }
    lrange $result 0 end-1
}

proc txt2tabRows {tabPart} {
    set lines [split [string trim $tabPart] \n]
    set colNum 0
    foreach line $lines {
	set length [llength [split $line \t]]
	if {$length > $colNum} {
	    set colNum $length
	}
    }
    set rowNum [llength $lines]
    set rows {}
    foreach i [range $rowNum] {
	set row [split [lindex $lines $i] \t]
	while {[llength $row] < $colNum} {
	    lappend row {}
	}
	lappend rows $row
    }
    set rows
}

proc txt2tabCols {tabPart} {
    set rows [txt2tabRows $tabPart]
    set rowNum [llength $rows]
    set colNum [llength [lindex $rows 0]]
    set cols {}
    foreach i [range $colNum] {
	set col {}
	foreach j [range $rowNum] {
	    lappend col [llindex $rows $j $i]
	}
	lappend cols $col
    }
    set cols
}

proc colType {col} {
    if {[globalSetting numberAlign] eq "left"} {
	return string
    }
    # try on integer
    set isInteger 1
    foreach f $col {
	if {![regexp {^[0-9+-]*$} $f]} {
	    set isInteger 0
	    break
	}
    }
    if {$isInteger} {
	return integer
    }
    let {Punkt Komma} [globalSetting 1000.dezimal,]
    set pat [subst -nocommand {^[+-]?[0-9$Punkt]+($Komma[0-9]+)?$}]
    foreach f $col {
	if {![regexp $pat $f]} {
	    return string
	}
    }
    return float
}

proc splitFloatCol {col} {
    let {Punkt Komma} [globalSetting 1000.dezimal,]
    let vorkommas {} nachkommas {}
    foreach float $col {
	let {vorkomma nachkomma} [split $float $Komma]
	lappend vorkommas $vorkomma
	lappend nachkommas $nachkomma
    }
    list $vorkommas $nachkommas
}

proc txt2tabColStruct {tabPart} {
    set cols [txt2tabCols $tabPart]
    set cols1 {}
    set types1 {}
    foreach col $cols type [map colType $cols] {
	switch $type {
	    float {
		lappend types1 vorkomma nachkomma
		let {vorkommas nachkommas} [splitFloatCol $col]
		lappend cols1 [map [lambda {numString} {
		    # string map "- \u2013" $numString
		    string map {- $-$ + $+$} $numString
		}] $vorkommas] [map [lambda {x} {
		    let {Punkt Komma} [globalSetting 1000.dezimal,]
		    if {$x ne ""} {
			return "$Komma$x"
		    }
		}] $nachkommas]
	    }
	    integer {
		lappend types1 $type
		lappend cols1 [map [lambda {numString} {
		    string map "- \u2013" $numString
		}] $col]
	    }
	    default {
		lappend types1 $type
		lappend cols1 $col
	    }
	}
    }
    list $types1 $cols1
}

proc txt2tabLineStruct {tabPart} {
    let {types cols} [txt2tabColStruct $tabPart]
    set colNum [llength $cols]
    set rowNum [llength [lindex $cols 0]]
    set result {}
    lappend result $types
    foreach i [range $rowNum] {
	set row {}
	foreach j [range $colNum] {
	    lappend row [llindex $cols $j $i]
	}
	lappend result $row
    }
    set result
}

proc tabRange2tex {tabPart} {
    set struct [txt2tabLineStruct $tabPart]
    set types [lindex $struct 0]
    set lines [lrange $struct 1 end]
    set patterns [map [lambda {type} {
	switch $type {
	    vorkomma {
		return " \\hfill \#"
	    }
	    nachkomma {
		return "\# \\hfill "
	    }
	    integer {
		return " \\hfill \# "
	    }
	    default {
		return " \# \\hfill "
	    }
	}
    }] $types]
    set texLines {}
    lappend texLines [join $patterns &]
    foreach line $lines {
	lappend texLines [join [map unicode2tex $line ] {&}]
    }
    set result \\halign
    append result \{ \n\
	[join $texLines \\cr\n]\
	\\cr \n \}
}

proc plaintext2tex {txt} {
    set sequence [getTextTabSequence $txt]
    set plaintext [lindex $sequence 0]
    set result [unicode2texWithItems [hyphenated $plaintext]]
    foreach {tabulatortext plaintext} [lrange $sequence 1 end] {
	append result\
	    \n\n\
	    [tabRange2tex $tabulatortext]\
	    \n\n\
	    [unicode2texWithItems [hyphenated [string trim $plaintext]]]
    }
    string trim $result
}