OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [SWidget.tcl] - Blame information for rev 1771

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# SWidget.tcl --
2
#
3
#       tixScrolledWidget: virtual base class. Do not instantiate
4
#       This is the core class for all scrolled widgets.
5
#
6
# Copyright (c) 1996, Expert Interface Technologies
7
#
8
# See the file "license.terms" for information on usage and redistribution
9
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10
#
11
 
12
 
13
tixWidgetClass tixScrolledWidget {
14
    -virtual true
15
    -classname TixScrolledWidget
16
    -superclass tixPrimitive
17
    -method {
18
    }
19
    -flag {
20
        -scrollbar -scrollbarspace
21
    }
22
    -configspec {
23
        {-scrollbar scrollbar Scrollbar both}
24
        {-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
25
        {-sizebox sizeBox SizeBox 0}
26
    }
27
}
28
 
29
proc tixScrolledWidget:InitWidgetRec {w} {
30
    upvar #0 $w data
31
 
32
    tixChainMethod $w InitWidgetRec
33
 
34
    set data(x,first)   0
35
    set data(x,last)    0
36
 
37
    set data(y,first)   0
38
    set data(y,last)    0
39
 
40
    set data(lastSpec) ""
41
    set data(lastMW)   ""
42
    set data(lastMH)   ""
43
    set data(lastScbW) ""
44
    set data(lastScbH) ""
45
 
46
    set data(repack)    0
47
    set data(counter)   0
48
 
49
    set data(vsbPadY)   0
50
    set data(hsbPadX)   0
51
}
52
 
53
proc tixScrolledWidget:SetBindings {w} {
54
    upvar #0 $w data
55
 
56
    tixChainMethod $w SetBindings
57
 
58
    tixManageGeometry $data(pw:client) "tixScrolledWidget:ClientGeomProc $w"
59
    bind $data(pw:client) <Configure> \
60
        [list tixScrolledWidget:ClientGeomProc $w "" $data(pw:client)]
61
 
62
    tixManageGeometry $data(w:hsb) "tixScrolledWidget:ClientGeomProc $w"
63
    bind $data(w:hsb) <Configure> \
64
        [list tixScrolledWidget:ClientGeomProc $w "" $data(w:hsb)]
65
 
66
    tixManageGeometry $data(w:vsb) "tixScrolledWidget:ClientGeomProc $w"
67
    bind $data(w:vsb) <Configure> \
68
        [list tixScrolledWidget:ClientGeomProc $w "" $data(w:vsb)]
69
 
70
    bind $w <Configure> "tixScrolledWidget:MasterGeomProc $w"
71
 
72
    tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
73
    set data(repack) 1
74
}
75
 
76
proc tixScrolledWidget:config-scrollbar {w value} {
77
    upvar #0 $w data
78
    global tcl_platform
79
 
80
    if {[lindex $value 0] == "auto"} {
81
        foreach xspec [lrange $value 1 end] {
82
            case $xspec {
83
                {+x -x +y -y} {}
84
                default {
85
                    error "bad -scrollbar value \"$value\""
86
                }
87
            }
88
        }
89
    } else {
90
        case $value in {
91
            {none x y both} {}
92
            default {
93
                error "bad -scrollbar value \"$value\""
94
            }
95
        }
96
    }
97
 
98
    if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
99
        set data(-scrollbar) both
100
    }
101
 
102
    if {$data(repack) == 0} {
103
        set data(repack) 1
104
        tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
105
    }
106
}
107
 
108
proc tixScrolledWidget:config-scrollbarspace {w value} {
109
    upvar #0 $w data
110
 
111
    if {$data(repack) == 0} {
112
        set data(repack) 1
113
        tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
114
    }
115
}
116
 
117
proc tixScrolledWidget:config-sizebox {w value} {
118
  error "unimplemented"
119
}
120
 
121
 
122
#----------------------------------------------------------------------
123
#
124
#                Scrollbar calculations
125
#
126
#----------------------------------------------------------------------
127
proc tixScrolledWidget:ClientGeomProc {w type client} {
128
    upvar #0 $w data
129
 
130
    if {$data(repack) == 0} {
131
        set data(repack) 1
132
        tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
133
    }
134
}
135
 
136
proc tixScrolledWidget:MasterGeomProc {w} {
137
    upvar #0 $w data
138
 
139
    if {$data(repack) == 0} {
140
        set data(repack) 1
141
        tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
142
    }
143
}
144
 
145
proc tixScrolledWidget:Configure {w} {
146
    if {![winfo exists $w]} {
147
        return
148
    }
149
 
150
    upvar #0 $w data
151
 
152
    if {$data(repack) == 0} {
153
        set data(repack) 1
154
        tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
155
    }
156
}
157
 
158
proc tixScrolledWidget:ScrollCmd {w scrollbar axis first last} {
159
    upvar #0 $w data
160
 
161
    $scrollbar set $first $last
162
}
163
 
164
# Show or hide the scrollbars as required.
165
#
166
# spec: 00 = need none
167
# spec: 01 = need y
168
# spec: 10 = need x
169
# spec: 11 = need xy
170
#
171
proc tixScrolledWidget:Repack {w} {
172
    tixCallMethod $w RepackHook
173
}
174
 
175
proc tixScrolledWidget:RepackHook {w} {
176
    upvar #0 $w data
177
    global tcl_platform
178
 
179
    if {![winfo exists $w]} {
180
        # This was generated by the <Destroy> event
181
        #
182
        return
183
    }
184
 
185
    set client $data(pw:client)
186
 
187
    # Calculate the size of the master
188
    #
189
    set mreqw [winfo reqwidth  $w]
190
    set mreqh [winfo reqheight $w]
191
    set creqw [winfo reqwidth  $client]
192
    set creqh [winfo reqheight $client]
193
 
194
    set scbW [winfo reqwidth  $w.vsb]
195
    set scbH [winfo reqheight $w.hsb]
196
 
197
    case $data(-scrollbarspace) {
198
        "x" {
199
            incr creqh $scbH
200
        }
201
        "y" {
202
            incr creqw $scbW
203
        }
204
        "both" {
205
            incr creqw $scbW
206
            incr creqh $scbH
207
        }
208
    }
209
 
210
    if {$data(-width) != 0} {
211
        set creqw $data(-width)
212
    }
213
    if {$data(-height) != 0} {
214
        set creqh $data(-height)
215
    }
216
 
217
    if {$mreqw != $creqw || $mreqh != $creqh } {
218
        if {![info exists data(counter)]} {
219
            set data(counter) 0
220
        }
221
        if {$data(counter) < 50} {
222
            incr data(counter)
223
            tixGeometryRequest $w $creqw $creqh
224
            tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
225
            set data(repack) 1
226
            return
227
        }
228
    }
229
 
230
    set data(counter) 0
231
    set mw [winfo width  $w]
232
    set mh [winfo height $w]
233
 
234
    set cw [expr $mw - $scbW]
235
    set ch [expr $mh - $scbH]
236
 
237
    set scbx [expr $mw - $scbW]
238
    set scby [expr $mh - $scbH]
239
 
240
    # Check the validity of the sizes: if window was not mapped then
241
    # sizes will be below 1x1
242
    if {$cw < 1} {
243
        set cw 1
244
    }
245
    if {$ch < 1} {
246
        set ch 1
247
    }
248
    if {$scbx < 1} {
249
        set scbx 1
250
    }
251
    if {$scby < 1} {
252
        set scby 1
253
    }
254
 
255
    if {[lindex $data(-scrollbar) 0] == "auto"} {
256
        # Find out how we are going to pack the scrollbars
257
        #
258
        set spec [tixScrolledWidget:CheckScrollbars $w $scbW $scbH]
259
 
260
        foreach xspec [lrange $data(-scrollbar) 1 end] {
261
            case $xspec {
262
                +x {
263
                    set spec [expr $spec | 10]
264
                }
265
                -x {
266
                    set spec [expr $spec & 01]
267
                }
268
                +y {
269
                    set spec [expr $spec | 01]
270
                }
271
                -y {
272
                    set spec [expr $spec & 10]
273
                }
274
            }
275
        }
276
        if {$spec == 0} {
277
            set spec 00
278
        }
279
        if {$spec == 1} {
280
            set spec 01
281
        }
282
    } else {
283
        case $data(-scrollbar) in {
284
            none {
285
                set spec 00
286
            }
287
            x {
288
                set spec 10
289
            }
290
            y {
291
                set spec 01
292
            }
293
            both {
294
                set spec 11
295
            }
296
        }
297
    }
298
 
299
 
300
    if {$data(lastSpec)==$spec && $data(lastMW)==$mw && $data(lastMH)==$mh} {
301
        if {$data(lastScbW) == $scbW && $data(lastScbH) == $scbH} {
302
            tixCallMethod $w PlaceWindow
303
            set data(repack) 0
304
            return
305
        }
306
    }
307
 
308
    set vsbH [expr $mh - $data(vsbPadY)]
309
    set hsbW [expr $mw - $data(hsbPadX)]
310
 
311
    if {$vsbH < 1} {
312
        set vsbH 1
313
    }
314
    if {$hsbW < 1} {
315
        set hsbW 1
316
    }
317
 
318
    case $spec in {
319
        "00" {
320
            tixMoveResizeWindow $client 0 0 $mw $mh
321
 
322
            tixMapWindow $client
323
            tixUnmapWindow $data(w:hsb)
324
            tixUnmapWindow $data(w:vsb)
325
        }
326
        "01" {
327
            tixMoveResizeWindow $client 0 0 $cw $mh
328
            tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
329
 
330
            tixMapWindow $client
331
            tixUnmapWindow $data(w:hsb)
332
            tixMapWindow $data(w:vsb)
333
        }
334
        "10" {
335
            tixMoveResizeWindow $client 0 0 $mw $ch
336
            tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH
337
 
338
            tixMapWindow $client
339
            tixMapWindow $data(w:hsb)
340
            tixUnmapWindow $data(w:vsb)
341
        }
342
        "11" {
343
            set vsbH [expr $ch - $data(vsbPadY)]
344
            set hsbW [expr $cw - $data(hsbPadX)]
345
            if {$vsbH < 1} {
346
                set vsbH 1
347
            }
348
            if {$hsbW < 1} {
349
                set hsbW 1
350
            }
351
 
352
            tixMoveResizeWindow $client 0 0 $cw $ch
353
            tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
354
            tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH
355
            if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
356
                tixMoveResizeWindow $data(w:sizebox) $scbx $scby $scbW $scbH
357
            }
358
 
359
            tixMapWindow $client
360
            tixMapWindow $data(w:hsb)
361
            tixMapWindow $data(w:vsb)
362
            if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
363
                tixMapWindow $data(w:sizebox)
364
            }
365
        }
366
    }
367
 
368
    set data(lastSpec) $spec
369
    set data(lastMW)   $mw
370
    set data(lastMH)   $mh
371
    set data(lastScbW) $scbW
372
    set data(lastScbH) $scbH
373
 
374
    tixCallMethod $w PlaceWindow
375
    set data(repack) 0
376
}
377
 
378
proc tixScrolledWidget:PlaceWindow {w} {
379
    # virtual base function
380
}
381
 
382
#
383
# Helper function
384
#
385
proc tixScrolledWidget:NeedScrollbar {w axis} {
386
    upvar #0 $w data
387
 
388
    if {$data($axis,first) > 0.0} {
389
        return 1
390
    }
391
 
392
    if {$data($axis,last) < 1.0} {
393
        return 1
394
    }
395
 
396
    return 0
397
}
398
 
399
# Return whether H and V needs scrollbars in a list of two booleans
400
#
401
#
402
proc tixScrolledWidget:CheckScrollbars {w scbW scbH} {
403
    upvar #0 $w data
404
 
405
    set mW [winfo width  $w]
406
    set mH [winfo height $w]
407
 
408
    set info [tixCallMethod $w GeometryInfo $mW $mH]
409
 
410
    if {$info != ""} {
411
        set xSpec [lindex $info 0]
412
        set ySpec [lindex $info 1]
413
 
414
        set data(x,first)   [lindex $xSpec 0]
415
        set data(x,last)    [lindex $xSpec 1]
416
 
417
        set data(y,first)   [lindex $ySpec 0]
418
        set data(y,last)    [lindex $ySpec 1]
419
    }
420
 
421
    set needX [tixScrolledWidget:NeedScrollbar $w x]
422
    set needY [tixScrolledWidget:NeedScrollbar $w y]
423
 
424
    if {[winfo ismapped $w]==0} {
425
        return "$needX$needY"
426
    }
427
 
428
    if {$needX && $needY} {
429
        return 11
430
    }
431
 
432
    if {$needX == 0 && $needY == 0} {
433
        return 00
434
    }
435
 
436
    if {$needX} {
437
        set mH [expr $mH - $scbH]
438
    }
439
    if {$needY} {
440
        set mW [expr $mW - $scbW]
441
    }
442
 
443
    set info [tixCallMethod $w GeometryInfo $mW $mH]
444
    if {$info != ""} {
445
        set xSpec [lindex $info 0]
446
        set ySpec [lindex $info 1]
447
 
448
        set data(x,first)   [lindex $xSpec 0]
449
        set data(x,last)    [lindex $xSpec 1]
450
 
451
        set data(y,first)   [lindex $ySpec 0]
452
        set data(y,last)    [lindex $ySpec 1]
453
    }
454
 
455
    set needX [tixScrolledWidget:NeedScrollbar $w x]
456
    set needY [tixScrolledWidget:NeedScrollbar $w y]
457
 
458
    return "$needX$needY"
459
}
460
 
461
#----------------------------------------------------------------------
462
# Following is a bunch of crap. Not needed in TK 4.0.
463
#----------------------------------------------------------------------
464
 
465
#----------------------------------------------------------------------
466
# Keyboard events -
467
#
468
#       Raw event handlers: redirect binding events to class methods
469
#
470
proc tixScrolledWidget:RawUpKey {w} {
471
    tixCallMethod $w HandleLineUp
472
}
473
 
474
proc tixScrolledWidget:RawDownKey {w} {
475
    tixCallMethod $w HandleLineDown
476
}
477
 
478
proc tixScrolledWidget:RawLeftKey {w} {
479
    tixCallMethod $w HandleLeftKey
480
}
481
 
482
proc tixScrolledWidget:RawRightKey {w} {
483
    tixCallMethod $w HandleRightKey
484
}
485
 
486
proc tixScrolledWidget:RawPriorKey {w} {
487
    tixCallMethod $w HandlePageUp
488
}
489
 
490
proc tixScrolledWidget:RawNextKey {w} {
491
    tixCallMethod $w HandlePageDown
492
}
493
 
494
# Virtual event handlers: subclasses can derive from these functions
495
#
496
 
497
proc tixScrolledWidget:HandleLineUp {w} {}
498
 
499
proc tixScrolledWidget:HandleLineDown {w} {}
500
 
501
proc tixScrolledWidget:HandlePageUp {w} {}
502
 
503
proc tixScrolledWidget:HandlePageDown {w} {}
504
 
505
proc tixScrolledWidget:HandleLeftKey {w} {}
506
 
507
proc tixScrolledWidget:HandleRightKey {w} {}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.