arcadia 0.1.1 → 0.1.2

data/tcl/BWidget-1.8.0/panelframe.tcl

@@ -0,0 +1,246 @@
+# ----------------------------------------------------------------------------
+#  panelframe.tcl
+#	Create PanelFrame widgets.
+#	A PanelFrame is a boxed frame that allows you to place items
+#	in the label area (liked combined frame+toolbar).  It uses the
+#	highlight colors the default frame color.
+#  $Id: panelframe.tcl,v 1.1 2004/09/09 22:17:51 hobbs Exp $
+# ----------------------------------------------------------------------------
+#  Index of commands:
+#     - PanelFrame::create
+#     - PanelFrame::configure
+#     - PanelFrame::cget
+#     - PanelFrame::getframe
+#     - PanelFrame::add
+#     - PanelFrame::remove
+#     - PanelFrame::items
+# ----------------------------------------------------------------------------
+
+namespace eval PanelFrame {
+    Widget::define PanelFrame panelframe
+
+    Widget::declare PanelFrame {
+	{-background	   TkResource "" 0 frame}
+	{-borderwidth	   TkResource 1	 0 frame}
+	{-relief	   TkResource flat 0 frame}
+	{-panelbackground  TkResource "" 0 {entry -selectbackground}}
+	{-panelforeground  TkResource "" 0 {entry -selectforeground}}
+	{-width		   Int	      0	 0}
+	{-height	   Int	      0	 0}
+	{-font		   TkResource "" 0 label}
+	{-text		   String     "" 0}
+	{-textvariable	   String     "" 0}
+	{-ipad		   String      1 0}
+	{-bg		   Synonym    -background}
+	{-bd		   Synonym    -borderwidth}
+    }
+    # Should we have automatic state handling?
+    #{-state            TkResource "" 0 label}
+
+    Widget::addmap PanelFrame "" :cmd {
+	-panelbackground -background
+	-width {} -height {} -borderwidth {} -relief {}
+    }
+    Widget::addmap PanelFrame "" .title	  {
+	-panelbackground -background
+    }
+    Widget::addmap PanelFrame "" .title.text   {
+	-panelbackground -background
+	-panelforeground -foreground
+	-text {} -textvariable {} -font {}
+    }
+    Widget::addmap PanelFrame "" .frame {
+	-background {}
+    }
+
+    if {0} {
+	# This would be code to have an automated close button
+	#{-closebutton	   Boolean    0	 0}
+	Widget::addmap PanelFrame "" .title.close   {
+	    -panelbackground -background
+	    -panelforeground -foreground
+	}
+	variable HaveMarlett \
+	    [expr {[lsearch -exact [font families] "Marlett"] != -1}]
+
+	variable imgdata {
+	    #define close_width 16
+	    #define close_height 16
+	    static char close_bits[] = {
+		0x00, 0x00, 0x00, 0x00,
+		0x00, 0x00, 0x10, 0x08,
+		0x38, 0x1c, 0x70, 0x0e,
+		0xe0, 0x07, 0xc0, 0x03,
+		0xc0, 0x03, 0xe0, 0x07,
+		0x70, 0x0e, 0x38, 0x1c,
+		0x10, 0x08, 0x00, 0x00,
+		0x00, 0x00, 0x00, 0x00};
+	}
+	# We use the same -foreground as the default -panelbackground
+	image create bitmap ::PanelFrame::X -data $imgdata \
+	    -foreground [lindex $Widget::PanelFrame::opt(-panelbackground) 1]
+    }
+
+    bind PanelFrame <Destroy> [list Widget::destroy %W]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanelFrame::create
+# ----------------------------------------------------------------------------
+proc PanelFrame::create { path args } {
+    variable HaveMarlett
+
+    Widget::init PanelFrame $path $args
+
+    set lblopts [list -bd 0 -highlightthickness 0]
+    set outer [eval [list frame $path -class PanelFrame] \
+		   [Widget::subcget $path :cmd]]
+    set title [eval [list frame $path.title] \
+		   [Widget::subcget $path .title]]
+    set tlbl  [eval [list label $path.title.text] $lblopts -anchor w \
+		   [Widget::subcget $path .title.text]]
+    set inner [eval [list frame $path.frame] \
+		   [Widget::subcget $path .frame]]
+
+    foreach {ipadx ipady} [_padval [Widget::cget $path -ipad]] { break }
+
+    if {0} {
+	set btnopts [list -padx 0 -pady 0 -relief flat -overrelief raised \
+			 -bd 1 -highlightthickness 0]
+	set clbl  [eval [list button $path.title.close] $btnopts \
+		       [Widget::subcget $path .title.close]]
+	set close [Widget::cget $path -closebutton]
+	if {$HaveMarlett} {
+	    $clbl configure -font "Marlett -14" -text \u0072
+	} else {
+	    $clbl configure -image ::PanelFrame::X
+	}
+	if {$close} {
+	    pack $path.title.close -side right -padx $ipadx -pady $ipady
+	}
+    }
+
+    grid $path.title -row 0 -column 0 -sticky ew
+    grid $path.frame -row 1 -column 0 -sticky news
+    grid columnconfigure $path 0 -weight 1
+    grid rowconfigure $path 1 -weight 1
+
+    pack $path.title.text -side left -fill x -anchor w \
+	-padx $ipadx -pady $ipady
+
+    return [Widget::create PanelFrame $path]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanelFrame::configure
+# ----------------------------------------------------------------------------
+proc PanelFrame::configure { path args } {
+    set res [Widget::configure $path $args]
+
+    if {[Widget::hasChanged $path -ipad ipad]} {
+    }
+
+    return $res
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanelFrame::cget
+# ----------------------------------------------------------------------------
+proc PanelFrame::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+# ----------------------------------------------------------------------------
+#  Command PanelFrame::getframe
+# ----------------------------------------------------------------------------
+proc PanelFrame::getframe { path } {
+    return $path.frame
+}
+
+# ------------------------------------------------------------------------
+#  Command PanelFrame::add
+# ------------------------------------------------------------------------
+proc PanelFrame::add {path w args} {
+    variable _widget
+
+    array set opts [list \
+			-side   right \
+			-fill   none \
+			-expand 0 \
+			-pad    [Widget::cget $path -ipad] \
+		       ]
+    foreach {key val} $args {
+	if {[info exists opts($key)]} {
+	    set opts($key) $val
+	} else {
+	    set msg "unknown option \"$key\", must be one of: "
+	    append msg [join [lsort [array names opts]] {, }]
+	    return -code error $msg
+	}
+    }
+    foreach {ipadx ipady} [_padval $opts(-pad)] { break }
+
+    set f $path.title
+
+    lappend _widget($path,items) $w
+    pack $w -in $f -padx $ipadx -pady $ipady -side $opts(-side) \
+	-fill $opts(-fill) -expand $opts(-expand)
+
+    return $w
+}
+
+# ------------------------------------------------------------------------
+#  Command PanelFrame::remove
+# ------------------------------------------------------------------------
+proc PanelFrame::remove {path args} {
+    variable _widget
+
+    set destroy [string equal [lindex $args 0] "-destroy"]
+    if {$destroy} {
+	set args [lrange $args 1 end]
+    }
+    foreach w $args {
+	set idx [lsearch -exact $_widget($path,items) $w]
+	if {$idx == -1} {
+	    # ignore unknown
+	    continue
+	}
+	if {$destroy} {
+	    destroy $w
+	} elseif {[winfo exists $w]} {
+	    pack forget $w
+	}
+	set _widget($path,items) [lreplace $_widget($path,items) $idx $idx]
+    }
+}
+
+# ------------------------------------------------------------------------
+#  Command PanelFrame::delete
+# ------------------------------------------------------------------------
+proc PanelFrame::delete {path args} {
+    return [PanelFrame::remove $path -destroy $args]
+}
+
+# ------------------------------------------------------------------------
+#  Command PanelFrame::items
+# ------------------------------------------------------------------------
+proc PanelFrame::items {path} {
+    variable _widget
+    return $_widget($path,items)
+}
+
+proc PanelFrame::_padval {padval} {
+    set len [llength $padval]
+    foreach {a b} $padval { break }
+    if {$len == 0 || $len > 2} {
+	return -code error \
+	    "invalid pad value \"$padval\", must be 1 or 2 pixel values"
+    } elseif {$len == 1} {
+	return [list $a $a]
+    } elseif {$len == 2} {
+	return $padval
+    }
+}

data/tcl/BWidget-1.8.0/passwddlg.tcl

@@ -0,0 +1,178 @@
+# -----------------------------------------------------------------------------
+#  passwddlg.tcl
+#  This file is part of Unifix BWidget Toolkit
+#   by Stephane Lavirotte (Stephane.Lavirotte@sophia.inria.fr)
+#  $Id: passwddlg.tcl,v 1.11 2006/09/28 22:31:28 dev_null42a Exp $
+# -----------------------------------------------------------------------------
+#  Index of commands:
+#     - PasswdDlg::create
+#     - PasswdDlg::configure
+#     - PasswdDlg::cget
+#     - PasswdDlg::_verifonlogin
+#     - PasswdDlg::_verifonpasswd
+#     - PasswdDlg::_max
+#------------------------------------------------------------------------------
+
+namespace eval PasswdDlg {
+    Widget::define PasswdDlg passwddlg Dialog LabelEntry
+
+    Widget::bwinclude PasswdDlg Dialog :cmd \
+	    remove     {-image -bitmap -side -default -cancel -separator} \
+	    initialize {-modal local -anchor e}
+    
+    Widget::bwinclude PasswdDlg LabelEntry .frame.lablog \
+	    remove [list -command -justify -name -show -side	        \
+		-state -takefocus -width -xscrollcommand -padx -pady	\
+		-dragenabled -dragendcmd -dragevent -draginitcmd	\
+		-dragtype -dropenabled -dropcmd -dropovercmd -droptypes	\
+		] \
+	    prefix [list login -editable -helptext -helpvar -label      \
+		-text -textvariable -underline				\
+		] \
+	    initialize [list -relief sunken -borderwidth 2		\
+		-labelanchor w -width 15 -loginlabel "Login"		\
+		]
+    
+    Widget::bwinclude PasswdDlg LabelEntry .frame.labpass		\
+	    remove [list -command -width -show -side -takefocus		\
+		-xscrollcommand -dragenabled -dragendcmd -dragevent	\
+		-draginitcmd -dragtype -dropenabled -dropcmd		\
+		-dropovercmd -droptypes -justify -padx -pady -name	\
+		] \
+	    prefix [list passwd -editable -helptext -helpvar -label	\
+		-state -text -textvariable -underline			\
+		] \
+	    initialize [list -relief sunken -borderwidth 2		\
+		-labelanchor w -width 15 -passwdlabel "Password"	\
+		]
+    
+    Widget::declare PasswdDlg {
+        {-type        Enum       ok           0 {ok okcancel}}
+        {-labelwidth  TkResource -1           0 {label -width}}
+        {-command     String     ""           0}
+    }
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::create
+# -----------------------------------------------------------------------------
+proc PasswdDlg::create { path args } {
+
+    array set maps [list PasswdDlg {} :cmd {} .frame.lablog {} \
+	    .frame.labpass {}]
+    array set maps [Widget::parseArgs PasswdDlg $args]
+
+    Widget::initFromODB PasswdDlg "$path#PasswdDlg" $maps(PasswdDlg)
+
+    # Extract the PasswdDlg megawidget options (those that don't map to a
+    # subwidget)
+    set type      [Widget::cget "$path#PasswdDlg" -type]
+    set cmd       [Widget::cget "$path#PasswdDlg" -command]
+
+    set defb -1
+    set canb -1
+    switch -- $type {
+        ok        { set lbut {ok}; set defb 0 }
+        okcancel  { set lbut {ok cancel} ; set defb 0; set canb 1 }
+    }
+
+    eval [list Dialog::create $path] $maps(:cmd) \
+        [list -class PasswdDlg -image [Bitmap::get passwd] \
+	     -side bottom -default $defb -cancel $canb]
+    foreach but $lbut {
+        if { $but == "ok" && $cmd != "" } {
+            Dialog::add $path -text $but -name $but -command $cmd
+        } else {
+            Dialog::add $path -text $but -name $but
+        }
+    }
+
+    set frame [Dialog::getframe $path]
+    bind $path  <Return>  ""
+    bind $frame <Destroy> [list Widget::destroy $path\#PasswdDlg]
+
+    set lablog [eval [list LabelEntry::create $frame.lablog] \
+		    $maps(.frame.lablog) \
+		    [list -name login -dragenabled 0 -dropenabled 0 \
+			 -command [list PasswdDlg::_verifonpasswd \
+				       $path $frame.labpass]]]
+
+    set labpass [eval [list LabelEntry::create $frame.labpass] \
+		     $maps(.frame.labpass) \
+		     [list -name password -show "*" \
+			  -dragenabled 0 -dropenabled 0 \
+			  -command [list PasswdDlg::_verifonlogin \
+					$path $frame.lablog]]]
+
+    # compute label width
+    if {[$lablog cget -labelwidth] == 0} {
+        set loglabel  [$lablog cget -label]
+        set passlabel [$labpass cget -label]
+        set labwidth  [_max [string length $loglabel] [string length $passlabel]]
+        incr labwidth 1
+        $lablog  configure -labelwidth $labwidth
+        $labpass configure -labelwidth $labwidth
+    }
+
+    Widget::create PasswdDlg $path 0
+
+    pack  $frame.lablog $frame.labpass -fill x -expand 1
+
+    # added by bach@mwgdna.com
+    #  give focus to loginlabel unless the state is disabled
+    if {[$lablog cget -editable]} {
+	focus $frame.lablog.e
+    } else {
+	focus $frame.labpass.e
+    }
+    set res [Dialog::draw $path]
+
+    if { $res == 0 } {
+        set res [list [$lablog.e cget -text] [$labpass.e cget -text]]
+    } else {
+        set res [list]
+    }
+    Widget::destroy "$path#PasswdDlg"
+    destroy $path
+
+    return $res
+}
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::configure
+# -----------------------------------------------------------------------------
+
+proc PasswdDlg::configure { path args } {
+    set res [Widget::configure "$path#PasswdDlg" $args]
+}
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::cget
+# -----------------------------------------------------------------------------
+
+proc PasswdDlg::cget { path option } {
+    return [Widget::cget "$path#PasswdDlg" $option]
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::_verifonlogin
+# -----------------------------------------------------------------------------
+proc PasswdDlg::_verifonlogin { path labpass } {
+    Dialog::enddialog $path 0
+}
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::_verifonpasswd
+# -----------------------------------------------------------------------------
+proc PasswdDlg::_verifonpasswd { path lablog } {
+    focus $lablog
+}
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::_max
+# -----------------------------------------------------------------------------
+proc PasswdDlg::_max { val1 val2 } { 
+    return [expr {($val1 > $val2) ? ($val1) : ($val2)}] 
+}

data/tcl/BWidget-1.8.0/pkgIndex.tcl

@@ -0,0 +1,47 @@
+if {[catch {package require Tcl}]} return
+package ifneeded BWidget 1.8 "\
+    package require Tk 8.1.1;\
+    [list tclPkgSetup $dir BWidget 1.8 {
+{arrow.tcl source {ArrowButton ArrowButton::create ArrowButton::use}}
+{labelframe.tcl source {LabelFrame LabelFrame::create LabelFrame::use}}
+{labelentry.tcl source {LabelEntry LabelEntry::create LabelEntry::use}}
+{bitmap.tcl source {Bitmap::get Bitmap::use}}
+{button.tcl source {Button Button::create Button::use}}
+{buttonbox.tcl source {ButtonBox ButtonBox::create ButtonBox::use}}
+{combobox.tcl source {ComboBox ComboBox::create ComboBox::use}}
+{label.tcl source {Label Label::create Label::use}}
+{entry.tcl source {Entry Entry::create Entry::use}}
+{pagesmgr.tcl source {PagesManager PagesManager::create PagesManager::use}}
+{notebook.tcl source {NoteBook NoteBook::create NoteBook::use}}
+{panedw.tcl source {PanedWindow PanedWindow::create PanedWindow::use}}
+{scrollw.tcl source {ScrolledWindow ScrolledWindow::create ScrolledWindow::use}}
+{scrollview.tcl source {ScrollView ScrollView::create ScrollView::use}}
+{scrollframe.tcl source {ScrollableFrame ScrollableFrame::create ScrollableFrame::use}}
+{panelframe.tcl source {PanelFrame PanelFrame::create PanelFrame::use}}
+{progressbar.tcl source {ProgressBar ProgressBar::create ProgressBar::use}}
+{progressdlg.tcl source {ProgressDlg ProgressDlg::create ProgressDlg::use}}
+{passwddlg.tcl source {PasswdDlg PasswdDlg::create PasswdDlg::use}}
+{dragsite.tcl source {DragSite::register DragSite::include DragSite::use}}
+{dropsite.tcl source {DropSite::register DropSite::include DropSite::use}}
+{separator.tcl source {Separator Separator::create Separator::use}}
+{spinbox.tcl source {SpinBox SpinBox::create SpinBox::use}}
+{statusbar.tcl source {StatusBar StatusBar::create StatusBar::use}}
+{titleframe.tcl source {TitleFrame TitleFrame::create TitleFrame::use}}
+{mainframe.tcl source {MainFrame MainFrame::create MainFrame::use}}
+{listbox.tcl source {ListBox ListBox::create ListBox::use}}
+{tree.tcl source {Tree Tree::create Tree::use}}
+{color.tcl source {SelectColor SelectColor::menu SelectColor::dialog SelectColor::setcolor}}
+{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include DynamicHelp::add DynamicHelp::delete}}
+{dialog.tcl source {Dialog Dialog::create Dialog::use}}
+{messagedlg.tcl source {MessageDlg MessageDlg::create MessageDlg::use}}
+{font.tcl source {SelectFont SelectFont::create SelectFont::use SelectFont::loadfont}}
+{widgetdoc.tcl source {Widget::generate-doc Widget::generate-widget-doc}}
+{wizard.tcl source {Wizard Wizard::create Wizard::use SimpleWizard ClassicWizard}}
+{xpm2image.tcl source {xpm-to-image}}
+}]; \
+	[list namespace eval ::BWIDGET {}]; \
+	[list set ::BWIDGET::LIBRARY $dir]; \
+    [list source [file join $dir widget.tcl]]; \
+    [list source [file join $dir init.tcl]]; \
+    [list source [file join $dir utils.tcl]]; \
+"