summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog22
-rw-r--r--demos/demo.tcl1605
-rw-r--r--generic/tkTreeCtrl.c17
-rw-r--r--library/filelist-bindings.tcl2
-rw-r--r--library/treectrl.tcl3
-rw-r--r--pkgIndex.tcl.in9
-rwxr-xr-xtests/all.tcl35
7 files changed, 845 insertions, 848 deletions
diff --git a/ChangeLog b/ChangeLog
index 1800865..f5a40ee 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2004-10-09 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * Makefile.in: Revamp build system to use TEA 3.1 setup.
+ * configure:
+ * configure.ac:
+ * tclconfig/tcl.m4:
+
+ * pkgIndex.tcl.in: Automate creation of pkgIndex.tcl and use
+ * demos/demo.tcl: tcl_findLibrary to avoid the issue of build vs.
+ * tests/all.tcl: install package.
+ * generic/tkTreeCtrl.c:
+
+ * generic/tkTreeDisplay.c: correctly handle the damageRgn var.
+
+ * generic/tkTreeUtils.c: Implement Tk_OffsetRegion as
+ XOffsetRegion on unix. (werner)
+
+ * library/filelist-bindings.tcl: ensure TreeCtrl namespace exists
+ * library/treectrl.tcl: source filelist-bindings
+
+ *** Tim Baker (treectrl) made numerous changes for 1.1 ***
+
2004-02-09 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tkTreeCtrl.c (ImageChangedProc): cause image change to
diff --git a/demos/demo.tcl b/demos/demo.tcl
index e3f88ac..57a4f51 100644
--- a/demos/demo.tcl
+++ b/demos/demo.tcl
@@ -1,106 +1,101 @@
#!../TclTk-8.4.6/bin/wish84.exe
+package require Tk 8.4
+
set thisPlatform $::tcl_platform(platform)
-switch -- $thisPlatform {
- unix {
- if {[package vcompare [info tclversion] 8.3] == 1} {
- if {[string equal [tk windowingsystem] "aqua"]} {
- set thisPlatform "macosx"
- }
- }
- }
+if {$thisPlatform eq "unix" && [tk windowingsystem] eq "aqua"} {
+ set thisPlatform "macosx"
}
# Get full pathname to this file
set ScriptDir [file normalize [file dirname [info script]]]
-cd $ScriptDir
# Command to create a full pathname in this file's directory
proc Path {args} {
- return [file normalize [eval file join [list $::ScriptDir] $args]]
+ return [file normalize [eval file join [list $::ScriptDir] $args]]
}
# Create some photo images on demand
proc InitPics {args} {
- foreach pattern $args {
- if {[lsearch [image names] $pattern] == -1} {
- foreach file [glob -directory [Path pics] $pattern.gif] {
- set imageName [file root [file tail $file]]
- # I created an image called "file", which clobbered the
- # original Tcl command "file". Then I got confused.
- if {[llength [info commands $imageName]]} {
- error "don't want to create image called \"$imageName\""
- }
- image create photo $imageName -file $file
-
- # Hack -- Create a "selected" version too
- image create photo ${imageName}Sel
- ${imageName}Sel copy $imageName
- imagetint ${imageName}Sel $::SystemHighlight 128
- }
+ foreach pattern $args {
+ if {[lsearch [image names] $pattern] == -1} {
+ foreach file [glob -directory [Path pics] $pattern.gif] {
+ set imageName [file root [file tail $file]]
+ # I created an image called "file", which clobbered the
+ # original Tcl command "file". Then I got confused.
+ if {[llength [info commands $imageName]]} {
+ error "don't want to create image called \"$imageName\""
}
+ image create photo $imageName -file $file
+
+ # Hack -- Create a "selected" version too
+ image create photo ${imageName}Sel
+ ${imageName}Sel copy $imageName
+ imagetint ${imageName}Sel $::SystemHighlight 128
+ }
}
- return
+ }
+ return
}
if {[catch {
- package require dbwin 1.0
+ package require dbwin 1.0
}]} {
- proc dbwin s {puts -nonewline $s}
+ proc dbwin s {puts -nonewline $s}
}
+package require treectrl
+
# Return TRUE if we are running from the development directory
proc IsDevelopment {} {
- return [file exists [Path .. generic]]
+ return [file exists [Path .. generic]]
}
-if {[IsDevelopment]} {
-
- switch -- $::thisPlatform {
- macintosh {
- load [Path .. treectrl.shlb]
- }
- macosx {
- load [Path .. build treectrl.dylib]
- }
- unix {
+if {[IsDevelopment] && [catch {package require treectrl}]} {
+ switch -- $::thisPlatform {
+ macintosh {
+ load [Path .. treectrl.shlb]
+ }
+ macosx {
+ load [Path .. build treectrl.dylib]
+ }
+ unix {
- # Try to load libtreectrl*.so on Unix
- load [glob -directory [Path ..] libtreectrl*[info sharedlibextension]]
- }
- default {
+ # Try to load libtreectrl*.so on Unix
+ load [glob -directory [Path ..] libtreectrl*[info sharedlibextension]]
+ }
+ default {
- # Windows build
- load [Path .. Build treectrl[info sharedlibextension]]
- }
+ # Windows build
+ load [Path .. Build treectrl[info sharedlibextension]]
}
+ }
- # Default TreeCtrl bindings
- source [Path .. library treectrl.tcl]
+ # Default TreeCtrl bindings
+ source [Path .. library treectrl.tcl]
- # Other useful bindings
- source [Path .. library filelist-bindings.tcl]
+ # Other useful bindings
+ source [Path .. library filelist-bindings.tcl]
} else {
-
- lappend ::auto_path [Path ..]
- package require treectrl 1.1
+ lappend ::auto_path [Path ..]
+ package require treectrl 1.1
}
# Demo sources
foreach file {
- bitmaps
- explorer
- help
- imovie
- layout
- mailwasher
- outlook-folders
- outlook-newgroup
- random
- www-options
- } {
- source [Path $file.tcl]
+ bitmaps
+ explorer
+ help
+ imovie
+ layout
+ mailwasher
+ outlook-folders
+ outlook-newgroup
+ random
+ www-options
+} {
+ source [Path $file.tcl]
}
# Get default colors
@@ -111,300 +106,300 @@ set SystemHighlightText [$w cget -selectforeground]
destroy $w
proc MakeMenuBar {} {
- set m [menu .menubar]
- . configure -menu $m
- set m2 [menu $m.mFile -tearoff no]
- if {$::tcl_platform(platform) ne "unix"} {
- console eval {.console conf -height 8}
- $m2 add command -label "Console" -command {
- if {[console eval {winfo ismapped .}]} {
- console hide
- } else {
- console show
- }
- }
- }
- $m2 add command -label "View Source" -command ToggleSourceWindow
- $m2 add command -label Quit -command exit
- $m add cascade -label File -menu $m2
- return
+ set m [menu .menubar]
+ . configure -menu $m
+ set m2 [menu $m.mFile -tearoff no]
+ if {$::tcl_platform(platform) ne "unix"} {
+ console eval {.console conf -height 8}
+ $m2 add command -label "Console" -command {
+ if {[console eval {winfo ismapped .}]} {
+ console hide
+ } else {
+ console show
+ }
+ }
+ }
+ $m2 add command -label "View Source" -command ToggleSourceWindow
+ $m2 add command -label Quit -command exit
+ $m add cascade -label File -menu $m2
+ return
}
proc MakeSourceWindow {} {
- set w [toplevel .source]
- set f [frame $w.f -borderwidth 0]
- switch -- $::thisPlatform {
- macintosh -
- macosx {
- set font {Geneva 9}
- }
- unix {
- set font {Courier 16}
- }
- default {
- set font {Courier 9}
- }
+ set w [toplevel .source]
+ set f [frame $w.f -borderwidth 0]
+ switch -- $::thisPlatform {
+ macintosh -
+ macosx {
+ set font {Geneva 9}
}
- text $f.t -font $font -tabs [font measure $font 1234] -wrap none \
- -yscrollcommand "$f.sv set" -xscrollcommand "$f.sh set"
- scrollbar $f.sv -orient vertical -command "$f.t yview"
- scrollbar $f.sh -orient horizontal -command "$f.t xview"
- pack $f -expand yes -fill both
- grid columnconfigure $f 0 -weight 1
- grid rowconfigure $f 0 -weight 1
- grid configure $f.t -row 0 -column 0 -sticky news
- grid configure $f.sh -row 1 -column 0 -sticky we
- grid configure $f.sv -row 0 -column 1 -sticky ns
+ unix {
+ set font {Courier 16}
+ }
+ default {
+ set font {Courier 9}
+ }
+ }
+ text $f.t -font $font -tabs [font measure $font 1234] -wrap none \
+ -yscrollcommand "$f.sv set" -xscrollcommand "$f.sh set"
+ scrollbar $f.sv -orient vertical -command "$f.t yview"
+ scrollbar $f.sh -orient horizontal -command "$f.t xview"
+ pack $f -expand yes -fill both
+ grid columnconfigure $f 0 -weight 1
+ grid rowconfigure $f 0 -weight 1
+ grid configure $f.t -row 0 -column 0 -sticky news
+ grid configure $f.sh -row 1 -column 0 -sticky we
+ grid configure $f.sv -row 0 -column 1 -sticky ns
- wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
- wm geom $w -0+0
- wm withdraw $w
+ wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
+ wm geom $w -0+0
+ wm withdraw $w
- return
+ return
}
proc ShowSource {file} {
- wm title .source "Demo Source: $file"
- set path [Path $file]
- set t .source.f.t
- set chan [open $path]
- $t delete 1.0 end
- $t insert end [read $chan]
- $t mark set insert 1.0
- close $chan
- return
+ wm title .source "Demo Source: $file"
+ set path [Path $file]
+ set t .source.f.t
+ set chan [open $path]
+ $t delete 1.0 end
+ $t insert end [read $chan]
+ $t mark set insert 1.0
+ close $chan
+ return
}
proc ToggleSourceWindow {} {
- set w .source
- if {[winfo ismapped $w]} {
- wm withdraw $w
- } else {
- wm deiconify $w
- }
- return
+ set w .source
+ if {[winfo ismapped $w]} {
+ wm withdraw $w
+ } else {
+ wm deiconify $w
+ }
+ return
}
MakeSourceWindow
MakeMenuBar
proc TreePlusScrollbarsInAFrame {f h v} {
- frame $f -borderwidth 1 -relief sunken
- switch -- $::thisPlatform {
- macintosh {
- set font {Geneva 9}
- }
- macosx {
- set font {{Lucida Grande} 11}
- }
- unix {
- set font {Helvetica 16}
- }
- default {
- # There is a bug on my Win98 box with Tk_MeasureChars() and
- # MS Sans Serif 8.
- set font {{MS Sans} 8}
- }
+ frame $f -borderwidth 1 -relief sunken
+ switch -- $::thisPlatform {
+ macintosh {
+ set font {Geneva 9}
}
- treectrl $f.t -highlightthickness 0 -borderwidth 0 -font $font
- $f.t configure -xscrollincrement 20
- $f.t debug configure -enable no -display no
- if {$h} {
- scrollbar $f.sh -orient horizontal -command "$f.t xview"
-# $f.t configure -xscrollcommand "$f.sh set"
- $f.t notify bind $f.sh <Scroll-x> { %W set %l %u }
- bind $f.sh <ButtonPress-1> "focus $f.t"
+ macosx {
+ set font {{Lucida Grande} 11}
}
- if {$v} {
- scrollbar $f.sv -orient vertical -command "$f.t yview"
-# $f.t configure -yscrollcommand "$f.sv set"
- $f.t notify bind $f.sv <Scroll-y> { %W set %l %u }
- bind $f.sv <ButtonPress-1> "focus $f.t"
- }
- grid columnconfigure $f 0 -weight 1
- grid rowconfigure $f 0 -weight 1
- grid configure $f.t -row 0 -column 0 -sticky news
- if {$h} {
- grid configure $f.sh -row 1 -column 0 -sticky we
- }
- if {$v} {
- grid configure $f.sv -row 0 -column 1 -sticky ns
- }
- return
+ unix {
+ set font {Helvetica 16}
+ }
+ default {
+ # There is a bug on my Win98 box with Tk_MeasureChars() and
+ # MS Sans Serif 8.
+ set font {{MS Sans} 8}
+ }
+ }
+ treectrl $f.t -highlightthickness 0 -borderwidth 0 -font $font
+ $f.t configure -xscrollincrement 20
+ $f.t debug configure -enable no -display no
+ if {$h} {
+ scrollbar $f.sh -orient horizontal -command "$f.t xview"
+ # $f.t configure -xscrollcommand "$f.sh set"
+ $f.t notify bind $f.sh <Scroll-x> { %W set %l %u }
+ bind $f.sh <ButtonPress-1> "focus $f.t"
+ }
+ if {$v} {
+ scrollbar $f.sv -orient vertical -command "$f.t yview"
+ # $f.t configure -yscrollcommand "$f.sv set"
+ $f.t notify bind $f.sv <Scroll-y> { %W set %l %u }
+ bind $f.sv <ButtonPress-1> "focus $f.t"
+ }
+ grid columnconfigure $f 0 -weight 1
+ grid rowconfigure $f 0 -weight 1
+ grid configure $f.t -row 0 -column 0 -sticky news
+ if {$h} {
+ grid configure $f.sh -row 1 -column 0 -sticky we
+ }
+ if {$v} {
+ grid configure $f.sv -row 0 -column 1 -sticky ns
+ }
+ return
}
proc MakeMainWindow {} {
- wm title . "TkTreeCtrl Demo"
+ wm title . "TkTreeCtrl Demo"
- switch -- $::thisPlatform {
- macintosh -
- macosx {
- wm geometry . +40+40
- }
- default {
- wm geometry . +0+0
- }
+ switch -- $::thisPlatform {
+ macintosh -
+ macosx {
+ wm geometry . +40+40
+ }
+ default {
+ wm geometry . +0+0
}
+ }
- panedwindow .pw2 -orient horizontal -borderwidth 0
- panedwindow .pw1 -orient vertical -borderwidth 0
-
- # Tree + scrollbar: demos
- TreePlusScrollbarsInAFrame .f1 0 1
- .f1.t configure -showbuttons no -showlines no -showroot no -height 100
- .f1.t column create -text "List of Demos" -expand yes -button no
-
- # Tree + scrollbar: styles + elements in list
- TreePlusScrollbarsInAFrame .f4 0 1
- .f4.t configure -showroot no -height 140
- .f4.t column create -text "Elements and Styles" -expand yes -button no
-
- # Tree + scrollbar: styles + elements in selected item
- TreePlusScrollbarsInAFrame .f3 0 1
- .f3.t configure -showroot no
- .f3.t column create -text "Styles in Item" -expand yes -button no
-
- .pw1 add .f1 .f4 .f3 -height 150
-
- # Frame on right
- frame .f2
-
- # Tree + scrollbars
- TreePlusScrollbarsInAFrame .f2.f1 1 1
- .f2.f1.t configure -indent 19
- .f2.f1.t debug configure -enable no -display yes -erasecolor pink -displaydelay 30
-
- # Give it a big border to debug drawing
- .f2.f1.t configure -borderwidth 6 -relief ridge -highlightthickness 3
-
- grid columnconfigure .f2 0 -weight 1
- grid rowconfigure .f2 0 -weight 1
- grid configure .f2.f1 -row 0 -column 0 -sticky news -pady 0
-
- .pw2 add .pw1 -width 200
- .pw2 add .f2 -width 450
-
- pack .pw2 -expand yes -fill both
-
- ###
- # A treectrl widget can generate the following built-in events:
- # <ActiveItem> called when the active item changes
- # <Collapse-before> called before an item is closed
- # <Collapse-after> called after an item is closed
- # <Expand-before> called before an item is opened
- # <Expand-after> called after an item is opened
- # <Selection> called when items are added to or removed from the selection
- # <Scroll-x> called when horizontal scroll position changes
- # <Scroll-y> called when vertical scroll position changes
- #
- # The application programmer can define custom events to be
- # generated by the "T notify generate" command. The following events
- # are generated by the example bindings.
-
- .f2.f1.t notify install event Header
- .f2.f1.t notify install detail Header invoke
-
- .f2.f1.t notify install event Drag
- .f2.f1.t notify install detail Drag begin
- .f2.f1.t notify install detail Drag end
- .f2.f1.t notify install detail Drag receive
-
- .f2.f1.t notify install event Edit
- .f2.f1.t notify install detail Edit accept
- ###
+ panedwindow .pw2 -orient horizontal -borderwidth 0
+ panedwindow .pw1 -orient vertical -borderwidth 0
- return
+ # Tree + scrollbar: demos
+ TreePlusScrollbarsInAFrame .f1 0 1
+ .f1.t configure -showbuttons no -showlines no -showroot no -height 100
+ .f1.t column create -text "List of Demos" -expand yes -button no
+
+ # Tree + scrollbar: styles + elements in list
+ TreePlusScrollbarsInAFrame .f4 0 1
+ .f4.t configure -showroot no -height 140
+ .f4.t column create -text "Elements and Styles" -expand yes -button no
+
+ # Tree + scrollbar: styles + elements in selected item
+ TreePlusScrollbarsInAFrame .f3 0 1
+ .f3.t configure -showroot no
+ .f3.t column create -text "Styles in Item" -expand yes -button no
+
+ .pw1 add .f1 .f4 .f3 -height 150
+
+ # Frame on right
+ frame .f2
+
+ # Tree + scrollbars
+ TreePlusScrollbarsInAFrame .f2.f1 1 1
+ .f2.f1.t configure -indent 19
+ .f2.f1.t debug configure -enable no -display yes -erasecolor pink -displaydelay 30
+
+ # Give it a big border to debug drawing
+ .f2.f1.t configure -borderwidth 6 -relief ridge -highlightthickness 3
+
+ grid columnconfigure .f2 0 -weight 1
+ grid rowconfigure .f2 0 -weight 1
+ grid configure .f2.f1 -row 0 -column 0 -sticky news -pady 0
+
+ .pw2 add .pw1 -width 200
+ .pw2 add .f2 -width 450
+
+ pack .pw2 -expand yes -fill both
+
+ ###
+ # A treectrl widget can generate the following built-in events:
+ # <ActiveItem> called when the active item changes
+ # <Collapse-before> called before an item is closed
+ # <Collapse-after> called after an item is closed
+ # <Expand-before> called before an item is opened
+ # <Expand-after> called after an item is opened
+ # <Selection> called when items are added to or removed from the selection
+ # <Scroll-x> called when horizontal scroll position changes
+ # <Scroll-y> called when vertical scroll position changes
+ #
+ # The application programmer can define custom events to be
+ # generated by the "T notify generate" command. The following events
+ # are generated by the example bindings.
+
+ .f2.f1.t notify install event Header
+ .f2.f1.t notify install detail Header invoke
+
+ .f2.f1.t notify install event Drag
+ .f2.f1.t notify install detail Drag begin
+ .f2.f1.t notify install detail Drag end
+ .f2.f1.t notify install detail Drag receive
+
+ .f2.f1.t notify install event Edit
+ .f2.f1.t notify install detail Edit accept
+ ###
+
+ return
}
proc MakeListPopup {} {
- set m [menu .f2.f1.t.mTree -tearoff no]
-
- set m2 [menu $m.mCollapse -tearoff no]
- $m add cascade -label Collapse -menu $m2
-
- set m2 [menu $m.mExpand -tearoff no]
- $m add cascade -label Expand -menu $m2
-
- set m2 [menu $m.mDebug -tearoff no]
- $m2 add checkbutton -label Data -variable Popup(debug,data) \
- -command {.f2.f1.t debug configure -data $Popup(debug,data)}
- $m2 add checkbutton -label Display -variable Popup(debug,display) \
- -command {.f2.f1.t debug configure -display $Popup(debug,display)}
- $m2 add checkbutton -label Enable -variable Popup(debug,enable) \
- -command {.f2.f1.t debug configure -enable $Popup(debug,enable)}
- $m add cascade -label Debug -menu $m2
-
- set m2 [menu $m.mBuffer -tearoff no]
- $m2 add radiobutton -label "none" -variable Popup(doublebuffer) -value none \
- -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
- $m2 add radiobutton -label "item" -variable Popup(doublebuffer) -value item \
- -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
- $m2 add radiobutton -label "window" -variable Popup(doublebuffer) -value window \
- -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
- $m add cascade -label Buffering -menu $m2
-
- set m2 [menu $m.mLineStyle -tearoff no]
- $m2 add radiobutton -label "dot" -variable Popup(linestyle) -value dot \
- -command {.f2.f1.t configure -linestyle $Popup(linestyle)}
- $m2 add radiobutton -label "solid" -variable Popup(linestyle) -value solid \
- -command {.f2.f1.t configure -linestyle $Popup(linestyle)}
- $m add cascade -label "Line style" -menu $m2
-
- set m2 [menu $m.mOrient -tearoff no]
- $m2 add radiobutton -label "Horizontal" -variable Popup(orient) -value horizontal \
- -command {.f2.f1.t configure -orient $Popup(orient)}
- $m2 add radiobutton -label "Vertical" -variable Popup(orient) -value vertical \
- -command {.f2.f1.t configure -orient $Popup(orient)}
- $m add cascade -label Orient -menu $m2
-
- set m2 [menu $m.mSelectMode -tearoff no]
- foreach mode [list browse extended multiple single] {
- $m2 add radiobutton -label $mode -variable Popup(selectmode) -value $mode \
- -command {.f2.f1.t configure -selectmode $Popup(selectmode)}
- }
- $m add cascade -label Selectmode -menu $m2
-
- set m2 [menu $m.mShow -tearoff no]
- $m2 add checkbutton -label "Buttons" -variable Popup(showbuttons) \
- -command {.f2.f1.t configure -showbuttons $Popup(showbuttons)}
- $m2 add checkbutton -label "Header" -variable Popup(showheader) \
- -command {.f2.f1.t configure -showheader $Popup(showheader)}
- $m2 add checkbutton -label "Lines" -variable Popup(showlines) \
- -command {.f2.f1.t configure -showlines $Popup(showlines)}
- $m2 add checkbutton -label "Root" -variable Popup(showroot) \
- -command {.f2.f1.t configure -showroot $Popup(showroot)}
- $m2 add checkbutton -label "Root Button" -variable Popup(showrootbutton) \
- -command {.f2.f1.t configure -showrootbutton $Popup(showrootbutton)}
- $m add cascade -label Show -menu $m2
-
- set m2 [menu $m.mVisible -tearoff no]
- $m add cascade -label Visible -menu $m2
- return
+ set m [menu .f2.f1.t.mTree -tearoff no]
+
+ set m2 [menu $m.mCollapse -tearoff no]
+ $m add cascade -label Collapse -menu $m2
+
+ set m2 [menu $m.mExpand -tearoff no]
+ $m add cascade -label Expand -menu $m2
+
+ set m2 [menu $m.mDebug -tearoff no]
+ $m2 add checkbutton -label Data -variable Popup(debug,data) \
+ -command {.f2.f1.t debug configure -data $Popup(debug,data)}
+ $m2 add checkbutton -label Display -variable Popup(debug,display) \
+ -command {.f2.f1.t debug configure -display $Popup(debug,display)}
+ $m2 add checkbutton -label Enable -variable Popup(debug,enable) \
+ -command {.f2.f1.t debug configure -enable $Popup(debug,enable)}
+ $m add cascade -label Debug -menu $m2
+
+ set m2 [menu $m.mBuffer -tearoff no]
+ $m2 add radiobutton -label "none" -variable Popup(doublebuffer) -value none \
+ -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
+ $m2 add radiobutton -label "item" -variable Popup(doublebuffer) -value item \
+ -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
+ $m2 add radiobutton -label "window" -variable Popup(doublebuffer) -value window \
+ -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
+ $m add cascade -label Buffering -menu $m2
+
+ set m2 [menu $m.mLineStyle -tearoff no]
+ $m2 add radiobutton -label "dot" -variable Popup(linestyle) -value dot \
+ -command {.f2.f1.t configure -linestyle $Popup(linestyle)}
+ $m2 add radiobutton -label "solid" -variable Popup(linestyle) -value solid \
+ -command {.f2.f1.t configure -linestyle $Popup(linestyle)}
+ $m add cascade -label "Line style" -menu $m2
+
+ set m2 [menu $m.mOrient -tearoff no]
+ $m2 add radiobutton -label "Horizontal" -variable Popup(orient) -value horizontal \
+ -command {.f2.f1.t configure -orient $Popup(orient)}
+ $m2 add radiobutton -label "Vertical" -variable Popup(orient) -value vertical \
+ -command {.f2.f1.t configure -orient $Popup(orient)}
+ $m add cascade -label Orient -menu $m2
+
+ set m2 [menu $m.mSelectMode -tearoff no]
+ foreach mode [list browse extended multiple single] {
+ $m2 add radiobutton -label $mode -variable Popup(selectmode) -value $mode \
+ -command {.f2.f1.t configure -selectmode $Popup(selectmode)}
+ }
+ $m add cascade -label Selectmode -menu $m2
+
+ set m2 [menu $m.mShow -tearoff no]
+ $m2 add checkbutton -label "Buttons" -variable Popup(showbuttons) \
+ -command {.f2.f1.t configure -showbuttons $Popup(showbuttons)}
+ $m2 add checkbutton -label "Header" -variable Popup(showheader) \
+ -command {.f2.f1.t configure -showheader $Popup(showheader)}
+ $m2 add checkbutton -label "Lines" -variable Popup(showlines) \
+ -command {.f2.f1.t configure -showlines $Popup(showlines)}
+ $m2 add checkbutton -label "Root" -variable Popup(showroot) \
+ -command {.f2.f1.t configure -showroot $Popup(showroot)}
+ $m2 add checkbutton -label "Root Button" -variable Popup(showrootbutton) \
+ -command {.f2.f1.t configure -showrootbutton $Popup(showrootbutton)}
+ $m add cascade -label Show -menu $m2
+
+ set m2 [menu $m.mVisible -tearoff no]
+ $m add cascade -label Visible -menu $m2
+ return
}
proc MakeHeaderPopup {} {
- set m [menu .f2.f1.t.mHeader -tearoff no]
-
- set m2 [menu $m.mArrow -tearoff no]
- $m add cascade -label Arrow -menu $m2
- $m2 add radiobutton -label "None" -variable Popup(arrow) -value none -command {.f2.f1.t column configure $Popup(column) -arrow none}
- $m2 add radiobutton -label "Up" -variable Popup(arrow) -value up -command {.f2.f1.t column configure $Popup(column) -arrow up}
- $m2 add radiobutton -label "Down" -variable Popup(arrow) -value down -command {.f2.f1.t column configure $Popup(column) -arrow down}
- $m2 add separator
- $m2 add radiobutton -label "Side Left" -variable Popup(arrow,side) -value left -command {.f2.f1.t column configure $Popup(column) -arrowside left}
- $m2 add radiobutton -label "Side Right" -variable Popup(arrow,side) -value right -command {.f2.f1.t column configure $Popup(column) -arrowside right}
- $m2 add separator
- $m2 add radiobutton -label "Gravity Left" -variable Popup(arrow,gravity) -value left -command {.f2.f1.t column configure $Popup(column) -arrowgravity left}
- $m2 add radiobutton -label "Gravity Right" -variable Popup(arrow,gravity) -value right -command {.f2.f1.t column configure $Popup(column) -arrowgravity right}
-
- $m add checkbutton -label "Expand" -variable Popup(expand) -command {.f2.f1.t column configure $Popup(column) -expand $Popup(expand)}
- $m add checkbutton -label "Squeeze" -variable Popup(squeeze) -command {.f2.f1.t column configure $Popup(column) -squeeze $Popup(squeeze)}
-
- set m2 [menu $m.mJustify -tearoff no]
- $m add cascade -label Justify -menu $m2
- $m2 add radiobutton -label "Left" -variable Popup(justify) -value left -command {.f2.f1.t column configure $Popup(column) -justify left}
- $m2 add radiobutton -label "Center" -variable Popup(justify) -value center -command {.f2.f1.t column configure $Popup(column) -justify center}
- $m2 add radiobutton -label "Right" -variable Popup(justify) -value right -command {.f2.f1.t column configure $Popup(column) -justify right}
- return
+ set m [menu .f2.f1.t.mHeader -tearoff no]
+
+ set m2 [menu $m.mArrow -tearoff no]
+ $m add cascade -label Arrow -menu $m2
+ $m2 add radiobutton -label "None" -variable Popup(arrow) -value none -command {.f2.f1.t column configure $Popup(column) -arrow none}
+ $m2 add radiobutton -label "Up" -variable Popup(arrow) -value up -command {.f2.f1.t column configure $Popup(column) -arrow up}
+ $m2 add radiobutton -label "Down" -variable Popup(arrow) -value down -command {.f2.f1.t column configure $Popup(column) -arrow down}
+ $m2 add separator
+ $m2 add radiobutton -label "Side Left" -variable Popup(arrow,side) -value left -command {.f2.f1.t column configure $Popup(column) -arrowside left}
+ $m2 add radiobutton -label "Side Right" -variable Popup(arrow,side) -value right -command {.f2.f1.t column configure $Popup(column) -arrowside right}
+ $m2 add separator
+ $m2 add radiobutton -label "Gravity Left" -variable Popup(arrow,gravity) -value left -command {.f2.f1.t column configure $Popup(column) -arrowgravity left}
+ $m2 add radiobutton -label "Gravity Right" -variable Popup(arrow,gravity) -value right -command {.f2.f1.t column configure $Popup(column) -arrowgravity right}
+
+ $m add checkbutton -label "Expand" -variable Popup(expand) -command {.f2.f1.t column configure $Popup(column) -expand $Popup(expand)}
+ $m add checkbutton -label "Squeeze" -variable Popup(squeeze) -command {.f2.f1.t column configure $Popup(column) -squeeze $Popup(squeeze)}
+
+ set m2 [menu $m.mJustify -tearoff no]
+ $m add cascade -label Justify -menu $m2
+ $m2 add radiobutton -label "Left" -variable Popup(justify) -value left -command {.f2.f1.t column configure $Popup(column) -justify left}
+ $m2 add radiobutton -label "Center" -variable Popup(justify) -value center -command {.f2.f1.t column configure $Popup(column) -justify center}
+ $m2 add radiobutton -label "Right" -variable Popup(justify) -value right -command {.f2.f1.t column configure $Popup(column) -justify right}
+ return
}
MakeMainWindow
@@ -412,359 +407,359 @@ MakeListPopup
MakeHeaderPopup
bind .f2.f1.t <ButtonPress-3> {
- set id [%W identify %x %y]
- if {$id ne ""} {
- if {[lindex $id 0] eq "header"} {
- set Popup(column) [lindex $id 1]
- set Popup(arrow) [%W column cget $Popup(column) -arrow]
- set Popup(arrow,side) [%W column cget $Popup(column) -arrowside]
- set Popup(arrow,gravity) [%W column cget $Popup(column) -arrowgravity]
- set Popup(expand) [%W column cget $Popup(column) -expand]
- set Popup(squeeze) [%W column cget $Popup(column) -squeeze]
- set Popup(justify) [%W column cget $Popup(column) -justify]
- tk_popup %W.mHeader %X %Y
- return
- }
- }
- set m %W.mTree.mCollapse
- $m delete 0 end
- $m add command -label "All" -command {%W item collapse all}
- if {$id ne ""} {
- if {[lindex $id 0] eq "item"} {
- set item [lindex $id 1]
- $m add command -label "Item $item" -command "%W item collapse $item"
- $m add command -label "Item $item (recurse)" -command "%W item collapse $item -recurse"
- }
- }
- set m %W.mTree.mExpand
- $m delete 0 end
- $m add command -label "All" -command {%W item expand all}
- if {$id ne ""} {
- if {[lindex $id 0] eq "item"} {
- set item [lindex $id 1]
- $m add command -label "Item $item" -command "%W item expand $item"
- $m add command -label "Item $item (recurse)" -command "%W item expand $item -recurse"
- }
- }
- foreach option {data display enable} {
- set Popup(debug,$option) [%W debug cget -$option]
- }
- set Popup(doublebuffer) [%W cget -doublebuffer]
- set Popup(linestyle) [%W cget -linestyle]
- set Popup(orient) [%W cget -orient]
- set Popup(selectmode) [%W cget -selectmode]
- set Popup(showbuttons) [%W cget -showbuttons]
- set Popup(showheader) [%W cget -showheader]
- set Popup(showlines) [%W cget -showlines]
- set Popup(showroot) [%W cget -showroot]
- set Popup(showrootbutton) [%W cget -showrootbutton]
- set m %W.mTree.mVisible
- $m delete 0 end
- for {set i 0} {$i < [%W numcolumns]} {incr i} {
- set Popup(visible,$i) [%W column cget $i -visible]
- $m add checkbutton -label "Column $i \"[%W column cget $i -text]\" \[[%W column cget $i -image]\]" -variable Popup(visible,$i) \
- -command "%W column configure $i -visible \$Popup(visible,$i)"
- }
- tk_popup %W.mTree %X %Y
+ set id [%W identify %x %y]
+ if {$id ne ""} {
+ if {[lindex $id 0] eq "header"} {
+ set Popup(column) [lindex $id 1]
+ set Popup(arrow) [%W column cget $Popup(column) -arrow]
+ set Popup(arrow,side) [%W column cget $Popup(column) -arrowside]
+ set Popup(arrow,gravity) [%W column cget $Popup(column) -arrowgravity]
+ set Popup(expand) [%W column cget $Popup(column) -expand]
+ set Popup(squeeze) [%W column cget $Popup(column) -squeeze]
+ set Popup(justify) [%W column cget $Popup(column) -justify]
+ tk_popup %W.mHeader %X %Y
+ return
+ }
+ }
+ set m %W.mTree.mCollapse
+ $m delete 0 end
+ $m add command -label "All" -command {%W item collapse all}
+ if {$id ne ""} {
+ if {[lindex $id 0] eq "item"} {
+ set item [lindex $id 1]
+ $m add command -label "Item $item" -command "%W item collapse $item"
+ $m add command -label "Item $item (recurse)" -command "%W item collapse $item -recurse"
+ }
+ }
+ set m %W.mTree.mExpand
+ $m delete 0 end
+ $m add command -label "All" -command {%W item expand all}
+ if {$id ne ""} {
+ if {[lindex $id 0] eq "item"} {
+ set item [lindex $id 1]
+ $m add command -label "Item $item" -command "%W item expand $item"
+ $m add command -label "Item $item (recurse)" -command "%W item expand $item -recurse"
+ }
+ }
+ foreach option {data display enable} {
+ set Popup(debug,$option) [%W debug cget -$option]
+ }
+ set Popup(doublebuffer) [%W cget -doublebuffer]
+ set Popup(linestyle) [%W cget -linestyle]
+ set Popup(orient) [%W cget -orient]
+ set Popup(selectmode) [%W cget -selectmode]
+ set Popup(showbuttons) [%W cget -showbuttons]
+ set Popup(showheader) [%W cget -showheader]
+ set Popup(showlines) [%W cget -showlines]
+ set Popup(showroot) [%W cget -showroot]
+ set Popup(showrootbutton) [%W cget -showrootbutton]
+ set m %W.mTree.mVisible
+ $m delete 0 end
+ for {set i 0} {$i < [%W numcolumns]} {incr i} {
+ set Popup(visible,$i) [%W column cget $i -visible]
+ $m add checkbutton -label "Column $i \"[%W column cget $i -text]\" \[[%W column cget $i -image]\]" -variable Popup(visible,$i) \
+ -command "%W column configure $i -visible \$Popup(visible,$i)"
+ }
+ tk_popup %W.mTree %X %Y
}
# Allow "scan" bindings
if {$::thisPlatform eq "windows"} {
- bind .f2.f1.t <Control-ButtonPress-3> { }
+ bind .f2.f1.t <Control-ButtonPress-3> { }
}
#
# List of demos
#
proc InitDemoList {} {
- global DemoCmd
- global DemoFile
-
- set t .f1.t
- $t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
- $t element create e2 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
- -showfocus yes
- $t style create s1
- $t style elements s1 {e2 e1}
- # Tk listbox has linespace + 1 height
- $t style layout s1 e2 -union [list e1] -ipadx 2 -ipady {0 1} -iexpand e
-
- $t configure -defaultstyle s1
-
- # "Picture Catalog" DemoPictureCatalog
- # "Picture Catalog 2" DemoPictureCatalog2
- # "Folder Contents (Vertical)" DemoExplorerFilesV
- foreach {label command file} [list \
- "Random $::RandomN Items" DemoRandom random.tcl \
- "Random $::RandomN Items, Button Images" DemoRandom2 random.tcl \
- "Outlook Express (Folders)" DemoOutlookFolders outlook-folders.tcl \
- "Outlook Express (Newsgroup)" DemoOutlookNewsgroup outlook-newgroup.tcl \
- "Explorer (Details)" DemoExplorerDetails explorer.tcl \
- "Explorer (List)" DemoExplorerList explorer.tcl \
- "Explorer (Large icons)" DemoExplorerLargeIcons explorer.tcl \
- "Explorer (Small icons)" DemoExplorerSmallIcons explorer.tcl \
- "Internet Options" DemoInternetOptions www-options.tcl \
- "Help Contents" DemoHelpContents help.tcl \
- "Layout" DemoLayout layout.tcl \
- "MailWasher" DemoMailWasher mailwasher.tcl \
- "Bitmaps" DemoBitmaps bitmaps.tcl \
- "iMovie" DemoIMovie imovie.tcl \
- ] {
- set item [$t item create]
- $t item lastchild root $item
-# $t item style set $item 0 s1
- $t item text $item 0 $label
- set DemoCmd($item) $command
- set DemoFile($item) $file
- }
- $t yview moveto 0.0
- return
+ global DemoCmd
+ global DemoFile
+
+ set t .f1.t
+ $t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
+ $t element create e2 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
+ -showfocus yes
+ $t style create s1
+ $t style elements s1 {e2 e1}
+ # Tk listbox has linespace + 1 height
+ $t style layout s1 e2 -union [list e1] -ipadx 2 -ipady {0 1} -iexpand e
+
+ $t configure -defaultstyle s1
+
+ # "Picture Catalog" DemoPictureCatalog
+ # "Picture Catalog 2" DemoPictureCatalog2
+ # "Folder Contents (Vertical)" DemoExplorerFilesV
+ foreach {label command file} [list \
+ "Random $::RandomN Items" DemoRandom random.tcl \
+ "Random $::RandomN Items, Button Images" DemoRandom2 random.tcl \
+ "Outlook Express (Folders)" DemoOutlookFolders outlook-folders.tcl \
+ "Outlook Express (Newsgroup)" DemoOutlookNewsgroup outlook-newgroup.tcl \
+ "Explorer (Details)" DemoExplorerDetails explorer.tcl \
+ "Explorer (List)" DemoExplorerList explorer.tcl \
+ "Explorer (Large icons)" DemoExplorerLargeIcons explorer.tcl \
+ "Explorer (Small icons)" DemoExplorerSmallIcons explorer.tcl \
+ "Internet Options" DemoInternetOptions www-options.tcl \
+ "Help Contents" DemoHelpContents help.tcl \
+ "Layout" DemoLayout layout.tcl \
+ "MailWasher" DemoMailWasher mailwasher.tcl \
+ "Bitmaps" DemoBitmaps bitmaps.tcl \
+ "iMovie" DemoIMovie imovie.tcl \
+ ] {
+ set item [$t item create]
+ $t item lastchild root $item
+ # $t item style set $item 0 s1
+ $t item text $item 0 $label
+ set DemoCmd($item) $command
+ set DemoFile($item) $file
+ }
+ $t yview moveto 0.0
+ return
}
InitDemoList
proc ClicksToSeconds {clicks} {
- return [format "%.2g" [expr {$clicks / 1000000.0}]]
+ return [format "%.2g" [expr {$clicks / 1000000.0}]]
}
proc DemoSet {cmd file} {
- DemoClear
- set clicks [clock clicks]
- uplevel #0 $cmd
- set clicks [expr {[clock clicks] - $clicks}]
- dbwin "set list in [ClicksToSeconds $clicks] seconds ($clicks clicks)\n"
- .f2.f1.t xview moveto 0
- .f2.f1.t yview moveto 0
- update
- DisplayStylesInList
- ShowSource $file
+ DemoClear
+ set clicks [clock clicks]
+ uplevel #0 $cmd
+ set clicks [expr {[clock clicks] - $clicks}]
+ dbwin "set list in [ClicksToSeconds $clicks] seconds ($clicks clicks)\n"
+ .f2.f1.t xview moveto 0
+ .f2.f1.t yview moveto 0
+ update
+ DisplayStylesInList
+ ShowSource $file
}
.f1.t notify bind .f1.t <Selection> {
- if {%c == 1} {
- set selection [%T selection get]
- set item [lindex $selection 0]
- DemoSet $DemoCmd($item) $DemoFile($item)
- }
+ if {%c == 1} {
+ set selection [%T selection get]
+ set item [lindex $selection 0]
+ DemoSet $DemoCmd($item) $DemoFile($item)
+ }
}
proc DisplayStylesInList {} {
- set T .f2.f1.t
- set t .f4.t
-
- # Create elements and styles the first time this is called
- if {[llength [$t style names]] == 0} {
- $t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
- $t element create e2 text -fill [list $::SystemHighlightText {selected focus} "" {selected !focus} blue {}]
- $t element create e3 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
- -showfocus yes
-
- $t style create s1
- $t style elements s1 {e3 e1}
- $t style layout s1 e3 -union [list e1] -ipadx 1 -ipady {0 1}
-
- $t style create s2
- $t style elements s2 {e3 e1 e2}
- $t style layout s2 e1 -padx {0 4}
- $t style layout s2 e3 -union [list e1 e2] -ipadx 1 -ipady {0 1}
- }
-
- # Clear the list
- $t item delete all
-
- # One item for each element in the demo list
- foreach elem [lsort [$T element names]] {
- set item [$t item create -button yes]
- $t item collapse $item
- $t item style set $item 0 s1
- $t item text $item 0 "Element $elem ([$T element type $elem])"
-
- # One item for each configuration option for this element
- foreach list [$T element configure $elem] {
- foreach {name x y default current} $list {}
- set item2 [$t item create]
- if {[string equal $default $current]} {
- $t item style set $item2 0 s1
- $t item complex $item2 [list [list e1 -text [list $name $current]]]
- } else {
- $t item style set $item2 0 s2
- $t item complex $item2 [list [list e1 -text $name] [list e2 -text [list $current]]]
- }
- $t item lastchild $item $item2
- }
- $t item lastchild root $item
- }
+ set T .f2.f1.t
+ set t .f4.t
- # One item for each style in the demo list
- foreach style [lsort [$T style names]] {
- set item [$t item create -button yes]
- $t item collapse $item
- $t item style set $item 0 s1
- $t item text $item 0 "Style $style"
-
- # One item for each element in the style
- foreach elem [$T style elements $style] {
- set item2 [$t item create -button yes]
- $t item collapse $item2
- $t item style set $item2 0 s1
- $t item text $item2 0 "Element $elem ([$T element type $elem])"
-
- # One item for each layout option for this element in this style
- foreach {option value} [$T style layout $style $elem] {
- set item3 [$t item create]
-# $t item hasbutton $item3 no
- $t item style set $item3 0 s1
- $t item text $item3 0 [list $option $value]
- $t item lastchild $item2 $item3
- }
- $t item lastchild $item $item2
- }
- $t item lastchild root $item
- }
+ # Create elements and styles the first time this is called
+ if {[llength [$t style names]] == 0} {
+ $t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
+ $t element create e2 text -fill [list $::SystemHighlightText {selected focus} "" {selected !focus} blue {}]
+ $t element create e3 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
+ -showfocus yes
- $t xview moveto 0
- $t yview moveto 0
- return
+ $t style create s1
+ $t style elements s1 {e3 e1}
+ $t style layout s1 e3 -union [list e1] -ipadx 1 -ipady {0 1}
+
+ $t style create s2
+ $t style elements s2 {e3 e1 e2}
+ $t style layout s2 e1 -padx {0 4}
+ $t style layout s2 e3 -union [list e1 e2] -ipadx 1 -ipady {0 1}
+ }
+
+ # Clear the list
+ $t item delete all
+
+ # One item for each element in the demo list
+ foreach elem [lsort [$T element names]] {
+ set item [$t item create -button yes]
+ $t item collapse $item
+ $t item style set $item 0 s1
+ $t item text $item 0 "Element $elem ([$T element type $elem])"
+
+ # One item for each configuration option for this element
+ foreach list [$T element configure $elem] {
+ foreach {name x y default current} $list {}
+ set item2 [$t item create]
+ if {[string equal $default $current]} {
+ $t item style set $item2 0 s1
+ $t item complex $item2 [list [list e1 -text [list $name $current]]]
+ } else {
+ $t item style set $item2 0 s2
+ $t item complex $item2 [list [list e1 -text $name] [list e2 -text [list $current]]]
+ }
+ $t item lastchild $item $item2
+ }
+ $t item lastchild root $item
+ }
+
+ # One item for each style in the demo list
+ foreach style [lsort [$T style names]] {
+ set item [$t item create -button yes]
+ $t item collapse $item
+ $t item style set $item 0 s1
+ $t item text $item 0 "Style $style"
+
+ # One item for each element in the style
+ foreach elem [$T style elements $style] {
+ set item2 [$t item create -button yes]
+ $t item collapse $item2
+ $t item style set $item2 0 s1
+ $t item text $item2 0 "Element $elem ([$T element type $elem])"
+
+ # One item for each layout option for this element in this style
+ foreach {option value} [$T style layout $style $elem] {
+ set item3 [$t item create]
+ # $t item hasbutton $item3 no
+ $t item style set $item3 0 s1
+ $t item text $item3 0 [list $option $value]
+ $t item lastchild $item2 $item3
+ }
+ $t item lastchild $item $item2
+ }
+ $t item lastchild root $item
+ }
+
+ $t xview moveto 0
+ $t yview moveto 0
+ return
}
proc DisplayStylesInItem {item} {
- set T .f2.f1.t
- set t .f3.t
- $t column configure 0 -text "Styles in item [$T index $item]"
-
- # Create elements and styles the first time this is called
- if {[llength [$t style names]] == 0} {
- $t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
- $t element create e2 text -fill [list $::SystemHighlightText {selected focus} "" {selected !focus} blue {}]
- $t element create e3 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
- -showfocus yes
-
- $t style create s1
- $t style elements s1 {e3 e1}
- $t style layout s1 e3 -union [list e1] -ipadx {1 2} -ipady {0 1}
-
- $t style create s2
- $t style elements s2 {e3 e1 e2}
- $t style layout s2 e1 -padx {0 4}
- $t style layout s2 e3 -union [list e1 e2] -ipadx 1 -ipady {0 1}
- }
+ set T .f2.f1.t
+ set t .f3.t
+ $t column configure 0 -text "Styles in item [$T index $item]"
- # Clear the list
- $t item delete all
+ # Create elements and styles the first time this is called
+ if {[llength [$t style names]] == 0} {
+ $t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
+ $t element create e2 text -fill [list $::SystemHighlightText {selected focus} "" {selected !focus} blue {}]
+ $t element create e3 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
+ -showfocus yes
- # One item for each item-column
- set column 0
- foreach style [$T item style set $item] {
- set item2 [$t item create]
- $t item collapse $item2
- $t item style set $item2 0 s1
- $t item element configure $item2 0 e1 -text "Column $column: Style $style"
- set button 0
-
- # One item for each element in this style
- if {[string length $style]} {
- foreach elem [$T item style elements $item $column] {
- set button 1
- set item3 [$t item create -button yes]
- $t item collapse $item3
- $t item style set $item3 0 s1
- $t item element configure $item3 0 e1 -text "Element $elem ([$T element type $elem])"
-
- # One item for each configuration option in this element
- foreach list [$T item element configure $item $column $elem] {
- foreach {name x y default current} $list {}
- set item4 [$t item create]
- set masterDefault [$T element cget $elem $name]
- set sameAsMaster [string equal $masterDefault $current]
- if {!$sameAsMaster && ![string length $current]} {
- set sameAsMaster 1
- set current $masterDefault
- }
-
- if {$sameAsMaster} {
- $t item style set $item4 0 s1
- $t item complex $item4 [list [list e1 -text "$name [list $current]"]]
- } else {
- $t item style set $item4 0 s2
- $t item complex $item4 [list [list e1 -text $name] [list e2 -text [list $current]]]
- }
- $t item lastchild $item3 $item4
- }
- $t item lastchild $item2 $item3
- }
- if {$button} {
- $t item configure $item2 -button yes
- }
+ $t style create s1
+ $t style elements s1 {e3 e1}
+ $t style layout s1 e3 -union [list e1] -ipadx {1 2} -ipady {0 1}
+
+ $t style create s2
+ $t style elements s2 {e3 e1 e2}
+ $t style layout s2 e1 -padx {0 4}
+ $t style layout s2 e3 -union [list e1 e2] -ipadx 1 -ipady {0 1}
+ }
+
+ # Clear the list
+ $t item delete all
+
+ # One item for each item-column
+ set column 0
+ foreach style [$T item style set $item] {
+ set item2 [$t item create]
+ $t item collapse $item2
+ $t item style set $item2 0 s1
+ $t item element configure $item2 0 e1 -text "Column $column: Style $style"
+ set button 0
+
+ # One item for each element in this style
+ if {[string length $style]} {
+ foreach elem [$T item style elements $item $column] {
+ set button 1
+ set item3 [$t item create -button yes]
+ $t item collapse $item3
+ $t item style set $item3 0 s1
+ $t item element configure $item3 0 e1 -text "Element $elem ([$T element type $elem])"
+
+ # One item for each configuration option in this element
+ foreach list [$T item element configure $item $column $elem] {
+ foreach {name x y default current} $list {}
+ set item4 [$t item create]
+ set masterDefault [$T element cget $elem $name]
+ set sameAsMaster [string equal $masterDefault $current]
+ if {!$sameAsMaster && ![string length $current]} {
+ set sameAsMaster 1
+ set current $masterDefault
+ }
+
+ if {$sameAsMaster} {
+ $t item style set $item4 0 s1
+ $t item complex $item4 [list [list e1 -text "$name [list $current]"]]
+ } else {
+ $t item style set $item4 0 s2
+ $t item complex $item4 [list [list e1 -text $name] [list e2 -text [list $current]]]
+ }
+ $t item lastchild $item3 $item4
}
- $t item lastchild root $item2
- incr column
+ $t item lastchild $item2 $item3
+ }
+ if {$button} {
+ $t item configure $item2 -button yes
+ }
}
- $t xview moveto 0
- $t yview moveto 0
+ $t item lastchild root $item2
+ incr column
+ }
+ $t xview moveto 0
+ $t yview moveto 0
- return
+ return
}
# When one item is selected in the demo list, display the styles in that item.
# See DemoClear for why the tag "DontDelete" is used
.f2.f1.t notify bind DontDelete <Selection> {
- if {%c == 1} {
- set selection [%T selection get]
- DisplayStylesInItem [lindex $selection 0]
- }
+ if {%c == 1} {
+ set selection [%T selection get]
+ DisplayStylesInItem [lindex $selection 0]
+ }
}
proc DemoClear {} {
- set T .f2.f1.t
+ set T .f2.f1.t
- # Clear the demo list
- $T item delete all
+ # Clear the demo list
+ $T item delete all
- # Clear all bindings on the demo list added by the previous demo.
- # This is why DontDelete is used for the <Selection> binding.
- foreach pattern [$T notify bind $T] {
- $T notify bind $T $pattern {}
- }
+ # Clear all bindings on the demo list added by the previous demo.
+ # This is why DontDelete is used for the <Selection> binding.
+ foreach pattern [$T notify bind $T] {
+ $T notify bind $T $pattern {}
+ }
- # Clear all run-time states
- foreach state [$T state names] {
- $T state undefine $state
- }
+ # Clear all run-time states
+ foreach state [$T state names] {
+ $T state undefine $state
+ }
- # Clear the styles-in-item list
- .f3.t item delete all
+ # Clear the styles-in-item list
+ .f3.t item delete all
- # Delete columns in demo list
- while {[$T numcolumns]} {
- $T column delete 0
- }
+ # Delete columns in demo list
+ while {[$T numcolumns]} {
+ $T column delete 0
+ }
- # Delete all styles in demo list
- eval $T style delete [$T style names]
+ # Delete all styles in demo list
+ eval $T style delete [$T style names]
- # Delete all elements in demo list
- eval $T element delete [$T element names]
+ # Delete all elements in demo list
+ eval $T element delete [$T element names]
- $T item configure root -button no
- $T item expand root
+ $T item configure root -button no
+ $T item expand root
- # Restore some happy defaults to the demo list
- $T configure -orient vertical -wrap "" -xscrollincrement 0 \
- -yscrollincrement 0 -itemheight 0 -showheader yes \
- -background white -scrollmargin 0 -xscrolldelay 50 -yscrolldelay 50 \
- -openbuttonimage "" -closedbuttonimage "" -backgroundmode row \
- -treecolumn 0 -indent 19 -defaultstyle {}
+ # Restore some happy defaults to the demo list
+ $T configure -orient vertical -wrap "" -xscrollincrement 0 \
+ -yscrollincrement 0 -itemheight 0 -showheader yes \
+ -background white -scrollmargin 0 -xscrolldelay 50 -yscrolldelay 50 \
+ -openbuttonimage "" -closedbuttonimage "" -backgroundmode row \
+ -treecolumn 0 -indent 19 -defaultstyle {}
- # Restore default bindings to the demo list
- bindtags $T [list $T TreeCtrl [winfo toplevel $T] all]
+ # Restore default bindings to the demo list
+ bindtags $T [list $T TreeCtrl [winfo toplevel $T] all]
- catch {destroy $T.entry}
- catch {destroy $T.text}
+ catch {destroy $T.entry}
+ catch {destroy $T.text}
- return
+ return
}
#
@@ -772,32 +767,32 @@ proc DemoClear {} {
#
proc DemoPictureCatalog {} {
- set T .f2.f1.t
-
- $T configure -showroot no -showbuttons no -showlines no \
- -selectmode multiple -orient horizontal -wrap window \
- -yscrollincrement 50 -showheader no
-
- $T element create elemTxt text -fill {SystemHighlightText {selected focus}}
- $T element create elemSelTxt rect -fill {SystemHighlight {selected focus}}
- $T element create elemSelImg rect -outline {SystemHighlight {selected focus}} \
- -outlinewidth 4
- $T element create elemImg rect -fill gray -width 80 -height 120
-
- set S [$T style create STYLE -orient vertical]
- $T style elements $S {elemSelImg elemImg elemSelTxt elemTxt}
- $T style layout $S elemSelImg -union elemImg -ipadx 6 -ipady 6
- $T style layout $S elemSelTxt -union elemTxt
- $T style layout $S elemImg -pady {0 6}
-
- for {set i 1} {$i <= 10} {incr i} {
- set I [$T item create]
- $T item style set $I 0 $S
- $T item text $I 0 "Picture #$i"
- $T item lastchild root $I
- }
+ set T .f2.f1.t
- return
+ $T configure -showroot no -showbuttons no -showlines no \
+ -selectmode multiple -orient horizontal -wrap window \
+ -yscrollincrement 50 -showheader no
+
+ $T element create elemTxt text -fill {SystemHighlightText {selected focus}}
+ $T element create elemSelTxt rect -fill {SystemHighlight {selected focus}}
+ $T element create elemSelImg rect -outline {SystemHighlight {selected focus}} \
+ -outlinewidth 4
+ $T element create elemImg rect -fill gray -width 80 -height 120
+
+ set S [$T style create STYLE -orient vertical]
+ $T style elements $S {elemSelImg elemImg elemSelTxt elemTxt}
+ $T style layout $S elemSelImg -union elemImg -ipadx 6 -ipady 6
+ $T style layout $S elemSelTxt -union elemTxt
+ $T style layout $S elemImg -pady {0 6}
+
+ for {set i 1} {$i <= 10} {incr i} {
+ set I [$T item create]
+ $T item style set $I 0 $S
+ $T item text $I 0 "Picture #$i"
+ $T item lastchild root $I
+ }
+
+ return
}
#
@@ -805,195 +800,195 @@ proc DemoPictureCatalog {} {
#
proc DemoPictureCatalog2 {} {
- set T .f2.f1.t
-
- $T configure -showroot no -showbuttons no -showlines no \
- -selectmode multiple -orient horizontal -wrap window \
- -yscrollincrement 50 -showheader no
-
- $T element create elemTxt text -fill {SystemHighlightText {selected focus}} \
- -justify left -wrap word -lines 2
- $T element create elemSelTxt rect -fill {SystemHighlight {selected focus}}
- $T element create elemSelImg rect -outline {SystemHighlight {selected focus}} \
- -outlinewidth 4
- $T element create elemImg rect -fill gray
-
- set S [$T style create STYLE -orient vertical]
- $T style elements $S {elemSelImg elemImg elemSelTxt elemTxt}
- $T style layout $S elemSelImg -union elemImg \
- -ipadx 6 -ipady 6
- $T style layout $S elemSelTxt -union elemTxt
- $T style layout $S elemImg -pady {0 6}
- $T style layout $S elemImg -expand n
- $T style layout $S elemTxt -expand s
-
- for {set i 1} {$i <= 10} {incr i} {
- set I [$T item create]
- $T item style set $I 0 $S
- $T item text $I 0 "This is\nPicture\n#$i"
- $T item element configure $I 0 elemImg -width [expr int(20 + rand() * 80)] \
- -height [expr int(20 + rand() * 120)]
- $T item lastchild root $I
- }
+ set T .f2.f1.t
- return
+ $T configure -showroot no -showbuttons no -showlines no \
+ -selectmode multiple -orient horizontal -wrap window \
+ -yscrollincrement 50 -showheader no
+
+ $T element create elemTxt text -fill {SystemHighlightText {selected focus}} \
+ -justify left -wrap word -lines 2
+ $T element create elemSelTxt rect -fill {SystemHighlight {selected focus}}
+ $T element create elemSelImg rect -outline {SystemHighlight {selected focus}} \
+ -outlinewidth 4
+ $T element create elemImg rect -fill gray
+
+ set S [$T style create STYLE -orient vertical]
+ $T style elements $S {elemSelImg elemImg elemSelTxt elemTxt}
+ $T style layout $S elemSelImg -union elemImg \
+ -ipadx 6 -ipady 6
+ $T style layout $S elemSelTxt -union elemTxt
+ $T style layout $S elemImg -pady {0 6}
+ $T style layout $S elemImg -expand n
+ $T style layout $S elemTxt -expand s
+
+ for {set i 1} {$i <= 10} {incr i} {
+ set I [$T item create]
+ $T item style set $I 0 $S
+ $T item text $I 0 "This is\nPicture\n#$i"
+ $T item element configure $I 0 elemImg -width [expr int(20 + rand() * 80)] \
+ -height [expr int(20 + rand() * 120)]
+ $T item lastchild root $I
+ }
+
+ return
}
proc CursorWindow {} {
- set w .cursors
- if {[winfo exists $w]} {
- destroy $w
- }
- toplevel $w
- set c [canvas $w.canvas -background white -width [expr {50 * 10}] \
- -highlightthickness 0 -borderwidth 0]
- pack $c -expand yes -fill both
- set cursors {
- X_cursor
- arrow
- based_arrow_down
- based_arrow_up
- boat
- bogosity
- bottom_left_corner
- bottom_right_corner
- bottom_side
- bottom_tee
- box_spiral
- center_ptr
- circle
- clock
- coffee_mug
- cross
- cross_reverse
- crosshair
- diamond_cross
- dot
- dotbox
- double_arrow
- draft_large
- draft_small
- draped_box
- exchange
- fleur
- gobbler
- gumby
- hand1
- hand2
- heart
- icon
- iron_cross
- left_ptr
- left_side
- left_tee
- leftbutton
- ll_angle
- lr_angle
- man
- middlebutton
- mouse
- pencil
- pirate
- plus
- question_arrow
- right_ptr
- right_side
- right_tee
- rightbutton
- rtl_logo
- sailboat
- sb_down_arrow
- sb_h_double_arrow
- sb_left_arrow
- sb_right_arrow
- sb_up_arrow
- sb_v_double_arrow
- shuttle
- sizing
- spider
- spraycan
- star
- target
- tcross
- top_left_arrow
- top_left_corner
- top_right_corner
- top_side
- top_tee
- trek
- ul_angle
- umbrella
- ur_angle
- watch
- xterm
- }
- set col 0
- set row 0
- foreach cursor $cursors {
- set x [expr {$col * 50}]
- set y [expr {$row * 40}]
- $c create rectangle $x $y [expr {$x + 50}] [expr {$y + 40}] \
- -fill gray90 -outline black -width 2 -tags $cursor.rect
- $c create text [expr {$x + 50 / 2}] [expr {$y + 4}] -text $cursor \
- -anchor n -width 42 -tags $cursor.text
- if {[incr col] == 10} {
- set col 0
- incr row
- }
- $c bind $cursor.rect <Enter> "
+ set w .cursors
+ if {[winfo exists $w]} {
+ destroy $w
+ }
+ toplevel $w
+ set c [canvas $w.canvas -background white -width [expr {50 * 10}] \
+ -highlightthickness 0 -borderwidth 0]
+ pack $c -expand yes -fill both
+ set cursors {
+ X_cursor
+ arrow
+ based_arrow_down
+ based_arrow_up
+ boat
+ bogosity
+ bottom_left_corner
+ bottom_right_corner
+ bottom_side
+ bottom_tee
+ box_spiral
+ center_ptr
+ circle
+ clock
+ coffee_mug
+ cross
+ cross_reverse
+ crosshair
+ diamond_cross
+ dot
+ dotbox
+ double_arrow
+ draft_large
+ draft_small
+ draped_box
+ exchange
+ fleur
+ gobbler
+ gumby
+ hand1
+ hand2
+ heart
+ icon
+ iron_cross
+ left_ptr
+ left_side
+ left_tee
+ leftbutton
+ ll_angle
+ lr_angle
+ man
+ middlebutton
+ mouse
+ pencil
+ pirate
+ plus
+ question_arrow
+ right_ptr
+ right_side
+ right_tee
+ rightbutton
+ rtl_logo
+ sailboat
+ sb_down_arrow
+ sb_h_double_arrow
+ sb_left_arrow
+ sb_right_arrow
+ sb_up_arrow
+ sb_v_double_arrow
+ shuttle
+ sizing
+ spider
+ spraycan
+ star
+ target
+ tcross
+ top_left_arrow
+ top_left_corner
+ top_right_corner
+ top_side
+ top_tee
+ trek
+ ul_angle
+ umbrella
+ ur_angle
+ watch
+ xterm
+ }
+ set col 0
+ set row 0
+ foreach cursor $cursors {
+ set x [expr {$col * 50}]
+ set y [expr {$row * 40}]
+ $c create rectangle $x $y [expr {$x + 50}] [expr {$y + 40}] \
+ -fill gray90 -outline black -width 2 -tags $cursor.rect
+ $c create text [expr {$x + 50 / 2}] [expr {$y + 4}] -text $cursor \
+ -anchor n -width 42 -tags $cursor.text
+ if {[incr col] == 10} {
+ set col 0
+ incr row
+ }
+ $c bind $cursor.rect <Enter> "
$c configure -cursor $cursor
$c itemconfigure $cursor.rect -fill linen
"
- $c bind $cursor.rect <Leave> "
+ $c bind $cursor.rect <Leave> "
$c configure -cursor {}
$c itemconfigure $cursor.rect -fill gray90
"
- $c bind $cursor.text <Enter> "
+ $c bind $cursor.text <Enter> "
$c configure -cursor $cursor
"
- $c bind $cursor.text <Leave> "
+ $c bind $cursor.text <Leave> "
$c configure -cursor {}
"
- }
- $c configure -height [expr {($row + 1) * 40}]
- return
+ }
+ $c configure -height [expr {($row + 1) * 40}]
+ return
}
proc compare {i1 i2} {
- if {$i1 < $i2} { return -1 }
- if {$i1 == $i2} { return 0 }
- return 1
+ if {$i1 < $i2} { return -1 }
+ if {$i1 == $i2} { return 0 }
+ return 1
}
# A little screen magnifier for X11
if {$::thisPlatform eq "unix"} {
-set Loupe(zoom) 3
-set Loupe(x) 0
-set Loupe(y) 0
-set Loupe(auto) 1
+ set Loupe(zoom) 3
+ set Loupe(x) 0
+ set Loupe(y) 0
+ set Loupe(auto) 1
-proc LoupeAfter {} {
+ proc LoupeAfter {} {
global Loupe
set x [winfo pointerx .]
set y [winfo pointery .]
if {$Loupe(auto) || ($Loupe(x) != $x) || ($Loupe(y) != $y)} {
- set w [image width $Loupe(image)]
- set h [image height $Loupe(image)]
- loupe $Loupe(image) $x $y $w $h $::Loupe(zoom)
- set Loupe(x) $x
- set Loupe(y) $y
+ set w [image width $Loupe(image)]
+ set h [image height $Loupe(image)]
+ loupe $Loupe(image) $x $y $w $h $::Loupe(zoom)
+ set Loupe(x) $x
+ set Loupe(y) $y
}
after $Loupe(delay) LoupeAfter
return
-}
+ }
-proc MakeLoupeWindow {} {
+ proc MakeLoupeWindow {} {
global Loupe
@@ -1005,9 +1000,9 @@ proc MakeLoupeWindow {} {
set Loupe(delay) 500
after $Loupe(delay) LoupeAfter
return
-}
-MakeLoupeWindow
+ }
+ MakeLoupeWindow
-# unix
+ # unix
}
diff --git a/generic/tkTreeCtrl.c b/generic/tkTreeCtrl.c
index 8906668..911a59d 100644
--- a/generic/tkTreeCtrl.c
+++ b/generic/tkTreeCtrl.c
@@ -7,7 +7,7 @@
* Copyright (c) 2002-2003 Christian Krone
* Copyright (c) 2003 ActiveState Corporation
*
- * RCS: @(#) $Id: tkTreeCtrl.c,v 1.24 2004/08/13 20:24:15 treectrl Exp $
+ * RCS: @(#) $Id: tkTreeCtrl.c,v 1.25 2004/10/09 22:57:44 hobbs2 Exp $
*/
#include "tkTreeCtrl.h"
@@ -2960,6 +2960,16 @@ int LoupeCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST
#endif /* not TARGET_OS_MAC */
#endif /* not WIN32 */
+static char initScript[] = "if {![llength [info proc ::TreeCtrl::Init]]} {\n\
+ namespace eval ::TreeCtrl {}\n\
+ proc ::TreeCtrl::Init {} {\n\
+ global treectrl_library\n\
+ tcl_findLibrary treectrl " PACKAGE_VERSION " " PACKAGE_VERSION " treectrl.tcl TREECTRL_LIBRARY treectrl_library\n\
+ }\n\
+}\n\
+::TreeCtrl::Init";
+
+
DLLEXPORT int Treectrl_Init(Tcl_Interp *interp)
{
#ifdef USE_TCL_STUBS
@@ -2991,7 +3001,10 @@ DLLEXPORT int Treectrl_Init(Tcl_Interp *interp)
#endif
#endif
Tcl_CreateObjCommand(interp, "treectrl", TreeObjCmd, NULL, NULL);
- return Tcl_PkgProvide(interp, "treectrl", "1.1");
+ if (Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL);
}
DLLEXPORT int Treectrl_SafeInit(Tcl_Interp *interp)
diff --git a/library/filelist-bindings.tcl b/library/filelist-bindings.tcl
index 43e61ec..3c61336 100644
--- a/library/filelist-bindings.tcl
+++ b/library/filelist-bindings.tcl
@@ -31,6 +31,8 @@ bind TreeCtrlFileList <ButtonRelease-1> {
break
}
+namespace eval TreeCtrl {}
+
proc TreeCtrl::FileListButton1 {T x y} {
variable Priv
focus $T
diff --git a/library/treectrl.tcl b/library/treectrl.tcl
index a965818..9b8864e 100644
--- a/library/treectrl.tcl
+++ b/library/treectrl.tcl
@@ -190,6 +190,9 @@ namespace eval ::TreeCtrl {
}
}
+# Retrieve filelist bindings from this dir
+source [file join [file dirname [info script]] filelist-bindings.tcl]
+
proc ::TreeCtrl::CursorCheck {w x y} {
variable Priv
set id [$w identify $x $y]
diff --git a/pkgIndex.tcl.in b/pkgIndex.tcl.in
deleted file mode 100644
index fa3c40e..0000000
--- a/pkgIndex.tcl.in
+++ /dev/null
@@ -1,9 +0,0 @@
-proc ::TreeCtrlLoad {dir} {
- uplevel #0 source [list [file join $dir treectrl.tcl]]
- uplevel #0 source [list [file join $dir filelist-bindings.tcl]]
- tclPkgSetup $dir treectrl @VERSION@ {
- {@treectrl_LIB_FILE@ load {treectrl imagetint textlayout}}
- }
-}
-package ifneeded treectrl @VERSION@ [list ::TreeCtrlLoad $dir]
-
diff --git a/tests/all.tcl b/tests/all.tcl
index 5eb0c60..13f373b 100755
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -7,7 +7,7 @@
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: all.tcl,v 1.2 2002/12/30 21:43:48 krischan Exp $
+# RCS: @(#) $Id: all.tcl,v 1.3 2004/10/09 22:57:44 hobbs2 Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -42,37 +42,8 @@ if {[llength $::tcltest::matchFiles] > 0} {
set timeCmd {clock format [clock seconds]}
puts $chan "Tests began at [eval $timeCmd]"
-# Currently the following doesn't work if tktreectrl is not yet installed:
-# package require treectrl
-# And we want to test the currently built version anyway.
-# So we have to load and source it by hand, until TreectrlInit()
-# evals the initScript with calls of tcl_findLibrary...
-
-proc package_require {treectrl} {
- set thisPlatform $::tcl_platform(platform)
- if {![catch {tk windowingsystem} windowingSystem] \
- && [string equal aqua $windowingSystem]} {
- set thisPlatform macosx
- }
- switch -- $thisPlatform {
- macintosh {
- load treectrl.shlb
- }
- macosx {
- load build/treectrl.dylib
- }
- unix {
- load [glob libtreectrl*[info sharedlibextension]]
- }
- default { # Windows
- load Build/treectrl[info sharedlibextension]
- }
- }
- if {![namespace exists ::TreeCtrl]} {
- uplevel #0 source [file join library treectrl.tcl]
- uplevel #0 source [file join library filelist-bindings.tcl]
- }
-}
+interp alias {} package_require {} package require
+package require treectrl
# source each of the specified tests
foreach file [lsort [::tcltest::getMatchingFiles]] {
generated by cgit v0.12 at 2024-09-29 03:37:16 (GMT)