source: trunk/notebook.tcl

Last change on this file was 1251, checked in by toby, 7 years ago

use svn ps svn:eol-style "native" * to change line ends

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