arcadia 0.1.1 → 0.1.2

data/tcl/BWidget-1.8.0/demo/basic.tcl

@@ -0,0 +1,199 @@
+
+namespace eval DemoBasic {
+    variable var
+    variable count 0
+    variable id    ""
+}
+
+
+proc DemoBasic::create { nb } {
+    set frame [$nb insert end demoBasic -text "Basic"]
+
+    set topf  [frame $frame.topf]
+    set titf1 [TitleFrame $topf.titf1 -text "Label"]
+    set titf2 [TitleFrame $topf.titf2 -text "Entry"]
+    set titf3 [TitleFrame $frame.titf3 -text "Button and ArrowButton"]
+
+    _label  [$titf1 getframe]
+    _entry  [$titf2 getframe]
+    _button [$titf3 getframe]
+
+    pack $titf1 $titf2 -side left -fill both -padx 4 -expand yes
+    pack $topf -pady 2 -fill x
+    pack $titf3 -pady 2 -padx 4 -fill x
+
+    return $frame
+}
+
+
+proc DemoBasic::_label { parent } {
+    variable var
+
+    set lab [Label $parent.label -text "This is a Label widget" \
+                 -helptext "Label widget"]
+    set chk [checkbutton $parent.chk -text "Disabled" \
+                 -variable DemoBasic::var($lab,-state) \
+                 -onvalue  disabled -offvalue normal \
+                 -command  "$lab configure -state \$DemoBasic::var($lab,-state)"]
+    pack $lab -anchor w -pady 4
+    pack $chk -anchor w
+}
+
+
+proc DemoBasic::_entry { parent } {
+    set ent  [Entry $parent.entry -text "Press enter" \
+                  -command  {set DemoBasic::var(entcmd) "-command called" ; after 500 {set DemoBasic::var(entcmd) ""}} \
+                   -helptext "Entry widget"]
+    set chk1 [checkbutton $parent.chk1 -text "Disabled" \
+                  -variable DemoBasic::var($ent,state) \
+                  -onvalue  disabled -offvalue normal \
+                  -command  "$ent configure -state \$DemoBasic::var($ent,state)"]
+    set chk2 [checkbutton $parent.chk2 -text "Non editable" \
+                  -variable DemoBasic::var($ent,editable) \
+                  -onvalue  false -offvalue true \
+                  -command  "$ent configure -editable \$DemoBasic::var($ent,editable)"]
+    set lab  [label $parent.cmd -textvariable DemoBasic::var(entcmd) -foreground red]
+    pack $ent -pady 4 -anchor w
+    pack $chk1 $chk2 -anchor w
+    pack $lab -pady 4
+}
+
+
+proc DemoBasic::_button { parent } {
+    variable var
+
+    set frame [frame $parent.butfr]
+    set but   [Button $frame.but -text "Press me!" \
+                   -repeatdelay 300 \
+                   -command  "DemoBasic::_butcmd command" \
+                   -helptext "This is a Button widget"]
+    set sep1  [Separator $frame.sep1 -orient vertical]
+    set arr1  [ArrowButton $frame.arr1 -type button \
+                   -width 25 -height 25 \
+                   -repeatdelay 300 \
+                   -command  "DemoBasic::_butcmd command" \
+                   -helptext "This is an ArrowButton widget\nof type button"]
+    set sep2  [Separator $frame.sep2 -orient vertical]
+    set arr2  [ArrowButton $frame.arr2 -type arrow \
+                   -width 25 -height 25 -relief sunken -ipadx 0 -ipady 0 \
+                   -repeatdelay 300 \
+                   -command  "DemoBasic::_butcmd command" \
+                   -helptext "This is an ArrowButton widget\nof type arrow"]
+
+    pack $but  -side left -padx 4
+    pack $sep1 -side left -padx 4 -fill y
+    pack $arr1 -side left -padx 4
+    pack $sep2 -side left -padx 4 -fill y
+    pack $arr2 -side left -padx 4
+    pack $frame
+
+    set sep3  [Separator $parent.sep3 -orient horizontal]
+    pack $sep3 -fill x -pady 10
+
+    set labf1 [LabelFrame $parent.labf1 -text "Command" -side top \
+                   -anchor w -relief sunken -borderwidth 1]
+    set subf  [$labf1 getframe]
+    set chk1  [checkbutton $subf.chk1 -text "Disabled" \
+                   -variable DemoBasic::var(bstate) -onvalue disabled -offvalue normal \
+                   -command  "DemoBasic::_bstate \$DemoBasic::var(bstate) $but $arr1 $arr2"]
+    set chk2  [checkbutton $subf.chk2 -text "Use -armcommand/\n-disarmcommand" \
+                   -justify left \
+                   -variable DemoBasic::var(barmcmd) \
+                   -command  "DemoBasic::_barmcmd \$DemoBasic::var(barmcmd) $but $arr1 $arr2"]
+    pack $chk1 $chk2 -anchor w
+
+    set label [label $parent.label -textvariable DemoBasic::var(butcmd) -foreground red]
+    pack $label -side bottom -pady 4
+
+    set labf2 [LabelFrame $parent.labf2 -text "Direction" -side top \
+                   -anchor w -relief sunken -borderwidth 1]
+    set subf  [$labf2 getframe]
+    set var(bside) top
+    foreach dir {top left bottom right} {
+        set rad [radiobutton $subf.$dir -text "$dir arrow" \
+                     -variable DemoBasic::var(bside) -value $dir \
+                     -command  "DemoBasic::_bside \$DemoBasic::var(bside) $arr1 $arr2"]
+        pack $rad -anchor w
+    }
+
+    set labf3 [LabelFrame $parent.labf3 -text "Relief" -side top \
+                   -anchor w -relief sunken -borderwidth 1]
+    set subf  [$labf3 getframe]
+    set var(brelief) raised
+    foreach {f lrelief} {f1 {raised sunken ridge groove} f2 {flat solid link}} {
+        set f [frame $subf.$f]
+        foreach relief $lrelief {
+            set rad [radiobutton $f.$relief -text $relief \
+                         -variable DemoBasic::var(brelief) -value $relief \
+                         -command  "DemoBasic::_brelief \$DemoBasic::var(brelief) $but $arr1 $arr2"]
+            pack $rad -anchor w
+        }
+        pack $f -side left -padx 2 -anchor n
+    }
+    pack $labf1 $labf2 $labf3 -side left -fill y -padx 4
+}
+
+
+proc DemoBasic::_bstate { state but arr1 arr2 } {
+    foreach but [list $but $arr1 $arr2] {
+        $but configure -state $state
+    }
+}
+
+
+proc DemoBasic::_brelief { relief but arr1 arr2 } {
+    $but configure -relief $relief
+    if { $relief != "link" } {
+        foreach arr [list $arr1 $arr2] {
+            $arr configure -relief $relief
+        }
+    }
+}
+
+
+proc DemoBasic::_bside { side args } {
+    foreach arr $args {
+        $arr configure -dir $side
+    }
+}
+
+
+proc DemoBasic::_barmcmd { value but arr1 arr2 } {
+    if { $value } {
+        $but configure \
+            -armcommand    "DemoBasic::_butcmd arm" \
+            -disarmcommand "DemoBasic::_butcmd disarm" \
+            -command {}
+        foreach arr [list $arr1 $arr2] {
+            $arr configure \
+                -armcommand    "DemoBasic::_butcmd arm" \
+                -disarmcommand "DemoBasic::_butcmd disarm" \
+                -command {}
+        }
+    } else {
+        $but configure -armcommand {} -disarmcommand {} \
+            -command  "DemoBasic::_butcmd command"
+        foreach arr [list $arr1 $arr2] {
+            $arr configure -armcommand {} -disarmcommand {} \
+                -command "DemoBasic::_butcmd command"
+        }
+    }
+}
+
+
+proc DemoBasic::_butcmd { reason } {
+    variable count
+    variable id
+
+    catch {after cancel $id}
+    if { $reason == "arm" } {
+        incr count
+        set DemoBasic::var(butcmd) "$reason command called ($count)"
+    } else {
+        set count 0
+        set DemoBasic::var(butcmd) "$reason command called"
+    }
+    set id [after 500 {set DemoBasic::var(butcmd) ""}]
+}
+
+

data/tcl/BWidget-1.8.0/demo/bwidget.xbm

@@ -0,0 +1,46 @@
+#define bwidget_width 76
+#define bwidget_height 64
+static char bwidget_bits[] = {
+ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,
+ 0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,
+ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,
+ 0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,
+ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,
+ 0x00,0x00,0x00,0x00,0xf0,0x00,0xb6,0x6d,0xdb,0x16,0x00,0x00,0x00,0x00,0xf0,
+ 0x00,0xdb,0xb6,0x6d,0xab,0x00,0x00,0x00,0x00,0xf0,0x00,0x55,0x55,0x55,0x75,
+ 0x01,0x00,0x00,0x00,0xf0,0x00,0x6d,0xdb,0xb6,0xad,0x02,0x00,0x00,0x00,0xf0,
+ 0x00,0xb6,0x6d,0xdb,0xb6,0x05,0x00,0x00,0x00,0xf0,0x00,0x55,0x55,0x55,0x55,
+ 0x05,0x00,0x00,0x00,0xf0,0x00,0xda,0xb6,0xad,0x6d,0x0b,0x00,0x00,0x00,0xf0,
+ 0x00,0x6b,0x03,0xc0,0xb6,0x05,0x00,0x00,0x00,0xf0,0x00,0x56,0x05,0x00,0x55,
+ 0x0d,0x00,0x00,0x00,0xf0,0x00,0xbb,0x05,0x80,0xdb,0x06,0x00,0x00,0x00,0xf0,
+ 0x00,0xca,0x06,0x00,0x6c,0x0b,0x00,0x00,0x00,0xf0,0x00,0xb6,0x02,0x00,0xaa,
+ 0x0a,0x00,0x00,0x00,0xf0,0x00,0xab,0x05,0x00,0x6c,0x0b,0x00,0x00,0x00,0xf0,
+ 0x00,0xdd,0x06,0x00,0xb6,0x05,0x00,0x00,0x00,0xf0,0x00,0xaa,0x02,0x00,0x55,
+ 0x05,0x00,0x00,0x00,0xf0,0x00,0xb7,0x05,0xc0,0xda,0x02,0x00,0x00,0x00,0xf0,
+ 0x00,0xd9,0x06,0x50,0x6b,0x01,0x00,0x00,0x00,0xf0,0x00,0x56,0xb5,0xad,0xad,
+ 0x00,0x00,0x00,0x00,0xf0,0x00,0xdb,0xd6,0x76,0x15,0x00,0x00,0x00,0x00,0xf0,
+ 0x00,0x6a,0xab,0xaa,0x2d,0x00,0x00,0x00,0x00,0xf0,0x00,0x56,0x75,0xad,0xb6,
+ 0x02,0x00,0x00,0x00,0xf0,0x00,0xbb,0xad,0xd6,0xaa,0x05,0x00,0x00,0x00,0xf0,
+ 0x00,0xca,0xb6,0x6b,0xdb,0x2a,0x00,0x00,0x00,0xf0,0x00,0x77,0xd5,0x5c,0x6d,
+ 0x2d,0x00,0x00,0x00,0xf0,0x00,0x99,0x05,0x00,0xaa,0x56,0x00,0x00,0x00,0xf0,
+ 0x00,0xee,0x06,0x00,0x6c,0xbb,0x00,0x00,0x00,0xf0,0x00,0xaa,0x02,0x00,0xb0,
+ 0x55,0x00,0x00,0x00,0xf0,0x00,0x55,0x05,0x00,0xa8,0xd6,0x00,0x00,0x00,0xf0,
+ 0x00,0xee,0x06,0x00,0xd0,0x6a,0x00,0x00,0x00,0xf0,0x00,0x55,0x03,0x00,0x68,
+ 0xb7,0xfc,0x00,0x7e,0xf0,0x00,0x6d,0x05,0x00,0xa8,0xaa,0xfc,0x80,0x7e,0xf0,
+ 0x00,0xb6,0x05,0x00,0x50,0xbb,0xfe,0x01,0x7e,0xf0,0x00,0x55,0x05,0x00,0x78,
+ 0xad,0xfe,0x81,0x1f,0xf0,0x00,0xb6,0x05,0x00,0xa4,0xb5,0xfe,0x81,0x1f,0xf0,
+ 0x00,0x5b,0x05,0x80,0xba,0x56,0xfe,0x83,0x1f,0xf0,0x00,0xaa,0x6b,0x5b,0xd5,
+ 0x5a,0xff,0x85,0x1f,0xf0,0x00,0xdb,0x5a,0xad,0x57,0x2b,0xff,0xc7,0x0f,0xf0,
+ 0x00,0x6d,0xad,0xd5,0x6a,0x0d,0xff,0xc7,0x0f,0xf0,0x00,0xaa,0xd6,0xb6,0xba,
+ 0x05,0xdf,0xc7,0x0f,0xf0,0x00,0xb7,0xb5,0x5a,0xab,0x8a,0xdf,0xcf,0x0f,0xf0,
+ 0x00,0xd9,0x5a,0xab,0x6d,0x8f,0xcf,0xef,0x07,0xf0,0x00,0x56,0xad,0x75,0xb5,
+ 0xaf,0x8f,0xef,0x07,0xf0,0x00,0xb5,0xeb,0x5a,0x00,0x9f,0xcf,0xef,0x07,0xf0,
+ 0x00,0x00,0x00,0x00,0x00,0xff,0x8f,0xff,0x07,0xf0,0x00,0x00,0x00,0x00,0x00,
+ 0xfe,0x87,0xff,0x03,0xf0,0x00,0x00,0x00,0x00,0x00,0xff,0x03,0xff,0x03,0xf0,
+ 0x00,0x00,0x00,0x00,0x00,0xfe,0x03,0xff,0x03,0xf0,0x00,0x00,0x00,0x00,0x00,
+ 0xfe,0x03,0xff,0x01,0xf0,0x00,0x00,0x00,0x00,0x00,0xfc,0x01,0xff,0x03,0xf0,
+ 0x00,0x00,0x00,0x00,0x00,0xfe,0x01,0xfe,0x01,0xf0,0x00,0x00,0x00,0x00,0x00,
+ 0xfc,0x01,0xfe,0x01,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,
+ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,
+ 0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,
+ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0};

data/tcl/BWidget-1.8.0/demo/demo.tcl

@@ -0,0 +1,212 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not tcl \
+exec wish "$0" ${1+"$@"}
+
+namespace eval Demo {
+    variable _wfont
+
+    variable notebook
+    variable mainframe
+    variable status
+    variable prgtext
+    variable prgindic
+    variable font
+    variable font_name
+    variable toolbar1  1
+    variable toolbar2  1
+
+    set pwd [pwd]
+    cd [file dirname [info script]]
+    variable DEMODIR [pwd]
+    cd $pwd
+
+    foreach script {
+	manager.tcl basic.tcl select.tcl dnd.tcl tree.tcl tmpldlg.tcl
+    } {
+	namespace inscope :: source $DEMODIR/$script
+    }
+}
+
+
+proc Demo::create { } {
+    global   tk_patchLevel
+    variable _wfont
+    variable notebook
+    variable mainframe
+    variable font
+    variable prgtext
+    variable prgindic
+
+    set prgtext "Please wait while loading font..."
+    set prgindic -1
+    _create_intro
+    update
+    SelectFont::loadfont
+
+    bind all <F12> { catch {console show} }
+
+    # Menu description
+    set descmenu {
+        "&File" all file 0 {
+            {command "E&xit" {} "Exit BWidget demo" {} -command exit}
+        }
+        "&Options" all options 0 {
+            {checkbutton "Toolbar &1" {all option} "Show/hide toolbar 1" {}
+                -variable Demo::toolbar1
+                -command  {$Demo::mainframe showtoolbar 0 $Demo::toolbar1}
+            }
+            {checkbutton "Toolbar &2" {all option} "Show/hide toolbar 2" {}
+                -variable Demo::toolbar2
+                -command  {$Demo::mainframe showtoolbar 1 $Demo::toolbar2}
+            }
+        }
+    }
+
+    set prgtext   "Creating MainFrame..."
+    set prgindic  0
+    set mainframe [MainFrame .mainframe \
+                       -menu         $descmenu \
+                       -textvariable Demo::status \
+                       -progressvar  Demo::prgindic]
+
+    # toolbar 1 creation
+    incr prgindic
+    set tb1  [$mainframe addtoolbar]
+    set bbox [ButtonBox $tb1.bbox1 -spacing 0 -padx 1 -pady 1]
+    $bbox add -image [Bitmap::get new] \
+        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
+        -helptext "Create a new file"
+    $bbox add -image [Bitmap::get open] \
+        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
+        -helptext "Open an existing file"
+    $bbox add -image [Bitmap::get save] \
+        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
+        -helptext "Save file"
+    pack $bbox -side left -anchor w
+
+    set sep [Separator $tb1.sep -orient vertical]
+    pack $sep -side left -fill y -padx 4 -anchor w
+
+    incr prgindic
+    set bbox [ButtonBox $tb1.bbox2 -spacing 0 -padx 1 -pady 1]
+    $bbox add -image [Bitmap::get cut] \
+        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
+        -helptext "Cut selection"
+    $bbox add -image [Bitmap::get copy] \
+        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
+        -helptext "Copy selection"
+    $bbox add -image [Bitmap::get paste] \
+        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
+        -helptext "Paste selection"
+    pack $bbox -side left -anchor w
+
+   # toolbar 2 creation
+    incr prgindic
+    set tb2    [$mainframe addtoolbar]
+    set _wfont [SelectFont $tb2.font -type toolbar \
+                    -command "Demo::update_font \[$tb2.font cget -font\]"]
+    set font   [$_wfont cget -font]
+    pack $_wfont -side left -anchor w
+
+    $mainframe addindicator -text "BWidget [package version BWidget]"
+    $mainframe addindicator -textvariable tk_patchLevel
+
+    # NoteBook creation
+    set frame    [$mainframe getframe]
+    set notebook [NoteBook $frame.nb]
+
+    set prgtext   "Creating Manager..."
+    incr prgindic
+    set f0  [DemoManager::create $notebook]
+    set prgtext   "Creating Basic..."
+    incr prgindic
+    set f1  [DemoBasic::create $notebook]
+    set prgtext   "Creating Select..."
+    incr prgindic
+    set f2 [DemoSelect::create $notebook]
+    set prgtext   "Creating Dialog..."
+    incr prgindic
+    set f3b [DemoDlg::create $notebook]
+    set prgtext   "Creating Drag and Drop..."
+    incr prgindic
+    set f4 [DemoDnd::create $notebook]
+    set prgtext   "Creating Tree..."
+    incr prgindic
+    set f5 [DemoTree::create $notebook]
+
+    set prgtext   "Done"
+    incr prgindic
+    $notebook compute_size
+    pack $notebook -fill both -expand yes -padx 4 -pady 4
+    $notebook raise [$notebook page 0]
+
+    pack $mainframe -fill both -expand yes
+    update idletasks
+    destroy .intro
+}
+
+
+proc Demo::update_font { newfont } {
+    variable _wfont
+    variable notebook
+    variable font
+    variable font_name
+
+    . configure -cursor watch
+    if { $font != $newfont } {
+        $_wfont configure -font $newfont
+        $notebook configure -font $newfont
+        set font $newfont
+    }
+    . configure -cursor ""
+}
+
+
+proc Demo::_create_intro { } {
+    variable DEMODIR
+
+    set top [toplevel .intro -relief raised -borderwidth 2]
+
+    wm withdraw $top
+    wm overrideredirect $top 1
+
+    set ximg  [label $top.x -bitmap @$DEMODIR/x1.xbm \
+	    -foreground grey90 -background white]
+    set bwimg [label $ximg.bw -bitmap @$DEMODIR/bwidget.xbm \
+	    -foreground grey90 -background white]
+    set frame [frame $ximg.f -background white]
+    set lab1  [label $frame.lab1 -text "Loading demo" \
+	    -background white -font {times 8}]
+    set lab2  [label $frame.lab2 -textvariable Demo::prgtext \
+	    -background white -font {times 8} -width 35]
+    set prg   [ProgressBar $frame.prg -width 50 -height 10 -background white \
+	    -variable Demo::prgindic -maximum 10]
+    pack $lab1 $lab2 $prg
+    place $frame -x 0 -y 0 -anchor nw
+    place $bwimg -relx 1 -rely 1 -anchor se
+    pack $ximg
+    BWidget::place $top 0 0 center
+    wm deiconify $top
+}
+
+
+proc Demo::main {} {
+    variable DEMODIR
+
+    lappend ::auto_path [file dirname $DEMODIR]
+    namespace inscope :: package require BWidget
+
+    option add *TitleFrame.l.font {helvetica 11 bold italic}
+
+    wm withdraw .
+    wm title . "BWidget demo"
+
+    Demo::create
+    BWidget::place . 0 0 center
+    wm deiconify .
+    raise .
+    focus -force .
+}
+
+Demo::main
+wm geom . [wm geom .]