Attachment "tklib-w24.patch.new" to
ticket [3007168fff]
added by
andreas_kupries
2010-07-08 03:39:56.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tklib/modules/ico/ChangeLog,v
retrieving revision 1.28
diff -w -u -r1.28 ChangeLog
--- ChangeLog 13 Oct 2009 06:42:02 -0000 1.28
+++ ChangeLog 7 Jul 2010 20:38:09 -0000
@@ -1,6 +1,13 @@
+2010-07-07 Andreas Kupries <[email protected]>
+
+ * ico.tcl: [Bug 3007168]: Fixed padding used for 24x24 icons.
+ * ico.man: Further allowing writeIcon to create missing files.
+ * pkgIndex.tcl: Bumped version to 1.0.5.
+
2009-10-12 Aaron Faupell <[email protected]>
- * ico.tcl fix error messages to be more clear and refactor fileext into gettype in the process
+ * ico.tcl fix error messages to be more clear and refactor fileext
+ into gettype in the process.
2009-05-21 Andreas Kupries <[email protected]>
Index: ico.man
===================================================================
RCS file: /cvsroot/tcllib/tklib/modules/ico/ico.man,v
retrieving revision 1.19
diff -w -u -r1.19 ico.man
--- ico.man 21 May 2009 16:32:24 -0000 1.19
+++ ico.man 7 Jul 2010 20:38:09 -0000
@@ -1,9 +1,9 @@
[comment {-*- tcl -*- doctools manpage}]
-[manpage_begin ico n 1.0.4]
+[manpage_begin ico n 1.0.5]
[moddesc {Windows ICO handling}]
[titledesc {Reading and writing windows icons}]
[require Tcl 8.4]
-[require ico [opt 1.0.4]]
+[require ico [opt 1.0.5]]
[description]
This package provides functions for reading and writing Windows icons
Index: ico.tcl
===================================================================
RCS file: /cvsroot/tcllib/tklib/modules/ico/ico.tcl,v
retrieving revision 1.30
diff -w -u -r1.30 ico.tcl
--- ico.tcl 13 Oct 2009 06:42:02 -0000 1.30
+++ ico.tcl 7 Jul 2010 20:38:09 -0000
@@ -272,9 +272,10 @@
#
proc ::ico::writeIcon {file name bpp data args} {
parseOpts type $args
- if {![file exists $file]} {
- return -code error "couldn't open \"$file\": no such file or directory"
- }
+ # Bug 3007168 (code is able to create a file if none is present)
+ #if {![file exists $file]} {
+ # return -code error "couldn't open \"$file\": no such file or directory"
+ #}
gettype type $file
if {![llength [info commands writeIcon$type]]} {
return -code error "unsupported file format $type"
@@ -651,7 +652,8 @@
foreach line $colors {
set l {}
foreach x $line {append l [expr {$x eq ""}]}
- append l [string repeat 0 [expr {[string length $l] % 32}]]
+ set w [string length $l]
+ append l [string repeat 0 [expr {($w == 24) ? 8 : ($w % 32)}]]
foreach {a b c d e f g h} [split $l {}] {
append and [binary format B8 $a$b$c$d$e$f$g$h]
}
@@ -770,8 +772,8 @@
# calculate byte size of an icon.
# often passed $w twice because $h is double $w in the binary data
proc ::ico::calcSize {w h bpp {offset 0}} {
- set s [expr {int(($w*$h) * ($bpp/8.0)) \
- + ((($w*$h) + ($h*($w%32)))/8) + $offset}]
+ set s [expr {int(($w*$h) * ($bpp/8.0)) +
+ ((($w*$h) + ($h*(($w==24) ? 8 : ($w%32))))/8) + $offset}]
if {$bpp <= 8} { set s [expr {$s + (1 << ($bpp + 2))}] }
return $s
}
@@ -796,7 +798,7 @@
}
set xor [read $fh [expr {int(($w * $h) * ($bpp / 8.0))}]]
- set and1 [read $fh [expr {(($w * $h) + ($h * ($w % 32))) / 8}]]
+ set and1 [read $fh [expr {(($w * $h) + ($h * (($w == 24) ? 8 : ($w % 32)))) / 8}]]
set and {}
set row [expr {((($w - 1) / 32) * 32 + 32) / 8}]
@@ -838,7 +840,7 @@
set end [expr {$cnt + int(($w * $h) * ($bpp / 8.0)) - 1}]
set xor [string range $data $cnt $end]
set and1 [string range $data [expr {$end + 1}] \
- [expr {$end + ((($w * $h) + ($h * ($w % 32))) / 8) - 1}]]
+ [expr {$end + ((($w * $h) + ($h * (($w == 24) ? 8 : ($w % 32)))) / 8) - 1}]]
set and {}
set row [expr {((($w - 1) / 32) * 32 + 32) / 8}]
@@ -1395,4 +1397,4 @@
interp alias {} ::ico::getRawIconDataICL {} ::ico::getRawIconDataEXE
interp alias {} ::ico::writeIconICL {} ::ico::writeIconEXE
-package provide ico 1.0.4
+package provide ico 1.0.5
Index: pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tklib/modules/ico/pkgIndex.tcl,v
retrieving revision 1.9
diff -w -u -r1.9 pkgIndex.tcl
--- pkgIndex.tcl 21 May 2009 16:32:24 -0000 1.9
+++ pkgIndex.tcl 7 Jul 2010 20:38:09 -0000
@@ -6,4 +6,4 @@
# RCS: @(#) $Id: pkgIndex.tcl,v 1.9 2009/05/21 16:32:24 andreas_kupries Exp $
package ifneeded ico 0.3.1 [list source [file join $dir ico0.tcl]]
-package ifneeded ico 1.0.4 [list source [file join $dir ico.tcl]]
+package ifneeded ico 1.0.5 [list source [file join $dir ico.tcl]]
