summaryrefslogtreecommitdiff
path: root/support/dinbrief-gui/dinbrief.vfs/adjustTabs.tcl
blob: c8ce23fcec817c6ba2c30d35a69dc0f7950549ac (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
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
namespace eval AdjustTabs {
    variable counter 0
}

proc ::AdjustTabs::checkTabEvent {win} {
    set index [$win index insert]
    let {line col} [split $index .]
    set tabTag [getTabTagAt $win insert]
    set tabOccurs [winHasTabsAtLine $win $line]
    if {!$tabOccurs && ($tabTag eq "")} {
	# no tabs, nothing to do
	return
    } elseif {$tabTag eq ""} {
	# new tab set
	set tabTags [setTabTagAt $win $index]
    } elseif {!$tabOccurs} {
	# existing tab deleted
	set tabTags [removeTabTagAt $win $index]
    } else {
	# existing tab area changed
	set tabTags $tabTag
    }
    foreach tag $tabTags {
	set code [namespace code "adjustWinTagTabs $win $tag"]
	after cancel $code
	after idle $code
    }
}

#
# ::AdjustTabs::removeTabTagAt
# remove tags tab and tab[0-9]+ at $index
# if inside, split area tabi to tabi + tabj
# return name(s) of affected tags
#
proc ::AdjustTabs::removeTabTagAt {win index} {
    set thisTabTag [getTabTagAt $win $index]
    if {$thisTabTag eq ""} {
	return
    }
    set fromIndex [$win index "$index linestart"]
    set toIndex [$win index $fromIndex+1lines]
    $win tag remove tab $fromIndex $toIndex
    if {[$win compare $fromIndex > 1.0]} {
	set aboveTabTag [getTabTagAt $win $fromIndex-1lines]
    } else {
	set aboveTabTag ""
    }
    set belowTabTag [getTabTagAt $win $toIndex]
    if {$aboveTabTag eq "" && $belowTabTag eq ""} {
	# no neighbour tab area
	$win tag remove $thisTabTag $fromIndex $toIndex
	return
    } elseif {$belowTabTag eq ""} {
	# reduce tag area above
	$win tag remove $aboveTabTag $fromIndex $toIndex
	return $aboveTabTag
    } elseif {$aboveTabTag eq ""} {
	# reduce tag area below
	$win tag remove $belowTabTag $fromIndex $toIndex
	return $belowTabTag
    } else {
	# split tag area
	let {fromAround toAround} [$win tag prevrange $aboveTabTag $index]
	$win tag remove $aboveTabTag $fromIndex $toAround
	set newTabTag [genTagName $win]
	lappend result $newTabTag
	$win tag add $newTabTag $toIndex $toAround
	# return this value
	list $aboveTabTag $newTabTag
    }
}

#
# ::AdjustTabs::setTabTagAt
# set tag tab[0-9]+ at $index
# return tag name
#
proc ::AdjustTabs::setTabTagAt {win index} {
    if {[getTabTagAt $win $index] ne ""} {
	return
    }
    set fromIndex [$win index "$index linestart"]
    set toIndex [$win index $fromIndex+1lines]
    $win tag add tab $fromIndex $toIndex
    if {[$win compare $fromIndex > 1.0]} {
	set aboveTabTag [getTabTagAt $win $fromIndex-1lines]
    } else {
	set aboveTabTag ""
    }
    set belowTabTag [getTabTagAt $win $toIndex]
    if {$aboveTabTag eq "" && $belowTabTag eq ""} {
	# no neighbour tab area
	set thisTabTag [genTagName $win]
	$win tag add $thisTabTag $fromIndex $toIndex
	return $thisTabTag
    } elseif {$belowTabTag eq ""} {
	# extend above tab area
	$win tag add $aboveTabTag $fromIndex $toIndex
	return $aboveTabTag
    } elseif {$aboveTabTag eq ""} {
	# extend below tab area
	$win tag add $belowTabTag $fromIndex $toIndex
	return $belowTabTag
    } else {
	# join tab area below and above
	let {belowFrom belowTo} [$win tag ranges $belowTabTag]
	$win tag remove $belowTabTag 1.0 end
	$win tag add $aboveTabTag $fromIndex $belowTo
	return $aboveTabTag
    }
}

#
# ::AdjustTabs::initTabTags
# remove all tags tab[0-9]+
# set tag tab on lines containing \t
# set new tags tab[0-9]+
# return list of set tags tab[0-9]+
#
proc ::AdjustTabs::initTabTags {win} {
    $win tag remove tab 1.0 end
    foreach tag [$win tag names] {
	if {[regexp {^tab[0-9]+$} $tag]} {
	    $win tag remove $tag 1.0 end
	}
    }
    set from 1.0
    set to 2.0
    while {[$win compare $from < end]} {
	if {[$win search \t $from $to] ne ""} {
	    $win tag add tab $from $to
	}
	set from [$win index $from+1lines]
	set to [$win index $to+1lines]
    }
    set result {}
    foreach {from to} [$win tag ranges tab] {
	set tabTag [genTagName $win]
	$win tag add $tabTag $from $to
	lappend result $tabTag
 	after idle\
 	    [namespace code\
 		 [list atjustWinTagTabsBackground $win $tabTag]]
    }
    raise [winfo toplevel .]
    set result
}

#
# ::AdjustTabs::genTagName
# return tag name tab[0-9]+ which is new to $win
#
proc ::AdjustTabs::genTagName {win} {
    variable counter
    while {[lsearch [$win tag names] tab$counter] >= 0} {
	incr counter
    }
    return tab$counter
}

#
# ::AdjustTabs::getTabTagAt
# return first tag tab[0-9]+ occuring at $index
#
proc ::AdjustTabs::getTabTagAt {win index} {
    foreach tag [$win tag names $index] {
	if {[regexp {^tab[0-9]+$} $tag]} {
	    return $tag
	}
    }
}

#
# ::AdjustTabs::winHasTabsAtLine
# return true if \t occurs in $line
#
proc ::AdjustTabs::winHasTabsAtLine {win line} {
    expr {[$win search \t $line.0 $line.end] ne ""}
}

#
# ::AdjustTabs::adjustWinTabAt
# adjust tab tag which occurs in $window at $index
#
proc ::AdjustTabs::adjustWinTabAt {window index} {
    set tabTag [getTabTagAt $window $index]
    adjustWinTagTabs $window $tabTag
}

#
# ::AdjustTabs::atjustWinTagTabsBackground
# 
#
proc ::AdjustTabs::atjustWinTagTabsBackground {win tag} {
    if {![winfo exists $win] || [$win tag ranges $tag] eq ""} {
	return
    }
    while {true} {
	let {from to} [$win tag ranges $tag]
	let {fromLine fromCol} [split $from .]
	let {toLine toCol} [split $to .]
	set someLinesVisible 0
	set allLinesVisible 1
	foreach line [range $fromLine $toLine] {
	    if {[$win dlineinfo $line.0] eq ""} {
		set allLinesVisible 0
	    } else {
		set someLinesVisible 1
	    }
	}
	if {$allLinesVisible} {
	    adjustWinTagTabs $win $tag
	    break
	} elseif {$someLinesVisible} {
	    adjustWinTagTabs $win $tag
	    sleep 200
	} else {
	    sleep 500
	}
    }
    list tabstops of $tag in $win are adjusted
}

#
# ::AdjustTabs::adjustWinTagTabs
# adjust tabs in range of tag $tabTab
# such that no cols overlap each other
#
proc ::AdjustTabs::adjustWinTagTabs {tabWindow tabTag {distance 12}} {
    set ranges [$tabWindow tag ranges $tabTag]
    if {$ranges eq {}} {
	return
    }
    set lineNrs {}
    foreach {from to} [$tabWindow tag ranges $tabTag] {
	set startIndex [$tabWindow index "$from linestart"]
	let {startLine startCol} [split $startIndex .]
	while {[$tabWindow compare $startLine.0 < $to]} {
	    lappend lineNrs $startLine
	    incr startLine
	}
    }
    if {[llength $lineNrs] <= 1} {
	$tabWindow tag configure $tabTag -tabs {}
	return
    }
    set cols ""
    foreach nr $lineNrs {
	set tabs [numOfTabsAtLine $tabWindow $nr]
	if {$cols eq ""} {
	    set cols $tabs
	} elseif {($tabs ne "" && $tabs > $cols)} {
	    set cols $tabs
	}
    }
    if {$cols eq ""} {
	return
    }
    set colWidths {}
    for {set i 0} {$i < $cols} {incr i} {
	set currentWidth [winTagColWidth $tabWindow $tabTag $i]
	if {$currentWidth eq ""} {
	    break
	}
	incr currentWidth $distance
	lappend colWidths $currentWidth
    }
    set tabstops {}
    set tabstop 0
    foreach colWidth $colWidths {
	lappend tabstops [incr tabstop $colWidth]
    }
    $tabWindow tag configure $tabTag -tabs $tabstops
}

#
# ::AdjustTabs::winTagColWidth
# return really needed width inside tag $tabTag on col $colNr
#
proc ::AdjustTabs::winTagColWidth {tabWindow tabTag colNr} {
    set result ""
    foreach {from to} [$tabWindow tag ranges $tabTag] {
	set startIndex [$tabWindow index "$from linestart"]
	let {startLine startCol} [split $startIndex .]
	while {[$tabWindow compare $startLine.0 < $to]} {
	    set colWidth [calcLineColWidth $tabWindow $startLine $colNr]
	    if {$colWidth ne ""} {
		if {$result eq "" || $colWidth > $result} {
		    set result $colWidth
		}
	    }
	    incr startLine
	}
    }
    set result
}

#
# ::AdjustTabs::calcLineColWidth
# return really needed width in line $line at tabstop $colNr
#
proc ::AdjustTabs::calcLineColWidth {window line colNr} {
    if {$colNr == 0} {
	let {x y w h} [$window bbox $line.0]
	if {![info exists x]} {
	    return
	}
	set leftEdge $x
    } else {
	set leftEdge [calcTabRightEdge $window $line [expr {$colNr-1}]]
    }
    if {$leftEdge eq ""} {
	return
    }
    set rightEdge [calcTabLeftEdge $window $line $colNr]
    if {$rightEdge ne ""} {
	expr {$rightEdge - $leftEdge}
    }
}

#
# ::AdjustTabs::calcTabLeftEdge
# return left edge of tab space in text window
#
proc ::AdjustTabs::calcTabLeftEdge {window line tabNr} {
    set index [calcTabIndex $window $line $tabNr]
    if {$index ne ""} {
	let {x y w h} [$window bbox $index]
	if {[info exists x]} {
	    set x
	}
    } elseif {[numOfTabsAtLine $window $line] == $tabNr} {
	let {x y w h} [$window bbox $line.end]
	if {[info exists x]} {
	    set x
	}
    }
}

#
# ::AdjustTabs::calcTabRightEdge
# return right edge of tab space in text window
#
proc ::AdjustTabs::calcTabRightEdge {window line tabNr} {
    set index [calcTabIndex $window $line $tabNr]
    if {$index ne ""} {
	let {x y w h} [$window bbox $index]
	if {[info exists x]} {
	    expr {$x + $w}
	}
    }
}

#
# ::AdjustTabs::calcTabIndex
# return widget index of tab $tabNr in line $line
#
proc ::AdjustTabs::calcTabIndex {window line tabNr {start 0}} {
    set result\
	[$window search \t "$line.0+$start chars" $line.0+1lines]
    if {$tabNr == 0 || $result eq ""} {
	set result
    } else {
	let {row col} [split $result .]
	calcTabIndex $window $line [expr {$tabNr-1}] [incr col]
    }
}

#
# ::AdjustTabs::numOfTabsAtLine
#  return number of tabs contained in line
#
proc ::AdjustTabs::numOfTabsAtLine {window line} {
    set str1 [$window get $line.0 $line.end]
    set str2 [string map [list \t {}] $str1]
    set l1 [string length $str1]
    set l2 [string length $str2]
    expr {$l1 - $l2}
}

namespace eval AdjustTabs {
    namespace export\
	checkTabEvent\
	initTabTags
}
namespace import -force ::AdjustTabs::*