Binary files /tmp/RqGKr15_al/bwidget-1.9.6/.fslckout and /tmp/WYZhxTndt2/bwidget-1.9.7/.fslckout differ diff -Nru bwidget-1.9.6/BWman/ComboBox.html bwidget-1.9.7/BWman/ComboBox.html --- bwidget-1.9.6/BWman/ComboBox.html 2006-09-28 15:46:06.000000000 +0000 +++ bwidget-1.9.7/BWman/ComboBox.html 2013-09-15 17:42:06.000000000 +0000 @@ -145,6 +145,7 @@ ?option? ?value option value ...?
pathName get
+
pathName getentry
pathName getlistbox
pathName getvalue
pathName icursor @@ -315,6 +316,13 @@
+
pathName getentry +
+ +Returns the path to the contained entry widget. + +
+
pathName getlistbox
diff -Nru bwidget-1.9.6/BWman/MainFrame.html bwidget-1.9.7/BWman/MainFrame.html --- bwidget-1.9.6/BWman/MainFrame.html 2011-05-25 15:08:16.000000000 +0000 +++ bwidget-1.9.7/BWman/MainFrame.html 2013-09-15 17:42:06.000000000 +0000 @@ -22,21 +22,24 @@   -progressvar (see -variable) +
WIDGET-SPECIFIC OPTIONS
- - + + + - - + + + - +
  -height
  -menu
  -height
  -menu
  -separator
  -textvariable
  -separator
  -textvariable
  -width
  -width
  -sizegrip
@@ -83,10 +86,10 @@ MainFrame manage toplevel to have:



@@ -108,33 +111,35 @@ where menuentries is a list where each element describe one menu entry, which can be: where: Each value enclosed by ? are optional and defaulted to empty string, but must be provided if one or more following options is not empty. @@ -155,7 +160,7 @@ {command "E&xit" {} "Exit the application" {} -command Menu::exit} } "&Options" {} {} 0 { - {checkbutton "Toolbar" {} "Show/hide toolbar" {} + {checkbutton "Toolbar" {} "Show/hide toolbar" {} -variable Menu::_drawtoolbar -command {$Menu::_mainframe showtoolbar toolbar $Menu::_drawtoolbar} } diff -Nru bwidget-1.9.6/ChangeLog bwidget-1.9.7/ChangeLog --- bwidget-1.9.6/ChangeLog 2012-07-27 11:36:04.000000000 +0000 +++ bwidget-1.9.7/ChangeLog 2013-09-15 17:42:06.000000000 +0000 @@ -1,3 +1,62 @@ +2013-09-15 Harald Oehlmann + + **** BWidget 1.9.7 tagged **** + +2013-09-11 Harald Oehlmann + + xpm2image.tcl: many issues fixed in xpm import + by Mattias Hembruch. Ticket [9a8b2ee42e] + +2013-08-14 Harald Oehlmann + + * notebook.tcl: cured error in _resize, that + data($p,width) is not (jet) present. Ticket [a4cbba655d]. + +2013-06-28 Harald Oehlmann + + * mainframe.tcl: Included Patch [9f67a66609] + curing issues of Shift-Accellerators with Shift-Lock + on Mac. By Keith Nash, Ticket [83ce3e84e7]. + +2013-06-26 Harald Oehlmann + + * mainframe.tcl: Reverted Patch [1977644] + (-casesensitive for accellerators). It has + issues with shift-lock. + +2013-06-21 Harald Oehlmann + + * labelentry.tcl: Bug fixed: + Methods from Tk entry widget restored [Bug 1002844]. + + * mainframe.tcl: Allow case sensitive accelerators + by new option -casesensitive. + Patch by cmard [Patch 1977644] + + * mainframe.tcl: Allow new modifiers Shift, Cmd and ShiftCmd + for accelerators. Patch by K.J.Nash [Patch-83ce3e84e7] + + * mainframe.tcl: When changing MainFrame -background, do + not change menu colors on Aqua. + Fix by Keith J.Nash [Bug-a81b7afc1e] + + * init.tcl: Make loadable in save interpreter. + Fix by Keith J.Nash [Bug-4365a23bd3] + + * combobox.tcl: Add method getentry to return entry + widget path for bind purposes. + Patch by Michael [Patch-2340355] + +2013-01-09 Harald Oehlmann + + * widget.tcl: Bug fixed: + Error 'invalid command name ".#BWidget.#ttk::entry"' + arises in themed mode when an Entry widget should get + focus by the tab key. + The temporary widget creation fails due to the "::" in + the command name of ttk widgets. + Any "::" is replaced by "__" [Bug 3599955]. + 2011-07-27 Harald Oehlmann **** BWidget 1.9.6 tagged **** diff -Nru bwidget-1.9.6/combobox.tcl bwidget-1.9.7/combobox.tcl --- bwidget-1.9.6/combobox.tcl 2012-04-02 09:53:41.000000000 +0000 +++ bwidget-1.9.7/combobox.tcl 2013-09-15 17:42:06.000000000 +0000 @@ -10,6 +10,7 @@ # - ComboBox::setvalue # - ComboBox::getvalue # - ComboBox::clearvalue +# - ComboBox::getentrypath # - ComboBox::_create_popup # - ComboBox::_mapliste # - ComboBox::_unmapliste @@ -451,6 +452,13 @@ } # ---------------------------------------------------------------------------- +# Command ComboBox::getentry +# ---------------------------------------------------------------------------- +proc ComboBox::getentry { path } { + return $path.e +} + +# ---------------------------------------------------------------------------- # Command ComboBox::_create_popup # ---------------------------------------------------------------------------- proc ComboBox::_create_popup { path } { diff -Nru bwidget-1.9.6/debian/changelog bwidget-1.9.7/debian/changelog --- bwidget-1.9.6/debian/changelog 2013-05-05 07:38:08.000000000 +0000 +++ bwidget-1.9.7/debian/changelog 2013-09-23 06:21:53.000000000 +0000 @@ -1,3 +1,11 @@ +bwidget (1.9.7-1) unstable; urgency=low + + * New upstream release. + * Removed unnecessary build dependency on quilt. + * Use debian/install files list instead of copying files in debian/rules. + + -- Sergei Golovan Mon, 23 Sep 2013 10:20:06 +0400 + bwidget (1.9.6-2) unstable; urgency=low * Build for unstable. diff -Nru bwidget-1.9.6/debian/control bwidget-1.9.7/debian/control --- bwidget-1.9.6/debian/control 2013-05-05 07:38:08.000000000 +0000 +++ bwidget-1.9.7/debian/control 2013-09-23 06:21:53.000000000 +0000 @@ -3,7 +3,7 @@ Priority: optional Maintainer: Debian Tcl/Tk Packagers Uploaders: Sergei Golovan -Build-Depends: debhelper (>= 8.0.0), quilt +Build-Depends: debhelper (>= 8.0.0) Build-Depends-Indep: tcl-dev Standards-Version: 3.9.4 Homepage: http://sourceforge.net/projects/tcllib/ diff -Nru bwidget-1.9.6/debian/examples bwidget-1.9.7/debian/examples --- bwidget-1.9.6/debian/examples 2013-05-05 07:33:04.000000000 +0000 +++ bwidget-1.9.7/debian/examples 2013-09-23 06:21:53.000000000 +0000 @@ -1,2 +1 @@ -demo/*.tcl -demo/*.xbm +demo/* diff -Nru bwidget-1.9.6/debian/install bwidget-1.9.7/debian/install --- bwidget-1.9.6/debian/install 1970-01-01 00:00:00.000000000 +0000 +++ bwidget-1.9.7/debian/install 2013-09-23 06:21:53.000000000 +0000 @@ -0,0 +1,4 @@ +*.tcl /usr/share/tcltk/bwidget1.9.7 +images /usr/share/tcltk/bwidget1.9.7 +lang /usr/share/tcltk/bwidget1.9.7 +BWman/* /usr/share/doc/bwidget/html diff -Nru bwidget-1.9.6/debian/rules bwidget-1.9.7/debian/rules --- bwidget-1.9.6/debian/rules 2013-05-05 07:38:08.000000000 +0000 +++ bwidget-1.9.7/debian/rules 2013-09-23 06:21:53.000000000 +0000 @@ -1,18 +1,10 @@ #!/usr/bin/make -f -v = 1.9.6 +v = 1.9.7 %: dh $@ -override_dh_auto_install: - # $(MAKE) install prefix=`pwd`/debian/bwidget/usr \ - # HTMLDIR=`pwd`/debian/bwidget/usr/share/doc/bwidget/html - mkdir debian/bwidget/usr/share/tcltk/bwidget$(v) - cp -R *.tcl lang images debian/bwidget/usr/share/tcltk/bwidget$(v) - rm -rf debian/bwidget/usr/share/tcltk/bwidget$(v)/images/CVS - cp BWman/* debian/bwidget/usr/share/doc/bwidget/html - override_dh_compress: dh_compress -X.tcl -X.xbm @@ -20,8 +12,12 @@ tcltk-depends dh_installdeb +override_dh_fixperms: + chmod a-x debian/bwidget/usr/share/tcltk/bwidget$(v)/lang/* + dh_fixperms + get-orig-source: wget -O bwidget_$(v).orig.tar.gz \ http://prdownloads.sourceforge.net/tcllib/bwidget-$(v).tar.gz -.PHONY: override_dh_auto_install override_dh_compress override_dh_installdeb get-orig-source +.PHONY: override_dh_compress override_dh_installdeb override_dh_fixperms get-orig-source diff -Nru bwidget-1.9.6/init.tcl bwidget-1.9.7/init.tcl --- bwidget-1.9.6/init.tcl 2010-08-04 14:35:54.000000000 +0000 +++ bwidget-1.9.7/init.tcl 2013-09-15 17:42:06.000000000 +0000 @@ -31,17 +31,18 @@ # Try to load lang file corresponding to current msgcat locale proc Widget::_opt_lang {} { - set langfile [file join $::BWIDGET::LIBRARY "lang" "en.rc"] if {0 != [llength [info commands ::msgcat::mcpreferences]]} { - foreach lang [::msgcat::mcpreferences] { - set l [file join $::BWIDGET::LIBRARY "lang" "$lang.rc"] - if {[file readable $l]} { - set langfile $l - break - } + set langs [::msgcat::mcpreferences] + } + lappend langs en + + foreach lang $langs { + set l [file join $::BWIDGET::LIBRARY "lang" "$lang.rc"] + if {(![catch {file readable $l} result]) && ($result)} { + option read $l + break } } - option read $langfile } Widget::_opt_lang diff -Nru bwidget-1.9.6/labelentry.tcl bwidget-1.9.7/labelentry.tcl --- bwidget-1.9.6/labelentry.tcl 2011-02-14 16:56:09.000000000 +0000 +++ bwidget-1.9.7/labelentry.tcl 2013-09-15 17:42:06.000000000 +0000 @@ -58,7 +58,10 @@ bindtags $path [list $path BwLabelEntry [winfo toplevel $path] all] - return [Widget::create LabelEntry $path] + Widget::create LabelEntry $path + proc ::$path { cmd args } \ + "return \[LabelEntry::_path_command [list $path] \$cmd \$args\]" + return $path } diff -Nru bwidget-1.9.6/mainframe.tcl bwidget-1.9.7/mainframe.tcl --- bwidget-1.9.6/mainframe.tcl 2011-05-25 15:10:07.000000000 +0000 +++ bwidget-1.9.7/mainframe.tcl 2013-09-15 17:42:06.000000000 +0000 @@ -38,13 +38,13 @@ } Widget::declare MainFrame { - {-width TkResource 0 0 frame} - {-height TkResource 0 0 frame} - {-background TkResource "" 0 frame} - {-textvariable String "" 0} - {-menu String {} 1} - {-separator Enum both 1 {none top bottom both}} - {-bg Synonym -background} + {-width TkResource 0 0 frame} + {-height TkResource 0 0 frame} + {-background TkResource "" 0 frame} + {-textvariable String "" 0} + {-menu String {} 1} + {-separator Enum both 1 {none top bottom both}} + {-bg Synonym -background} {-menubarfont String "" 0} {-menuentryfont String "" 0} @@ -203,7 +203,8 @@ # The ttk frame has no -background if {![Widget::theme] && [Widget::hasChanged $path -background bg] } { - if {$::tcl_platform(platform) == "unix"} { + if {($::tcl_platform(platform) == "unix") + && (0 != [string compare [tk windowingsystem] "aqua"])} { set listmenu [$_widget($path,top) cget -menu] while { [llength $listmenu] } { set newlist {} @@ -627,7 +628,16 @@ set accel [_parse_accelerator [lindex $entry 4]] if { [llength $accel] } { lappend opt -accelerator [lindex $accel 0] - bind $_widget($path,top) [lindex $accel 1] [list $menu invoke $count] + foreach event [lindex $accel 1] { + bind $_widget($path,top) $event [list $menu invoke $count] + } + foreach event [lindex $accel 2] { + if {[bind $_widget($path,top) $event] == {}} { + bind $_widget($path,top) $event { # do nothing } + } else { + # The existing binding will intercept these events. + } + } } # user options @@ -663,25 +673,39 @@ # MainFrame::_parse_accelerator -- # # Given a key combo description, construct an appropriate human readable -# string (for display on as a menu accelerator) and the corresponding -# bind event. +# string (for display on as a menu accelerator), a list of the +# corresponding bind events, and a separate list of bind events that need +# to be blocked. +# +# When argument $desc does not include "Shift", the bindings to $events +# will in some cases also intercept events that have the modifier "Shift", +# unless more specific bindings $blockEvents exist to the latter. This +# situation occurs, for example, when a Cmd binding exists without a +# corresponding ShiftCmd binding. The list of events that need to be +# blocked is returned as the third element of the result. # # Arguments: # desc a list with the following format: # ?sequence? key -# sequence may be None, Ctrl, Alt, or CtrlAlt +# sequence may be None, Ctrl, Alt, CtrlAlt, Shift, Cmd or +# ShiftCmd # key may be any key # # Results: -# {accel event} a list containing the accelerator string and the event +# {accel events blockEvents} a list containing the accelerator string and +# two lists of events proc MainFrame::_parse_accelerator { desc } { + variable _widget + + set fKey 0 if { [llength $desc] == 1 } { set seq None set key [string tolower [lindex $desc 0]] # If the key is an F key (ie, F1, F2, etc), it has to be capitalized if {[regexp {^f([1-9]|([12][0-9]|3[0-5]))$} $key]} { set key [string toupper $key] + set fKey 1 } } elseif { [llength $desc] == 2 } { set seq [lindex $desc 0] @@ -689,30 +713,94 @@ # If the key is an F key (ie, F1, F2, etc), it has to be capitalized if {[regexp {^f([1-9]|([12][0-9]|3[0-5]))$} $key]} { set key [string toupper $key] + set fKey 1 } } else { return {} } + + # Plain "Shift" can be used only with F keys, but "ShiftCmd" is allowed. + if {[string equal $seq "Shift"] && (!$fKey)} { + return -code error {Shift accelerator can be used only with F keys} + } + + set blockEvents {} + set upc [string toupper $key] + switch -- $seq { None { - set accel "[string toupper $key]" - set event "" + set accel "$upc" + set events [list ""] + if {$fKey} { + set blockEvents [list ""] + } + } + Shift { + # Used only with Function keys. + set accel "Shift+$upc" + set events [list ""] + } + Cmd { + set accel "Cmd+$upc" + + if { [string equal [tk windowingsystem] "aqua"] && + ([string first AppKit [winfo server .]] == -1) + } { + # Carbon + set events [list "" \ + "" ] + set blockEvents [list ""] + # Both bindings must be included in $events - the first binding + # does not fire if "Lock" is set, and this is as bind(n) states + # because the second binding is NOT a more specialized form of + # the first. + } else { + # Cocoa and anything else that uses Cmd + set events [list ""] + # A binding to "" must not be included + # here - both events fire if "Lock" is set. + set blockEvents [list ""] + } + } + ShiftCmd { + if { [string equal [tk windowingsystem] "aqua"] && + ([string first AppKit [winfo server .]] == -1) + } { + # Carbon + set accel "Shift+Cmd+$upc" + set events [list "" \ + ""] + # Both bindings must be included here - the first binding does + # not fire if "Lock" is set, even though the second binding + # should be recognized as a more specialized form of the first. + } else { + # Cocoa and anything else that uses Cmd + set accel "Shift+Cmd+$upc" + set events [list ""] + # A binding to "" must not be + # included here - both events fire if "Lock" is set. + # Tk/Cocoa fails to recognize + # as a "more specialized" binding + # than . + # Perversely, Tk/Carbon (above) makes the opposite error. + } } Ctrl { - set accel "Ctrl+[string toupper $key]" - set event "" + set accel "Ctrl+$upc" + set events [list ""] } Alt { - set accel "Alt+[string toupper $key]" - set event "" + set accel "Alt+$upc" + set events [list ""] } CtrlAlt { - set accel "Ctrl+Alt+[string toupper $key]" - set event "" + set accel "Ctrl+Alt+$upc" + set events [list ""] } default { return -code error "invalid accelerator code $seq" } } - return [list $accel $event] + + return [list $accel $events $blockEvents] } diff -Nru bwidget-1.9.6/notebook.tcl bwidget-1.9.7/notebook.tcl --- bwidget-1.9.6/notebook.tcl 2011-04-26 14:13:24.000000000 +0000 +++ bwidget-1.9.7/notebook.tcl 2013-09-15 17:42:06.000000000 +0000 @@ -1107,12 +1107,22 @@ variable $path upvar 0 $path data + # Check if pages are fully initialized or if we are still initializing + if { 0 < [llength $data(pages)] && + ![info exists data([lindex $data(pages) end],width)] } { + return + } + if {!$data(realized)} { - if { [set width [Widget::cget $path -width]] == 0 || - [set height [Widget::cget $path -height]] == 0 } { + set data(realized) 1 + if { [Widget::cget $path -width] == 0 || + [Widget::cget $path -height] == 0 } { + # This does an update allowing other events (resize) to enter + # In addition, it does a redraw, so first set the realized and + # then exit compute_size $path + return } - set data(realized) 1 } NoteBook::_redraw $path diff -Nru bwidget-1.9.6/pkgIndex.tcl bwidget-1.9.7/pkgIndex.tcl --- bwidget-1.9.6/pkgIndex.tcl 2012-07-27 11:43:26.000000000 +0000 +++ bwidget-1.9.7/pkgIndex.tcl 2013-09-15 17:42:06.000000000 +0000 @@ -1,7 +1,7 @@ if {[catch {package require Tcl}]} return -package ifneeded BWidget 1.9.6 "\ +package ifneeded BWidget 1.9.7 "\ package require Tk 8.1.1;\ - [list tclPkgSetup $dir BWidget 1.9.6 { + [list tclPkgSetup $dir BWidget 1.9.7 { {arrow.tcl source {ArrowButton ArrowButton::create ArrowButton::use}} {labelframe.tcl source {LabelFrame LabelFrame::create LabelFrame::use}} {labelentry.tcl source {LabelEntry LabelEntry::create LabelEntry::use}} @@ -35,7 +35,6 @@ {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}} }]; \ diff -Nru bwidget-1.9.6/widget.tcl bwidget-1.9.7/widget.tcl --- bwidget-1.9.6/widget.tcl 2011-11-14 14:33:29.000000000 +0000 +++ bwidget-1.9.7/widget.tcl 2013-09-15 17:42:06.000000000 +0000 @@ -1100,6 +1100,19 @@ return [list $optdb $optclass] } +# ---------------------------------------------------------------------------- +# Command Widget::_make_tk_widget_name +# ---------------------------------------------------------------------------- +# Before, the widget meta name was build as: ".#BWidget.#$tkwidget" +# This does not work for ttk widgets, as they have an "::" in their name. +# Thus replace any "::" by "__" will do the job. +proc Widget::_make_tk_widget_name { tkwidget } { + set pos 0 + for {set pos 0} {0 <= [set pos [string first "::" $tkwidget $pos]]} {incr pos} { + set tkwidget [string range $tkwidget 0 [expr {$pos-1}]]__[string range $tkwidget [expr {$pos+2}] end] + } + return ".#BWidget.#$tkwidget" +} # ---------------------------------------------------------------------------- # Command Widget::_get_tkwidget_options @@ -1109,7 +1122,7 @@ variable _optiondb variable _optionclass - set widget ".#BWidget.#$tkwidget" + set widget [_make_tk_widget_name $tkwidget] # encapsulation frame to not pollute '.' childspace if {![winfo exists ".#BWidget"]} { frame ".#BWidget" } if { ![winfo exists $widget] || ![info exists _tk_widget($tkwidget)] } { @@ -1162,7 +1175,7 @@ # set tkwidget [lindex $arg 0] # set realopt [lindex $arg 1] foreach {tkwidget realopt} $arg break - set path ".#BWidget.#$tkwidget" + set path [_make_tk_widget_name $tkwidget] set old [$path cget $realopt] $path configure $realopt $value set res [$path cget $realopt] diff -Nru bwidget-1.9.6/xpm2image.tcl bwidget-1.9.7/xpm2image.tcl --- bwidget-1.9.6/xpm2image.tcl 2004-09-09 22:17:03.000000000 +0000 +++ bwidget-1.9.7/xpm2image.tcl 2013-09-15 17:42:06.000000000 +0000 @@ -10,16 +10,87 @@ # # ---------------------------------------------------------------------------- +proc _xpm-to-image_process_line { line } { + upvar 1 data data + set line [string map {"\t" " "} $line] + + set idx $data(chars_per_pixel) + incr idx -1 + set cname [string range $line 0 $idx] + + + set lend [string trim [string range $line $data(chars_per_pixel) end]] + + ## now replace multiple spaces with just one.. + while {-1 != [string first " " $lend]} { + set lend [string map {" " " "} $lend] + } + set cl [split $lend " "] + + set idx 0 + set clen [llength $cl] + + ## scan through the line, looking for records of type c, g or m + while { $idx < $clen } { + set key [lindex $cl $idx] + if { [string equal $key {}] } { + incr idx + continue + } + + while { ![string equal $key "c"] + && ![string equal $key "m"] + && ![string equal $key "g"] + && ![string equal $key "g4"] + && ![string equal $key ""] + } { + incr idx + set key [lindex $cl $idx] + } + + incr idx + set color [string tolower [lindex $cl $idx]] + + ## one file used opaque to mean black + if { [string equal -nocase $color "opaque"] } { + set color "black" + } + set data(color-$key-$cname) $color + if { [string equal -nocase $color "none"] } { + set data(transparent) $cname + } + incr idx + } + + + foreach key {c g g4 m} { + if {[info exists data(color-$key-$cname)]} { + set color $data(color-$key-$cname) + set data(color-$cname) $color + set data(cname-$color) $cname + lappend data(colors) $color + break + } + } + if { ![info exists data(color-$cname)] } { + error "color definition {$line} failed to define a color" + } +} + proc xpm-to-image { file } { set f [open $file] set string [read $f] close $f - # # parse the strings in the xpm data # set xpm {} foreach line [split $string "\n"] { + ## some files have blank lines in them, skip those + ## also, some files indent each line with spaces - remove those + set line [string trim $line] + if { $line eq "" } { continue } + if {[regexp {^"([^\"]*)"} $line all meat]} { if {[string first XPMEXT $meat] == 0} { break @@ -51,32 +122,7 @@ # extract the color definitions in the xpm data # foreach line [lrange $xpm 1 $data(ncolors)] { - set colors [split $line \t] - set cname [lindex $colors 0] - lappend data(cnames) $cname - if { [string length $cname] != $data(chars_per_pixel) } { - error "color definition {$line} in file $file has a bad size color name" - } - foreach record [lrange $colors 1 end] { - set key [lindex $record 0] - set color [string tolower [join [lrange $record 1 end] { }]] - set data(color-$key-$cname) $color - if { [string equal -nocase $color "none"] } { - set data(transparent) $cname - } - } - foreach key {c g g4 m} { - if {[info exists data(color-$key-$cname)]} { - set color $data(color-$key-$cname) - set data(color-$cname) $color - set data(cname-$color) $cname - lappend data(colors) $color - break - } - } - if { ![info exists data(color-$cname)] } { - error "color definition {$line} in $file failed to define a color" - } + _xpm-to-image_process_line $line } # @@ -84,11 +130,25 @@ # set image [image create photo -width $data(width) -height $data(height)] set y 0 + set idx 0 foreach line [lrange $xpm [expr {1+$data(ncolors)}] [expr {1+$data(ncolors)+$data(height)}]] { set x 0 set pixels {} while { [string length $line] > 0 } { set pixel [string range $line 0 [expr {$data(chars_per_pixel)-1}]] + ## see if they lied about the number of colors by not counting + ## "none" in the color count entry + set none 0 + if { ($idx == 0) && ([info exists data(cname-none)]) && \ + ![info exists data(color-$pixel)] } { + ## it appears that way - process this line as another + ## color entry + _xpm-to-image_process_line $line + incr idx + set none 1 + break; + } + incr idx set c $data(color-$pixel) if { [string equal $c none] } { if { [string length $pixels] } { @@ -101,6 +161,9 @@ set line [string range $line $data(chars_per_pixel) end] incr x } + if { $none == 1 } { + continue + } if { [llength $pixels] } { $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y } @@ -112,4 +175,3 @@ # return $image } -