source: trunk/notebook.tcl @ 116

Last change on this file since 116 was 116, checked in by toby, 11 years ago

# on 1999/11/15 14:32:48, toby did:
A standard Tcl/Tk? notebook widget

  • Property rcs:author set to toby
  • Property rcs:date set to 1999/11/15 14:32:48
  • Property rcs:rev set to 1.1
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 8.7 KB
Line 
1# A Notebook widget for Tcl/Tk
2# $Revision: 116 $ $Date: 2009-12-04 23:00:40 +0000 (Fri, 04 Dec 2009) $
3#
4# This version have been modified by Brian Toby to
5#        define Notebook:resize
6#        deactivate tabs for notebook pages that have "-state disabled"
7#        define a -command configuration option
8#
9# Copyright (C) 1996,1997,1998 D. Richard Hipp
10#
11# This library is free software; you can redistribute it and/or
12# modify it under the terms of the GNU Library General Public
13# License as published by the Free Software Foundation; either
14# version 2 of the License, or (at your option) any later version.
15#
16# This library is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19# Library General Public License for more details.
20#
21# You should have received a copy of the GNU Library General Public
22# License along with this library; if not, write to the
23# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24# Boston, MA  02111-1307, USA.
25#
26# Author contact information:
27#   drh@acm.org
28#   http://www.hwaci.com/drh/
29
30
31#
32# Create a new notebook widget
33#
34proc Notebook:create {w args} {
35  global Notebook
36  set Notebook($w,width) 400
37  set Notebook($w,height) 300
38  set Notebook($w,pages) {}
39  set Notebook($w,top) 0
40  set Notebook($w,pad) 5
41  set Notebook($w,fg,on) black
42  set Notebook($w,fg,off) grey50
43  canvas $w -bd 0 -highlightthickness 0 -takefocus 0
44  set Notebook($w,bg) [$w cget -bg]
45  bind $w <1> "Notebook:click $w %x %y"
46  bind $w <Configure> "Notebook:scheduleExpand $w"
47  eval Notebook:config $w $args
48  set cnt 0
49  # initalize commands and state for each page
50  foreach p $Notebook($w,pages) {
51      set Notebook($w,t$cnt,state) 1
52      set Notebook($w,c$cnt,command) {}
53      incr cnt
54  }
55}
56
57#
58# Change configuration options for the notebook widget
59#
60proc Notebook:config {w args} {
61  global Notebook
62  foreach {tag value} $args {
63    switch -- $tag {
64      -width {
65        set Notebook($w,width) $value
66      }
67      -height {
68        set Notebook($w,height) $value
69      }
70      -pages {
71        set Notebook($w,pages) $value
72          # reinitalize commands and state for each page
73          set cnt 0
74          foreach p $Notebook($w,pages) {
75              set Notebook($w,t$cnt,state) 1
76              set Notebook($w,c$cnt,command) {}
77              incr cnt
78          }
79      }
80      -pad {
81        set Notebook($w,pad) $value
82      }
83      -bg {
84        set Notebook($w,bg) $value
85      }
86      -fg {
87        set Notebook($w,fg,on) $value
88      }
89      -disabledforeground {
90        set Notebook($w,fg,off) $value
91      }
92    }
93  }
94
95  #
96  # After getting new configuration values, reconstruct the widget
97  #
98  $w delete all
99  set Notebook($w,x1) $Notebook($w,pad)
100  set Notebook($w,x2) [expr $Notebook($w,x1)+2]
101  set Notebook($w,x3) [expr $Notebook($w,x2)+$Notebook($w,width)]
102  set Notebook($w,x4) [expr $Notebook($w,x3)+2]
103  set Notebook($w,y1) [expr $Notebook($w,pad)+2]
104  set Notebook($w,y2) [expr $Notebook($w,y1)+2]
105  set Notebook($w,y5) [expr $Notebook($w,y1)+30]
106  set Notebook($w,y6) [expr $Notebook($w,y5)+2]
107  set Notebook($w,y3) [expr $Notebook($w,y6)+$Notebook($w,height)]
108  set Notebook($w,y4) [expr $Notebook($w,y3)+2]
109  set x $Notebook($w,x1)
110  set cnt 0
111  set y7 [expr $Notebook($w,y1)+10]
112  foreach p $Notebook($w,pages) {
113    set Notebook($w,p$cnt,x5) $x
114    set id [$w create text 0 0 -text $p -anchor nw -tags "p$cnt t$cnt"]
115    set bbox [$w bbox $id]
116    set width [lindex $bbox 2]
117    $w move $id [expr $x+10] $y7
118    $w create line \
119       $x $Notebook($w,y5)\
120       $x $Notebook($w,y2) \
121       [expr $x+2] $Notebook($w,y1) \
122       [expr $x+$width+16] $Notebook($w,y1) \
123       -width 2 -fill white -tags p$cnt
124    $w create line \
125       [expr $x+$width+16] $Notebook($w,y1) \
126       [expr $x+$width+18] $Notebook($w,y2) \
127       [expr $x+$width+18] $Notebook($w,y5) \
128       -width 2 -fill black -tags p$cnt
129    set x [expr $x+$width+20]
130    set Notebook($w,p$cnt,x6) [expr $x-2]
131    if {![winfo exists $w.f$cnt]} {
132      frame $w.f$cnt -bd 0
133    }
134    $w.f$cnt config -bg $Notebook($w,bg)
135    place $w.f$cnt -x $Notebook($w,x2) -y $Notebook($w,y6) \
136      -width $Notebook($w,width) -height $Notebook($w,height)
137    incr cnt
138  }
139  $w create line \
140     $Notebook($w,x1) [expr $Notebook($w,y5)-2] \
141     $Notebook($w,x1) $Notebook($w,y3) \
142     -width 2 -fill white
143  $w create line \
144     $Notebook($w,x1) $Notebook($w,y3) \
145     $Notebook($w,x2) $Notebook($w,y4) \
146     $Notebook($w,x3) $Notebook($w,y4) \
147     $Notebook($w,x4) $Notebook($w,y3) \
148     $Notebook($w,x4) $Notebook($w,y6) \
149     $Notebook($w,x3) $Notebook($w,y5) \
150     -width 2 -fill black
151  $w config -width [expr $Notebook($w,x4)+$Notebook($w,pad)] \
152            -height [expr $Notebook($w,y4)+$Notebook($w,pad)] \
153            -bg $Notebook($w,bg)
154  set top $Notebook($w,top)
155  set Notebook($w,top) -1
156  Notebook:raise.page $w $top
157}
158
159#
160# This routine is called whenever the mouse-button is pressed over
161# the notebook.  It determines if any page should be raised and raises
162# that page.
163#
164proc Notebook:click {w x y} {
165  global Notebook
166  if {$y<$Notebook($w,y1) || $y>$Notebook($w,y6)} return
167  set N [llength $Notebook($w,pages)]
168  for {set i 0} {$i<$N} {incr i} {
169    if {$x>=$Notebook($w,p$i,x5) && $x<=$Notebook($w,p$i,x6)} {
170      Notebook:raise.page $w $i
171      break
172    }
173  }
174}
175
176#
177# For internal use only.  This procedure raised the n-th page of
178# the notebook
179#
180proc Notebook:raise.page {w n} {
181  global Notebook
182  if {$n<0 || $n>=[llength $Notebook($w,pages)]} return
183    if {! $Notebook($w,t$n,state)} return
184  set top $Notebook($w,top)
185  if {$top>=0 && $top<[llength $Notebook($w,pages)]} {
186    $w move p$top 0 2
187  }
188  $w move p$n 0 -2
189  $w delete topline
190  if {$n>0} {
191    $w create line \
192       $Notebook($w,x1) $Notebook($w,y6) \
193       $Notebook($w,x2) $Notebook($w,y5) \
194       $Notebook($w,p$n,x5) $Notebook($w,y5) \
195       $Notebook($w,p$n,x5) [expr $Notebook($w,y5)-2] \
196       -width 2 -fill white -tags topline
197  }
198  $w create line \
199    $Notebook($w,p$n,x6) [expr $Notebook($w,y5)-2] \
200    $Notebook($w,p$n,x6) $Notebook($w,y5) \
201    -width 2 -fill white -tags topline
202  $w create line \
203    $Notebook($w,p$n,x6) $Notebook($w,y5) \
204    $Notebook($w,x3) $Notebook($w,y5) \
205    -width 2 -fill white -tags topline
206  set Notebook($w,top) $n
207  raise $w.f$n
208  if {$Notebook($w,c$n,command) != {}} {
209      if [catch {eval uplevel #0 {$Notebook($w,c$n,command)} } errmsg] {
210          puts "Notebook command error: $errmsg"
211      }
212  }
213}
214
215#
216# Change the page-specific configuration options for the notebook
217#
218proc Notebook:pageconfig {w name args} {
219  global Notebook
220  set i [lsearch $Notebook($w,pages) $name]
221  if {$i<0} return
222  foreach {tag value} $args {
223    switch -- $tag {
224      -state {
225        if {"$value"=="disabled"} {
226          $w itemconfig t$i -fill $Notebook($w,fg,off)
227            set Notebook($w,t$i,state) 0
228        } else {
229          $w itemconfig t$i -fill $Notebook($w,fg,on)
230            set Notebook($w,t$i,state) 1
231        }
232      }
233      -command {
234        set Notebook($w,c$i,command) $value
235      }
236      -onexit {
237        set Notebook($w,p$i,onexit) $value
238      }
239    }
240  }
241}
242
243#
244# This procedure raises a notebook page given its name.  But first
245# we check the "onexit" procedure for the current page (if any) and
246# if it returns false, we don't allow the raise to proceed.
247#
248proc Notebook:raise {w name} {
249  global Notebook
250  set i [lsearch $Notebook($w,pages) $name]
251  if {$i<0} return
252  if {[info exists Notebook($w,p$i,onexit)]} {
253    set onexit $Notebook($w,p$i,onexit)
254    if {"$onexit"!="" && [eval uplevel #0 $onexit]!=0} {
255      Notebook:raise.page $w $i
256    }
257  } else {
258    Notebook:raise.page $w $i
259  }
260}
261
262#
263# Return the frame associated with a given page of the notebook.
264#
265proc Notebook:frame {w name} {
266  global Notebook
267  set i [lsearch $Notebook($w,pages) $name]
268  if {$i>=0} {
269    return $w.f$i
270  } else {
271    return {}
272  }
273}
274
275#
276# Try to resize the notebook to the next time we become idle.
277#
278proc Notebook:scheduleExpand w {
279  global Notebook
280  if {[info exists Notebook($w,expand)]} return
281  set Notebook($w,expand) 1
282  after idle "Notebook:expand $w"
283}
284
285#
286# Resize the notebook to fit inside its containing widget.
287#
288proc Notebook:expand w {
289  global Notebook
290  set wi [expr [winfo width $w]-($Notebook($w,pad)*2+4)]
291  set hi [expr [winfo height $w]-($Notebook($w,pad)*2+36)]
292  Notebook:config $w -width $wi -height $hi
293  catch {unset Notebook($w,expand)}
294}
295
296#
297# Resize the notebook so that it fits the contents.
298#
299proc Notebook:resize w {
300    update idletasks
301    set maxw [lindex [$w bbox all] 2]
302    set deltah 0
303    foreach page [place slaves $w] {
304        set h [expr [winfo reqheight $page] - [winfo height $page]]
305        set deltah [expr ($deltah > $h) ? $deltah : $h]
306        set wid [winfo reqwidth $page]
307        set maxw [expr ($maxw > $wid) ? $maxw : $wid]
308    }
309    $w config -width $maxw -height [expr [winfo height $w] + $deltah]
310}
Note: See TracBrowser for help on using the repository browser.