arcadia 0.1.1 → 0.1.2

data/tcl/BWidget-1.8.0/images/minus.xbm

@@ -0,0 +1,5 @@
+#define minus_width 9
+#define minus_height 9
+static char minus_bits[] = {
+ 0xff,0x01,0x01,0x01,0x01,0x01,0x01,0x01,0x7d,0x01,0x01,0x01,0x01,0x01,0x01,
+ 0x01,0xff,0x01};

data/tcl/BWidget-1.8.0/images/opcopy.xbm

@@ -0,0 +1,5 @@
+#define opcopy_width 11
+#define opcopy_height 11
+static char opcopy_bits[] = {
+ 0xff,0xff,0x01,0xfc,0x21,0xfc,0x21,0xfc,0x21,0xfc,0xfd,0xfd,0x21,0xfc,0x21,
+ 0xfc,0x21,0xfc,0x01,0xfc,0xff,0xff};

data/tcl/BWidget-1.8.0/images/oplink.xbm

@@ -0,0 +1,5 @@
+#define oplink_width 11
+#define oplink_height 11
+static char oplink_bits[] = {
+ 0xff,0xff,0x01,0xfc,0xf1,0xfc,0xe1,0xfc,0xf1,0xfc,0xb9,0xfc,0x19,0xfc,0x09,
+ 0xfc,0x11,0xfc,0x01,0xfc,0xff,0xff};

data/tcl/BWidget-1.8.0/images/opmove.xbm

@@ -0,0 +1,5 @@
+#define opmove_width 11
+#define opmove_height 11
+static char opmove_bits[] = {
+ 0xff,0xff,0x01,0xfc,0x01,0xfc,0x51,0xfc,0x89,0xfc,0xfd,0xfd,0x89,0xfc,0x51,
+ 0xfc,0x01,0xfc,0x01,0xfc,0xff,0xff};

data/tcl/BWidget-1.8.0/images/plus.xbm

@@ -0,0 +1,5 @@
+#define plus_width 9
+#define plus_height 9
+static char plus_bits[] = {
+ 0xff,0x01,0x01,0x01,0x11,0x01,0x11,0x01,0x7d,0x01,0x11,0x01,0x11,0x01,0x01,
+ 0x01,0xff,0x01};

data/tcl/BWidget-1.8.0/images/target.xbm

@@ -0,0 +1,9 @@
+#define target_width 24
+#define target_height 24
+static unsigned char target_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00,
+   0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x3e, 0xe0, 0x03, 0x3e, 0xe0, 0x03, 0x3e, 0xe0, 0x03, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00,
+   0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};

data/tcl/BWidget-1.8.0/init.tcl

@@ -0,0 +1,40 @@
+namespace eval Widget {}
+proc Widget::_opt_defaults {{prio widgetDefault}} {
+    if {$::tcl_version >= 8.4} {
+	set plat [tk windowingsystem]
+    } else {
+	set plat $::tcl_platform(platform)
+    }
+    switch -exact $plat {
+	"aqua" {
+	}
+	"win32" -
+	"windows" {
+	    #option add *Listbox.background	SystemWindow $prio
+	    option add *ListBox.background	SystemWindow $prio
+	    #option add *Button.padY		0 $prio
+	    option add *ButtonBox.padY		0 $prio
+	    option add *Dialog.padY		0 $prio
+	    option add *Dialog.anchor		e $prio
+	}
+	"x11" -
+	default {
+	    option add *Scrollbar.width		12 $prio
+	    option add *Scrollbar.borderWidth	1  $prio
+	    option add *Dialog.separator	1  $prio
+	    option add *MainFrame.relief	raised $prio
+	    option add *MainFrame.separator	none   $prio
+	}
+    }
+}
+Widget::_opt_defaults
+
+option read [file join $::BWIDGET::LIBRARY "lang" "en.rc"]
+
+## Add a TraverseIn binding to standard Tk widgets to handle some of
+## the BWidget-specific things we do.
+bind Entry   <<TraverseIn>> { %W selection range 0 end; %W icursor end }
+bind Spinbox <<TraverseIn>> { %W selection range 0 end; %W icursor end }
+
+bind all <Key-Tab>       { Widget::traverseTo [Widget::focusNext %W] }
+bind all <<PrevWindow>>  { Widget::traverseTo [Widget::focusPrev %W] }

data/tcl/BWidget-1.8.0/label.tcl

@@ -0,0 +1,271 @@
+# ------------------------------------------------------------------------------
+#  label.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id: label.tcl,v 1.10 2003/10/20 21:23:52 damonc Exp $
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - Label::create
+#     - Label::configure
+#     - Label::cget
+#     - Label::setfocus
+#     - Label::_drag_cmd
+#     - Label::_drop_cmd
+#     - Label::_over_cmd
+# ------------------------------------------------------------------------------
+
+namespace eval Label {
+    Widget::define Label label DragSite DropSite DynamicHelp
+
+    Widget::tkinclude Label label .l \
+        remove { -foreground -text -textvariable -underline }
+
+    Widget::declare Label {
+        {-name               String     ""     0}
+        {-text               String     ""     0}
+        {-textvariable       String     ""     0}
+        {-underline          Int        -1     0 "%d >= -1"}
+        {-focus              String     ""     0}
+        {-foreground         TkResource ""     0 label}
+        {-disabledforeground TkResource ""     0 button}
+        {-state              Enum       normal 0  {normal disabled}}
+
+        {-fg                 Synonym    -foreground}
+    }
+
+    DynamicHelp::include Label balloon
+    DragSite::include    Label "" 1
+    DropSite::include    Label {
+        TEXT    {move {}}
+        IMAGE   {move {}}
+        BITMAP  {move {}}
+        FGCOLOR {move {}}
+        BGCOLOR {move {}}
+        COLOR   {move {}}
+    }
+
+    Widget::syncoptions Label "" .l {-text {} -underline {}}
+
+    bind BwLabel <FocusIn> [list Label::setfocus %W]
+    bind BwLabel <Destroy> [list Label::_destroy %W]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::create
+# ------------------------------------------------------------------------------
+proc Label::create { path args } {
+    array set maps [list Label {} .l {}]
+    array set maps [Widget::parseArgs Label $args]
+    frame $path -class Label -borderwidth 0 -highlightthickness 0 -relief flat
+    Widget::initFromODB Label $path $maps(Label)
+
+    eval [list label $path.l] $maps(.l)
+
+    if { [Widget::cget $path -state] == "normal" } {
+        set fg [Widget::cget $path -foreground]
+    } else {
+        set fg [Widget::cget $path -disabledforeground]
+    }
+
+    set var [Widget::cget $path -textvariable]
+    if {  $var == "" &&
+          [Widget::cget $path -image] == "" &&
+          [Widget::cget $path -bitmap] == ""} {
+        set desc [BWidget::getname [Widget::cget $path -name]]
+        if { $desc != "" } {
+            set text  [lindex $desc 0]
+            set under [lindex $desc 1]
+        } else {
+            set text  [Widget::cget $path -text]
+            set under [Widget::cget $path -underline]
+        }
+    } else {
+        set under -1
+        set text  ""
+    }
+
+    $path.l configure -text $text -textvariable $var \
+	    -underline $under -foreground $fg
+
+    set accel [string tolower [string index $text $under]]
+    if { $accel != "" } {
+        bind [winfo toplevel $path] <Alt-$accel> "Label::setfocus $path"
+    }
+
+    bindtags $path   [list BwLabel [winfo toplevel $path] all]
+    bindtags $path.l [list $path.l $path Label [winfo toplevel $path] all]
+    pack $path.l -expand yes -fill both
+
+    set dragendcmd [Widget::cget $path -dragendcmd]
+    DragSite::setdrag $path $path.l Label::_init_drag_cmd $dragendcmd 1
+    DropSite::setdrop $path $path.l Label::_over_cmd Label::_drop_cmd 1
+    DynamicHelp::sethelp $path $path.l 1
+
+    return [Widget::create Label $path]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::configure
+# ------------------------------------------------------------------------------
+proc Label::configure { path args } {
+    set oldunder [$path.l cget -underline]
+    if { $oldunder != -1 } {
+        set oldaccel [string tolower [string index [$path.l cget -text] $oldunder]]
+    } else {
+        set oldaccel ""
+    }
+    set res [Widget::configure $path $args]
+
+    set cfg  [Widget::hasChanged $path -foreground fg]
+    set cdfg [Widget::hasChanged $path -disabledforeground dfg]
+    set cst  [Widget::hasChanged $path -state state]
+
+    if { $cst || $cfg || $cdfg } {
+        if { $state == "normal" } {
+            $path.l configure -fg $fg
+        } else {
+            $path.l configure -fg $dfg
+        }
+    }
+
+    set cv [Widget::hasChanged $path -textvariable var]
+    set cb [Widget::hasChanged $path -image img]
+    set ci [Widget::hasChanged $path -bitmap bmp]
+    set cn [Widget::hasChanged $path -name name]
+    set ct [Widget::hasChanged $path -text text]
+    set cu [Widget::hasChanged $path -underline under]
+
+    if { $cv || $cb || $ci || $cn || $ct || $cu } {
+        if {  $var == "" && $img == "" && $bmp == "" } {
+            set desc [BWidget::getname $name]
+            if { $desc != "" } {
+                set text  [lindex $desc 0]
+                set under [lindex $desc 1]
+            }
+        } else {
+            set under -1
+            set text  ""
+        }
+        set top [winfo toplevel $path]
+        if { $oldaccel != "" } {
+            bind $top <Alt-$oldaccel> {}
+        }
+        set accel [string tolower [string index $text $under]]
+        if { $accel != "" } {
+            bind $top <Alt-$accel> [list Label::setfocus $path]
+        }
+        $path.l configure -text $text -underline $under -textvariable $var
+    }
+
+    set force [Widget::hasChanged $path -dragendcmd dragend]
+    DragSite::setdrag $path $path.l Label::_init_drag_cmd $dragend $force
+    DropSite::setdrop $path $path.l Label::_over_cmd Label::_drop_cmd
+    DynamicHelp::sethelp $path $path.l
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::cget
+# ------------------------------------------------------------------------------
+proc Label::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::setfocus
+# ------------------------------------------------------------------------------
+proc Label::setfocus { path } {
+    if { [string equal [Widget::cget $path -state] "normal"] } {
+        set w [Widget::cget $path -focus]
+        if { [winfo exists $w] && [Widget::focusOK $w] } {
+            focus $w
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::_init_drag_cmd
+# ------------------------------------------------------------------------------
+proc Label::_init_drag_cmd { path X Y top } {
+    set path [winfo parent $path]
+    if { [set cmd [Widget::cget $path -draginitcmd]] != "" } {
+        return [uplevel \#0 $cmd [list $path $X $Y $top]]
+    }
+    if { [set data [$path.l cget -image]] != "" } {
+        set type "IMAGE"
+        pack [label $top.l -image $data]
+    } elseif { [set data [$path.l cget -bitmap]] != "" } {
+        set type "BITMAP"
+        pack [label $top.l -bitmap $data]
+    } else {
+        set data [$path.l cget -text]
+        set type "TEXT"
+    }
+    set usertype [Widget::getoption $path -dragtype]
+    if { $usertype != "" } {
+        set type $usertype
+    }
+    return [list $type {copy} $data]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::_drop_cmd
+# ------------------------------------------------------------------------------
+proc Label::_drop_cmd { path source X Y op type data } {
+    set path [winfo parent $path]
+    if { [set cmd [Widget::cget $path -dropcmd]] != "" } {
+        return [uplevel \#0 $cmd [list $path $source $X $Y $op $type $data]]
+    }
+    if { $type == "COLOR" || $type == "FGCOLOR" } {
+        configure $path -foreground $data
+    } elseif { $type == "BGCOLOR" } {
+        configure $path -background $data
+    } else {
+        set text   ""
+        set image  ""
+        set bitmap ""
+        switch -- $type {
+            IMAGE   {set image $data}
+            BITMAP  {set bitmap $data}
+            default {
+                set text $data
+                if { [set var [$path.l cget -textvariable]] != "" } {
+                    configure $path -image "" -bitmap ""
+                    GlobalVar::setvar $var $data
+                    return
+                }
+            }
+        }
+        configure $path -text $text -image $image -bitmap $bitmap
+    }
+    return 1
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::_over_cmd
+# ------------------------------------------------------------------------------
+proc Label::_over_cmd { path source event X Y op type data } {
+    set path [winfo parent $path]
+    if { [set cmd [Widget::cget $path -dropovercmd]] != "" } {
+        return [uplevel \#0 $cmd [list $path $source $event $X $Y $op $type $data]]
+    }
+    if { [Widget::getoption $path -state] == "normal" ||
+         $type == "COLOR" || $type == "FGCOLOR" || $type == "BGCOLOR" } {
+        DropSite::setcursor based_arrow_down
+        return 1
+    }
+    DropSite::setcursor dot
+    return 0
+}
+
+
+proc Label::_destroy { path } {
+    Widget::destroy $path
+}

data/tcl/BWidget-1.8.0/labelentry.tcl

@@ -0,0 +1,100 @@
+# ------------------------------------------------------------------------------
+#  labelentry.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id: labelentry.tcl,v 1.6 2003/10/20 21:23:52 damonc Exp $
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - LabelEntry::create
+#     - LabelEntry::configure
+#     - LabelEntry::cget
+#     - LabelEntry::bind
+# ------------------------------------------------------------------------------
+
+namespace eval LabelEntry {
+    Widget::define LabelEntry labelentry Entry LabelFrame
+
+    Widget::bwinclude LabelEntry LabelFrame .labf \
+        remove {-relief -borderwidth -focus} \
+        rename {-text -label} \
+        prefix {label -justify -width -anchor -height -font -textvariable}
+
+    Widget::bwinclude LabelEntry Entry .e \
+        remove {-fg -bg} \
+        rename {-foreground -entryfg -background -entrybg}
+
+    Widget::addmap LabelEntry "" :cmd {-background {}}
+
+    Widget::syncoptions LabelEntry Entry .e {-text {}}
+    Widget::syncoptions LabelEntry LabelFrame .labf {-label -text -underline {}}
+
+    ::bind BwLabelEntry <FocusIn> [list focus %W.labf]
+    ::bind BwLabelEntry <Destroy> [list LabelEntry::_destroy %W]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelEntry::create
+# ------------------------------------------------------------------------------
+proc LabelEntry::create { path args } {
+    array set maps [list LabelEntry {} :cmd {} .labf {} .e {}]
+    array set maps [Widget::parseArgs LabelEntry $args]
+
+    eval [list frame $path] $maps(:cmd) -class LabelEntry \
+	    -relief flat -bd 0 -highlightthickness 0 -takefocus 0
+    Widget::initFromODB LabelEntry $path $maps(LabelEntry)
+	
+    set labf  [eval [list LabelFrame::create $path.labf] $maps(.labf) \
+                   [list -relief flat -borderwidth 0 -focus $path.e]]
+    set subf  [LabelFrame::getframe $labf]
+    set entry [eval [list Entry::create $path.e] $maps(.e)]
+
+    pack $entry -in $subf -fill both -expand yes
+    pack $labf  -fill both -expand yes
+
+    bindtags $path [list $path BwLabelEntry [winfo toplevel $path] all]
+
+    return [Widget::create LabelEntry $path]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelEntry::configure
+# ------------------------------------------------------------------------------
+proc LabelEntry::configure { path args } {
+    return [Widget::configure $path $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelEntry::cget
+# ------------------------------------------------------------------------------
+proc LabelEntry::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelEntry::bind
+# ------------------------------------------------------------------------------
+proc LabelEntry::bind { path args } {
+    return [eval [list ::bind $path.e] $args]
+}
+
+
+#------------------------------------------------------------------------------
+#  Command LabelEntry::_path_command
+#------------------------------------------------------------------------------
+proc LabelEntry::_path_command { path cmd larg } {
+    if { [string equal $cmd "configure"] ||
+         [string equal $cmd "cget"] ||
+         [string equal $cmd "bind"] } {
+        return [eval [list LabelEntry::$cmd $path] $larg]
+    } else {
+        return [eval [list $path.e:cmd $cmd] $larg]
+    }
+}
+
+
+proc LabelEntry::_destroy { path } {
+    Widget::destroy $path
+}