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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [NoteBook.tcl] - Blame information for rev 1782

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

Line No. Rev Author Line
1 578 markom 
# NoteBook.tcl --
2 
#
3 
#       tixNoteBook: NoteBook type of window.
4 
#
5 
# Copyright (c) 1996, Expert Interface Technologies
6 
#
7 
# See the file "license.terms" for information on usage and redistribution
8 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9 
#
10 
 
11 
tixWidgetClass tixNoteBook {
12 
    -classname TixNoteBook
13 
    -superclass tixVStack
14 
    -method {
15 
    }
16 
    -flag {
17 
    }
18 
    -configspec {
19 
        {-takefocus takeFocus TakeFocus 0 tixVerifyBoolean}
20 
    }
21 
    -default {
22 
        {.Background            #d9d9d9}
23 
        {.nbframe.tabPadX       8}
24 
        {.nbframe.tabPadY       0}
25 
        {.nbframe.borderWidth   2}
26 
        {.nbframe.Background    #d9d9d9}
27 
        {*nbframe.relief        raised}
28 
        {*nbframe.font          -Adobe-Helvetica-Bold-R-Normal--*-120-*}
29 
    }
30 
}
31 
 
32 
proc tixNoteBook:InitWidgetRec {w} {
33 
    upvar #0 $w data
34 
 
35 
    tixChainMethod $w InitWidgetRec
36 
 
37 
    set data(pad-x1) 0
38 
    set data(pad-x2) 0
39 
    set data(pad-y1) 20
40 
    set data(pad-y2) 0
41 
}
42 
 
43 
proc tixNoteBook:ConstructWidget {w} {
44 
    upvar #0 $w data
45 
 
46 
    tixChainMethod $w ConstructWidget
47 
 
48 
    set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
49 
    set data(w:nbframe) $data(w:top)
50 
 
51 
    bind $data(w:top) <ButtonPress-1> "tixNoteBook:MouseDown $w %x %y"
52 
    bind $data(w:top) <ButtonRelease-1> "tixNoteBook:MouseUp $w %x %y"
53 
 
54 
    bind $data(w:top) <B1-Motion> "tixNoteBook:MouseDown $w %x %y"
55 
 
56 
    bind $data(w:top) <Left>  "tixNoteBook:FocusNext $w prev"
57 
    bind $data(w:top) <Right> "tixNoteBook:FocusNext $w next"
58 
 
59 
    bind $data(w:top) <Return> "tixNoteBook:SetFocusByKey $w"
60 
    bind $data(w:top) <space>  "tixNoteBook:SetFocusByKey $w"
61 
}
62 
 
63 
#----------------------------------------------------------------------
64 
# Public methods
65 
#----------------------------------------------------------------------
66 
proc tixNoteBook:add {w child args} {
67 
    upvar #0 $w data
68 
 
69 
    set ret [eval tixChainMethod $w add $child $args]
70 
 
71 
    set new_args ""
72 
    tixForEach {flag value} $args {
73 
        if {$flag != "-createcmd" && $flag != "-raisecmd"} {
74 
            lappend new_args $flag
75 
            lappend new_args $value
76 
        }
77 
    }
78 
 
79 
    eval $data(w:top) add $child $new_args
80 
 
81 
    return $ret
82 
}
83 
 
84 
proc tixNoteBook:raise {w child} {
85 
    upvar #0 $w data
86 
 
87 
    tixChainMethod $w raise $child
88 
 
89 
    if {[$data(w:top) pagecget $child -state] == "normal"} {
90 
        $data(w:top) activate $child
91 
    }
92 
}
93 
 
94 
proc tixNoteBook:delete {w child} {
95 
    upvar #0 $w data
96 
 
97 
    tixChainMethod $w delete $child
98 
    $data(w:top) delete $child
99 
}
100 
 
101 
#----------------------------------------------------------------------
102 
# Private methods
103 
#----------------------------------------------------------------------
104 
proc tixNoteBook:Resize {w} {
105 
    upvar #0 $w data
106 
 
107 
    # We have to take care of the size of the tabs so that
108 
    #
109 
    set rootReq [$data(w:top) geometryinfo]
110 
    set tW [lindex $rootReq 0]
111 
    set tH [lindex $rootReq 1]
112 
 
113 
    set data(pad-x1) 2
114 
    set data(pad-x2) 2
115 
    set data(pad-y1) [expr $tH + $data(-ipadx) + 1]
116 
    set data(pad-y2) 2
117 
    set data(minW)   [expr $tW]
118 
    set data(minH)   [expr $tH]
119 
 
120 
    # Now that we know data(pad-y1), we can chain the call
121 
    #
122 
    tixChainMethod $w Resize
123 
}
124 
 
125 
proc tixNoteBook:MouseDown {w x y} {
126 
    upvar #0 $w data
127 
 
128 
    focus $data(w:top)
129 
 
130 
    set name [$data(w:top) identify $x $y]
131 
    $data(w:top) focus $name
132 
    set data(w:down) $name
133 
}
134 
 
135 
proc tixNoteBook:MouseUp {w x y} {
136 
    upvar #0 $w data
137 
 
138 
    #it could happen (using the tk/menu) that a MouseUp
139 
    #proceeds without a MouseDown event!!
140 
    if {! [info exists data(w:down)] || ! [info exists data(w:top)]} {
141 
        return
142 
    }
143 
 
144 
    set name [$data(w:top) identify $x $y]
145 
 
146 
    if {$name != "" && $name == $data(w:down) && [$data(w:top) pagecget $name -state] == "normal" } {
147 
        $data(w:top) activate $name
148 
        tixCallMethod $w raise $name
149 
    } else {
150 
        $data(w:top) focus ""
151 
    }
152 
}
153 
 
154 
 
155 
#----------------------------------------------------------------------
156 
#
157 
# Section for keyboard bindings
158 
#
159 
#----------------------------------------------------------------------
160 
 
161 
proc tixNoteBook:FocusNext {w dir} {
162 
    upvar #0 $w data
163 
 
164 
    if {[$data(w:top) info focus] == ""} {
165 
        set name [$data(w:top) info active]
166 
        $data(w:top) focus $name
167 
 
168 
        if {$name != ""} {
169 
            return
170 
        }
171 
    } else {
172 
        set name [$data(w:top) info focus$dir]
173 
        $data(w:top) focus $name
174 
   }
175 
}
176 
 
177 
proc tixNoteBook:SetFocusByKey {w} {
178 
    upvar #0 $w data
179 
 
180 
    set name [$data(w:top) info focus]
181 
 
182 
    if {$name != "" && [$data(w:top) pagecget $name -state] == "normal"} {
183 
        tixCallMethod $w raise $name
184 
        $data(w:top) activate $name
185 
    }
186 
}
187 
 
188 
#----------------------------------------------------------------------
189 
# Automatic bindings for alt keys
190 
#----------------------------------------------------------------------
191 
proc tixNoteBookFind {w char} {
192 
    global tkPriv
193 
    set char [string tolower $char]
194 
 
195 
    foreach child [winfo child $w] {
196 
        if {![winfo ismapped $w]} {
197 
            continue
198 
        }
199 
        switch [winfo class $child] {
200 
            {Toplevel} {
201 
                continue
202 
            }
203 
            TixNoteBook {
204 
                set nbframe [$child subwidget nbframe]
205 
                foreach page [$nbframe info pages] {
206 
                    set char2 [string index [$nbframe pagecget $page -label] \
207 
                        [$nbframe pagecget $page -underline]]
208 
                    if {([string compare $char [string tolower $char2]] == 0)||
209 
                        ($char == "")} {
210 
                        if {[$nbframe pagecget $page -state] != "disabled"} {
211 
                            return "$child $page"
212 
                        }
213 
                    }
214 
                }
215 
            }
216 
        }
217 
        # Well, this notebook doesn't match with the key, but maybe
218 
        # it contains a "subnotebook" that will match ..
219 
        set match [tixNoteBookFind $child $char]
220 
        if {$match != ""} {
221 
            return $match
222 
        }
223 
    }
224 
    return ""
225 
}
226 
 
227 
proc tixTraverseToNoteBook {w char} {
228 
    if {$char == ""} {
229 
        return 0
230 
    }
231 
    if {![winfo exists $w]} {
232 
        return 0
233 
    }
234 
    set list [tixNoteBookFind [winfo toplevel $w] $char]
235 
    if {$list != ""} {
236 
        [lindex $list 0] raise [lindex $list 1]
237 
        return 1
238 
    }
239 
    return 0
240 
}
241 
 
242 
#----------------------------------------------------------------------
243 
# Set default class bindings
244 
#----------------------------------------------------------------------
245 
 
246 
bind all <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
247 
bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"
248 
 

powered by: WebSVN 2.1.0

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