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

Subversion Repositories or1k_old

[/] [or1k_old/] [tags/] [start/] [insight/] [itcl/] [iwidgets3.0.0/] [generic/] [toolbar.itk] - Blame information for rev 1782

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
#
2
# Toolbar
3
# ----------------------------------------------------------------------
4
#
5
# The Toolbar command creates a new window (given by the pathName
6
# argument) and makes it into a Tool Bar widget. Additional options,
7
# described above may be specified on the command line or in the
8
# option database to configure aspects of the Toolbar such as its
9
# colors, font, and orientation. The Toolbar command returns its
10
# pathName argument. At the time this command is invoked, there
11
# must not exist a window named pathName, but pathName's parent
12
# must exist.
13
#
14
# A Toolbar is a widget that displays a collection of widgets arranged
15
# either in a row or a column (depending on the value of the -orient
16
# option). This collection of widgets is usually for user convenience
17
# to give access to a set of commands or settings. Any widget may be
18
# placed on a Toolbar. However, command or value-oriented widgets (such
19
# as button, radiobutton, etc.) are usually the most useful kind of
20
# widgets to appear on a Toolbar.
21
#
22
# WISH LIST:
23
#   This section lists possible future enhancements.
24
#
25
#       Toggle between text and image/bitmap so that the toolbar could
26
#     display either all text or all image/bitmaps.
27
#   Implementation of the -toolbarfile option that allows toolbar
28
#     add commands to be read in from a file.
29
# ----------------------------------------------------------------------
30
#  AUTHOR: Bill W. Scott                 EMAIL: bscott@spd.dsccc.com
31
#
32
#  @(#) $Id: toolbar.itk,v 1.1.1.1 2002-01-16 10:24:51 markom Exp $
33
# ----------------------------------------------------------------------
34
#            Copyright (c) 1995 DSC Technologies Corporation
35
# ======================================================================
36
# Permission to use, copy, modify, distribute and license this software
37
# and its documentation for any purpose, and without fee or written
38
# agreement with DSC, is hereby granted, provided that the above copyright
39
# notice appears in all copies and that both the copyright notice and
40
# warranty disclaimer below appear in supporting documentation, and that
41
# the names of DSC Technologies Corporation or DSC Communications
42
# Corporation not be used in advertising or publicity pertaining to the
43
# software without specific, written prior permission.
44
#
45
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
46
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
47
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
48
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
49
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
50
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
51
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
52
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
53
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
54
# SOFTWARE.
55
# ======================================================================
56
 
57
#
58
# Default resources.
59
#
60
option add *Toolbar*padX 5 widgetDefault
61
option add *Toolbar*padY 5 widgetDefault
62
option add *Toolbar*orient horizontal widgetDefault
63
option add *Toolbar*highlightThickness 0 widgetDefault
64
option add *Toolbar*indicatorOn false widgetDefault
65
option add *Toolbar*selectColor [. cget -bg] widgetDefault
66
 
67
#
68
# Usual options.
69
#
70
itk::usual Toolbar {
71
    keep -activebackground -activeforeground -background -balloonbackground \
72
         -balloondelay1 -balloondelay2 -balloonfont -balloonforeground \
73
         -borderwidth -cursor -disabledforeground -font -foreground \
74
         -highlightbackground -highlightcolor -highlightthickness \
75
         -insertbackground -insertforeground -selectbackground \
76
         -selectborderwidth -selectcolor -selectforeground -troughcolor
77
}
78
 
79
# ------------------------------------------------------------------
80
#                            TOOLBAR
81
# ------------------------------------------------------------------
82
class iwidgets::Toolbar {
83
    inherit itk::Widget
84
 
85
    constructor {args} {}
86
    destructor {}
87
 
88
    itk_option define -balloonbackground \
89
            balloonBackground BalloonBackground yellow
90
    itk_option define -balloonforeground \
91
            balloonForeground BalloonForeground black
92
    itk_option define -balloonfont balloonFont BalloonFont 6x10
93
    itk_option define -balloondelay1 \
94
            balloonDelay1 BalloonDelay1 1000
95
    itk_option define -balloondelay2 \
96
            balloonDelay2 BalloonDelay2 200
97
    itk_option define -helpvariable helpVariable HelpVariable {}
98
    itk_option define -orient orient Orient "horizontal"
99
 
100
    #
101
    # The following options implement propogated configurations to
102
    # any widget that might be added to us. The problem is this is
103
    # not deterministic as someone might add a new kind of widget with
104
    # and option like -armbackground, so we would not be aware of
105
    # this kind of option. Anyway we support as many of the obvious
106
    # ones that we can. They can always configure them with itemconfigures.
107
    #
108
    itk_option define -activebackground activeBackground Foreground #c3c3c3
109
    itk_option define -activeforeground activeForeground Background Black
110
    itk_option define -background background Background #d9d9d9
111
    itk_option define -borderwidth borderWidth BorderWidth 2
112
    itk_option define -cursor cursor Cursor {}
113
    itk_option define -disabledforeground \
114
            disabledForeground DisabledForeground #a3a3a3
115
    itk_option define -font \
116
            font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"
117
    itk_option define -foreground foreground Foreground #000000000000
118
    itk_option define -highlightbackground \
119
            highlightBackground HighlightBackground #d9d9d9
120
    itk_option define -highlightcolor highlightColor HighlightColor Black
121
    itk_option define -highlightthickness \
122
            highlightThickness HighlightThickness 0
123
    itk_option define -insertforeground insertForeground Background #c3c3c3
124
    itk_option define -insertbackground insertBackground Foreground Black
125
    itk_option define -selectbackground selectBackground Foreground #c3c3c3
126
    itk_option define -selectborderwidth selectBorderWidth BorderWidth {}
127
    itk_option define -selectcolor selectColor Background #b03060
128
    itk_option define -selectforeground selectForeground Background Black
129
    itk_option define -state state State normal
130
    itk_option define -troughcolor troughColor Background #c3c3c3
131
 
132
    public method add {widgetCommand name args}
133
    public method delete {args}
134
    public method index {index}
135
    public method insert {beforeIndex widgetCommand name args}
136
    public method itemcget {index args}
137
    public method itemconfigure {index args}
138
 
139
    public method _resetBalloonTimer {}
140
    public method _startBalloonDelay {window}
141
    public method _stopBalloonDelay {window balloonClick}
142
 
143
    private method _deleteWidgets {index1 index2}
144
    private method _addWidget {widgetCommand name args}
145
    private method _index {toolList index}
146
    private method _getAttachedOption {optionListName widget args retValue}
147
    private method _setAttachedOption {optionListName widget option args}
148
    private method _packToolbar {}
149
 
150
    public method hideHelp {}
151
    public method showHelp {window}
152
    public method showBalloon {window}
153
    public method hideBalloon {}
154
 
155
    private variable _balloonTimer 0
156
    private variable _balloonAfterID 0
157
    private variable _balloonClick false
158
 
159
    private variable _interior {}
160
    private variable _initialMapping 1   ;# Is this the first mapping?
161
    private variable _toolList {}        ;# List of all widgets on toolbar
162
    private variable _opts               ;# New options for child widgets
163
    private variable _currHelpWidget {}  ;# Widget currently displaying help for
164
    private variable _hintWindow {}      ;# Balloon help bubble.
165
 
166
    # list of options we want to propogate to widgets added to toolbar.
167
    private common _optionList {
168
        -activebackground \
169
                -activeforeground \
170
                -background \
171
                -borderwidth \
172
                -cursor \
173
                -disabledforeground \
174
                -font \
175
                -foreground \
176
                -highlightbackground \
177
                -highlightcolor \
178
                -highlightthickness \
179
                -insertbackground \
180
                -insertforeground \
181
                -selectbackground \
182
                -selectborderwidth \
183
                -selectcolor \
184
                -selectforeground \
185
                -state \
186
                -troughcolor \
187
            }
188
}
189
 
190
# ------------------------------------------------------------------
191
#                            CONSTRUCTOR
192
# ------------------------------------------------------------------
193
body iwidgets::Toolbar::constructor {args} {
194
    component hull configure -borderwidth 0
195
    set _interior $itk_interior
196
 
197
    #
198
    # Handle configs
199
    #
200
    eval itk_initialize $args
201
 
202
    # build balloon help window
203
    set _hintWindow [toplevel $itk_component(hull).balloonHintWindow]
204
    wm withdraw $_hintWindow
205
    label $_hintWindow.label \
206
        -foreground $itk_option(-balloonforeground) \
207
        -background $itk_option(-balloonbackground) \
208
        -font $itk_option(-balloonfont) \
209
        -relief raised \
210
        -borderwidth 1
211
    pack $_hintWindow.label
212
 
213
    # ... Attach help handler to this widget
214
    bind toolbar-help-$itk_component(hull) \
215
             "+[code $this showHelp %W]"
216
    bind toolbar-help-$itk_component(hull) \
217
             "+[code $this hideHelp]"
218
 
219
    # ... Set up Microsoft style balloon help display.
220
    set _balloonTimer $itk_option(-balloondelay1)
221
    bind $_interior \
222
             "+[code $this _resetBalloonTimer]"
223
    bind toolbar-balloon-$itk_component(hull) \
224
             "+[code $this _startBalloonDelay %W]"
225
    bind toolbar-balloon-$itk_component(hull) \
226
             "+[code $this _stopBalloonDelay %W false]"
227
    bind toolbar-balloon-$itk_component(hull) \
228
             "+[code $this _stopBalloonDelay %W true]"
229
}
230
 
231
#
232
# Provide a lowercase access method for the Toolbar class
233
#
234
proc ::iwidgets::toolbar {pathName args} {
235
    uplevel ::iwidgets::Toolbar $pathName $args
236
}
237
 
238
# ------------------------------------------------------------------
239
#                           DESTURCTOR
240
# ------------------------------------------------------------------
241
body iwidgets::Toolbar::destructor {} {
242
    if {$_balloonAfterID != 0} {after cancel $_balloonAfterID}
243
}
244
 
245
# ------------------------------------------------------------------
246
#                            OPTIONS
247
# ------------------------------------------------------------------
248
 
249
# ------------------------------------------------------------------
250
# OPTION -balloonbackground
251
# ------------------------------------------------------------------
252
configbody iwidgets::Toolbar::balloonbackground {
253
    if { $_hintWindow != {} } {
254
        if { $itk_option(-balloonbackground) != {} } {
255
            $_hintWindow.label configure \
256
                -background $itk_option(-balloonbackground)
257
        }
258
    }
259
}
260
 
261
# ------------------------------------------------------------------
262
# OPTION -balloonforeground
263
# ------------------------------------------------------------------
264
configbody iwidgets::Toolbar::balloonforeground {
265
    if { $_hintWindow != {} } {
266
        if { $itk_option(-balloonforeground) != {} } {
267
            $_hintWindow.label configure \
268
                -foreground $itk_option(-balloonforeground)
269
        }
270
    }
271
}
272
 
273
# ------------------------------------------------------------------
274
# OPTION -balloonfont
275
# ------------------------------------------------------------------
276
configbody iwidgets::Toolbar::balloonfont {
277
    if { $_hintWindow != {} } {
278
        if { $itk_option(-balloonfont) != {} } {
279
            $_hintWindow.label configure \
280
                -font $itk_option(-balloonfont)
281
        }
282
    }
283
}
284
 
285
# ------------------------------------------------------------------
286
# OPTION: -orient
287
#
288
# Position buttons either horizontally or vertically.
289
# ------------------------------------------------------------------
290
configbody iwidgets::Toolbar::orient {
291
    switch $itk_option(-orient) {
292
        "horizontal" - "vertical" {
293
            _packToolbar
294
        }
295
        default {error "Invalid orientation. Must be either \
296
                horizontal or vertical"
297
        }
298
    }
299
}
300
 
301
# ------------------------------------------------------------------
302
#                            METHODS
303
# ------------------------------------------------------------------
304
 
305
# -------------------------------------------------------------
306
# METHOD: add widgetCommand name ?option value?
307
#
308
# Adds a widget with the command widgetCommand whose name is
309
# name to the Toolbar.   If widgetCommand is radiobutton
310
# or checkbutton, its packing is slightly padded to match the
311
# geometry of button widgets.
312
# -------------------------------------------------------------
313
body iwidgets::Toolbar::add { widgetCommand name args } {
314
 
315
    eval "_addWidget $widgetCommand $name $args"
316
 
317
    lappend _toolList $itk_component($name)
318
 
319
    if { $widgetCommand == "radiobutton" || \
320
            $widgetCommand == "checkbutton" } {
321
        set iPad 1
322
    } else {
323
        set iPad 0
324
    }
325
 
326
    # repack the tool bar
327
    _packToolbar
328
 
329
    return $itk_component($name)
330
 
331
}
332
 
333
# -------------------------------------------------------------
334
#
335
# METHOD: delete index ?index2?
336
#
337
# This command deletes all components between index and
338
# index2 inclusive. If index2 is omitted then it defaults
339
# to index. Returns an empty string
340
#
341
# -------------------------------------------------------------
342
body iwidgets::Toolbar::delete { args } {
343
    # empty toolbar
344
    if { $_toolList == {} } {
345
        error "can't delete widget, no widgets in the Toolbar \
346
                \"$itk_component(hull)\""
347
    }
348
 
349
    set len [llength $args]
350
    switch -- $len {
351
        1 {
352
            set fromWidget [_index $_toolList [lindex $args 0]]
353
 
354
            if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } {
355
                error "bad Toolbar widget index in delete method: \
356
                        should be between 0 and [expr [llength $_toolList] - 1]"
357
            }
358
 
359
            set toWidget $fromWidget
360
            _deleteWidgets $fromWidget $toWidget
361
        }
362
 
363
        2 {
364
            set fromWidget [_index $_toolList [lindex $args 0]]
365
 
366
            if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } {
367
                error "bad Toolbar widget index1 in delete method: \
368
                        should be between 0 and [expr [llength $_toolList] - 1]"
369
            }
370
 
371
            set toWidget [_index $_toolList [lindex $args 1]]
372
 
373
            if { $toWidget < 0 || $toWidget >= [llength $_toolList] } {
374
                error "bad Toolbar widget index2 in delete method: \
375
                        should be between 0 and [expr [llength $_toolList] - 1]"
376
            }
377
 
378
            if { $fromWidget > $toWidget } {
379
                error "bad Toolbar widget index1 in delete method: \
380
                        index1 is greater than index2"
381
            }
382
 
383
            _deleteWidgets $fromWidget $toWidget
384
        }
385
 
386
        default {
387
            # ... too few/many parameters passed
388
            error "wrong # args: should be \
389
                    \"$itk_component(hull) delete index1 ?index2?\""
390
        }
391
    }
392
 
393
    return {}
394
}
395
 
396
 
397
# -------------------------------------------------------------
398
#
399
# METHOD: index index
400
#
401
# Returns the widget's numerical index for the entry corresponding
402
# to index. If index is not found, -1 is returned
403
#
404
# -------------------------------------------------------------
405
body iwidgets::Toolbar::index { index } {
406
 
407
    return [_index $_toolList $index]
408
 
409
}
410
 
411
# -------------------------------------------------------------
412
#
413
# METHOD: insert beforeIndex widgetCommand name ?option value?
414
#
415
# Insert a new component named name with the command
416
# widgetCommand before the com ponent specified by beforeIndex.
417
# If widgetCommand is radiobutton or checkbutton, its packing
418
# is slightly padded to match the geometry of button widgets.
419
#
420
# -------------------------------------------------------------
421
body iwidgets::Toolbar::insert {  beforeIndex widgetCommand name args } {
422
 
423
    set beforeIndex [_index $_toolList $beforeIndex]
424
 
425
    if {$beforeIndex < 0 || $beforeIndex > [llength $_toolList] } {
426
        error "bad toolbar entry index $beforeIndex"
427
    }
428
 
429
    eval "_addWidget $widgetCommand $name $args"
430
 
431
    # linsert into list
432
    set _toolList [linsert $_toolList $beforeIndex $itk_component($name)]
433
 
434
    # repack the tool bar
435
    _packToolbar
436
 
437
    return $itk_component($name)
438
 
439
}
440
 
441
# ----------------------------------------------------------------------
442
# METHOD: itemcget index ?option?
443
#
444
# Returns the value for the option setting of the widget at index $index.
445
# index can be numeric or widget name
446
#
447
# ----------------------------------------------------------------------
448
body iwidgets::Toolbar::itemcget { index args} {
449
 
450
    return [lindex [eval itemconfigure $index $args] 4]
451
}
452
 
453
# -------------------------------------------------------------
454
#
455
# METHOD: itemconfigure index ?option? ?value? ?option value...?
456
#
457
# Query or modify the configuration options of the widget of
458
# the Toolbar specified by index. If no option is specified,
459
# returns a list describing all of the available options for
460
# index (see Tk_ConfigureInfo for information on the format
461
# of this list). If option is specified with no value, then
462
# the command returns a list describing the one named option
463
# (this list will be identical to the corresponding sublist
464
# of the value returned if no option is specified). If one
465
# or more option-value pairs are specified, then the command
466
# modifies the given widget option(s) to have the given
467
# value(s); in this case the command returns an empty string.
468
# The component type of index determines the valid available options.
469
#
470
# -------------------------------------------------------------
471
body iwidgets::Toolbar::itemconfigure { index args } {
472
 
473
    # Get a numeric index.
474
    set index [_index $_toolList $index]
475
 
476
    # Get the tool path
477
    set toolPath [lindex $_toolList $index]
478
 
479
    set len [llength $args]
480
 
481
    switch $len {
482
 
483
            # show all options
484
            # ''''''''''''''''
485
 
486
            # support display of -helpstr and -balloonstr configs
487
            set optList [$toolPath configure]
488
 
489
            ## @@@ might want to use _getAttachedOption instead...
490
            if { [info exists _opts($toolPath,-helpstr)] } {
491
                set value $_opts($toolPath,-helpstr)
492
            } else {
493
                set value {}
494
            }
495
            lappend optList [list -helpstr helpStr HelpStr {} $value]
496
            if { [info exists _opts($toolPath,-balloonstr)] } {
497
                set value $_opts($toolPath,-balloonstr)
498
            } else {
499
                set value {}
500
            }
501
            lappend optList [list -balloonstr balloonStr BalloonStr {} $value]
502
            return $optList
503
        }
504
        1 {
505
            # show only option specified
506
            # ''''''''''''''''''''''''''
507
            # did we satisfy the option get request?
508
 
509
            if { [regexp -- {-helpstr} $args] } {
510
                if { [info exists _opts($toolPath,-helpstr)] } {
511
                    set value $_opts($toolPath,-helpstr)
512
                } else {
513
                    set value {}
514
                }
515
                return [list -helpstr helpStr HelpStr {} $value]
516
            } elseif { [regexp -- {-balloonstr} $args] } {
517
                if { [info exists _opts($toolPath,-balloonstr)] } {
518
                    set value $_opts($toolPath,-balloonstr)
519
                } else {
520
                    set value {}
521
                }
522
                return [list -balloonstr balloonStr BalloonStr {} $value]
523
            } else {
524
                return [eval $toolPath configure $args]
525
            }
526
 
527
        }
528
        default {
529
            # ... do a normal configure
530
 
531
            # first screen for all our child options we are adding
532
            _setAttachedOption \
533
                    _opts \
534
                    $toolPath \
535
                    "-helpstr" \
536
                    $args
537
 
538
            _setAttachedOption \
539
                    _opts \
540
                    $toolPath \
541
                    "-balloonstr" \
542
                    $args
543
 
544
            # with a clean args list do a configure
545
 
546
            # if the stripping process brought us down to no options
547
            # to set, then forget the configure of widget.
548
            if { [llength $args] != 0 } {
549
                return [eval $toolPath configure $args]
550
            } else {
551
                return ""
552
            }
553
        }
554
    }
555
 
556
}
557
 
558
# -------------------------------------------------------------
559
#
560
# METHOD: _resetBalloonDelay1
561
#
562
# Sets the delay that will occur before a balloon could be popped
563
# up to balloonDelay1
564
#
565
# -------------------------------------------------------------
566
body iwidgets::Toolbar::_resetBalloonTimer {} {
567
    set _balloonTimer $itk_option(-balloondelay1)
568
 
569
    # reset the <1> longer delay
570
    set _balloonClick false
571
}
572
 
573
# -------------------------------------------------------------
574
#
575
# METHOD: _startBalloonDelay
576
#
577
# Starts waiting to pop up a balloon id
578
#
579
# -------------------------------------------------------------
580
body iwidgets::Toolbar::_startBalloonDelay {window} {
581
    set _balloonAfterID [after $_balloonTimer [code $this showBalloon $window]]
582
}
583
 
584
# -------------------------------------------------------------
585
#
586
# METHOD: _stopBalloonDelay
587
#
588
# This method will stop the timer for a balloon popup if one is
589
# in progress. If however there is already a balloon window up
590
# it will hide the balloon window and set timing to delay 2 stage.
591
#
592
# -------------------------------------------------------------
593
body iwidgets::Toolbar::_stopBalloonDelay { window balloonClick } {
594
 
595
    # If <1> then got a click cancel
596
    if { $balloonClick } {
597
        set _balloonClick true
598
    }
599
    if { $_balloonAfterID != 0 } {
600
        after cancel $_balloonAfterID
601
        set _balloonAfterID 0
602
    } else {
603
        hideBalloon
604
 
605
        # If this was cancelled with a <1> use longer delay.
606
        if { $_balloonClick } {
607
            set _balloonTimer $itk_option(-balloondelay1)
608
        } else {
609
            set _balloonTimer $itk_option(-balloondelay2)
610
        }
611
    }
612
}
613
 
614
# -------------------------------------------------------------
615
# PRIVATE METHOD: _addWidget
616
#
617
# widgetCommand : command to invoke to create the added widget
618
# name          : name of the new widget to add
619
# args          : options for the widget create command
620
#
621
# Looks for -helpstr, -balloonstr and grabs them, strips from
622
# args list. Then tries to add a component and keeps based
623
# on known type. If it fails, it tries to clean up. Then it
624
# binds handlers for helpstatus and balloon help.
625
#
626
# Returns the path of the widget added.
627
#
628
# -------------------------------------------------------------
629
body iwidgets::Toolbar::_addWidget { widgetCommand name args } {
630
 
631
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
632
    # Add the widget to the tool bar
633
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
634
 
635
    # ... Strip out and save the -helpstr, -balloonstr options from args
636
    #     and save it in _opts
637
    _setAttachedOption \
638
            _opts \
639
            $_interior.$name \
640
            -helpstr \
641
            $args
642
 
643
    _setAttachedOption \
644
            _opts \
645
            $_interior.$name \
646
            -balloonstr \
647
            $args
648
 
649
 
650
    # ... Add the new widget as a component (catch an error if occurs)
651
    set createFailed [catch {
652
        itk_component add $name {
653
            eval $widgetCommand $_interior.$name $args
654
        } {
655
        }
656
    } errMsg]
657
 
658
    # ... Clean up if the create failed, and exit.
659
    #     The _opts list if it has -helpstr, -balloonstr just entered for
660
    #     this, it must be cleaned up.
661
    if { $createFailed } {
662
        # clean up
663
        if {![catch {set _opts($_interior.$name,-helpstr)}]} {
664
            set lastIndex [\
665
                    expr [llength \
666
                    $_opts($_interior.$name,-helpstr) ]-1]
667
            lreplace $_opts($_interior.$name,-helpstr) \
668
                    $lastIndex $lastIndex ""
669
        }
670
        if {![catch {set _opts($_interior.$name,-balloonstr)}]} {
671
            set lastIndex [\
672
                    expr [llength \
673
                    $_opts($_interior.$name,-balloonstr) ]-1]
674
            lreplace $_opts($_interior.$name,-balloonstr) \
675
                    $lastIndex $lastIndex ""
676
        }
677
        error $errMsg
678
    }
679
 
680
    # ... Add in dynamic options that apply from the _optionList
681
    foreach optionSet [$itk_component($name) configure] {
682
        set option [lindex $optionSet 0]
683
        if { [lsearch $_optionList $option] != -1 } {
684
            itk_option add $name.$option
685
        }
686
    }
687
 
688
    bindtags $itk_component($name) \
689
            [linsert [bindtags $itk_component($name)] end \
690
            toolbar-help-$itk_component(hull)]
691
    bindtags $itk_component($name) \
692
            [linsert [bindtags $itk_component($name)] end \
693
            toolbar-balloon-$itk_component(hull)]
694
 
695
    return $itk_component($name)
696
}
697
 
698
# -------------------------------------------------------------
699
#
700
# PRIVATE METHOD: _deleteWidgets
701
#
702
# deletes widget range by numerical index numbers.
703
#
704
# -------------------------------------------------------------
705
body iwidgets::Toolbar::_deleteWidgets { index1 index2 } {
706
 
707
    for { set index $index1 } { $index <= $index2 } { incr index } {
708
 
709
        # kill the widget
710
        set component [lindex $_toolList $index]
711
        destroy $component
712
 
713
    }
714
 
715
    # physically remove the page
716
    set _toolList [lreplace $_toolList $index1 $index2]
717
 
718
}
719
 
720
# -------------------------------------------------------------
721
# PRIVATE METHOD: _index
722
#
723
# toolList : list of widget names to search thru if index
724
#            is non-numeric
725
# index    : either number, 'end', 'last', or pattern
726
#
727
# _index takes takes the value $index converts it to
728
# a numeric identifier. If the value is not already
729
# an integer it looks it up in the $toolList array.
730
# If it fails it returns -1
731
#
732
# -------------------------------------------------------------
733
body iwidgets::Toolbar::_index { toolList index } {
734
 
735
    switch -- $index {
736
        end - last {
737
            set number [expr [llength $toolList] -1]
738
        }
739
        default {
740
            # is it a number already? Then just use the number
741
            if { [regexp {^[0-9]+$} $index] } {
742
                set number $index
743
                # check bounds
744
                if { $number < 0 || $number >= [llength $toolList] } {
745
                    set number -1
746
                }
747
                # otherwise it is a widget name
748
            } else {
749
                if { [catch { set itk_component($index) } ] } {
750
                    set number -1
751
                } else {
752
                    set number [lsearch -exact $toolList \
753
                            $itk_component($index)]
754
                }
755
            }
756
        }
757
    }
758
 
759
    return $number
760
}
761
 
762
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
763
# STATUS HELP for linking to helpVariable
764
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
765
# -------------------------------------------------------------
766
#
767
# PUBLIC METHOD: hideHelp
768
#
769
# Bound to the  event on a toolbar widget. This clears the
770
# status widget help area and resets the help entry.
771
#
772
# -------------------------------------------------------------
773
body iwidgets::Toolbar::hideHelp {} {
774
    if { $itk_option(-helpvariable) != {} } {
775
        upvar #0 $itk_option(-helpvariable) helpvar
776
        set helpvar {}
777
    }
778
    set _currHelpWidget {}
779
}
780
 
781
# -------------------------------------------------------------
782
#
783
# PUBLIC METHOD: showHelp
784
#
785
# Bound to the  event on a tool bar widget. This puts the
786
# help string associated with the tool bar widget into the
787
# status widget help area. If no help exists for the current
788
# entry, the status widget is cleared.
789
#
790
# -------------------------------------------------------------
791
body iwidgets::Toolbar::showHelp { window } {
792
 
793
    set widgetPath $window
794
    # already on this item?
795
    if { $window == $_currHelpWidget } {
796
        return
797
    }
798
 
799
    set _currHelpWidget $window
800
 
801
    # Do we have a helpvariable set on the toolbar?
802
    if { $itk_option(-helpvariable) != {} } {
803
        upvar #0 $itk_option(-helpvariable) helpvar
804
 
805
        # is the -helpstr set for this widget?
806
        set args "-helpstr"
807
        if {[_getAttachedOption _opts \
808
                $window args value]} {
809
            set helpvar $value.
810
        } else {
811
            set helpvar {}
812
        }
813
    }
814
}
815
 
816
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
817
# BALLOON HELP for show/hide of hint window
818
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
819
# -------------------------------------------------------------
820
#
821
# PUBLIC METHOD: showBalloon
822
#
823
# -------------------------------------------------------------
824
body iwidgets::Toolbar::showBalloon {window} {
825
    set _balloonClick false
826
    set _balloonAfterID 0
827
    # Are we still inside the window?
828
    set mouseWindow \
829
            [winfo containing [winfo pointerx .] [winfo pointery .]]
830
 
831
    if { [string match $window* $mouseWindow] } {
832
        # set up the balloonString
833
        set args "-balloonstr"
834
        if {[_getAttachedOption _opts \
835
                $window args hintStr]} {
836
            # configure the balloon help
837
            $_hintWindow.label configure -text $hintStr
838
 
839
            # Coordinates of the balloon
840
            set balloonLeft \
841
                    [expr [winfo rootx $window] + round(([winfo width $window]/2.0))]
842
            set balloonTop \
843
                    [expr [winfo rooty $window] + [winfo height $window]]
844
 
845
            # put up balloon window
846
            wm overrideredirect $_hintWindow 0
847
            wm geometry $_hintWindow "+$balloonLeft+$balloonTop"
848
            wm overrideredirect $_hintWindow 1
849
            wm deiconify $_hintWindow
850
            raise $_hintWindow
851
        } else {
852
            #NO BALLOON HELP AVAILABLE
853
        }
854
    } else {
855
        #NOT IN BUTTON
856
    }
857
 
858
}
859
 
860
# -------------------------------------------------------------
861
#
862
# PUBLIC METHOD: hideBalloon
863
#
864
# -------------------------------------------------------------
865
body iwidgets::Toolbar::hideBalloon {} {
866
    wm withdraw $_hintWindow
867
}
868
 
869
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
870
# OPTION MANAGEMENT for -helpstr, -balloonstr
871
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
872
# -------------------------------------------------------------
873
# PRIVATE METHOD: _getAttachedOption
874
#
875
# optionListName : the name of the array that holds all attached
876
#              options. It is indexed via widget,option to get
877
#              the value.
878
# widget     : the widget that the option is associated with
879
# option     : the option whose value we are looking for on
880
#              this widget.
881
#
882
# expects to be called only if the $option is length 1
883
# -------------------------------------------------------------
884
body iwidgets::Toolbar::_getAttachedOption { optionListName widget args retValue} {
885
 
886
    # get a reference to the option, so we can change it.
887
    upvar $args argsRef
888
    upvar $retValue retValueRef
889
 
890
    set success false
891
 
892
    if { ![catch { set retValueRef \
893
            [eval set [subst [set optionListName]]($widget,$argsRef)]}]} {
894
 
895
        # remove the option argument
896
        set success true
897
        set argsRef ""
898
    }
899
 
900
    return $success
901
}
902
 
903
# -------------------------------------------------------------
904
# PRIVATE METHOD: _setAttachedOption
905
#
906
# This method allows us to attach new options to a widget. It
907
# catches the 'option' to be attached, strips it out of 'args'
908
# attaches it to the 'widget' by stuffing the value into
909
# 'optionList(widget,option)'
910
#
911
# optionListName:  where to store the option and widget association
912
# widget: is the widget we want to associate the attached option
913
# option: is the attached option (unknown to this widget)
914
# args:   the arg list to search and remove the option from (if found)
915
#
916
# Modifies the args parameter.
917
# Returns boolean indicating the success of the method
918
#
919
# -------------------------------------------------------------
920
body iwidgets::Toolbar::_setAttachedOption {optionListName widget option args} {
921
 
922
    upvar args argsRef
923
 
924
    set success false
925
 
926
    # check for 'option' in the 'args' list for the 'widget'
927
    set optPos [eval lsearch $args $option]
928
 
929
    # ... found it
930
    if { $optPos != -1 } {
931
        # grab a copy of the option from arg list
932
        set [subst [set optionListName]]($widget,$option) \
933
                [eval lindex $args [expr $optPos + 1]]
934
 
935
        # remove the option argument and value from the arg list
936
        set argsRef [eval lreplace $args $optPos [expr $optPos + 1]]
937
        set success true
938
    }
939
    # ... if not found, will leave args alone
940
 
941
    return $success
942
}
943
 
944
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
945
# GEOMETRY MANAGEMENT for tool widgets
946
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
947
# -------------------------------------------------------------
948
#
949
# PRIVATE METHOD: _packToolbar
950
#
951
#
952
#
953
# -------------------------------------------------------------
954
body iwidgets::Toolbar::_packToolbar {} {
955
 
956
    # forget the previous locations
957
    foreach tool $_toolList {
958
        pack forget $tool
959
    }
960
 
961
    # pack in order of _toolList.
962
    foreach tool $_toolList {
963
        # adjust for radios and checks to match buttons
964
        if { [winfo class $tool] == "Radiobutton" ||
965
        [winfo class $tool] == "Checkbutton" } {
966
            set iPad 1
967
        } else {
968
            set iPad 0
969
        }
970
 
971
        # pack by horizontal or vertical orientation
972
        if {$itk_option(-orient) == "horizontal" } {
973
            pack $tool -side left -fill y \
974
                    -ipadx $iPad -ipady $iPad
975
        } else {
976
            pack $tool -side top -fill x \
977
                    -ipadx $iPad -ipady $iPad
978
        }
979
    }
980
}

powered by: WebSVN 2.1.0

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