From 970a72bb92857f54d7fedccfad37d2a5b03c5e4f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 May 2020 20:41:13 +0000 Subject: A different approach to glyph indexing --- library/entry.tcl | 26 +++++++++++++++++++++----- library/text.tcl | 6 +++--- library/tk.tcl | 29 +++++++++++++++++++++++++++++ library/ttk/entry.tcl | 25 +++++++++++++++++++++++-- 4 files changed, 76 insertions(+), 10 deletions(-) diff --git a/library/entry.tcl b/library/entry.tcl index 02384da..a750b34 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -119,17 +119,17 @@ bind Entry { } bind Entry <> { - tk::EntrySetCursor %W [expr {[%W index insert] - 1}] + tk::EntrySetCursor %W [tk::EntryPreviousChar %W insert] } bind Entry <> { - tk::EntrySetCursor %W [expr {[%W index insert] + 1}] + tk::EntrySetCursor %W [tk::EntryNextChar %W insert] } bind Entry <> { - tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + tk::EntryKeySelect %W [tk::EntryPreviousChar %W insert] tk::EntrySeeInsert %W } bind Entry <> { - tk::EntryKeySelect %W [expr {[%W index insert] + 1}] + tk::EntryKeySelect %W [tk::EntryNextChar %W insert] tk::EntrySeeInsert %W } bind Entry <> { @@ -518,7 +518,7 @@ proc ::tk::EntryBackspace w { if {[$w selection present]} { $w delete sel.first sel.last } else { - set x [expr {[$w index insert] - 1}] + set x [tcl_startOfChar [$w get] [$w index insert]] if {$x >= 0} { $w delete $x } @@ -634,6 +634,22 @@ proc ::tk::EntryPreviousWord {w start} { return $pos } +proc ::tk::EntryNextChar {w start} { + set pos [tcl_endOfChar [$w get] [expr {[$w index $start]+1}]] + if {$pos < 0} { + return end + } + return $pos +} + +proc ::tk::EntryPreviousChar {w start} { + set pos [tcl_startOfChar [$w get] [expr {[$w index $start]-1}]] + if {$pos < 0} { + return 0 + } + return $pos +} + # ::tk::EntryScanMark -- # # Marks the start of a possible scan drag operation diff --git a/library/text.tcl b/library/text.tcl index 28c6c20..d5598f1 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -99,10 +99,10 @@ bind Text { # nothing } # stop an accidental movement triggering bind Text { # nothing } bind Text <> { - tk::TextSetCursor %W insert-1displayindices + tk::TextSetCursor %W [tk::TextPrevPos %W {insert-1displayindices} tcl_startOfChar] } bind Text <> { - tk::TextSetCursor %W insert+1displayindices + tk::TextSetCursor %W [tk::TextNextPos %W {insert+1displayindices} tcl_endOfChar] } bind Text <> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] @@ -114,7 +114,7 @@ bind Text <> { tk::TextKeySelect %W [%W index {insert - 1displayindices}] } bind Text <> { - tk::TextKeySelect %W [%W index {insert + 1displayindices}] + tk::TextKeySelect %W [tk::TextNextPos %W {insert + 1displayindices} tcl_endOfChar] } bind Text <> { tk::TextKeySelect %W [tk::TextUpDownLine %W -1] diff --git a/library/tk.tcl b/library/tk.tcl index 311d316..9711e7a 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -694,6 +694,35 @@ if {[tk windowingsystem] eq "aqua"} { } } +proc tcl_endOfChar {str start} { + if {$start >= [string length $str]} { + return -1; + } + if {[string length [string index $str $start]] > 1} { + set start [expr {$start+1}] + } + if {[string index $str $start] eq {^}} { + set start [expr {$start+1}] + } + return $start +} + +proc tcl_startOfChar {str start} { + if {$start eq "end"} { + set start [expr {[string length $str]-1}] + } + if {$start < 1} { + return 0; + } + if {[string index $str $start] eq {^}} { + set start [expr {$start-1}] + } + if {[string length [string index $str $start-1]] > 1} { + return [expr {$start-1}] + } + return $start +} + # Create a dictionary to store the starting index of the IME marked # text in an Entry or Text widget. diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 4cdb5ac..1d7b2fb 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -274,12 +274,33 @@ proc ttk::entry::PrevWord {w start} { return $pos } +## NextChar -- Find the next char position. +# +proc ttk::entry::NextChar {w start} { + variable State + set pos [tcl_endOfChar [$w get] [expr {[$w index $start]+1}]] + if {$pos < 0} { + return end + } + return $pos +} + +## PrevChar -- Find the previous word position. +# +proc ttk::entry::PrevChar {w start} { + set pos [tcl_startOfChar [$w get] [expr {[$w index $start]-1}]] + if {$pos < 0} { + return 0 + } + return $pos +} + ## RelIndex -- Compute character/word/line-relative index. # proc ttk::entry::RelIndex {w where {index insert}} { switch -- $where { - prevchar { expr {[$w index $index] - 1} } - nextchar { expr {[$w index $index] + 1} } + prevchar { PrevChar $w $index } + nextchar { NextChar $w $index } prevword { PrevWord $w $index } nextword { NextWord $w $index } home { return 0 } -- cgit v0.12 From 53c3528bef55541b6033d2c2e77ba804a0a80141 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 27 May 2020 13:12:10 +0000 Subject: Fix "Delete" and "Backspace" for text widgets --- library/text.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index 1b6fe70..9fb9a79 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -222,7 +222,7 @@ bind Text { %W delete sel.first sel.last } else { if {[%W compare end != insert+1c]} { - %W delete [tk::TextPrevPos %W insert+1c ::tk::startOfGlyphCluster] [expr {[tk::TextNextPos %W insert ::tk::endOfGlyphCluster]+1}] + %W delete [tk::TextPrevPos %W insert+1c ::tk::startOfGlyphCluster] "[tk::TextNextPos %W insert ::tk::endOfGlyphCluster]+1c" } %W see insert } @@ -232,7 +232,7 @@ bind Text { %W delete sel.first sel.last } else { if {[%W compare insert != 1.0]} { - %W delete [tk::TextPrevPos %W insert ::tk::startOfGlyphCluster] [expr {[tk::TextNextPos %W insert-1c ::tk::endOfGlyphCluster]+1}] + %W delete [tk::TextPrevPos %W insert ::tk::startOfGlyphCluster] "[tk::TextNextPos %W insert-1c ::tk::endOfGlyphCluster]+1c" } %W see insert } -- cgit v0.12 From a49d6e52a72b1f086503ae32cb28b0da62e5fa99 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 May 2020 13:26:57 +0000 Subject: Slight definition change in ::tk::endOfGlyphCluster. It now returns the index _after_ the boundary not the one before. Also, the spinbox is now fully working. --- library/entry.tcl | 8 ++++---- library/spinbox.tcl | 14 +++++++------- library/text.tcl | 6 +++--- library/tk.tcl | 1 + library/ttk/entry.tcl | 6 +++--- 5 files changed, 18 insertions(+), 17 deletions(-) diff --git a/library/entry.tcl b/library/entry.tcl index 85127fa..7a5ef2b 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -165,7 +165,7 @@ bind Entry { if {[%W selection present]} { %W delete sel.first sel.last } else { - %W delete [::tk::startOfGlyphCluster [%W get] [%W index insert]]] [expr {[::tk::endOfGlyphCluster [%W get] [%W index insert]]+1}]] + %W delete [::tk::startOfGlyphCluster [%W get] [%W index insert]] [::tk::endOfGlyphCluster [%W get] [%W index insert]] } } bind Entry { @@ -520,7 +520,7 @@ proc ::tk::EntryBackspace w { } else { set x [expr {[$w index insert] - 1}] if {$x >= 0} { - $w delete [::tk::startOfGlyphCluster [$w get] $x] [expr {[::tk::endOfGlyphCluster [$w get] $x]+1}] + $w delete [::tk::startOfGlyphCluster [$w get] $x] [::tk::endOfGlyphCluster [$w get] $x] } if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -635,7 +635,7 @@ proc ::tk::EntryPreviousWord {w start} { } proc ::tk::EntryNextChar {w start} { - set pos [::tk::endOfGlyphCluster [$w get] [expr {[$w index $start]+1}]] + set pos [::tk::endOfGlyphCluster [$w get] [$w index $start]] if {$pos < 0} { return end } @@ -651,7 +651,7 @@ proc ::tk::EntryPreviousChar {w start} { } proc ::tk::EntryInsertChar {w start} { - set pos [::tk::endOfGlyphCluster [$w get] [expr {[$w index $start]+1}]] + set pos [::tk::endOfGlyphCluster [$w get] [$w index $start]] if {$pos < 0} { return end } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 909405e..15330e9 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -129,18 +129,18 @@ bind Spinbox <> { } bind Spinbox <> { - ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] + tk::EntrySetCursor %W [tk::EntryPreviousChar %W insert] } bind Spinbox <> { - ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] + tk::EntrySetCursor %W [tk::EntryNextChar %W insert] } bind Spinbox <> { - ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] - ::tk::EntrySeeInsert %W + tk::EntryKeySelect %W [tk::EntryPreviousChar %W insert] + tk::EntrySeeInsert %W } bind Spinbox <> { - ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}] - ::tk::EntrySeeInsert %W + tk::EntryKeySelect %W [tk::EntryNextChar %W insert] + tk::EntrySeeInsert %W } bind Spinbox <> { ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] @@ -175,7 +175,7 @@ bind Spinbox { if {[%W selection present]} { %W delete sel.first sel.last } else { - %W delete insert + %W delete [::tk::startOfGlyphCluster [%W get] [%W index insert]] [::tk::endOfGlyphCluster [%W get] [%W index insert]] } } bind Spinbox { diff --git a/library/text.tcl b/library/text.tcl index 9fb9a79..1c84b40 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -102,7 +102,7 @@ bind Text <> { tk::TextSetCursor %W [tk::TextPrevPos %W insert ::tk::startOfGlyphCluster] } bind Text <> { - tk::TextSetCursor %W [tk::TextNextPos %W insert+1c ::tk::endOfGlyphCluster] + tk::TextSetCursor %W [tk::TextNextPos %W insert ::tk::endOfGlyphCluster] } bind Text <> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] @@ -222,7 +222,7 @@ bind Text { %W delete sel.first sel.last } else { if {[%W compare end != insert+1c]} { - %W delete [tk::TextPrevPos %W insert+1c ::tk::startOfGlyphCluster] "[tk::TextNextPos %W insert ::tk::endOfGlyphCluster]+1c" + %W delete [tk::TextPrevPos %W insert+1c ::tk::startOfGlyphCluster] [tk::TextNextPos %W insert ::tk::endOfGlyphCluster] } %W see insert } @@ -232,7 +232,7 @@ bind Text { %W delete sel.first sel.last } else { if {[%W compare insert != 1.0]} { - %W delete [tk::TextPrevPos %W insert ::tk::startOfGlyphCluster] "[tk::TextNextPos %W insert-1c ::tk::endOfGlyphCluster]+1c" + %W delete [tk::TextPrevPos %W insert ::tk::startOfGlyphCluster] [tk::TextNextPos %W insert-1c ::tk::endOfGlyphCluster] } %W see insert } diff --git a/library/tk.tcl b/library/tk.tcl index 3b358ca..66b8a87 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -701,6 +701,7 @@ proc ::tk::endOfGlyphCluster {str start} { if {[string length [string index $str $start]] > 1} { set start [expr {$start+1}] } + set start [expr {$start+1}] if {[string index $str $start] eq {^}} { set start [expr {$start+1}];# For demo purposes only } diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 44a190d..6723833 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -278,7 +278,7 @@ proc ttk::entry::PrevWord {w start} { # proc ttk::entry::NextChar {w start} { variable State - set pos [::tk::endOfGlyphCluster [$w get] [expr {[$w index $start]+1}]] + set pos [::tk::endOfGlyphCluster [$w get] [$w index $start]] if {$pos < 0} { return end } @@ -631,7 +631,7 @@ proc ttk::entry::Backspace {w} { set x [expr {[$w index insert] - 1}] if {$x < 0} { return } - $w delete [::tk::startOfGlyphCluster [$w get] $x] [expr {[::tk::endOfGlyphCluster [$w get] $x]+1}] + $w delete [::tk::startOfGlyphCluster [$w get] $x] [::tk::endOfGlyphCluster [$w get] $x] if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -646,7 +646,7 @@ proc ttk::entry::Backspace {w} { # proc ttk::entry::Delete {w} { if {![PendingDelete $w]} { - $w delete [::tk::startOfGlyphCluster [$w get] [$w index insert]] [expr {[::tk::endOfGlyphCluster [$w get] [$w index insert]]+1}] + $w delete [::tk::startOfGlyphCluster [$w get] [$w index insert]] [::tk::endOfGlyphCluster [$w get] [$w index insert]] } } -- cgit v0.12 From 6a8615c1dd7f7a03cf55b1b7489caf6071c06d78 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 8 Jun 2020 14:51:24 +0000 Subject: First concept --- generic/tkObj.c | 25 ++++--------------------- tests/canvText.test | 2 +- tests/entry.test | 6 +++--- tests/listbox.test | 50 +++++++++++++++++++++++++------------------------- tests/spinbox.test | 6 +++--- 5 files changed, 36 insertions(+), 53 deletions(-) diff --git a/generic/tkObj.c b/generic/tkObj.c index 63c6db7..bf18114 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -50,7 +50,6 @@ typedef struct PixelRep { typedef struct { const Tcl_ObjType *doubleTypePtr; const Tcl_ObjType *intTypePtr; - const Tcl_ObjType *endTypePtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -112,12 +111,12 @@ typedef struct TclIntStubs { extern const struct TclIntStubs *tclIntStubsPtr; # undef Tcl_GetIntForIndex -# define Tcl_GetIntForIndex(interp, obj, max, ptr) ((tclIntStubsPtr->tclGetIntForIndex == NULL)? \ - ((int (*)(Tcl_Interp*, Tcl_Obj *, int, int*))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[645]))((interp), (obj), (max), (ptr)): \ +# define Tcl_GetIntForIndex(interp, obj, max, flags, ptr) ((tclIntStubsPtr->tclGetIntForIndex == NULL)? \ + ((int (*)(Tcl_Interp*, Tcl_Obj *, int, int, int*))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[645]))((interp), (obj), (max), (flags), (ptr)): \ tclIntStubsPtr->tclGetIntForIndex((interp), (obj), (max), (ptr))) #elif TCL_MINOR_VERSION < 7 extern int TclGetIntForIndex(Tcl_Interp*, Tcl_Obj *, int, int*); -# define Tcl_GetIntForIndex TclGetIntForIndex +# define Tcl_GetIntForIndex(interp, obj, max, flags, ptr) TclGetIntForIndex(interp, obj, max, ptr) #endif #endif @@ -184,11 +183,6 @@ GetTypeCache(void) /* Smart initialization of doubleTypePtr/intTypePtr without * hash-table lookup or creating complete Tcl_Obj's */ Tcl_Obj obj; - obj.bytes = (char *)"end"; - obj.length = 3; - obj.typePtr = NULL; - Tcl_GetIntForIndex(NULL, &obj, TCL_INDEX_NONE, (TkSizeT *)&obj.internalRep.doubleValue); - tsdPtr->endTypePtr = obj.typePtr; obj.bytes = (char *)"0.0"; obj.length = 3; obj.typePtr = NULL; @@ -228,18 +222,7 @@ TkGetIntForIndex( int lastOK, TkSizeT *indexPtr) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - - if (Tcl_GetIntForIndex(NULL, indexObj, end + lastOK, indexPtr) != TCL_OK) { - return TCL_ERROR; - } - if (indexObj->typePtr == tsdPtr->endTypePtr) { - /* check for "end", but not "end-??" or "end+??" */ - return (*indexPtr == (end + lastOK)) ? TCL_OK : TCL_ERROR; - } - if (indexObj->typePtr != tsdPtr->intTypePtr) { - /* Neither do we accept "??-??" or "??+??" */ + if (Tcl_GetIntForIndex(NULL, indexObj, end + lastOK, TCL_INDEX_ERROR, indexPtr) != TCL_OK) { return TCL_ERROR; } #if TCL_MAJOR_VERSION < 9 diff --git a/tests/canvText.test b/tests/canvText.test index 20cbff4..67f2d10 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -753,7 +753,7 @@ test canvText-14.1 {GetTextIndex procedure} -setup { list [.c index test end] [.c index test insert] \ [.c index test sel.first] [.c index test sel.last] \ [.c index test @0,0] \ - [.c index test -1] [.c index test 10] [.c index test 100] + [.c index test 0] [.c index test 10] [.c index test 100] } -cleanup { .c delete test } -result {15 12 5 8 0 0 10 15} diff --git a/tests/entry.test b/tests/entry.test index b92c894..fff16e4 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -1533,7 +1533,7 @@ test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { .e insert end "runs off the end of the window quite a bit." .e xview 0 update - .e xview -4 + .e xview 0 .e index @0 } -cleanup { destroy .e @@ -2101,7 +2101,7 @@ test entry-8.2 {DeleteChars procedure} -setup { } -body { .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde - .e delete -2 2 + .e delete 0 2 set timeout [after 500 {set $scrollInfo "timeout"}] vwait scrollInfo list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] @@ -2833,7 +2833,7 @@ test entry-13.23 {GetEntryIndex procedure} -body { .e insert 0 012345678901234567890 .e xview 4 update - .e index -10 + .e index 0 } -cleanup { destroy .e } -result {0} diff --git a/tests/listbox.test b/tests/listbox.test index 98ec96c..04e66dc 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -374,7 +374,7 @@ test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} -body { .l index active } -result 3 test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} -body { - .l activate -1 + .l activate 0 .l index active } -result {0} test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} -body { @@ -587,7 +587,7 @@ test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} -setup { } -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 - .l2 delete -3 2 + .l2 delete 0 2 .l2 get 0 end } -cleanup { destroy .l2 @@ -597,11 +597,11 @@ test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} -setup { } -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 - .l2 delete -3 -1 + .l2 delete 0 0 .l2 get 0 end } -cleanup { destroy .l2 -} -result {el0 el1 el2 el3 el4 el5 el6 el7} +} -result {el1 el2 el3 el4 el5 el6 el7} test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} -setup { destroy .l2 } -body { @@ -681,13 +681,13 @@ test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} -setup { destroy .l2 } -result {{two words} el4 el5 el6 el7} test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} -body { - .l get -1 -} -result {} + .l get 0 +} -result el0 test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} -body { - .l get -2 -1 -} -result {} + .l get 0 0 +} -result el0 test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} -body { - .l get -2 3 + .l get 0 3 } -result {el0 el1 el2 el3} test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} -body { .l get 12 end @@ -717,8 +717,8 @@ test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} -body { .l index 2 } -result 2 test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} -body { - .l index -1 -} -result {-1} + .l index 0 +} -result 0 test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} -body { .l index end } -result 18 @@ -746,7 +746,7 @@ test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} -setup { } -body { listbox .l2 .l2 insert end a b c - .l2 insert -1 x + .l2 insert 0 x .l2 get 0 end } -cleanup { destroy .l2 @@ -858,7 +858,7 @@ test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} -body { } -result {11} test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 - .l see -1 + .l see 0 .l index @0,0 } -result {0} test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} -body { @@ -896,17 +896,17 @@ test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} -body { [.l selection anchor 0; .l index anchor] } -result {5 0} test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} -body { - .l selection anchor -1 + .l selection anchor 0 .l index anchor -} -result {0} +} -result 0 test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection anchor end .l index anchor -} -result {17} +} -result 17 test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection anchor 44 .l index anchor -} -result {17} +} -result 17 test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection clear 0 end .l selection set 2 8 @@ -925,8 +925,8 @@ test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} -body { } -result {1 0 1} test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection set 0 end - .l selection includes -1 -} -result {0} + .l selection includes 0 +} -result 1 test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection clear 0 end .l selection set end @@ -2129,10 +2129,10 @@ test listbox-10.19 {GetListboxIndex procedure} -setup { pack [listbox .l] .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 update - .l index -2 + .l index 0 } -cleanup { destroy .l -} -result -1 +} -result 0 test listbox-10.20 {GetListboxIndex procedure} -setup { destroy .l } -body { @@ -2155,7 +2155,7 @@ test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} - .l yview 3 update set x [.l index @0,0] - .l yview -1 + .l yview 0 update lappend x [.l index @0,0] } -cleanup { @@ -2378,14 +2378,14 @@ test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} -bo .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end - .l select set -2 -1 + .l select set 0 0 .l curselection -} -result {} +} -result 0 test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end - .l select set -1 3 + .l select set 0 3 .l curselection } -result {0 1 2 3} test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} -body { diff --git a/tests/spinbox.test b/tests/spinbox.test index 2d03cf1..3d62303 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -1871,7 +1871,7 @@ test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { .e insert end "runs off the end of the window quite a bit." .e xview 0 update - .e xview -4 + .e xview 0 .e index @0 } -cleanup { destroy .e @@ -2386,7 +2386,7 @@ test spinbox-8.2 {DeleteChars procedure} -setup { } -body { .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde - .e delete -2 2 + .e delete 0 2 set timeout [after 500 {set $scrollInfo "timeout"}] vwait scrollInfo list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] @@ -3115,7 +3115,7 @@ test spinbox-13.23 {GetSpinboxIndex procedure} -body { .e insert 0 012345678901234567890 .e xview 4 update - .e index -10 + .e index 0 } -cleanup { destroy .e } -result {0} -- cgit v0.12 From 365218a0fd5b55d722815a7ae8afdb86bd4a19bf Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Jun 2020 07:05:36 +0000 Subject: Make it compile/run with Tcl 8.6 (again), even without strict-index modifications --- generic/tkInt.h | 4 ++ tests/canvText.test | 18 +++--- tests/entry.test | 154 ++++++++++++++++++++++++++-------------------------- tests/listbox.test | 148 +++++++++++++++++++++++++------------------------- tests/spinbox.test | 140 +++++++++++++++++++++++------------------------ 5 files changed, 234 insertions(+), 230 deletions(-) diff --git a/generic/tkInt.h b/generic/tkInt.h index ab06435..05f5eba 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -923,6 +923,10 @@ typedef struct { #ifndef TCL_INDEX_NONE # define TCL_INDEX_NONE (-1) #endif +/* See TIP #577 */ +#ifndef TCL_INDEX_ERROR +# define TCL_INDEX_ERROR 0x100 +#endif /* * The following structure is used with TkMakeEnsemble to create ensemble diff --git a/tests/canvText.test b/tests/canvText.test index 67f2d10..da60ea4 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -250,7 +250,7 @@ test canvText-4.6 {ConfigureText procedure: adjust cursor} -setup { .c index test insert } -cleanup { .c delete test -} -result {4} +} -result 4 test canvText-5.1 {ConfigureText procedure: adjust cursor} -body { @@ -573,7 +573,7 @@ test canvText-8.8 {TextInsert procedure: inserting before cursor} -setup { .c icursor test 3 .c insert test 2 "xyz" .c index test insert -} -result {6} +} -result 6 test canvText-8.9 {TextInsert procedure: inserting after cursor} -setup { .c create text 20 20 -tag test focus .c @@ -583,7 +583,7 @@ test canvText-8.9 {TextInsert procedure: inserting after cursor} -setup { .c icursor test 3 .c insert test 4 "xyz" .c index test insert -} -result {3} +} -result 3 # Item used in 9.* tests .c create text 20 20 -tag test @@ -673,19 +673,19 @@ test canvText-9.13 {TextInsert procedure: move cursor} -body { .c icursor test 6 .c dchars test 2 4 .c index test insert -} -result {3} +} -result 3 test canvText-9.14 {TextInsert procedure: keep cursor >= first} -body { .c itemconfig test -text "abcdefghijk" .c icursor test 6 .c dchars test 2 10 .c index test insert -} -result {2} +} -result 2 test canvText-9.15 {TextInsert procedure: cursor doesn't move} -body { .c itemconfig test -text "abcdefghijk" .c icursor test 5 .c dchars test 7 9 .c index test insert -} -result {5} +} -result 5 .c delete test @@ -695,7 +695,7 @@ test canvText-10.1 {TextToPoint procedure} -body { .c index test @0,0 } -cleanup { .c delete test -} -result {0} +} -result 0 test canvText-11.1 {TextToArea procedure} -setup { @@ -753,7 +753,7 @@ test canvText-14.1 {GetTextIndex procedure} -setup { list [.c index test end] [.c index test insert] \ [.c index test sel.first] [.c index test sel.last] \ [.c index test @0,0] \ - [.c index test 0] [.c index test 10] [.c index test 100] + [.c index test -1] [.c index test 10] [.c index test 100] } -cleanup { .c delete test } -result {15 12 5 8 0 0 10 15} @@ -834,7 +834,7 @@ test canvText-15.1 {SetTextCursor procedure} -setup { .c index test insert } -cleanup { .c delete test -} -result {3} +} -result 3 test canvText-16.1 {GetSelText procedure} -setup { .c create text 0 0 -tag test diff --git a/tests/entry.test b/tests/entry.test index fff16e4..967546f 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -69,7 +69,7 @@ test entry-1.3 {configuration option: "bd" for entry} -setup { .e cget -bd } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-1.4 {configuration option: "bd" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -109,7 +109,7 @@ test entry-1.7 {configuration option: "borderwidth" for entry} -setup { .e cget -borderwidth } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-1.8 {configuration option: "borderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -189,7 +189,7 @@ test entry-1.15 {configuration option: "exportselection" for entry} -setup { .e cget -exportselection } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-1.16 {configuration option: "exportselection" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -309,7 +309,7 @@ test entry-1.27 {configuration option: "highlightthickness" for entry} -setup { .e cget -highlightthickness } -cleanup { destroy .e -} -result {6} +} -result 6 test entry-1.28 {configuration option: "highlightthickness" for entry} -setup { entry .e -borderwidth 2 -font {Helvetica -12 bold} pack .e @@ -319,7 +319,7 @@ test entry-1.28 {configuration option: "highlightthickness" for entry} -setup { .e cget -highlightthickness } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-1.29 {configuration option: "highlightthickness" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -359,7 +359,7 @@ test entry-1.32 {configuration option: "insertborderwidth" for entry} -setup { .e cget -insertborderwidth } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-1.33 {configuration option: "insertborderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -379,7 +379,7 @@ test entry-1.34 {configuration option: "insertofftime" for entry} -setup { .e cget -insertofftime } -cleanup { destroy .e -} -result {100} +} -result 100 test entry-1.35 {configuration option: "insertofftime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -399,7 +399,7 @@ test entry-1.36 {configuration option: "insertontime" for entry} -setup { .e cget -insertontime } -cleanup { destroy .e -} -result {100} +} -result 100 test entry-1.37 {configuration option: "insertontime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -512,7 +512,7 @@ test entry-1.47 {configuration option: "selectborderwidth" for entry} -setup { .e cget -selectborderwidth } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-1.48 {configuration option: "selectborderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -605,7 +605,7 @@ test entry-1.56 {configuration option: "width" for entry} -setup { .e cget -width } -cleanup { destroy .e -} -result {402} +} -result 402 test entry-1.57 {configuration option: "width" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -816,7 +816,7 @@ test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} -setup { .e cget -bd } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} -setup { entry .e pack .e @@ -825,7 +825,7 @@ test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} -setup { llength [.e configure] } -cleanup { destroy .e -} -result {38} +} -result 38 test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} -setup { entry .e } -body { @@ -841,7 +841,7 @@ test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} -setup { lindex [.e configure -bd] 4 } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e } -body { @@ -880,7 +880,7 @@ test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {014567890} +} -result 014567890 test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e } -body { @@ -889,7 +889,7 @@ test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {0123457890} +} -result 0123457890 test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e pack .e @@ -921,7 +921,7 @@ test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e pack .e @@ -934,7 +934,7 @@ test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test entry-3.26a {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e pack .e @@ -947,7 +947,7 @@ test entry-3.26a {EntryWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} -setup { entry .e } -body { @@ -977,7 +977,7 @@ test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} -setup { .e index insert } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} -setup { entry .e } -body { @@ -1063,7 +1063,7 @@ test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} -setup { .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test entry-3.40a {EntryWidgetCmd procedure, "insert" widget command} -setup { entry .e pack .e @@ -1076,7 +1076,7 @@ test entry-3.40a {EntryWidgetCmd procedure, "insert" widget command} -setup { .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} -setup { entry .e } -body { @@ -1136,7 +1136,7 @@ test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} -constraints { .e index @0 } -cleanup { destroy .e -} -result {2} +} -result 2 test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} -setup { entry .e } -body { @@ -1205,7 +1205,7 @@ test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} - .e selection present } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} -setup { entry .e pack .e @@ -1218,7 +1218,7 @@ test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} - .e selection present } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} -setup { entry .e pack .e @@ -1231,7 +1231,7 @@ test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} - .e selection present } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { entry .e } -body { @@ -1259,7 +1259,7 @@ test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} -s selection get } -cleanup { destroy .e -} -result {123} +} -result 123 test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { entry .e pack .e @@ -1273,7 +1273,7 @@ test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} -s selection get } -cleanup { destroy .e -} -result {234} +} -result 234 test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} -setup { entry .e } -body { @@ -1487,7 +1487,7 @@ test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} -setup { .e index @0 } -cleanup { destroy .e -} -result {32} +} -result 32 test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1501,7 +1501,7 @@ test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { .e index @0 } -cleanup { destroy .e -} -result {29} +} -result 29 test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1533,11 +1533,11 @@ test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { .e insert end "runs off the end of the window quite a bit." .e xview 0 update - .e xview 0 + .e xview -1 .e index @0 } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1549,7 +1549,7 @@ test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { .e index @0 } -cleanup { destroy .e -} -result {73} +} -result 73 test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1600,7 +1600,7 @@ test entry-5.1 {ConfigureEntry procedure, -textvariable} -body { .e get } -cleanup { destroy .e -} -result {12345} +} -result 12345 test entry-5.2 {ConfigureEntry procedure, -textvariable} -body { set x 12345 entry .e -textvariable x @@ -1806,7 +1806,7 @@ test entry-6.4 {EntryComputeGeometry procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {6} +} -result 6 test entry-6.5 {EntryComputeGeometry procedure} -setup { entry .e -highlightthickness 2 pack .e @@ -1818,7 +1818,7 @@ test entry-6.5 {EntryComputeGeometry procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {6} +} -result 6 test entry-6.6 {EntryComputeGeometry procedure} -constraints { fonts } -setup { @@ -2026,7 +2026,7 @@ test entry-7.7 {InsertChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {7} +} -result 7 test entry-7.8 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2037,7 +2037,7 @@ test entry-7.8 {InsertChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-7.9 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2049,7 +2049,7 @@ test entry-7.9 {InsertChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {7} +} -result 7 test entry-7.10 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2061,7 +2061,7 @@ test entry-7.10 {InsertChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-7.11 {InsertChars procedure} -constraints { fonts @@ -2075,7 +2075,7 @@ test entry-7.11 {InsertChars procedure} -constraints { winfo reqwidth .e } -cleanup { destroy .e -} -result {59} +} -result 59 test entry-8.1 {DeleteChars procedure} -setup { unset -nocomplain contents @@ -2101,7 +2101,7 @@ test entry-8.2 {DeleteChars procedure} -setup { } -body { .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde - .e delete 0 2 + .e delete -1 2 set timeout [after 500 {set $scrollInfo "timeout"}] vwait scrollInfo list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] @@ -2260,7 +2260,7 @@ test entry-8.12 {DeleteChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-8.13 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2273,7 +2273,7 @@ test entry-8.13 {DeleteChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-8.14 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2286,7 +2286,7 @@ test entry-8.14 {DeleteChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-8.15 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2299,7 +2299,7 @@ test entry-8.15 {DeleteChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-8.16 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2312,7 +2312,7 @@ test entry-8.16 {DeleteChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-8.17 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2325,7 +2325,7 @@ test entry-8.17 {DeleteChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-8.18 {DeleteChars procedure} -setup { entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2347,7 +2347,7 @@ test entry-8.18 {DeleteChars procedure} -setup { } -cleanup { destroy .e unset XPAD expected -} -result {1} +} -result 1 test entry-9.1 {EntryValueChanged procedure} -setup { unset -nocomplain x @@ -2428,7 +2428,7 @@ test entry-10.5 {EntrySetValue procedure, updating display position} -setup { .e index @0 } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-10.6 {EntrySetValue procedure, updating display position} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 @@ -2444,7 +2444,7 @@ test entry-10.6 {EntrySetValue procedure, updating display position} -setup { .e index @0 } -cleanup { destroy .e -} -result {10} +} -result 10 test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 @@ -2459,7 +2459,7 @@ test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { .e index insert } -cleanup { destroy .e -} -result {3} +} -result 3 test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 @@ -2473,7 +2473,7 @@ test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { .e index insert } -cleanup { destroy .e -} -result {5} +} -result 5 test entry-11.1 {EntryEventProc procedure} -setup { entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} @@ -2517,7 +2517,7 @@ test entry-13.1 {GetEntryIndex procedure} -setup { .e index end } -cleanup { destroy .e -} -result {21} +} -result 21 test entry-13.2 {GetEntryIndex procedure} -body { entry .e .e index abogus @@ -2536,7 +2536,7 @@ test entry-13.3 {GetEntryIndex procedure} -setup { .e index anchor } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-13.4 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken pack .e @@ -2549,7 +2549,7 @@ test entry-13.4 {GetEntryIndex procedure} -setup { .e index anchor } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-13.5 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken pack .e @@ -2563,7 +2563,7 @@ test entry-13.5 {GetEntryIndex procedure} -setup { .e index anchor } -cleanup { destroy .e -} -result {15} +} -result 15 test entry-13.6 {GetEntryIndex procedure} -setup { entry .e } -body { @@ -2582,7 +2582,7 @@ test entry-13.7 {GetEntryIndex procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {2} +} -result 2 test entry-13.8 {GetEntryIndex procedure} -setup { entry .e } -body { @@ -2647,7 +2647,7 @@ test entry-13.11 {GetEntryIndex procedure} -constraints aquaOrWin32 -body { .e index sel.first } -cleanup { destroy .e -} -result {1} +} -result 1 test entry-13.12 {GetEntryIndex procedure} -constraints x11 -body { # Previous settings: @@ -2761,7 +2761,7 @@ test entry-13.16 {GetEntryIndex procedure} -constraints fonts -body { .e index @4 } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} @@ -2772,7 +2772,7 @@ test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { .e index @11 } -cleanup { destroy .e -} -result {4} +} -result 4 test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} @@ -2783,7 +2783,7 @@ test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { .e index @12 } -cleanup { destroy .e -} -result {5} +} -result 5 test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} @@ -2794,7 +2794,7 @@ test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { .e index @[expr {[winfo width .e] - 6}] } -cleanup { destroy .e -} -result {8} +} -result 8 test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} @@ -2805,7 +2805,7 @@ test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { .e index @[expr {[winfo width .e] - 5}] } -cleanup { destroy .e -} -result {9} +} -result 9 test entry-13.21 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} @@ -2816,7 +2816,7 @@ test entry-13.21 {GetEntryIndex procedure} -body { .e index @1000 } -cleanup { destroy .e -} -result {9} +} -result 9 test entry-13.22 {GetEntryIndex procedure} -setup { entry .e pack .e @@ -2833,10 +2833,10 @@ test entry-13.23 {GetEntryIndex procedure} -body { .e insert 0 012345678901234567890 .e xview 4 update - .e index 0 + .e index -1 } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-13.24 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} @@ -2847,7 +2847,7 @@ test entry-13.24 {GetEntryIndex procedure} -body { .e index 12 } -cleanup { destroy .e -} -result {12} +} -result 12 test entry-13.25 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} @@ -2858,7 +2858,7 @@ test entry-13.25 {GetEntryIndex procedure} -body { .e index 49 } -cleanup { destroy .e -} -result {21} +} -result 21 test entry-13.26 {GetEntryIndex procedure} -constraints fonts -body { entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} selection clear .e @@ -2905,7 +2905,7 @@ test entry-14.3 {EntryFetchSelection procedure} -setup { string compare [selection get] $x } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-15.1 {EntryLostSelection} -body { entry .e @@ -3025,7 +3025,7 @@ test entry-18.1 {Entry widget vs hiding} -setup { set res1 [list [winfo children .] [interp hidden]] set res2 [list {} $l] expr {$res1 == $res2} -} -result {1} +} -result 1 ## ## Entry widget VALIDATION tests @@ -3424,7 +3424,7 @@ test entry-20.1 {widget deletion while active} -body { winfo exists .e } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-20.2 {widget deletion while active} -body { entry .e -validate all \ @@ -3434,7 +3434,7 @@ test entry-20.2 {widget deletion while active} -body { winfo exists .e } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-20.3 {widget deletion while active} -body { entry .e -validate all \ @@ -3443,7 +3443,7 @@ test entry-20.3 {widget deletion while active} -body { winfo exists .e } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-20.4 {widget deletion while active} -body { entry .e -validate all \ @@ -3453,7 +3453,7 @@ test entry-20.4 {widget deletion while active} -body { winfo exists .e } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-20.5 {widget deletion while active} -body { entry .e -validatecommand { destroy .e ; return 0 } @@ -3461,7 +3461,7 @@ test entry-20.5 {widget deletion while active} -body { winfo exists .e } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-20.6 {widget deletion while active} -body { pack [entry .e] @@ -3471,7 +3471,7 @@ test entry-20.6 {widget deletion while active} -body { winfo exists .e } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-20.7 {widget deletion with textvariable active} -body { # SF bugs 607390 and 617446 @@ -3483,7 +3483,7 @@ test entry-20.7 {widget deletion with textvariable active} -body { winfo exists .e } -cleanup { destroy .e -} -result {0} +} -result 0 test entry-21.1 {selection present while disabled, bug 637828} -body { diff --git a/tests/listbox.test b/tests/listbox.test index 04e66dc..c4c178f 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -374,17 +374,17 @@ test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} -body { .l index active } -result 3 test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} -body { - .l activate 0 + .l activate -1 .l index active -} -result {0} +} -result 0 test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} -body { .l activate 30 .l index active -} -result {17} +} -result 17 test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} -body { .l activate end .l index active -} -result {17} +} -result 17 test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} -body { .l bbox } -returnCodes error -result {wrong # args: should be ".l bbox index"} @@ -508,7 +508,7 @@ test listbox-3.18b {ListboxWidgetCmd procedure, "bbox" option, justified, non-de } -cleanup { destroy .top.l .top unset -nocomplain lres res -} -result {1} +} -result 1 test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} -body { .l cget } -returnCodes error -result {wrong # args: should be ".l cget option"} @@ -520,10 +520,10 @@ test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} -body { } -returnCodes error -result {unknown option "-gorp"} test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} -body { .l cget -setgrid -} -result {0} +} -result 0 test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} -body { llength [.l configure] -} -result {28} +} -result 28 test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} -body { .l configure -gorp } -returnCodes error -result {unknown option "-gorp"} @@ -587,7 +587,7 @@ test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} -setup { } -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 - .l2 delete 0 2 + .l2 delete -1 2 .l2 get 0 end } -cleanup { destroy .l2 @@ -597,11 +597,11 @@ test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} -setup { } -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 - .l2 delete 0 0 + .l2 delete -1 -1 .l2 get 0 end } -cleanup { destroy .l2 -} -result {el1 el2 el3 el4 el5 el6 el7} +} -result {el0 el1 el2 el3 el4 el5 el6 el7} test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} -setup { destroy .l2 } -body { @@ -681,13 +681,13 @@ test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} -setup { destroy .l2 } -result {{two words} el4 el5 el6 el7} test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} -body { - .l get 0 -} -result el0 + .l get -1 +} -result {} test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} -body { - .l get 0 0 -} -result el0 + .l get -1 -1 +} -result {} test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} -body { - .l get 0 3 + .l get -1 3 } -result {el0 el1 el2 el3} test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} -body { .l get 12 end @@ -717,8 +717,8 @@ test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} -body { .l index 2 } -result 2 test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} -body { - .l index 0 -} -result 0 + .l index -1 +} -result {-1} test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} -body { .l index end } -result 18 @@ -746,7 +746,7 @@ test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} -setup { } -body { listbox .l2 .l2 insert end a b c - .l2 insert 0 x + .l2 insert -1 x .l2 get 0 end } -cleanup { destroy .l2 @@ -783,7 +783,7 @@ test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} -body { test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} -body { .l yview 3 .l nearest 1000 -} -result {7} +} -result 7 test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} -body { .l scan a b } -returnCodes error -result {wrong # args: should be ".l scan mark|dragto x y"} @@ -830,52 +830,52 @@ test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 7 .l index @0,0 -} -result {7} +} -result 7 test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 11 .l index @0,0 -} -result {7} +} -result 7 test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 6 .l index @0,0 -} -result {6} +} -result 6 test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 5 .l index @0,0 -} -result {3} +} -result 3 test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 12 .l index @0,0 -} -result {8} +} -result 8 test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 13 .l index @0,0 -} -result {11} +} -result 11 test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 - .l see 0 + .l see -1 .l index @0,0 -} -result {0} +} -result 0 test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see end .l index @0,0 -} -result {13} +} -result 13 test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 322 .l index @0,0 -} -result {13} +} -result 13 test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} -body { mkPartial .partial.l see 4 .partial.l index @0,0 -} -result {1} +} -result 1 test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} -body { .l select a } -returnCodes error -result {wrong # args: should be ".l selection option index ?index?"} @@ -896,7 +896,7 @@ test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} -body { [.l selection anchor 0; .l index anchor] } -result {5 0} test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} -body { - .l selection anchor 0 + .l selection anchor -1 .l index anchor } -result 0 test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} -body { @@ -925,17 +925,17 @@ test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} -body { } -result {1 0 1} test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection set 0 end - .l selection includes 0 -} -result 1 + .l selection includes -1 +} -result 0 test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection clear 0 end .l selection set end .l selection includes end -} -result {1} +} -result 1 test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection set 0 end .l selection includes 44 -} -result {0} +} -result 0 test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} -setup { destroy .l2 } -body { @@ -943,7 +943,7 @@ test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} -setup { .l2 selection includes 0 } -cleanup { destroy .l2 -} -result {0} +} -result 0 test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection clear 0 end .l selection set 2 @@ -965,7 +965,7 @@ test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} -body { } -returnCodes error -result {wrong # args: should be ".l size"} test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} -body { .l size -} -result {18} +} -result 18 test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} -setup { destroy .l2 } -body { @@ -1242,7 +1242,7 @@ test listbox-4.2 {ConfigureListbox procedure} -setup { .l cget -highlightthickness } -cleanup { deleteWindows -} -result {0} +} -result 0 test listbox-4.3 {ConfigureListbox procedure} -setup { deleteWindows destroy .l @@ -1573,14 +1573,14 @@ test listbox-6.2 {InsertEls procedure} -body { .l selection anchor 2 .l insert 2 A B .l index anchor -} -result {4} +} -result 4 test listbox-6.3 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l insert 3 A B .l index anchor -} -result {2} +} -result 2 test listbox-6.4 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j @@ -1588,7 +1588,7 @@ test listbox-6.4 {InsertEls procedure} -body { update .l insert 2 A B .l index @0,0 -} -result {5} +} -result 5 test listbox-6.5 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j @@ -1596,31 +1596,31 @@ test listbox-6.5 {InsertEls procedure} -body { update .l insert 3 A B .l index @0,0 -} -result {3} +} -result 3 test listbox-6.6 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 5 .l insert 5 A B .l index active -} -result {7} +} -result 7 test listbox-6.7 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 5 .l insert 6 A B .l index active -} -result {5} +} -result 5 test listbox-6.8 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c .l index active -} -result {2} +} -result 2 test listbox-6.9 {InsertEls procedure} -body { .l delete 0 end .l insert 0 .l index active -} -result {0} +} -result 0 test listbox-6.10 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b "two words" c d e f g h i j @@ -1728,28 +1728,28 @@ test listbox-7.5 {DeleteEls procedure} -body { .l selection anchor 2 .l delete 0 1 .l index anchor -} -result {0} +} -result 0 test listbox-7.6 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l delete 2 .l index anchor -} -result {2} +} -result 2 test listbox-7.7 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 4 .l delete 2 5 .l index anchor -} -result {2} +} -result 2 test listbox-7.8 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 3 .l delete 4 5 .l index anchor -} -result {3} +} -result 3 test listbox-7.9 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j @@ -1757,7 +1757,7 @@ test listbox-7.9 {DeleteEls procedure} -body { update .l delete 1 2 .l index @0,0 -} -result {1} +} -result 1 test listbox-7.10 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j @@ -1765,7 +1765,7 @@ test listbox-7.10 {DeleteEls procedure} -body { update .l delete 3 4 .l index @0,0 -} -result {3} +} -result 3 test listbox-7.11 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j @@ -1773,7 +1773,7 @@ test listbox-7.11 {DeleteEls procedure} -body { update .l delete 4 6 .l index @0,0 -} -result {3} +} -result 3 test listbox-7.12 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j @@ -1781,42 +1781,42 @@ test listbox-7.12 {DeleteEls procedure} -body { update .l delete 3 end .l index @0,0 -} -result {1} +} -result 1 test listbox-7.13 {DeleteEls procedure, updating view with partial last line} -body { mkPartial .partial.l yview 8 update .partial.l delete 10 13 .partial.l index @0,0 -} -result {7} +} -result 7 test listbox-7.14 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 3 4 .l index active -} -result {4} +} -result 4 test listbox-7.15 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 5 7 .l index active -} -result {5} +} -result 5 test listbox-7.16 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 5 end .l index active -} -result {4} +} -result 4 test listbox-7.17 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 0 end .l index active -} -result {0} +} -result 0 test listbox-7.18 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c "two words" d e f g h i j @@ -1987,7 +1987,7 @@ test listbox-10.5 {GetListboxIndex procedure} -setup { .l index end } -cleanup { destroy .l -} -result {12} +} -result 12 test listbox-10.6 {GetListboxIndex procedure} -setup { destroy .l } -body { @@ -2102,7 +2102,7 @@ test listbox-10.16 {GetListboxIndex procedure} -setup { .l index 3 } -cleanup { destroy .l -} -result {3} +} -result 3 test listbox-10.17 {GetListboxIndex procedure} -setup { destroy .l } -body { @@ -2112,7 +2112,7 @@ test listbox-10.17 {GetListboxIndex procedure} -setup { .l index 20 } -cleanup { destroy .l -} -result {12} +} -result 12 test listbox-10.18 {GetListboxIndex procedure} -setup { destroy .l } -body { @@ -2129,10 +2129,10 @@ test listbox-10.19 {GetListboxIndex procedure} -setup { pack [listbox .l] .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 update - .l index 0 + .l index -1 } -cleanup { destroy .l -} -result 0 +} -result -1 test listbox-10.20 {GetListboxIndex procedure} -setup { destroy .l } -body { @@ -2155,7 +2155,7 @@ test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} - .l yview 3 update set x [.l index @0,0] - .l yview 0 + .l yview -1 update lappend x [.l index @0,0] } -cleanup { @@ -2226,7 +2226,7 @@ test listbox-11.6 {ChangeListboxView procedure, partial last line} -body { .partial.l index @0,0 } -cleanup { destroy .l -} -result {11} +} -result 11 # Listbox used in 12.* tests @@ -2314,7 +2314,7 @@ test listbox-13.3 {ListboxScanTo procedure} -constraints { test listbox-14.1 {NearestListboxElement procedure, partial last line} -body { mkPartial .partial.l nearest [winfo height .partial.l] -} -result {4} +} -result 4 # Listbox used in 14.* tests destroy .l listbox .l -font $fixed -width 20 -height 10 @@ -2326,7 +2326,7 @@ test listbox-14.2 {NearestListboxElement procedure} -constraints { fonts } -body { .l index @50,0 -} -result {4} +} -result 4 test listbox-14.3 {NearestListboxElement procedure} -constraints { fonts } -body { @@ -2336,7 +2336,7 @@ test listbox-14.4 {NearestListboxElement procedure} -constraints { fonts } -body { .l index @50,200 -} -result {13} +} -result 13 # Listbox used in 15.* 16.* and 17.* tests @@ -2378,14 +2378,14 @@ test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} -bo .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end - .l select set 0 0 + .l select set -1 -1 .l curselection -} -result 0 +} -result {} test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end - .l select set 0 3 + .l select set -1 3 .l curselection } -result {0 1 2 3} test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} -body { @@ -2415,7 +2415,7 @@ test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} -bo .l select clear 0 end .l select set end 30 .l curselection -} -result {5} +} -result 5 test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f @@ -2451,7 +2451,7 @@ test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} - string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel } -cleanup { catch {unset long sel} -} -result {0} +} -result 0 test listbox-17.1 {ListboxLostSelection procedure} -setup { diff --git a/tests/spinbox.test b/tests/spinbox.test index 3d62303..6131033 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -93,7 +93,7 @@ test spinbox-1.5 {configuration option: "bd"} -setup { .e cget -bd } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-1.6 {configuration option: "bd" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -137,7 +137,7 @@ test spinbox-1.9 {configuration option: "borderwidth"} -setup { .e cget -borderwidth } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-1.10 {configuration option: "borderwidth" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -281,7 +281,7 @@ test spinbox-1.22 {configuration option: "exportselection"} -setup { .e cget -exportselection } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-1.23 {configuration option: "exportselection" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -457,7 +457,7 @@ test spinbox-1.38 {configuration option: "highlightthickness"} -setup { .e cget -highlightthickness } -cleanup { destroy .e -} -result {6} +} -result 6 test spinbox-1.39 {configuration option: "highlightthickness" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -479,7 +479,7 @@ test spinbox-1.40 {configuration option: "highlightthickness"} -setup { .e cget -highlightthickness } -cleanup { destroy .e -} -result {0} +} -result 0 test spinbox-1.41 {configuration option: "increment"} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ @@ -535,7 +535,7 @@ test spinbox-1.45 {configuration option: "insertborderwidth"} -setup { .e cget -insertborderwidth } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-1.46 {configuration option: "insertborderwidth" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -557,7 +557,7 @@ test spinbox-1.47 {configuration option: "insertofftime"} -setup { .e cget -insertofftime } -cleanup { destroy .e -} -result {100} +} -result 100 test spinbox-1.48 {configuration option: "insertofftime" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -579,7 +579,7 @@ test spinbox-1.49 {configuration option: "insertontime"} -setup { .e cget -insertontime } -cleanup { destroy .e -} -result {100} +} -result 100 test spinbox-1.50 {configuration option: "insertontime" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -757,7 +757,7 @@ test spinbox-1.65 {configuration option: "selectborderwidth"} -setup { .e cget -selectborderwidth } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-1.66 {configuration option: "selectborderwidth" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -937,7 +937,7 @@ test spinbox-1.81 {configuration option: "width"} -setup { .e cget -width } -cleanup { destroy .e -} -result {402} +} -result 402 test spinbox-1.82 {configuration option: "width" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -959,7 +959,7 @@ test spinbox-1.83 {configuration option: "wrap"} -setup { .e cget -wrap } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-1.84 {configuration option: "wrap" for spinbox} -setup { spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ -relief sunken @@ -1154,7 +1154,7 @@ test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} -setup { .e cget -bd } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} -setup { spinbox .e pack .e @@ -1163,7 +1163,7 @@ test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} -setu llength [.e configure] } -cleanup { destroy .e -} -result {51} +} -result 51 test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} -setup { spinbox .e } -body { @@ -1179,7 +1179,7 @@ test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} -setu lindex [.e configure -bd] 4 } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-3.18 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { spinbox .e } -body { @@ -1218,7 +1218,7 @@ test spinbox-3.22 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {014567890} +} -result 014567890 test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { spinbox .e } -body { @@ -1227,7 +1227,7 @@ test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {0123457890} +} -result 0123457890 test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { spinbox .e pack .e @@ -1259,7 +1259,7 @@ test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test spinbox-3.26 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { spinbox .e pack .e @@ -1272,7 +1272,7 @@ test spinbox-3.26 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test spinbox-3.26.1 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { spinbox .e pack .e @@ -1285,7 +1285,7 @@ test spinbox-3.26.1 {SpinboxWidgetCmd procedure, "delete" widget command} -setup .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test spinbox-3.27 {SpinboxWidgetCmd procedure, "get" widget command} -setup { spinbox .e } -body { @@ -1315,7 +1315,7 @@ test spinbox-3.30 {SpinboxWidgetCmd procedure, "icursor" widget command} -setup .e index insert } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-3.31 {SpinboxWidgetCmd procedure, "index" widget command} -setup { spinbox .e } -body { @@ -1401,7 +1401,7 @@ test spinbox-3.40 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test spinbox-3.40.1 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { spinbox .e pack .e @@ -1414,7 +1414,7 @@ test spinbox-3.40.1 {SpinboxWidgetCmd procedure, "insert" widget command} -setup .e get } -cleanup { destroy .e -} -result {01234567890} +} -result 01234567890 test spinbox-3.41 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { spinbox .e } -body { @@ -1474,7 +1474,7 @@ test spinbox-3.46 {SpinboxWidgetCmd procedure, "scan" widget command} -constrain .e index @0 } -cleanup { destroy .e -} -result {2} +} -result 2 test spinbox-3.47 {SpinboxWidgetCmd procedure, "select" widget command} -setup { spinbox .e } -body { @@ -1543,7 +1543,7 @@ test spinbox-3.52 {SpinboxWidgetCmd procedure, "selection present" widget comman .e selection present } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-3.53 {SpinboxWidgetCmd procedure, "selection present" widget command} -setup { spinbox .e pack .e @@ -1556,7 +1556,7 @@ test spinbox-3.53 {SpinboxWidgetCmd procedure, "selection present" widget comman .e selection present } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-3.54 {SpinboxWidgetCmd procedure, "selection present" widget command} -setup { spinbox .e pack .e @@ -1569,7 +1569,7 @@ test spinbox-3.54 {SpinboxWidgetCmd procedure, "selection present" widget comman .e selection present } -cleanup { destroy .e -} -result {0} +} -result 0 test spinbox-3.55 {SpinboxWidgetCmd procedure, "selection adjust" widget command} -setup { spinbox .e } -body { @@ -1597,7 +1597,7 @@ test spinbox-3.57 {SpinboxWidgetCmd procedure, "selection adjust" widget command selection get } -cleanup { destroy .e -} -result {123} +} -result 123 test spinbox-3.58 {SpinboxWidgetCmd procedure, "selection adjust" widget command} -setup { spinbox .e pack .e @@ -1611,7 +1611,7 @@ test spinbox-3.58 {SpinboxWidgetCmd procedure, "selection adjust" widget command selection get } -cleanup { destroy .e -} -result {234} +} -result 234 test spinbox-3.59 {SpinboxWidgetCmd procedure, "selection from" widget command} -setup { spinbox .e } -body { @@ -1825,7 +1825,7 @@ test spinbox-3.75 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { .e index @0 } -cleanup { destroy .e -} -result {32} +} -result 32 test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1839,7 +1839,7 @@ test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { .e index @0 } -cleanup { destroy .e -} -result {29} +} -result 29 test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1871,11 +1871,11 @@ test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { .e insert end "runs off the end of the window quite a bit." .e xview 0 update - .e xview 0 + .e xview -1 .e index @0 } -cleanup { destroy .e -} -result {0} +} -result 0 test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1887,7 +1887,7 @@ test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { .e index @0 } -cleanup { destroy .e -} -result {73} +} -result 73 test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1926,7 +1926,7 @@ test spinbox-5.1 {ConfigureSpinbox procedure, -textvariable} -body { .e get } -cleanup { destroy .e -} -result {12345} +} -result 12345 test spinbox-5.2 {ConfigureSpinbox procedure, -textvariable} -body { set x 12345 spinbox .e -textvariable x @@ -2144,7 +2144,7 @@ test spinbox-6.4 {SpinboxComputeGeometry procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {6} +} -result 6 test spinbox-6.5 {SpinboxComputeGeometry procedure} -setup { spinbox .e -highlightthickness 2 pack .e @@ -2156,7 +2156,7 @@ test spinbox-6.5 {SpinboxComputeGeometry procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {6} +} -result 6 test spinbox-6.6 {SpinboxComputeGeometry procedure} -constraints { fonts } -setup { @@ -2311,7 +2311,7 @@ test spinbox-7.7 {InsertChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {7} +} -result 7 test spinbox-7.8 {InsertChars procedure} -setup { spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2322,7 +2322,7 @@ test spinbox-7.8 {InsertChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-7.9 {InsertChars procedure} -setup { spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2334,7 +2334,7 @@ test spinbox-7.9 {InsertChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {7} +} -result 7 test spinbox-7.10 {InsertChars procedure} -setup { spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2346,7 +2346,7 @@ test spinbox-7.10 {InsertChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-7.11 {InsertChars procedure} -constraints { fonts @@ -2386,7 +2386,7 @@ test spinbox-8.2 {DeleteChars procedure} -setup { } -body { .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde - .e delete 0 2 + .e delete -1 2 set timeout [after 500 {set $scrollInfo "timeout"}] vwait scrollInfo list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] @@ -2545,7 +2545,7 @@ test spinbox-8.12 {DeleteChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-8.13 {DeleteChars procedure} -setup { spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2558,7 +2558,7 @@ test spinbox-8.13 {DeleteChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-8.14 {DeleteChars procedure} -setup { spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2571,7 +2571,7 @@ test spinbox-8.14 {DeleteChars procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-8.15 {DeleteChars procedure} -setup { spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2584,7 +2584,7 @@ test spinbox-8.15 {DeleteChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-8.16 {DeleteChars procedure} -setup { spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2597,7 +2597,7 @@ test spinbox-8.16 {DeleteChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-8.17 {DeleteChars procedure} -setup { spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2610,7 +2610,7 @@ test spinbox-8.17 {DeleteChars procedure} -setup { .e index @0 } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-8.18 {DeleteChars procedure} -setup { spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e @@ -2637,7 +2637,7 @@ test spinbox-8.18 {DeleteChars procedure} -setup { } -cleanup { destroy .e unset XPAD buttonWidth expected -} -result {1} +} -result 1 test spinbox-9.1 {SpinboxValueChanged procedure} -setup { unset -nocomplain x @@ -2717,7 +2717,7 @@ test spinbox-10.5 {SpinboxSetValue procedure, updating display position} -setup .e index @0 } -cleanup { destroy .e -} -result {0} +} -result 0 test spinbox-10.6 {SpinboxSetValue procedure, updating display position} -setup { unset -nocomplain x spinbox .e -highlightthickness 2 -bd 2 @@ -2748,7 +2748,7 @@ test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} -setup .e index insert } -cleanup { destroy .e -} -result {3} +} -result 3 test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} -setup { unset -nocomplain x spinbox .e -highlightthickness 2 -bd 2 @@ -2762,7 +2762,7 @@ test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} -setup .e index insert } -cleanup { destroy .e -} -result {5} +} -result 5 test spinbox-11.1 {SpinboxEventProc procedure} -setup { spinbox .e -highlightthickness 2 -bd 2 -font {Helvetica -12} @@ -2825,7 +2825,7 @@ test spinbox-13.3 {GetSpinboxIndex procedure} -setup { .e index anchor } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-13.4 {GetSpinboxIndex procedure} -setup { spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken pack .e @@ -2838,7 +2838,7 @@ test spinbox-13.4 {GetSpinboxIndex procedure} -setup { .e index anchor } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-13.5 {GetSpinboxIndex procedure} -setup { spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken pack .e @@ -2871,7 +2871,7 @@ test spinbox-13.7 {GetSpinboxIndex procedure} -setup { .e index insert } -cleanup { destroy .e -} -result {2} +} -result 2 test spinbox-13.8 {GetSpinboxIndex procedure} -setup { spinbox .e } -body { @@ -2931,7 +2931,7 @@ test spinbox-13.11 {GetSpinboxIndex procedure} -constraints aquaOrWin32 -body { .e index sel.first } -cleanup { destroy .e -} -result {1} +} -result 1 test spinbox-13.12 {GetSpinboxIndex procedure} -constraints x11 -body { # Previous settings: @@ -3043,7 +3043,7 @@ test spinbox-13.16 {GetSpinboxIndex procedure} -constraints fonts -body { .e index @4 } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-13.17 {GetSpinboxIndex procedure} -constraints fonts -body { spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ -font {Courier -12} @@ -3054,7 +3054,7 @@ test spinbox-13.17 {GetSpinboxIndex procedure} -constraints fonts -body { .e index @11 } -cleanup { destroy .e -} -result {4} +} -result 4 test spinbox-13.18 {GetSpinboxIndex procedure} -constraints fonts -body { spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ -font {Courier -12} @@ -3065,7 +3065,7 @@ test spinbox-13.18 {GetSpinboxIndex procedure} -constraints fonts -body { .e index @12 } -cleanup { destroy .e -} -result {5} +} -result 5 test spinbox-13.19 {GetSpinboxIndex procedure} -constraints fonts -body { spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ -font {Courier -12} @@ -3076,7 +3076,7 @@ test spinbox-13.19 {GetSpinboxIndex procedure} -constraints fonts -body { .e index @[expr {[winfo width .e] - 6-11}] } -cleanup { destroy .e -} -result {8} +} -result 8 test spinbox-13.20 {GetSpinboxIndex procedure} -constraints fonts -body { spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ -font {Courier -12} @@ -3087,7 +3087,7 @@ test spinbox-13.20 {GetSpinboxIndex procedure} -constraints fonts -body { .e index @[expr {[winfo width .e] - 5}] } -cleanup { destroy .e -} -result {9} +} -result 9 test spinbox-13.21 {GetSpinboxIndex procedure} -body { spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ -font {Courier -12} @@ -3098,7 +3098,7 @@ test spinbox-13.21 {GetSpinboxIndex procedure} -body { .e index @1000 } -cleanup { destroy .e -} -result {9} +} -result 9 test spinbox-13.22 {GetSpinboxIndex procedure} -setup { spinbox .e pack .e @@ -3115,10 +3115,10 @@ test spinbox-13.23 {GetSpinboxIndex procedure} -body { .e insert 0 012345678901234567890 .e xview 4 update - .e index 0 + .e index -1 } -cleanup { destroy .e -} -result {0} +} -result 0 test spinbox-13.24 {GetSpinboxIndex procedure} -body { spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ -font {Courier -12} @@ -3129,7 +3129,7 @@ test spinbox-13.24 {GetSpinboxIndex procedure} -body { .e index 12 } -cleanup { destroy .e -} -result {12} +} -result 12 test spinbox-13.25 {GetSpinboxIndex procedure} -body { spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ -font {Courier -12} @@ -3140,7 +3140,7 @@ test spinbox-13.25 {GetSpinboxIndex procedure} -body { .e index 49 } -cleanup { destroy .e -} -result {21} +} -result 21 # XXX Still need to write tests for SpinboxScanTo and SpinboxSelectTo. @@ -3166,7 +3166,7 @@ test spinbox-14.3 {SpinboxFetchSelection procedure} -setup { string compare [selection get] $x } -cleanup { destroy .e -} -result {0} +} -result 0 test spinbox-15.1 {SpinboxLostSelection} -body { spinbox .e @@ -3264,7 +3264,7 @@ test spinbox-18.1 {Spinbox widget vs hiding} -setup { set res1 [list [winfo children .] [interp hidden]] set res2 [list {} $l] expr {$res1 == $res2} -} -result {1} +} -result 1 ## ## Spinbox widget VALIDATION tests @@ -3805,7 +3805,7 @@ test spinbox-22.1 {spinbox config, -from changes SF bug 559078} -body { set val } -cleanup { destroy .e -} -result {5} +} -result 5 test spinbox-22.2 {spinbox config, -from changes SF bug 559078} -body { set val 5 spinbox .e -from 1 -to 10 -textvariable val @@ -3813,7 +3813,7 @@ test spinbox-22.2 {spinbox config, -from changes SF bug 559078} -body { set val } -cleanup { destroy .e -} -result {5} +} -result 5 test spinbox-22.3 {spinbox config, -from changes SF bug 559078} -body { set val 5 spinbox .e -from 3 -to 10 -textvariable val @@ -3821,7 +3821,7 @@ test spinbox-22.3 {spinbox config, -from changes SF bug 559078} -body { set val } -cleanup { destroy .e -} -result {6} +} -result 6 test spinbox-23.1 {selection present while disabled, bug 637828} -body { spinbox .e -- cgit v0.12 From bdbec5671088fa3f28bd273e5987fc7a7aa5af29 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 12 Jun 2020 11:50:53 +0000 Subject: More progress, implementing enhanced "-underline" --- generic/tkButton.c | 2 +- generic/tkButton.h | 2 +- generic/tkConfig.c | 25 +++++++++++++++---------- generic/tkFont.c | 4 ++-- generic/tkInt.h | 3 +++ generic/tkMenu.c | 4 ++-- generic/tkMenubutton.c | 2 +- generic/tkMenubutton.h | 2 +- generic/tkObj.c | 14 ++++++++++++-- generic/ttk/ttkButton.c | 4 ++-- generic/ttk/ttkLabel.c | 5 ++--- tests/font.test | 6 +++--- tests/menu.test | 8 ++++---- unix/tkUnixMenu.c | 6 +++--- win/tkWinMenu.c | 5 +++-- 15 files changed, 55 insertions(+), 37 deletions(-) diff --git a/generic/tkButton.c b/generic/tkButton.c index 211fdac..d061d80 100644 --- a/generic/tkButton.c +++ b/generic/tkButton.c @@ -687,7 +687,7 @@ ButtonCreate( butPtr->type = type; butPtr->optionTable = optionTable; butPtr->textPtr = NULL; - butPtr->underline = -1; + butPtr->underline = INT_MIN; butPtr->textVarNamePtr = NULL; butPtr->bitmap = None; butPtr->imagePtr = NULL; diff --git a/generic/tkButton.h b/generic/tkButton.h index edf7efe..73dc351 100644 --- a/generic/tkButton.h +++ b/generic/tkButton.h @@ -67,7 +67,7 @@ typedef struct { Tcl_Obj *textPtr; /* Value of -text option: specifies text to * display in button. */ int underline; /* Value of -underline option: specifies index - * of character to underline. < 0 means don't + * of character to underline. INT_MIN means don't * underline anything. */ Tcl_Obj *textVarNamePtr; /* Value of -textvariable option: specifies * name of variable or NULL. If non-NULL, diff --git a/generic/tkConfig.c b/generic/tkConfig.c index fad4f94..972db13 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -638,20 +638,17 @@ DoObjConfig( case TK_OPTION_INDEX: { TkSizeT newIndex; - /* TODO: don't bother handling "end" yet */ - if (TkGetIntForIndex(valuePtr, INT_MAX - 1, 0, &newIndex) != TCL_OK) { + if (TkGetIntForIndex(valuePtr, (TkSizeT)TCL_INDEX_END, 0, &newIndex) != TCL_OK) { if (interp) { Tcl_AppendResult(interp, "bad index \"", Tcl_GetString(valuePtr), "\": must be integer?[+-]integer?, end?[+-]integer? or none", NULL); } return TCL_ERROR; } - if (valuePtr->internalRep.wideValue < INT_MIN) { + if (newIndex == TCL_INDEX_NONE) { newIndex = (TkSizeT)INT_MIN; - } else if (valuePtr->internalRep.wideValue > INT_MAX) { - newIndex = (TkSizeT)INT_MAX; - } else if (valuePtr->internalRep.wideValue < 0) { - newIndex = (TkSizeT)valuePtr->internalRep.wideValue; + } else if ((int)newIndex <= (int)TCL_INDEX_END) { + newIndex++; } if (internalPtr != NULL) { *((int *) oldInternalPtr) = *((int *) internalPtr); @@ -1911,14 +1908,22 @@ GetObjectForOption( objPtr = Tcl_NewWideIntObj(*((int *) internalPtr)); break; case TK_OPTION_INDEX: - if (*((int *) internalPtr) >= 0 && *((int *) internalPtr) < INT_MAX) { - objPtr = Tcl_NewWideIntObj(*((int *) internalPtr)); - } else { + if (*((int *) internalPtr) == INT_MIN) { #if TCL_MAJOR_VERSION > 8 || defined(TK_NO_DEPRECATED) objPtr = Tcl_NewStringObj("none", -1); #else objPtr = Tcl_NewWideIntObj(-1); #endif + } else if (*((int *) internalPtr) == INT_MAX) { + objPtr = Tcl_NewStringObj("end+1", -1); + } else if (*((int *) internalPtr) == -1) { + objPtr = Tcl_NewStringObj("end", -1); + } else if (*((int *) internalPtr) < 0) { + char buf[32]; + sprintf(buf, "end%d", *((int *) internalPtr)); + objPtr = Tcl_NewStringObj(buf, -1); + } else { + objPtr = Tcl_NewWideIntObj(*((int *) internalPtr)); } break; case TK_OPTION_DOUBLE: diff --git a/generic/tkFont.c b/generic/tkFont.c index 98a10f4..81b9a8a 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -2441,7 +2441,7 @@ Tk_UnderlineTextLayout( int x, int y, /* Upper-left hand corner of rectangle in * which to draw (pixels). */ int underline) /* Index of the single character to underline, - * or -1 for no underline. */ + * or INT_MIN for no underline. */ { int xx, yy, width, height; @@ -2468,7 +2468,7 @@ TkUnderlineAngledTextLayout( * which to draw (pixels). */ double angle, int underline) /* Index of the single character to underline, - * or -1 for no underline. */ + * or INT_MIN for no underline. */ { int xx, yy, width, height; diff --git a/generic/tkInt.h b/generic/tkInt.h index 05f5eba..fc36c50 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -923,6 +923,9 @@ typedef struct { #ifndef TCL_INDEX_NONE # define TCL_INDEX_NONE (-1) #endif +#ifndef TCL_INDEX_END +# define TCL_INDEX_END ((TkSizeT)-2) +#endif /* See TIP #577 */ #ifndef TCL_INDEX_ERROR # define TCL_INDEX_ERROR 0x100 diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 776c7e8..5ee9ede 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -160,7 +160,7 @@ static const Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = { DEF_MENU_ENTRY_STATE, TCL_INDEX_NONE, offsetof(TkMenuEntry, state), 0, (ClientData) menuStateStrings, 0}, - {TK_OPTION_INT, "-underline", NULL, NULL, + {TK_OPTION_INDEX, "-underline", NULL, NULL, DEF_MENU_ENTRY_UNDERLINE, TCL_INDEX_NONE, offsetof(TkMenuEntry, underline), 0, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0} }; @@ -2278,7 +2278,7 @@ MenuNewEntry( mePtr->menuPtr = menuPtr; mePtr->labelPtr = NULL; mePtr->labelLength = 0; - mePtr->underline = -1; + mePtr->underline = INT_MIN; mePtr->bitmapPtr = NULL; mePtr->imagePtr = NULL; mePtr->image = NULL; diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 7d6086f..3e9d511 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -262,7 +262,7 @@ Tk_MenubuttonObjCmd( mbPtr->optionTable = optionTable; mbPtr->menuName = NULL; mbPtr->text = NULL; - mbPtr->underline = -1; + mbPtr->underline = INT_MIN; mbPtr->textVarName = NULL; mbPtr->bitmap = None; mbPtr->imageString = NULL; diff --git a/generic/tkMenubutton.h b/generic/tkMenubutton.h index 1dbacb3..31eb93f 100644 --- a/generic/tkMenubutton.h +++ b/generic/tkMenubutton.h @@ -64,7 +64,7 @@ typedef struct { char *text; /* Text to display in button (malloc'ed) or * NULL. */ - int underline; /* Index of character to underline. */ + int underline; /* Index of character to underline. INT_MIN means no underline */ char *textVarName; /* Name of variable (malloc'ed) or NULL. If * non-NULL, button displays the contents of * this variable. */ diff --git a/generic/tkObj.c b/generic/tkObj.c index bf18114..0da9ad4 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -222,15 +222,25 @@ TkGetIntForIndex( int lastOK, TkSizeT *indexPtr) { +#ifdef TK_NO_DEPRECATED + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); +#endif + if (Tcl_GetIntForIndex(NULL, indexObj, end + lastOK, TCL_INDEX_ERROR, indexPtr) != TCL_OK) { return TCL_ERROR; } +#ifdef TK_NO_DEPRECATED + if ((indexObj->typePtr == tsdPtr->intTypePtr) && (*indexPtr == TCL_INDEX_NONE)) { + return TCL_ERROR; + } +#endif #if TCL_MAJOR_VERSION < 9 - if ((*indexPtr < -1) || (end < -1)) { + if ((*indexPtr < -1) || (end < TCL_INDEX_END)) { return TCL_ERROR; } #endif - if ((*indexPtr + 1) > (end + 1)) { + if ((end + 1 >= 0) && (*indexPtr + 1) > (end + 1)) { *indexPtr = end + 1; } return TCL_OK; diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c index efb53b7..56dc3af 100644 --- a/generic/ttk/ttkButton.c +++ b/generic/ttk/ttkButton.c @@ -25,7 +25,7 @@ typedef struct Tcl_Obj *textObj; Tcl_Obj *justifyObj; Tcl_Obj *textVariableObj; - Tcl_Obj *underlineObj1; + Tcl_Obj *underlineObj; Tcl_Obj *widthObj; Ttk_TraceHandle *textVariableTrace; @@ -67,7 +67,7 @@ static const Tk_OptionSpec BaseOptionSpecs[] = offsetof(Base,base.textVariableObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, offsetof(Base,base.underlineObj1), TCL_INDEX_NONE, + DEF_BUTTON_UNDERLINE, offsetof(Base,base.underlineObj), TCL_INDEX_NONE, 0,0,0 }, /* SB: OPTION_INT, see <> */ {TK_OPTION_STRING, "-width", "width", "Width", diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index c83c222..46658b0 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -171,9 +171,8 @@ static void TextDraw(TextElement *text, Tk_Window tkwin, Drawable d, Ttk_Box b) Tk_DrawTextLayout(Tk_Display(tkwin), d, gc1, text->textLayout, b.x, b.y, 0/*firstChar*/, -1/*lastChar*/); - /* TODO: Handle end+/- syntax */ - TkGetIntForIndex(text->underlineObj, INT_MAX - 1, TCL_INDEX_ERROR, &underline); - if ((underline != TCL_INDEX_NONE) && (underline < (TkSizeT)INT_MAX)) { + TkGetIntForIndex(text->underlineObj, TCL_INDEX_END, TCL_INDEX_ERROR, &underline); + if (underline != TCL_INDEX_NONE) { if (text->embossed) { Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc2, text->textLayout, b.x+1, b.y+1, underline); diff --git a/tests/font.test b/tests/font.test index 92894d1..5ff9750 100644 --- a/tests/font.test +++ b/tests/font.test @@ -1681,14 +1681,14 @@ destroy .t.f pack [label .t.f] update test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} -body { - .t.f config -text "foo" -under -1 + .t.f config -text "foo" -underline none } -result {} test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} -body { .t.f config -text "000 00000" -wrap [expr $ax*7] -under 10 } -result {} test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} -body { .t.f config -text "000 00000" -wrap [expr $ax*7] -under 5 - .t.f config -wrap -1 -under -1 + .t.f config -wrap -1 -underline none } -result {} destroy .t.f @@ -1763,7 +1763,7 @@ destroy .t.f pack [label .t.f] update test font-29.1 {Tk_CharBBox procedure: index < 0} -body { - .t.f config -text "000" -underline -1 + .t.f config -text "000" -underline none } -result {} test font-29.2 {Tk_CharBBox procedure: loop} -body { .t.f config -text "000\t000\t000\t000" -underline 9 diff --git a/tests/menu.test b/tests/menu.test index c288661..ee5e90d 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -1199,11 +1199,11 @@ test menu-2.223 {entry configuration options 0 -underline 3p tearoff} -body { test menu-2.224 {entry configuration options 1 -underline 3p command} -body { .m1 entryconfigure 1 -underline 3p -} -returnCodes error -result {expected integer but got "3p"} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer? or none} test menu-2.225 {entry configuration options 2 -underline 3p cascade} -body { .m1 entryconfigure 2 -underline 3p -} -returnCodes error -result {expected integer but got "3p"} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer? or none} test menu-2.226 {entry configuration options 3 -underline 3p separator} -body { .m1 entryconfigure 3 -underline 3p @@ -1211,11 +1211,11 @@ test menu-2.226 {entry configuration options 3 -underline 3p separator} -body { test menu-2.227 {entry configuration options 4 -underline 3p checkbutton} -body { .m1 entryconfigure 4 -underline 3p -} -returnCodes error -result {expected integer but got "3p"} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer? or none} test menu-2.228 {entry configuration options 5 -underline 3p radiobutton} -body { .m1 entryconfigure 5 -underline 3p -} -returnCodes error -result {expected integer but got "3p"} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer? or none} deleteWindows if {[testConstraint hasEarthPhoto]} { diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c index 7c7ed26..e60c007 100644 --- a/unix/tkUnixMenu.c +++ b/unix/tkUnixMenu.c @@ -875,16 +875,16 @@ DrawMenuUnderline( { (void)width; - if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) { + if (mePtr->labelPtr != NULL) { int len; len = Tcl_GetCharLength(mePtr->labelPtr); - if (mePtr->underline < len) { + if (mePtr->underline < -len || mePtr->underline >= len) { int activeBorderWidth, leftEdge, ch; const char *label, *start, *end; label = Tcl_GetString(mePtr->labelPtr); - start = Tcl_UtfAtIndex(label, mePtr->underline); + start = Tcl_UtfAtIndex(label, (mePtr->underline < 0) ? mePtr->underline + len : mePtr->underline); end = start + TkUtfToUniChar(start, &ch); Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index 0b6efcf..a3c45f9 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -1252,7 +1252,8 @@ TkWinHandleMenuEvent( hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, *plParam); if (hashEntryPtr != NULL) { - TkSizeT i, len, underline; + TkSizeT i, len; + int underline; Tcl_Obj *labelPtr; WCHAR *wlabel; int menuChar; @@ -1270,7 +1271,7 @@ TkWinHandleMenuEvent( for (i = 0; i < menuPtr->numEntries; i++) { underline = menuPtr->entries[i]->underline; labelPtr = menuPtr->entries[i]->labelPtr; - if ((underline != TCL_INDEX_NONE) && (labelPtr != NULL)) { + if ((underline >= 0) && (labelPtr != NULL)) { /* * Ensure we don't exceed the label length, then check */ -- cgit v0.12 From d25c25608f9dffe7405b552f4c70510379f6a586 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 15 Jun 2020 12:07:26 +0000 Subject: More progress, mainly in tkCanvTest.c --- generic/tkButton.c | 16 ++++---- generic/tkCanvText.c | 95 +++++++++++++++++++++++++++++++++++++++++++++-- generic/tkFont.c | 11 +++++- generic/tkMenubutton.c | 4 +- generic/tkObj.c | 4 ++ generic/ttk/ttkButton.c | 2 +- generic/ttk/ttkFrame.c | 4 +- generic/ttk/ttkNotebook.c | 2 +- macosx/tkMacOSXDefault.h | 3 +- tests/canvText.test | 2 +- unix/tkUnixDefault.h | 1 - win/tkWinDefault.h | 1 - 12 files changed, 120 insertions(+), 25 deletions(-) diff --git a/generic/tkButton.c b/generic/tkButton.c index d061d80..0c94944 100644 --- a/generic/tkButton.c +++ b/generic/tkButton.c @@ -143,8 +143,8 @@ static const Tk_OptionSpec labelOptionSpecs[] = { {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", DEF_BUTTON_TEXT_VARIABLE, offsetof(TkButton, textVarNamePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, TCL_INDEX_NONE, offsetof(TkButton, underline), 0, 0, 0}, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_BUTTON_WIDTH, offsetof(TkButton, widthPtr), TCL_INDEX_NONE, 0, 0, 0}, {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", @@ -244,8 +244,8 @@ static const Tk_OptionSpec buttonOptionSpecs[] = { {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", DEF_BUTTON_TEXT_VARIABLE, offsetof(TkButton, textVarNamePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, TCL_INDEX_NONE, offsetof(TkButton, underline), 0, 0, 0}, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_BUTTON_WIDTH, offsetof(TkButton, widthPtr), TCL_INDEX_NONE, 0, 0, 0}, {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", @@ -354,8 +354,8 @@ static const Tk_OptionSpec checkbuttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-tristatevalue", "tristateValue", "TristateValue", DEF_BUTTON_TRISTATE_VALUE, offsetof(TkButton, tristateValuePtr), TCL_INDEX_NONE, 0, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, TCL_INDEX_NONE, offsetof(TkButton, underline), 0, 0, 0}, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-variable", "variable", "Variable", DEF_CHECKBUTTON_VARIABLE, offsetof(TkButton, selVarNamePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, @@ -464,8 +464,8 @@ static const Tk_OptionSpec radiobuttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-tristatevalue", "tristateValue", "TristateValue", DEF_BUTTON_TRISTATE_VALUE, offsetof(TkButton, tristateValuePtr), TCL_INDEX_NONE, 0, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, TCL_INDEX_NONE, offsetof(TkButton, underline), 0, 0, 0}, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-value", "value", "Value", DEF_BUTTON_VALUE, offsetof(TkButton, onValuePtr), TCL_INDEX_NONE, 0, 0, 0}, {TK_OPTION_STRING, "-variable", "variable", "Variable", diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 304e009..8762777 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -53,7 +53,7 @@ typedef struct TextItem { int width; /* Width of lines for word-wrap, pixels. Zero * means no word-wrap. */ int underline; /* Index of character to put underline beneath - * or -1 for no underlining. */ + * or INT_MIN for no underlining. */ double angle; /* What angle, in degrees, to draw the text * at. */ @@ -93,6 +93,93 @@ static const Tk_CustomOption offsetOption = { TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE) }; +static int +UnderlineParseProc( + ClientData dummy, /* Not used.*/ + Tcl_Interp *interp, /* Used for reporting errors. */ + Tk_Window tkwin, /* Window containing canvas widget. */ + const char *value, /* Value of option. */ + char *widgRec, /* Pointer to record for item. */ + TkSizeT offset) /* Offset into item (ignored). */ +{ + int *underlinePtr = (int *) (widgRec + offset); + Tcl_Obj obj; + int code; + TkSizeT underline; + (void)dummy; + (void)tkwin; + + if (value == NULL || *value == 0) { + *underlinePtr = INT_MIN; /* No underline */ + return TCL_OK; + } + + obj.refCount = 1; + obj.bytes = (char *)value; + obj.length = strlen(value); + obj.typePtr = NULL; + code = TkGetIntForIndex(&obj, TCL_INDEX_END, TCL_INDEX_ERROR, &underline); + if (code == TCL_OK) { + if (underline == TCL_INDEX_NONE) { + underline = INT_MIN; + } else if ((size_t)underline > ((size_t)TCL_INDEX_END)>>1) { + underline++; + } else if (underline > INT_MAX) { + underline = INT_MAX; + } + *underlinePtr = underline; + } else { + Tcl_AppendResult(interp, "bad index \"", value, + "\": must be integer?[+-]integer?, end?[+-]integer? or none", NULL); + } + return code; +} + +const char * +UnderlinePrintProc( + ClientData dummy, /* Ignored. */ + Tk_Window tkwin, /* Window containing canvas widget. */ + char *widgRec, /* Pointer to record for item. */ + TkSizeT offset, /* Pointer to record for item. */ + Tcl_FreeProc **freeProcPtr) /* Pointer to variable to fill in with + * information about how to reclaim storage + * for return string. */ +{ + int underline = *(int *)(widgRec + offset); + char *p = (char *)ckalloc(32); + (void)dummy; + (void)tkwin; + + if (underline == INT_MIN) { +#if TCL_MAJOR_VERSION > 9 || defined(TK_NON_DEPRECATED) + p = (char *)"none"; +#else + p = (char *)"-1"; +#endif + *freeProcPtr = TCL_STATIC; + return p; + } else if (underline == INT_MAX) { + p = (char *)"end+1"; + *freeProcPtr = TCL_STATIC; + return p; + } else if (underline == -1) { + p = (char *)"end"; + *freeProcPtr = TCL_STATIC; + return p; + } + if (underline < 0) { + sprintf(p, "end%d", underline); + } else { + sprintf(p, "%d", underline); + } + *freeProcPtr = TCL_DYNAMIC; + return p; +} + +static const Tk_CustomOption underlineOption = { + UnderlineParseProc, UnderlinePrintProc, NULL +}; + static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_COLOR, "-activefill", NULL, NULL, NULL, offsetof(TextItem, activeColor), TK_CONFIG_NULL_OK, NULL}, @@ -123,8 +210,8 @@ static const Tk_ConfigSpec configSpecs[] = { NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_STRING, "-text", NULL, NULL, "", offsetof(TextItem, text), 0, NULL}, - {TK_CONFIG_INT, "-underline", NULL, NULL, - "-1", offsetof(TextItem, underline), 0, NULL}, + {TK_CONFIG_CUSTOM, "-underline", NULL, NULL, DEF_BUTTON_UNDERLINE, + offsetof(TextItem, underline), TK_CONFIG_NULL_OK, &underlineOption}, {TK_CONFIG_PIXELS, "-width", NULL, NULL, "0", offsetof(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} @@ -264,7 +351,7 @@ CreateText( textPtr->disabledStipple = None; textPtr->text = NULL; textPtr->width = 0; - textPtr->underline = -1; + textPtr->underline = INT_MIN; textPtr->angle = 0.0; textPtr->numChars = 0; diff --git a/generic/tkFont.c b/generic/tkFont.c index 81b9a8a..14cfca7 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -2696,7 +2696,7 @@ Tk_CharBbox( Tk_TextLayout layout, /* Layout information, from a previous call to * Tk_ComputeTextLayout(). */ int index, /* The index of the character whose bbox is - * desired. */ + * desired. Negative means count backwards. */ int *xPtr, int *yPtr, /* Filled with the upper-left hand corner, in * pixels, of the bounding box for the * character specified by index, if @@ -2714,7 +2714,14 @@ Tk_CharBbox( const char *end; if (index < 0) { - return 0; + int len = 0; + for (i = 0; i < layoutPtr->numChunks; i++) { + len += chunkPtr->numChars; + } + index += len; + if (index < 0) { + return 0; + } } chunkPtr = layoutPtr->chunks; diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 3e9d511..8d512c1 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -146,8 +146,8 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_MENUBUTTON_TEXT_VARIABLE, TCL_INDEX_NONE, offsetof(TkMenuButton, textVarName), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_MENUBUTTON_UNDERLINE, TCL_INDEX_NONE, offsetof(TkMenuButton, underline), - 0, 0, 0}, + DEF_BUTTON_UNDERLINE, TCL_INDEX_NONE, offsetof(TkMenuButton, underline), + TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_MENUBUTTON_WIDTH, TCL_INDEX_NONE, offsetof(TkMenuButton, widthString), 0, 0, 0}, diff --git a/generic/tkObj.c b/generic/tkObj.c index 0da9ad4..3138d0a 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -227,6 +227,10 @@ TkGetIntForIndex( Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); #endif + if (indexObj == NULL) { + *indexPtr = TCL_INDEX_NONE; + return TCL_OK; + } if (Tcl_GetIntForIndex(NULL, indexObj, end + lastOK, TCL_INDEX_ERROR, indexPtr) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c index 56dc3af..e85313e 100644 --- a/generic/ttk/ttkButton.c +++ b/generic/ttk/ttkButton.c @@ -68,7 +68,7 @@ static const Tk_OptionSpec BaseOptionSpecs[] = TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, offsetof(Base,base.underlineObj), TCL_INDEX_NONE, - 0,0,0 }, + TK_OPTION_NULL_OK,0,0 }, /* SB: OPTION_INT, see <> */ {TK_OPTION_STRING, "-width", "width", "Width", NULL, offsetof(Base,base.widthObj), TCL_INDEX_NONE, diff --git a/generic/ttk/ttkFrame.c b/generic/ttk/ttkFrame.c index 6fea538..7ebc40f 100644 --- a/generic/ttk/ttkFrame.c +++ b/generic/ttk/ttkFrame.c @@ -259,8 +259,8 @@ static const Tk_OptionSpec LabelframeOptionSpecs[] = { offsetof(Labelframe,label.textObj), TCL_INDEX_NONE, 0,0,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, offsetof(Labelframe,label.underlineObj), TCL_INDEX_NONE, - 0,0,0 }, + NULL, offsetof(Labelframe,label.underlineObj), TCL_INDEX_NONE, + TK_OPTION_NULL_OK,0,0 }, {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget", NULL, TCL_INDEX_NONE, offsetof(Labelframe,label.labelWidget), TK_OPTION_NULL_OK,0,LABELWIDGET_CHANGED|GEOMETRY_CHANGED }, diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c index 6b185c1..61f95f0 100644 --- a/generic/ttk/ttkNotebook.c +++ b/generic/ttk/ttkNotebook.c @@ -69,7 +69,7 @@ static const Tk_OptionSpec TabOptionSpecs[] = NULL, offsetof(Tab,compoundObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,(void *)ttkCompoundStrings,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, - offsetof(Tab,underlineObj), TCL_INDEX_NONE, 0,0,GEOMETRY_CHANGED }, + offsetof(Tab,underlineObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0 } }; diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index b20454b..4dcb7d3 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -117,7 +117,7 @@ #if TCL_MAJOR_VERSION < 9 && !defined(TK_NO_DEPRECATED) # define DEF_BUTTON_UNDERLINE "-1" #else -# define DEF_BUTTON_UNDERLINE "none" +# define DEF_BUTTON_UNDERLINE NULL #endif #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" @@ -374,7 +374,6 @@ #define DEF_MENUBUTTON_TAKE_FOCUS "0" #define DEF_MENUBUTTON_TEXT "" #define DEF_MENUBUTTON_TEXT_VARIABLE "" -#define DEF_MENUBUTTON_UNDERLINE DEF_BUTTON_UNDERLINE #define DEF_MENUBUTTON_WIDTH "0" #define DEF_MENUBUTTON_WRAP_LENGTH "0" diff --git a/tests/canvText.test b/tests/canvText.test index 8037040..0a2adfc 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -63,7 +63,7 @@ test canvText-1.12 {configuration options: good value for "underline"} -body { } -result {0 0} test canvasText-1.13 {configuration options: bad value for "underline"} -body { .c itemconfigure test -underline xyz -} -returnCodes error -result {expected integer but got "xyz"} +} -returnCodes error -result {bad index "xyz": must be integer?[+-]integer?, end?[+-]integer? or none} test canvText-1.14 {configuration options: good value for "width"} -body { .c itemconfigure test -width 6 list [lindex [.c itemconfigure test -width] 4] [.c itemcget test -width] diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index 231a48b..982f192 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -335,7 +335,6 @@ #define DEF_MENUBUTTON_TAKE_FOCUS "0" #define DEF_MENUBUTTON_TEXT "" #define DEF_MENUBUTTON_TEXT_VARIABLE "" -#define DEF_MENUBUTTON_UNDERLINE DEF_BUTTON_UNDERLINE #define DEF_MENUBUTTON_WIDTH "0" #define DEF_MENUBUTTON_WRAP_LENGTH "0" diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index 906887d..e2193fd 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -339,7 +339,6 @@ #define DEF_MENUBUTTON_TAKE_FOCUS "0" #define DEF_MENUBUTTON_TEXT "" #define DEF_MENUBUTTON_TEXT_VARIABLE "" -#define DEF_MENUBUTTON_UNDERLINE DEF_BUTTON_UNDERLINE #define DEF_MENUBUTTON_WIDTH "0" #define DEF_MENUBUTTON_WRAP_LENGTH "0" -- cgit v0.12 From b787fb229d2e4874fdad8cb9c6bf792ae35f8f24 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 16 Jun 2020 23:00:36 +0000 Subject: Implementation complete, appears to function as expected --- generic/tkCanvText.c | 9 +++++---- generic/tkConfig.c | 4 ++-- generic/tkFont.c | 7 ++----- generic/tkListbox.c | 2 +- generic/tkObj.c | 16 ++++++++++++++-- generic/ttk/ttkEntry.c | 2 +- generic/ttk/ttkLabel.c | 9 +++++++-- generic/ttk/ttkManager.c | 4 +--- 8 files changed, 33 insertions(+), 20 deletions(-) diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 8762777..cc36e70 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -118,16 +118,17 @@ UnderlineParseProc( obj.bytes = (char *)value; obj.length = strlen(value); obj.typePtr = NULL; - code = TkGetIntForIndex(&obj, TCL_INDEX_END, TCL_INDEX_ERROR, &underline); + code = TkGetIntForIndex(&obj, TCL_INDEX_END, 0, &underline); if (code == TCL_OK) { if (underline == TCL_INDEX_NONE) { underline = INT_MIN; - } else if ((size_t)underline > ((size_t)TCL_INDEX_END)>>1) { - underline++; - } else if (underline > INT_MAX) { + } else if ((size_t)underline > (size_t)TCL_INDEX_END>>1) { + underline++; + } else if (underline >= INT_MAX) { underline = INT_MAX; } *underlinePtr = underline; + } else { Tcl_AppendResult(interp, "bad index \"", value, "\": must be integer?[+-]integer?, end?[+-]integer? or none", NULL); diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 972db13..1583903 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -638,7 +638,7 @@ DoObjConfig( case TK_OPTION_INDEX: { TkSizeT newIndex; - if (TkGetIntForIndex(valuePtr, (TkSizeT)TCL_INDEX_END, 0, &newIndex) != TCL_OK) { + if (TkGetIntForIndex(valuePtr, TCL_INDEX_END, 0, &newIndex) != TCL_OK) { if (interp) { Tcl_AppendResult(interp, "bad index \"", Tcl_GetString(valuePtr), "\": must be integer?[+-]integer?, end?[+-]integer? or none", NULL); @@ -647,7 +647,7 @@ DoObjConfig( } if (newIndex == TCL_INDEX_NONE) { newIndex = (TkSizeT)INT_MIN; - } else if ((int)newIndex <= (int)TCL_INDEX_END) { + } else if ((size_t)newIndex > (size_t)TCL_INDEX_END>>1) { newIndex++; } if (internalPtr != NULL) { diff --git a/generic/tkFont.c b/generic/tkFont.c index 14cfca7..3876d61 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -2707,24 +2707,21 @@ Tk_CharBbox( * index, if non-NULL. */ { TextLayout *layoutPtr = (TextLayout *) layout; - LayoutChunk *chunkPtr; + LayoutChunk *chunkPtr = layoutPtr->chunks; int i, x = 0, w; Tk_Font tkfont; TkFont *fontPtr; const char *end; if (index < 0) { - int len = 0; for (i = 0; i < layoutPtr->numChunks; i++) { - len += chunkPtr->numChars; + index += (chunkPtr + i)->numChars; } - index += len; if (index < 0) { return 0; } } - chunkPtr = layoutPtr->chunks; tkfont = layoutPtr->tkfont; fontPtr = (TkFont *) tkfont; diff --git a/generic/tkListbox.c b/generic/tkListbox.c index e738155..693e5c8 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -2742,7 +2742,7 @@ GetListboxIndex( result = TkGetIntForIndex(indexObj, listPtr->nElements - 1, lastOK, &idx); if (result == TCL_OK) { - if (idx + 1 > (TkSizeT)listPtr->nElements + 1) { + if ((idx != TCL_INDEX_NONE) && (idx > (TkSizeT)listPtr->nElements)) { idx = listPtr->nElements; } *indexPtr = (int)idx; diff --git a/generic/tkObj.c b/generic/tkObj.c index 3138d0a..4abdde5 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -50,6 +50,9 @@ typedef struct PixelRep { typedef struct { const Tcl_ObjType *doubleTypePtr; const Tcl_ObjType *intTypePtr; +#if TCL_MAJOR_VERSION < 9 + const Tcl_ObjType *endTypePtr; +#endif } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -183,6 +186,13 @@ GetTypeCache(void) /* Smart initialization of doubleTypePtr/intTypePtr without * hash-table lookup or creating complete Tcl_Obj's */ Tcl_Obj obj; +#if TCL_MAJOR_VERSION < 9 + obj.bytes = (char *)"end"; + obj.length = 3; + obj.typePtr = NULL; + Tcl_GetIntForIndex(NULL, &obj, TCL_INDEX_NONE, 0, (TkSizeT *)&obj.internalRep.doubleValue); + tsdPtr->endTypePtr = obj.typePtr; +#endif obj.bytes = (char *)"0.0"; obj.length = 3; obj.typePtr = NULL; @@ -222,7 +232,7 @@ TkGetIntForIndex( int lastOK, TkSizeT *indexPtr) { -#ifdef TK_NO_DEPRECATED +#if defined(TK_NO_DEPRECATED) || TCL_MAJOR_VERSION < 9 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); #endif @@ -240,7 +250,9 @@ TkGetIntForIndex( } #endif #if TCL_MAJOR_VERSION < 9 - if ((*indexPtr < -1) || (end < TCL_INDEX_END)) { + if ((indexObj->typePtr == tsdPtr->endTypePtr) + && (indexObj->internalRep.wideValue == ((Tcl_WideInt)(((Tcl_WideUInt)-1) >> 1))-1)) { + /* 'end+2' and higher are illegal in Tk. */ return TCL_ERROR; } #endif diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index cbc3b3f..89b398c 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -1372,7 +1372,7 @@ EntryIndex( const char *string; if (TCL_OK == TkGetIntForIndex(indexObj, entryPtr->entry.numChars - 1, 1, &idx)) { - if (idx + 1 > entryPtr->entry.numChars + 1) { + if ((idx != TCL_INDEX_NONE) && (idx > entryPtr->entry.numChars)) { idx = entryPtr->entry.numChars; } *indexPtr = idx; diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index 46658b0..0578118 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -171,8 +171,13 @@ static void TextDraw(TextElement *text, Tk_Window tkwin, Drawable d, Ttk_Box b) Tk_DrawTextLayout(Tk_Display(tkwin), d, gc1, text->textLayout, b.x, b.y, 0/*firstChar*/, -1/*lastChar*/); - TkGetIntForIndex(text->underlineObj, TCL_INDEX_END, TCL_INDEX_ERROR, &underline); - if (underline != TCL_INDEX_NONE) { + TkGetIntForIndex(text->underlineObj, TCL_INDEX_END, 0, &underline); + if (underline == TCL_INDEX_NONE) { + underline = (TkSizeT)INT_MIN; + } else if ((size_t)underline > (size_t)TCL_INDEX_END>>1) { + underline++; + } + if (underline != (TkSizeT)INT_MIN) { if (text->embossed) { Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc2, text->textLayout, b.x+1, b.y+1, underline); diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c index 2795570..5fa9918 100644 --- a/generic/ttk/ttkManager.c +++ b/generic/ttk/ttkManager.c @@ -448,13 +448,11 @@ int Ttk_GetSlaveIndexFromObj( { const char *string = Tcl_GetString(objPtr); TkSizeT slaveIndex = 0; - TkSizeT idx; Tk_Window tkwin; /* Try interpreting as an integer first: */ - if (TkGetIntForIndex(objPtr, mgr->nSlaves - 1, 1, &idx) == TCL_OK) { - slaveIndex = idx; + if (TkGetIntForIndex(objPtr, mgr->nSlaves - 1, 1, &slaveIndex) == TCL_OK) { if ((size_t)slaveIndex > (size_t)mgr->nSlaves) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Slave index %d out of bounds", (int)slaveIndex)); -- cgit v0.12 From 435deb263d3876aa9dcca43472efdca252b6fe98 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Jun 2020 14:48:44 +0000 Subject: Handle different possible form of "none" better. --- generic/tkConfig.c | 2 +- generic/tkMenu.c | 4 ++-- library/entry.tcl | 26 +++++++++++++++----------- library/spinbox.tcl | 8 ++++++-- library/tearoff.tcl | 6 +++--- library/text.tcl | 4 ++-- library/ttk/entry.tcl | 10 ++++++---- macosx/tkMacOSXDefault.h | 2 +- macosx/tkMacOSXNotify.c | 2 +- unix/tkUnixDefault.h | 4 ++-- win/tkWinDefault.h | 4 ++-- 11 files changed, 41 insertions(+), 31 deletions(-) diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 1583903..a4cb367 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -1910,7 +1910,7 @@ GetObjectForOption( case TK_OPTION_INDEX: if (*((int *) internalPtr) == INT_MIN) { #if TCL_MAJOR_VERSION > 8 || defined(TK_NO_DEPRECATED) - objPtr = Tcl_NewStringObj("none", -1); + objPtr = Tcl_NewObj(); #else objPtr = Tcl_NewWideIntObj(-1); #endif diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 5ee9ede..91eb87d 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -161,7 +161,7 @@ static const Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = { TCL_INDEX_NONE, offsetof(TkMenuEntry, state), 0, (ClientData) menuStateStrings, 0}, {TK_OPTION_INDEX, "-underline", NULL, NULL, - DEF_MENU_ENTRY_UNDERLINE, TCL_INDEX_NONE, offsetof(TkMenuEntry, underline), 0, NULL, 0}, + DEF_MENU_ENTRY_UNDERLINE, TCL_INDEX_NONE, offsetof(TkMenuEntry, underline), TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0} }; @@ -844,7 +844,7 @@ MenuWidgetObjCmd( goto error; } if (index == TCL_INDEX_NONE) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); + Tcl_SetObjResult(interp, Tcl_NewObj()); } else { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index)); } diff --git a/library/entry.tcl b/library/entry.tcl index 02384da..14c4eb9 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -119,13 +119,17 @@ bind Entry { } bind Entry <> { - tk::EntrySetCursor %W [expr {[%W index insert] - 1}] + if {[%W index insert] != 0} { + tk::EntrySetCursor %W [expr {[%W index insert] - 1}] + } } bind Entry <> { tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } bind Entry <> { - tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + if {[%W index insert] != 0} { + tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + } tk::EntrySeeInsert %W } bind Entry <> { @@ -518,9 +522,9 @@ proc ::tk::EntryBackspace w { if {[$w selection present]} { $w delete sel.first sel.last } else { - set x [expr {[$w index insert] - 1}] - if {$x >= 0} { - $w delete $x + set x [$w index insert] + if {$x > 0} { + $w delete [expr {$x - 1}] } if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -575,10 +579,10 @@ proc ::tk::EntryTranspose w { if {$i < [$w index end]} { incr i } - set first [expr {$i-2}] - if {$first < 0} { + if {$first < 2} { return } + set first [expr {$i-2}] set data [$w get] set new [string index $data [expr {$i-1}]][string index $data $first] $w delete $first $i @@ -599,10 +603,10 @@ proc ::tk::EntryTranspose w { if {[tk windowingsystem] eq "win32"} { proc ::tk::EntryNextWord {w start} { set pos [tcl_endOfWord [$w get] [$w index $start]] - if {$pos >= 0} { + if {![string is none $pos]} { set pos [tcl_startOfNextWord [$w get] $pos] } - if {$pos < 0} { + if {[string is none $pos]} { return end } return $pos @@ -610,7 +614,7 @@ if {[tk windowingsystem] eq "win32"} { } else { proc ::tk::EntryNextWord {w start} { set pos [tcl_endOfWord [$w get] [$w index $start]] - if {$pos < 0} { + if {[string is none $pos]} { return end } return $pos @@ -628,7 +632,7 @@ if {[tk windowingsystem] eq "win32"} { proc ::tk::EntryPreviousWord {w start} { set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] - if {$pos < 0} { + if {[string is none $pos]} { return 0 } return $pos diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 909405e..3f101e3 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -129,13 +129,17 @@ bind Spinbox <> { } bind Spinbox <> { - ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] + if {[%W index insert] != 0} { + ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] + } } bind Spinbox <> { ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } bind Spinbox <> { - ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + if {[%W index insert] != 0} { + ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + } ::tk::EntrySeeInsert %W } bind Spinbox <> { diff --git a/library/tearoff.tcl b/library/tearoff.tcl index c2d2d6b..79e9783 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -135,7 +135,7 @@ proc ::tk::MenuDup {src dst type} { } eval $cmd set last [$src index last] - if {$last eq "none"} { + if {[string is none $last]} { return } for {set i [$src cget -tearoff]} {$i <= $last} {incr i} { @@ -153,7 +153,7 @@ proc ::tk::MenuDup {src dst type} { # Copy tags to x, replacing each substring of src with dst. - while {[set index [string first $src $tags]] != -1} { + while {![string is none [set index [string first $src $tags]]]} { if {$index > 0} { append x [string range $tags 0 [expr {$index - 1}]]$dst } @@ -170,7 +170,7 @@ proc ::tk::MenuDup {src dst type} { # Copy script to x, replacing each substring of event with dst. - while {[set index [string first $event $script]] != -1} { + while {![string is none [set index [string first $event $script]]]} { if {$index > 0} { append x [string range $script 0 [expr {$index - 1}]] } diff --git a/library/text.tcl b/library/text.tcl index 28c6c20..8fff2c4 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -1176,7 +1176,7 @@ proc ::tk::TextNextPos {w start op} { while {[$w compare $cur < end]} { set text $text[$w get -displaychars $cur "$cur lineend + 1c"] set pos [$op $text 0] - if {$pos >= 0} { + if {![string is none $pos]} { return [$w index "$start + $pos display chars"] } set cur [$w index "$cur lineend +1c"] @@ -1199,7 +1199,7 @@ proc ::tk::TextPrevPos {w start op} { while {[$w compare $cur > 0.0]} { set text [$w get -displaychars "$cur linestart - 1c" $cur]$text set pos [$op $text end] - if {$pos >= 0} { + if {![string is none $pos]} { return [$w index "$cur linestart - 1c + $pos display chars"] } set cur [$w index "$cur linestart - 1c"] diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 4cdb5ac..a2fa746 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -228,7 +228,9 @@ proc ttk::entry::Cut {w} { proc ttk::entry::ClosestGap {w x} { set pos [$w index @$x] set bbox [$w bbox $pos] - if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} { + if {[string is none $pos]} { + set pos 0 + } elif {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} { incr pos } return $pos @@ -239,7 +241,7 @@ proc ttk::entry::ClosestGap {w x} { proc ttk::entry::See {w {index insert}} { set c [$w index $index] # @@@ OR: check [$w index left] / [$w index right] - if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} { + if {[string is none $c] || $c < [$w index @0] || $c >= [$w index @[winfo width $w]]} { $w xview $c } } @@ -258,7 +260,7 @@ proc ttk::entry::NextWord {w start} { if {$pos >= 0 && $State(startNext)} { set pos [tcl_startOfNextWord [$w get] $pos] } - if {$pos < 0} { + if {[string is none $pos]} { return end } return $pos @@ -268,7 +270,7 @@ proc ttk::entry::NextWord {w start} { # proc ttk::entry::PrevWord {w start} { set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] - if {$pos < 0} { + if {[string is none $pos]} { return 0 } return $pos diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index 4dcb7d3..80ea1ee 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -309,7 +309,7 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE "-1" +#define DEF_MENU_ENTRY_UNDERLINE DEF_BUTTON_UNDERLINE /* * Defaults for menus overall: diff --git a/macosx/tkMacOSXNotify.c b/macosx/tkMacOSXNotify.c index 82ded8a..1e63279 100644 --- a/macosx/tkMacOSXNotify.c +++ b/macosx/tkMacOSXNotify.c @@ -13,10 +13,10 @@ * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include #include "tkMacOSXPrivate.h" #include "tkMacOSXInt.h" #include "tkMacOSXConstants.h" -#include #import /* This is not used for anything at the moment. */ diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index 982f192..8678d47 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -89,7 +89,7 @@ #if TCL_MAJOR_VERSION < 9 && !defined(TK_NO_DEPRECATED) # define DEF_BUTTON_UNDERLINE "-1" #else -# define DEF_BUTTON_UNDERLINE "none" +# define DEF_BUTTON_UNDERLINE NULL #endif #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" @@ -270,7 +270,7 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE "-1" +#define DEF_MENU_ENTRY_UNDERLINE DEF_BUTTON_UNDERLINE /* * Defaults for menus overall: diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index e2193fd..1631b3e 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -94,7 +94,7 @@ #if TCL_MAJOR_VERSION < 9 && !defined(TK_NO_DEPRECATED) # define DEF_BUTTON_UNDERLINE "-1" #else -# define DEF_BUTTON_UNDERLINE "none" +# define DEF_BUTTON_UNDERLINE NULL #endif #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" @@ -274,7 +274,7 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE "-1" +#define DEF_MENU_ENTRY_UNDERLINE DEF_BUTTON_UNDERLINE /* * Defaults for menus overall: -- cgit v0.12 From 32dfbede133921ddb52e77da15090b48ca29385b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 Jul 2020 13:58:21 +0000 Subject: Don't use constants like DEF_BUTTON_UNDERLINE any more, since the default underline should always be no underline anyway. --- generic/tkButton.c | 8 ++++---- generic/tkCanvText.c | 6 +----- generic/tkMenu.c | 2 +- generic/tkMenubutton.c | 4 ++-- generic/ttk/ttkButton.c | 2 +- generic/ttk/ttkLabel.c | 28 ++++++++++++++-------------- generic/ttk/ttkNotebook.c | 2 +- macosx/tkMacOSXDefault.h | 6 ------ tests/ttk/notebook.test | 2 +- unix/tkUnixDefault.h | 6 ------ win/tkWinDefault.h | 6 ------ 11 files changed, 25 insertions(+), 47 deletions(-) diff --git a/generic/tkButton.c b/generic/tkButton.c index 0c94944..8fe4169 100644 --- a/generic/tkButton.c +++ b/generic/tkButton.c @@ -143,7 +143,7 @@ static const Tk_OptionSpec labelOptionSpecs[] = { {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", DEF_BUTTON_TEXT_VARIABLE, offsetof(TkButton, textVarNamePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_BUTTON_WIDTH, offsetof(TkButton, widthPtr), TCL_INDEX_NONE, 0, 0, 0}, @@ -244,7 +244,7 @@ static const Tk_OptionSpec buttonOptionSpecs[] = { {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", DEF_BUTTON_TEXT_VARIABLE, offsetof(TkButton, textVarNamePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_BUTTON_WIDTH, offsetof(TkButton, widthPtr), TCL_INDEX_NONE, 0, 0, 0}, @@ -354,7 +354,7 @@ static const Tk_OptionSpec checkbuttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-tristatevalue", "tristateValue", "TristateValue", DEF_BUTTON_TRISTATE_VALUE, offsetof(TkButton, tristateValuePtr), TCL_INDEX_NONE, 0, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-variable", "variable", "Variable", DEF_CHECKBUTTON_VARIABLE, offsetof(TkButton, selVarNamePtr), TCL_INDEX_NONE, @@ -464,7 +464,7 @@ static const Tk_OptionSpec radiobuttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-tristatevalue", "tristateValue", "TristateValue", DEF_BUTTON_TRISTATE_VALUE, offsetof(TkButton, tristateValuePtr), TCL_INDEX_NONE, 0, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-value", "value", "Value", DEF_BUTTON_VALUE, offsetof(TkButton, onValuePtr), TCL_INDEX_NONE, 0, 0, 0}, diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index cc36e70..433d129 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -152,11 +152,7 @@ UnderlinePrintProc( (void)tkwin; if (underline == INT_MIN) { -#if TCL_MAJOR_VERSION > 9 || defined(TK_NON_DEPRECATED) - p = (char *)"none"; -#else p = (char *)"-1"; -#endif *freeProcPtr = TCL_STATIC; return p; } else if (underline == INT_MAX) { @@ -211,7 +207,7 @@ static const Tk_ConfigSpec configSpecs[] = { NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_STRING, "-text", NULL, NULL, "", offsetof(TextItem, text), 0, NULL}, - {TK_CONFIG_CUSTOM, "-underline", NULL, NULL, DEF_BUTTON_UNDERLINE, + {TK_CONFIG_CUSTOM, "-underline", NULL, NULL, NULL, offsetof(TextItem, underline), TK_CONFIG_NULL_OK, &underlineOption}, {TK_CONFIG_PIXELS, "-width", NULL, NULL, "0", offsetof(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT, NULL}, diff --git a/generic/tkMenu.c b/generic/tkMenu.c index a8c81f3..bb8e62a 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -161,7 +161,7 @@ static const Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = { TCL_INDEX_NONE, offsetof(TkMenuEntry, state), 0, (ClientData) menuStateStrings, 0}, {TK_OPTION_INDEX, "-underline", NULL, NULL, - DEF_MENU_ENTRY_UNDERLINE, TCL_INDEX_NONE, offsetof(TkMenuEntry, underline), TK_OPTION_NULL_OK, NULL, 0}, + NULL, TCL_INDEX_NONE, offsetof(TkMenuEntry, underline), TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0} }; diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 8d512c1..d046c84 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -146,8 +146,8 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_MENUBUTTON_TEXT_VARIABLE, TCL_INDEX_NONE, offsetof(TkMenuButton, textVarName), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, TCL_INDEX_NONE, offsetof(TkMenuButton, underline), - TK_OPTION_NULL_OK, 0, 0}, + NULL, TCL_INDEX_NONE, offsetof(TkMenuButton, underline), + TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_MENUBUTTON_WIDTH, TCL_INDEX_NONE, offsetof(TkMenuButton, widthString), 0, 0, 0}, diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c index e85313e..89312c0 100644 --- a/generic/ttk/ttkButton.c +++ b/generic/ttk/ttkButton.c @@ -67,7 +67,7 @@ static const Tk_OptionSpec BaseOptionSpecs[] = offsetof(Base,base.textVariableObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, offsetof(Base,base.underlineObj), TCL_INDEX_NONE, + NULL, offsetof(Base,base.underlineObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,0 }, /* SB: OPTION_INT, see <> */ {TK_OPTION_STRING, "-width", "width", "Width", diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index 0578118..a9a39bb 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -55,7 +55,7 @@ static const Ttk_ElementOptionSpec TextElementOptions[] = { { "-foreground", TK_OPTION_COLOR, offsetof(TextElement,foregroundObj), "black" }, { "-underline", TK_OPTION_INDEX, - offsetof(TextElement,underlineObj), DEF_BUTTON_UNDERLINE}, + offsetof(TextElement,underlineObj), NULL}, { "-width", TK_OPTION_INT, offsetof(TextElement,widthObj), "-1"}, { "-anchor", TK_OPTION_ANCHOR, @@ -171,19 +171,19 @@ static void TextDraw(TextElement *text, Tk_Window tkwin, Drawable d, Ttk_Box b) Tk_DrawTextLayout(Tk_Display(tkwin), d, gc1, text->textLayout, b.x, b.y, 0/*firstChar*/, -1/*lastChar*/); - TkGetIntForIndex(text->underlineObj, TCL_INDEX_END, 0, &underline); - if (underline == TCL_INDEX_NONE) { - underline = (TkSizeT)INT_MIN; - } else if ((size_t)underline > (size_t)TCL_INDEX_END>>1) { - underline++; - } - if (underline != (TkSizeT)INT_MIN) { - if (text->embossed) { - Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc2, - text->textLayout, b.x+1, b.y+1, underline); + if (text->underlineObj != NULL) { + TkGetIntForIndex(text->underlineObj, TCL_INDEX_END, 0, &underline); + if (underline != TCL_INDEX_NONE) { + if ((size_t)underline > (size_t)TCL_INDEX_END>>1) { + underline++; + } + if (text->embossed) { + Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc2, + text->textLayout, b.x+1, b.y+1, underline); + } + Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc1, + text->textLayout, b.x, b.y, underline); } - Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc1, - text->textLayout, b.x, b.y, underline); } if (clipRegion != NULL) { @@ -470,7 +470,7 @@ static const Ttk_ElementOptionSpec LabelElementOptions[] = { { "-foreground", TK_OPTION_COLOR, offsetof(LabelElement,text.foregroundObj), "black" }, { "-underline", TK_OPTION_INDEX, - offsetof(LabelElement,text.underlineObj), DEF_BUTTON_UNDERLINE}, + offsetof(LabelElement,text.underlineObj), NULL}, { "-width", TK_OPTION_INT, offsetof(LabelElement,text.widthObj), ""}, { "-anchor", TK_OPTION_ANCHOR, diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c index 61f95f0..dedd158 100644 --- a/generic/ttk/ttkNotebook.c +++ b/generic/ttk/ttkNotebook.c @@ -68,7 +68,7 @@ static const Tk_OptionSpec TabOptionSpecs[] = {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", NULL, offsetof(Tab,compoundObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,(void *)ttkCompoundStrings,GEOMETRY_CHANGED }, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", DEF_BUTTON_UNDERLINE, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, offsetof(Tab,underlineObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0 } }; diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index 80ea1ee..f25c69e 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -114,11 +114,6 @@ #define DEF_BUTTON_TAKE_FOCUS NULL #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" -#if TCL_MAJOR_VERSION < 9 && !defined(TK_NO_DEPRECATED) -# define DEF_BUTTON_UNDERLINE "-1" -#else -# define DEF_BUTTON_UNDERLINE NULL -#endif #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" #define DEF_BUTTON_WRAP_LENGTH "0" @@ -309,7 +304,6 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE DEF_BUTTON_UNDERLINE /* * Defaults for menus overall: diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test index ac63088..253e1cc 100644 --- a/tests/ttk/notebook.test +++ b/tests/ttk/notebook.test @@ -69,7 +69,7 @@ test notebook-2.5 "tab - get all options" -body { .nb tab .nb.foo } -result [list \ -padding 0 -sticky nsew \ - -state normal -text "Changed Foo" -image "" -compound {} -underline -1] + -state normal -text "Changed Foo" -image "" -compound {} -underline {}] test notebook-4.1 "Test .nb index end" -body { .nb index end diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index 8678d47..87af737 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -86,11 +86,6 @@ #define DEF_BUTTON_TAKE_FOCUS NULL #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" -#if TCL_MAJOR_VERSION < 9 && !defined(TK_NO_DEPRECATED) -# define DEF_BUTTON_UNDERLINE "-1" -#else -# define DEF_BUTTON_UNDERLINE NULL -#endif #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" #define DEF_BUTTON_WRAP_LENGTH "0" @@ -270,7 +265,6 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE DEF_BUTTON_UNDERLINE /* * Defaults for menus overall: diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index 1631b3e..1aac782 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -91,11 +91,6 @@ #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" #define DEF_BUTTON_TRISTATE_VALUE "" -#if TCL_MAJOR_VERSION < 9 && !defined(TK_NO_DEPRECATED) -# define DEF_BUTTON_UNDERLINE "-1" -#else -# define DEF_BUTTON_UNDERLINE NULL -#endif #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" #define DEF_BUTTON_WRAP_LENGTH "0" @@ -274,7 +269,6 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE DEF_BUTTON_UNDERLINE /* * Defaults for menus overall: -- cgit v0.12 From e34f23079907b43b473166de5403ae25016a3fb5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 Jul 2020 14:13:29 +0000 Subject: No need to #include "default.h" in ttk widgets (and in tkUnixMenu.c/tkMenubutton.c) --- generic/tkMenubutton.c | 1 - generic/ttk/ttkButton.c | 3 +-- generic/ttk/ttkFrame.c | 3 +-- generic/ttk/ttkLabel.c | 3 +-- generic/ttk/ttkNotebook.c | 3 +-- tests/ttk/notebook.test | 2 +- unix/tkUnixMenu.c | 1 - 7 files changed, 5 insertions(+), 11 deletions(-) diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index d046c84..722de8c 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -13,7 +13,6 @@ #include "tkInt.h" #include "tkMenubutton.h" -#include "default.h" /* * The structure below defines menubutton class behavior by means of diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c index 89312c0..38e8721 100644 --- a/generic/ttk/ttkButton.c +++ b/generic/ttk/ttkButton.c @@ -7,7 +7,6 @@ #include "tkInt.h" #include "ttkTheme.h" #include "ttkWidget.h" -#include "default.h" /* Bit fields for OptionSpec mask field: */ @@ -67,7 +66,7 @@ static const Tk_OptionSpec BaseOptionSpecs[] = offsetof(Base,base.textVariableObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - NULL, offsetof(Base,base.underlineObj), TCL_INDEX_NONE, + "-1", offsetof(Base,base.underlineObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,0 }, /* SB: OPTION_INT, see <> */ {TK_OPTION_STRING, "-width", "width", "Width", diff --git a/generic/ttk/ttkFrame.c b/generic/ttk/ttkFrame.c index 7ebc40f..e1ab211 100644 --- a/generic/ttk/ttkFrame.c +++ b/generic/ttk/ttkFrame.c @@ -8,7 +8,6 @@ #include "ttkTheme.h" #include "ttkWidget.h" #include "ttkManager.h" -#include "default.h" /* ====================================================================== * +++ Frame widget: @@ -259,7 +258,7 @@ static const Tk_OptionSpec LabelframeOptionSpecs[] = { offsetof(Labelframe,label.textObj), TCL_INDEX_NONE, 0,0,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - NULL, offsetof(Labelframe,label.underlineObj), TCL_INDEX_NONE, + "-1", offsetof(Labelframe,label.underlineObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,0 }, {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget", NULL, TCL_INDEX_NONE, offsetof(Labelframe,label.labelWidget), diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index a9a39bb..91f52a8 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -8,7 +8,6 @@ #include "tkInt.h" #include "ttkTheme.h" -#include "default.h" /*---------------------------------------------------------------------- * +++ Text element. @@ -470,7 +469,7 @@ static const Ttk_ElementOptionSpec LabelElementOptions[] = { { "-foreground", TK_OPTION_COLOR, offsetof(LabelElement,text.foregroundObj), "black" }, { "-underline", TK_OPTION_INDEX, - offsetof(LabelElement,text.underlineObj), NULL}, + offsetof(LabelElement,text.underlineObj), "-1"}, { "-width", TK_OPTION_INT, offsetof(LabelElement,text.widthObj), ""}, { "-anchor", TK_OPTION_ANCHOR, diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c index dedd158..60fc766 100644 --- a/generic/ttk/ttkNotebook.c +++ b/generic/ttk/ttkNotebook.c @@ -6,7 +6,6 @@ #include "ttkTheme.h" #include "ttkWidget.h" #include "ttkManager.h" -#include "default.h" #define MIN(a,b) ((a) < (b) ? (a) : (b)) #define MAX(a,b) ((a) > (b) ? (a) : (b)) @@ -68,7 +67,7 @@ static const Tk_OptionSpec TabOptionSpecs[] = {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", NULL, offsetof(Tab,compoundObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,(void *)ttkCompoundStrings,GEOMETRY_CHANGED }, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", "-1", offsetof(Tab,underlineObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0 } }; diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test index 253e1cc..ac63088 100644 --- a/tests/ttk/notebook.test +++ b/tests/ttk/notebook.test @@ -69,7 +69,7 @@ test notebook-2.5 "tab - get all options" -body { .nb tab .nb.foo } -result [list \ -padding 0 -sticky nsew \ - -state normal -text "Changed Foo" -image "" -compound {} -underline {}] + -state normal -text "Changed Foo" -image "" -compound {} -underline -1] test notebook-4.1 "Test .nb index end" -body { .nb index end diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c index e60c007..42eb525 100644 --- a/unix/tkUnixMenu.c +++ b/unix/tkUnixMenu.c @@ -11,7 +11,6 @@ #include "tkUnixInt.h" #include "tkMenu.h" -#include "default.h" /* * Constants used for menu drawing. -- cgit v0.12 From d2ab1fe96fa2eeb20d0bce978ec1242ecd06d0f6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 20 Aug 2020 16:25:13 +0000 Subject: Plug memory leak in UnderlinePrintProc() --- generic/tkCanvText.c | 7 ++++++- generic/tkObj.c | 3 --- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 86760a2..d9c836f 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -147,12 +147,16 @@ UnderlinePrintProc( * for return string. */ { int underline = *(int *)(widgRec + offset); - char *p = (char *)ckalloc(32); + char *p; (void)dummy; (void)tkwin; if (underline == INT_MIN) { +#if !defined(TK_NO_DEPRECATED) && TK_MAJOR_VERSION < 9 p = (char *)"-1"; +#else + p = (char *)""; +#endif *freeProcPtr = TCL_STATIC; return p; } else if (underline == INT_MAX) { @@ -164,6 +168,7 @@ UnderlinePrintProc( *freeProcPtr = TCL_STATIC; return p; } + p = (char *)ckalloc(32); if (underline < 0) { sprintf(p, "end%d", underline); } else { diff --git a/generic/tkObj.c b/generic/tkObj.c index a5ac233..b8ddb2b 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -233,9 +233,6 @@ TkGetIntForIndex( } return TCL_ERROR; } - if (Tcl_GetString(indexObj)[0] == '-') { - return TCL_ERROR; - } if ((end + 1 >= 0) && (*indexPtr + 1) > (end + 1)) { *indexPtr = end + 1; } -- cgit v0.12 From a5b431355b9a94c3f57f6de93d123a9b3ce65ff9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 14 Sep 2020 14:58:00 +0000 Subject: Make all test-cases pass (finally) --- generic/tkInt.h | 2 +- generic/tkMenu.c | 2 +- macosx/tkMacOSXDefault.h | 3 --- tests/listbox.test | 8 ++++---- tests/menuDraw.test | 4 ++-- tests/ttk/combobox.test | 8 ++++---- unix/tkUnixDefault.h | 3 --- win/tkWinDefault.h | 3 --- 8 files changed, 12 insertions(+), 21 deletions(-) diff --git a/generic/tkInt.h b/generic/tkInt.h index e509a19..7ce7af8 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1376,7 +1376,7 @@ MODULE_SCOPE int TkGetIntForIndex(Tcl_Obj *, TkSizeT, int lastOK, TkSizeT*); #if !defined(TK_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) # define TkNewIndexObj(value) Tcl_NewWideIntObj((Tcl_WideInt)(value + 1) - 1) #else -# define TkNewIndexObj(value) (((value) == TCL_INDEX_NONE) ? Tcl_NewObj() : Tcl_NewWideIntObj(value)) +# define TkNewIndexObj(value) (((TkSizeT)(value) == TCL_INDEX_NONE) ? Tcl_NewObj() : Tcl_NewWideIntObj(value)) #endif #ifdef _WIN32 diff --git a/generic/tkMenu.c b/generic/tkMenu.c index f30d61b..75255f4 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -845,7 +845,7 @@ MenuWidgetObjCmd( } #if !defined(TK_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) if (index == TCL_INDEX_NONE) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); + Tcl_SetObjResult(interp, Tcl_NewObj()); } else #endif Tcl_SetObjResult(interp, TkNewIndexObj(index)); diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index 8a6546f..1c145cd 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -114,7 +114,6 @@ #define DEF_BUTTON_TAKE_FOCUS NULL #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" -#define DEF_BUTTON_UNDERLINE "-1" #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" #define DEF_BUTTON_WRAP_LENGTH "0" @@ -305,7 +304,6 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE "-1" /* * Defaults for menus overall: @@ -370,7 +368,6 @@ #define DEF_MENUBUTTON_TAKE_FOCUS "0" #define DEF_MENUBUTTON_TEXT "" #define DEF_MENUBUTTON_TEXT_VARIABLE "" -#define DEF_MENUBUTTON_UNDERLINE "-1" #define DEF_MENUBUTTON_WIDTH "0" #define DEF_MENUBUTTON_WRAP_LENGTH "0" diff --git a/tests/listbox.test b/tests/listbox.test index f2f4c70..d2d04d2 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -717,8 +717,8 @@ test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} -body { .l index 2 } -result 2 test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} -body { - .l index {} -} -result -1 + expr {[.l index {}]<0} +} -result 1 test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} -body { .l index end } -result 18 @@ -2129,10 +2129,10 @@ test listbox-10.19 {GetListboxIndex procedure} -setup { pack [listbox .l] .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 update - .l index {} + expr {[.l index {}]<0} } -cleanup { destroy .l -} -result -1 +} -result 1 test listbox-10.20 {GetListboxIndex procedure} -setup { destroy .l } -body { diff --git a/tests/menuDraw.test b/tests/menuDraw.test index bf15f25..f7c6faa 100644 --- a/tests/menuDraw.test +++ b/tests/menuDraw.test @@ -558,10 +558,10 @@ test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} -setup { menu .m1 .m1 add command -label "foo" -state active set tearoff [tk::TearOffMenu .m1 40 40] - $tearoff index active + expr {[$tearoff index active]<0} } -cleanup { deleteWindows -} -result none +} -result 1 test menuDraw-15.3 {TkPostTearoffMenu - post command} -setup { deleteWindows } -body { diff --git a/tests/ttk/combobox.test b/tests/ttk/combobox.test index c14db9b..2257ed7 100644 --- a/tests/ttk/combobox.test +++ b/tests/ttk/combobox.test @@ -20,8 +20,8 @@ test combobox-1.end "Combobox tests -- cleanup" -body { test combobox-2.0 "current command" -body { ttk::combobox .cb -values [list a b c d e a] - .cb current -} -result -1 + expr {[.cb current]<0} +} -result 1 test combobox-2.1 "current -- set index" -body { .cb current 5 @@ -40,8 +40,8 @@ test combobox-2.3 "current -- change value" -body { test combobox-2.4 "current -- value not in list" -body { .cb set "z" - .cb current -} -result -1 + expr {[.cb current]<0} +} -result 1 test combobox-2.5 "current -- set to end index" -body { .cb configure -values [list a b c d e thelastone] diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index b59f7ae..3cae17b 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -88,7 +88,6 @@ #define DEF_BUTTON_TAKE_FOCUS NULL #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" -#define DEF_BUTTON_UNDERLINE "-1" #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" #define DEF_BUTTON_WRAP_LENGTH "0" @@ -268,7 +267,6 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE "-1" /* * Defaults for menus overall: @@ -333,7 +331,6 @@ #define DEF_MENUBUTTON_TAKE_FOCUS "0" #define DEF_MENUBUTTON_TEXT "" #define DEF_MENUBUTTON_TEXT_VARIABLE "" -#define DEF_MENUBUTTON_UNDERLINE "-1" #define DEF_MENUBUTTON_WIDTH "0" #define DEF_MENUBUTTON_WRAP_LENGTH "0" diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index eaceb42..0a747d9 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -91,7 +91,6 @@ #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" #define DEF_BUTTON_TRISTATE_VALUE "" -#define DEF_BUTTON_UNDERLINE "-1" #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" #define DEF_BUTTON_WRAP_LENGTH "0" @@ -270,7 +269,6 @@ #define DEF_MENU_ENTRY_CHECK_VARIABLE NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT NULL -#define DEF_MENU_ENTRY_UNDERLINE "-1" /* * Defaults for menus overall: @@ -335,7 +333,6 @@ #define DEF_MENUBUTTON_TAKE_FOCUS "0" #define DEF_MENUBUTTON_TEXT "" #define DEF_MENUBUTTON_TEXT_VARIABLE "" -#define DEF_MENUBUTTON_UNDERLINE "-1" #define DEF_MENUBUTTON_WIDTH "0" #define DEF_MENUBUTTON_WRAP_LENGTH "0" -- cgit v0.12 From 39f0dce0e852ac81431c337fb50da0a1c0ec5eec Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 14 Sep 2020 16:25:21 +0000 Subject: Make default underline -1 (again) when compiled with Tcl 8 headers --- generic/tkButton.c | 16 ++++++++-------- generic/tkConfig.c | 4 +--- generic/tkInt.h | 7 +++---- generic/tkMenu.c | 2 +- generic/tkMenubutton.c | 3 +-- generic/ttk/ttkButton.c | 3 +-- generic/ttk/ttkFrame.c | 3 +-- generic/ttk/ttkLabel.c | 8 ++++++++ generic/ttk/ttkNotebook.c | 4 ++-- tests/ttk/notebook.test | 3 ++- 10 files changed, 28 insertions(+), 25 deletions(-) diff --git a/generic/tkButton.c b/generic/tkButton.c index f0dc07b..7ca84c4 100644 --- a/generic/tkButton.c +++ b/generic/tkButton.c @@ -143,8 +143,8 @@ static const Tk_OptionSpec labelOptionSpecs[] = { {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", DEF_BUTTON_TEXT_VARIABLE, offsetof(TkButton, textVarNamePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, - TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", + TK_OPTION_UNDERLINE_DEF(TkButton, underline), 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_BUTTON_WIDTH, offsetof(TkButton, widthPtr), TCL_INDEX_NONE, 0, 0, 0}, {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", @@ -244,8 +244,8 @@ static const Tk_OptionSpec buttonOptionSpecs[] = { {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", DEF_BUTTON_TEXT_VARIABLE, offsetof(TkButton, textVarNamePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, - TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", + TK_OPTION_UNDERLINE_DEF(TkButton, underline), 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_BUTTON_WIDTH, offsetof(TkButton, widthPtr), TCL_INDEX_NONE, 0, 0, 0}, {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", @@ -354,8 +354,8 @@ static const Tk_OptionSpec checkbuttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-tristatevalue", "tristateValue", "TristateValue", DEF_BUTTON_TRISTATE_VALUE, offsetof(TkButton, tristateValuePtr), TCL_INDEX_NONE, 0, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, - TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", + TK_OPTION_UNDERLINE_DEF(TkButton, underline), 0}, {TK_OPTION_STRING, "-variable", "variable", "Variable", DEF_CHECKBUTTON_VARIABLE, offsetof(TkButton, selVarNamePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, @@ -464,8 +464,8 @@ static const Tk_OptionSpec radiobuttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-tristatevalue", "tristateValue", "TristateValue", DEF_BUTTON_TRISTATE_VALUE, offsetof(TkButton, tristateValuePtr), TCL_INDEX_NONE, 0, 0, 0}, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, - TCL_INDEX_NONE, offsetof(TkButton, underline), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", + TK_OPTION_UNDERLINE_DEF(TkButton, underline), 0}, {TK_OPTION_STRING, "-value", "value", "Value", DEF_BUTTON_VALUE, offsetof(TkButton, onValuePtr), TCL_INDEX_NONE, 0, 0, 0}, {TK_OPTION_STRING, "-variable", "variable", "Variable", diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 8e48da6..2c6ba3d 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -1427,8 +1427,6 @@ Tk_RestoreSavedOptions( switch (specPtr->type) { case TK_OPTION_BOOLEAN: case TK_OPTION_INT: - *((int *) internalPtr) = *((int *) ptr); - break; case TK_OPTION_INDEX: *((int *) internalPtr) = *((int *) ptr); break; @@ -1905,7 +1903,7 @@ GetObjectForOption( break; case TK_OPTION_INDEX: if (*((int *) internalPtr) == INT_MIN) { - objPtr = Tcl_NewObj(); + objPtr = TkNewIndexObj(TCL_INDEX_NONE); } else if (*((int *) internalPtr) == INT_MAX) { objPtr = Tcl_NewStringObj("end+1", -1); } else if (*((int *) internalPtr) == -1) { diff --git a/generic/tkInt.h b/generic/tkInt.h index 7ce7af8..b59bed5 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -933,10 +933,6 @@ typedef struct { #ifndef TCL_INDEX_END # define TCL_INDEX_END ((TkSizeT)-2) #endif -/* See TIP #577 */ -#ifndef TCL_INDEX_ERROR -# define TCL_INDEX_ERROR 0x100 -#endif /* * The following structure is used with TkMakeEnsemble to create ensemble @@ -1375,10 +1371,13 @@ MODULE_SCOPE int TkGetIntForIndex(Tcl_Obj *, TkSizeT, int lastOK, TkSizeT*); #if !defined(TK_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) # define TkNewIndexObj(value) Tcl_NewWideIntObj((Tcl_WideInt)(value + 1) - 1) +# define TK_OPTION_UNDERLINE_DEF(type, field) "-1", TCL_INDEX_NONE, offsetof(type, field), 0, NULL #else # define TkNewIndexObj(value) (((TkSizeT)(value) == TCL_INDEX_NONE) ? Tcl_NewObj() : Tcl_NewWideIntObj(value)) +# define TK_OPTION_UNDERLINE_DEF(type, field) NULL, TCL_INDEX_NONE, offsetof(type, field), TK_OPTION_NULL_OK, NULL #endif + #ifdef _WIN32 #define TkParseColor XParseColor #else diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 75255f4..947d996 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -161,7 +161,7 @@ static const Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = { TCL_INDEX_NONE, offsetof(TkMenuEntry, state), 0, (ClientData) menuStateStrings, 0}, {TK_OPTION_INDEX, "-underline", NULL, NULL, - NULL, TCL_INDEX_NONE, offsetof(TkMenuEntry, underline), TK_OPTION_NULL_OK, NULL, 0}, + TK_OPTION_UNDERLINE_DEF(TkMenuEntry, underline), 0}, {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0} }; diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 52951a2..369437c 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -145,8 +145,7 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_MENUBUTTON_TEXT_VARIABLE, TCL_INDEX_NONE, offsetof(TkMenuButton, textVarName), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - NULL, TCL_INDEX_NONE, offsetof(TkMenuButton, underline), - TK_OPTION_NULL_OK, 0, 0}, + TK_OPTION_UNDERLINE_DEF(TkMenuButton, underline), 0}, {TK_OPTION_STRING, "-width", "width", "Width", DEF_MENUBUTTON_WIDTH, TCL_INDEX_NONE, offsetof(TkMenuButton, widthString), 0, 0, 0}, diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c index 5348e96..02c118c 100644 --- a/generic/ttk/ttkButton.c +++ b/generic/ttk/ttkButton.c @@ -66,8 +66,7 @@ static const Tk_OptionSpec BaseOptionSpecs[] = offsetof(Base,base.textVariableObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - NULL, offsetof(Base,base.underlineObj), TCL_INDEX_NONE, - TK_OPTION_NULL_OK,0,0 }, + TK_OPTION_UNDERLINE_DEF(Base, base.underlineObj), 0}, /* SB: OPTION_INT, see <> */ {TK_OPTION_STRING, "-width", "width", "Width", NULL, offsetof(Base,base.widthObj), TCL_INDEX_NONE, diff --git a/generic/ttk/ttkFrame.c b/generic/ttk/ttkFrame.c index f1aadb8..7e9e416 100644 --- a/generic/ttk/ttkFrame.c +++ b/generic/ttk/ttkFrame.c @@ -258,8 +258,7 @@ static const Tk_OptionSpec LabelframeOptionSpecs[] = { offsetof(Labelframe,label.textObj), TCL_INDEX_NONE, 0,0,GEOMETRY_CHANGED }, {TK_OPTION_INDEX, "-underline", "underline", "Underline", - NULL , offsetof(Labelframe,label.underlineObj), TCL_INDEX_NONE, - TK_OPTION_NULL_OK,0,0 }, + TK_OPTION_UNDERLINE_DEF(Labelframe, label.underlineObj), 0}, {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget", NULL, TCL_INDEX_NONE, offsetof(Labelframe,label.labelWidget), TK_OPTION_NULL_OK,0,LABELWIDGET_CHANGED|GEOMETRY_CHANGED }, diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index 3dc5c58..fdf7802 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -54,7 +54,11 @@ static const Ttk_ElementOptionSpec TextElementOptions[] = { { "-foreground", TK_OPTION_COLOR, offsetof(TextElement,foregroundObj), "black" }, { "-underline", TK_OPTION_INDEX, +#if !defined(TK_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) + offsetof(TextElement,underlineObj), "-1"}, +#else offsetof(TextElement,underlineObj), NULL}, +#endif { "-width", TK_OPTION_INT, offsetof(TextElement,widthObj), "-1"}, { "-anchor", TK_OPTION_ANCHOR, @@ -469,7 +473,11 @@ static const Ttk_ElementOptionSpec LabelElementOptions[] = { { "-foreground", TK_OPTION_COLOR, offsetof(LabelElement,text.foregroundObj), "black" }, { "-underline", TK_OPTION_INDEX, +#if !defined(TK_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) + offsetof(LabelElement,text.underlineObj), "-1"}, +#else offsetof(LabelElement,text.underlineObj), NULL}, +#endif { "-width", TK_OPTION_INT, offsetof(LabelElement,text.widthObj), ""}, { "-anchor", TK_OPTION_ANCHOR, diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c index 1a9d106..7e8d44f 100644 --- a/generic/ttk/ttkNotebook.c +++ b/generic/ttk/ttkNotebook.c @@ -67,8 +67,8 @@ static const Tk_OptionSpec TabOptionSpecs[] = {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", NULL, offsetof(Tab,compoundObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK,(void *)ttkCompoundStrings,GEOMETRY_CHANGED }, - {TK_OPTION_INDEX, "-underline", "underline", "Underline", NULL, - offsetof(Tab,underlineObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, GEOMETRY_CHANGED }, + {TK_OPTION_INDEX, "-underline", "underline", "Underline", + TK_OPTION_UNDERLINE_DEF(Tab, underlineObj), GEOMETRY_CHANGED}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0 } }; diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test index 253e1cc..f6daeae 100644 --- a/tests/ttk/notebook.test +++ b/tests/ttk/notebook.test @@ -66,10 +66,11 @@ test notebook-2.4 "tab - set value" -body { } -result "Changed Foo" test notebook-2.5 "tab - get all options" -body { + .nb tab .nb.foo -underline -1 .nb tab .nb.foo } -result [list \ -padding 0 -sticky nsew \ - -state normal -text "Changed Foo" -image "" -compound {} -underline {}] + -state normal -text "Changed Foo" -image "" -compound {} -underline -1] test notebook-4.1 "Test .nb index end" -body { .nb index end -- cgit v0.12 From 6c4b0caaaf5b566e2ce4b03caa5e44943383601f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 16 Sep 2020 14:24:22 +0000 Subject: Fix crash in Travis testcase run --- tests/listbox.test | 2 +- unix/tkUnixMenu.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/listbox.test b/tests/listbox.test index d2d04d2..df7536d 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -426,7 +426,7 @@ test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} -constraints { } -body { .l yview 0 update - list [.l bbox none] [.l bbox 0] + list [.l bbox {}] [.l bbox 0] } -result {{} {7 7 17 14}} test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} -constraints { fonts diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c index ae0eca4..243d45f 100644 --- a/unix/tkUnixMenu.c +++ b/unix/tkUnixMenu.c @@ -878,7 +878,7 @@ DrawMenuUnderline( int len; len = Tcl_GetCharLength(mePtr->labelPtr); - if (mePtr->underline < -len || mePtr->underline >= len) { + if (mePtr->underline < len && mePtr->underline >= -len) { int activeBorderWidth, leftEdge, ch; const char *label, *start, *end; -- cgit v0.12 From 4b687f8b1fa0e8a697d84246ae7735fbc5c2f061 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 Oct 2020 09:17:51 +0000 Subject: Fix menu-3.71 expected result --- tests/menu.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/menu.test b/tests/menu.test index babec58..bf40e94 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -1865,7 +1865,7 @@ test menu-3.71 {MenuWidgetCmd procedure, "index end" option, bug [f3cd942e9e]} - list [.m1 index "end"] } -cleanup { destroy .m1 -} -result none +} -result {} test menu-4.1 {TkInvokeMenu: disabled} -setup { -- cgit v0.12 From 5a7aa650e450b240ab33b7d9f74e08c60854a64c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 Oct 2020 10:00:30 +0000 Subject: Now really fix menu-3.71 expected result --- tests/menu.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/menu.test b/tests/menu.test index bf40e94..58c29d5 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -1862,7 +1862,7 @@ test menu-3.71 {MenuWidgetCmd procedure, "index end" option, bug [f3cd942e9e]} - destroy .m1 } -body { menu .m1 - list [.m1 index "end"] + .m1 index "end" } -cleanup { destroy .m1 } -result {} -- cgit v0.12 From 387766b8dc96912fac2f0cf7f1a29f32c4951faf Mon Sep 17 00:00:00 2001 From: culler Date: Tue, 10 Nov 2020 19:39:45 +0000 Subject: For Aqua, a real implementation of endOfGlyphCluster and startOfGlyphCluster. Makes entry editing fully functional. --- library/tk.tcl | 55 +++++++++++++++------------ macosx/tkMacOSXFont.c | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 132 insertions(+), 23 deletions(-) diff --git a/library/tk.tcl b/library/tk.tcl index b1b7629..559af38 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -700,34 +700,43 @@ if {[tk windowingsystem] eq "aqua"} { } } -proc ::tk::endOfGlyphCluster {str start} { - if {$start >= [string length $str]} { - return -1; - } - if {[string length [string index $str $start]] > 1} { - set start [expr {$start+1}] +if {[tk windowingsystem] eq "aqua"} { + proc ::tk::endOfGlyphCluster {str index} { + return [endOfGlyph $str $index] } - set start [expr {$start+1}] - if {[string index $str $start] eq {^}} { - set start [expr {$start+1}];# For demo purposes only + proc ::tk::startOfGlyphCluster {str index} { + return [startOfGlyph $str $index] } - return $start +} else { + proc ::tk::endOfGlyphCluster {str start} { + if {$start >= [string length $str]} { + return -1; + } + if {[string length [string index $str $start]] > 1} { + set start [expr {$start+1}] + } + set start [expr {$start+1}] + if {[string index $str $start] eq {^}} { + set start [expr {$start+1}];# For demo purposes only + } + return $start } -proc ::tk::startOfGlyphCluster {str start} { - if {$start eq "end"} { - set start [expr {[string length $str]-1}] - } - if {$start < 0} { - return -1; - } - if {[string index $str $start] eq {^}} { - set start [expr {$start-1}];# For demo purposes only - } - if {[string length [string index $str [expr {$start-1}]]] > 1} { - return [expr {$start-1}] + proc ::tk::startOfGlyphCluster {str start} { + if {$start eq "end"} { + set start [expr {[string length $str]-1}] + } + if {$start < 0} { + return -1; + } + if {[string index $str $start] eq {^}} { + set start [expr {$start-1}];# For demo purposes only + } + if {[string length [string index $str [expr {$start-1}]]] > 1} { + return [expr {$start-1}] + } + return $start } - return $start } # Create a dictionary to store the starting index of the IME marked diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index 6c66ed8..11d690c 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -149,6 +149,16 @@ static int CreateNamedSystemFont(Tcl_Interp *interp, return [_string characterAtIndex:index]; } +- (NSUInteger)startOfGlyphCluster:(NSUInteger)index +{ + NSRange range = [_string rangeOfComposedCharacterSequenceAtIndex:index]; + return range.location; +} +- (NSUInteger)endOfGlyphCluster:(NSUInteger)index +{ + NSRange range = [_string rangeOfComposedCharacterSequenceAtIndex:index]; + return range.location + range.length; +} # ifndef __clang__ @synthesize DString = _ds; #endif @@ -425,6 +435,94 @@ CreateNamedSystemFont( } #pragma mark - + +#pragma mark Glyph indexing + +/* + *---------------------------------------------------------------------- + * + * startOfGlyphObjCmd -- + * + * This function is invoked to process the startOfGlyph command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +startOfGlyphObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + TKNSString *S; + const char *stringArg; + int numBytes; + Tcl_WideInt indexArg; + Tcl_WideInt result; + if ((objc != 3)) { + Tcl_WrongNumArgs(interp, 1, objv, "string index"); + return TCL_ERROR; + } + stringArg = Tcl_GetStringFromObj(objv[1], &numBytes); + if (stringArg == NULL) { + return TCL_ERROR; + } + if (Tcl_GetWideIntFromObj(interp, objv[2], &indexArg) != TCL_OK) { + return TCL_ERROR; + } + S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; + if ((unsigned long long) indexArg >= [S length]) { + Tcl_SetObjResult(interp, Tcl_NewWideIntObj([S length])); + return TCL_OK; + } + result = indexArg >= 0 ? [S startOfGlyphCluster:indexArg] : -1; + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); + return TCL_OK; +} + +static int +endOfGlyphObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + TKNSString *S; + char *stringArg; + int numBytes; + Tcl_WideInt indexArg; + Tcl_WideInt result; + + if ((objc != 3)) { + Tcl_WrongNumArgs(interp, 1, objv, "string index"); + return TCL_ERROR; + } + stringArg = Tcl_GetStringFromObj(objv[1], &numBytes); + if (stringArg == NULL) { + return TCL_ERROR; + } + if (Tcl_GetWideIntFromObj(interp, objv[2], &indexArg) != TCL_OK) { + return TCL_ERROR; + } + if (indexArg < 0) { + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); + return TCL_OK; + } + S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; + result = (unsigned long long) indexArg < [S length] ? + [S endOfGlyphCluster:indexArg] : [S length]; + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); + return TCL_OK; +} + +#pragma mark - #pragma mark Font handling: /* @@ -520,6 +618,8 @@ TkpFontPkgInit( [cs release]; } [pool drain]; + Tcl_CreateObjCommand(interp, "startOfGlyph", startOfGlyphObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "endOfGlyph", endOfGlyphObjCmd, NULL, NULL); } /* -- cgit v0.12 From 0f9a010d1cf8a2bf2f14a573cf48eefdb46a0abd Mon Sep 17 00:00:00 2001 From: culler Date: Tue, 10 Nov 2020 22:18:25 +0000 Subject: Better names, better implementation: GlyphCluster -> Cluster; use namespaces --- library/entry.tcl | 12 ++++++------ library/tk.tcl | 15 +++++++-------- library/ttk/entry.tcl | 8 ++++---- macosx/tkMacOSXFont.c | 30 +++++++++++++++--------------- 4 files changed, 32 insertions(+), 33 deletions(-) diff --git a/library/entry.tcl b/library/entry.tcl index 3652ebe..8d0fb3e 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -165,7 +165,7 @@ bind Entry { if {[%W selection present]} { %W delete sel.first sel.last } else { - %W delete [::tk::startOfGlyphCluster [%W get] [%W index insert]] [::tk::endOfGlyphCluster [%W get] [%W index insert]] + %W delete [::tk::startOfCluster [%W get] [%W index insert]] [::tk::endOfCluster [%W get] [%W index insert]] } } bind Entry { @@ -505,8 +505,8 @@ proc ::tk::EntryBackspace w { } else { set x [expr {[$w index insert] - 1}] if {$x >= 0} { - $w delete [::tk::startOfGlyphCluster [$w get] $x] \ - [::tk::endOfGlyphCluster [$w get] $x] + $w delete [::tk::startOfCluster [$w get] $x] \ + [::tk::endOfCluster [$w get] $x] } if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -621,7 +621,7 @@ proc ::tk::EntryPreviousWord {w start} { } proc ::tk::EntryNextChar {w start} { - set pos [::tk::endOfGlyphCluster [$w get] [$w index $start]] + set pos [::tk::endOfCluster [$w get] [$w index $start]] if {$pos < 0} { return end } @@ -629,7 +629,7 @@ proc ::tk::EntryNextChar {w start} { } proc ::tk::EntryPreviousChar {w start} { - set pos [::tk::startOfGlyphCluster [$w get] [expr {[$w index $start]-1}]] + set pos [::tk::startOfCluster [$w get] [expr {[$w index $start]-1}]] if {$pos < 0} { return 0 } @@ -637,7 +637,7 @@ proc ::tk::EntryPreviousChar {w start} { } proc ::tk::EntryInsertChar {w start} { - set pos [::tk::endOfGlyphCluster [$w get] [$w index $start]] + set pos [::tk::endOfCluster [$w get] [$w index $start]] if {$pos < 0} { return end } diff --git a/library/tk.tcl b/library/tk.tcl index 559af38..c26718b 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -701,14 +701,14 @@ if {[tk windowingsystem] eq "aqua"} { } if {[tk windowingsystem] eq "aqua"} { - proc ::tk::endOfGlyphCluster {str index} { - return [endOfGlyph $str $index] + namespace eval :: { + namespace export endOfCluster startOfCluster } - proc ::tk::startOfGlyphCluster {str index} { - return [startOfGlyph $str $index] + namespace eval ::tk:: { + namespace import ::endOfCluster ::startOfCluster } } else { - proc ::tk::endOfGlyphCluster {str start} { + proc ::tk::endOfCluster {str start} { if {$start >= [string length $str]} { return -1; } @@ -720,9 +720,8 @@ if {[tk windowingsystem] eq "aqua"} { set start [expr {$start+1}];# For demo purposes only } return $start -} - - proc ::tk::startOfGlyphCluster {str start} { + } + proc ::tk::startOfCluster {str start} { if {$start eq "end"} { set start [expr {[string length $str]-1}] } diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 16f6108..2d68aef 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -272,7 +272,7 @@ proc ttk::entry::PrevWord {w start} { # proc ttk::entry::NextChar {w start} { variable State - set pos [::tk::endOfGlyphCluster [$w get] [$w index $start]] + set pos [::tk::endOfCluster [$w get] [$w index $start]] if {$pos < 0} { return end } @@ -282,7 +282,7 @@ proc ttk::entry::NextChar {w start} { ## PrevChar -- Find the previous word position. # proc ttk::entry::PrevChar {w start} { - set pos [::tk::startOfGlyphCluster [$w get] [expr {[$w index $start]-1}]] + set pos [::tk::startOfCluster [$w get] [expr {[$w index $start]-1}]] if {$pos < 0} { return 0 } @@ -625,7 +625,7 @@ proc ttk::entry::Backspace {w} { set x [expr {[$w index insert] - 1}] if {$x < 0} { return } - $w delete [::tk::startOfGlyphCluster [$w get] $x] [::tk::endOfGlyphCluster [$w get] $x] + $w delete [::tk::startOfCluster [$w get] $x] [::tk::endOfCluster [$w get] $x] if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -640,7 +640,7 @@ proc ttk::entry::Backspace {w} { # proc ttk::entry::Delete {w} { if {![PendingDelete $w]} { - $w delete [::tk::startOfGlyphCluster [$w get] [$w index insert]] [::tk::endOfGlyphCluster [$w get] [$w index insert]] + $w delete [::tk::startOfCluster [$w get] [$w index insert]] [::tk::endOfCluster [$w get] [$w index insert]] } } diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index 11d690c..d94ae31 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -149,12 +149,12 @@ static int CreateNamedSystemFont(Tcl_Interp *interp, return [_string characterAtIndex:index]; } -- (NSUInteger)startOfGlyphCluster:(NSUInteger)index +- (NSUInteger)startOfCluster:(NSUInteger)index { NSRange range = [_string rangeOfComposedCharacterSequenceAtIndex:index]; return range.location; } -- (NSUInteger)endOfGlyphCluster:(NSUInteger)index +- (NSUInteger)endOfCluster:(NSUInteger)index { NSRange range = [_string rangeOfComposedCharacterSequenceAtIndex:index]; return range.location + range.length; @@ -436,14 +436,14 @@ CreateNamedSystemFont( #pragma mark - -#pragma mark Glyph indexing +#pragma mark Grapheme Cluster indexing /* *---------------------------------------------------------------------- * - * startOfGlyphObjCmd -- + * startOfClusterObjCmd -- * - * This function is invoked to process the startOfGlyph command. + * This function is invoked to process the startOfCluster command. * * Results: * A standard Tcl result. @@ -455,7 +455,7 @@ CreateNamedSystemFont( */ static int -startOfGlyphObjCmd( +startOfClusterObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -467,7 +467,7 @@ startOfGlyphObjCmd( Tcl_WideInt indexArg; Tcl_WideInt result; if ((objc != 3)) { - Tcl_WrongNumArgs(interp, 1, objv, "string index"); + Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } stringArg = Tcl_GetStringFromObj(objv[1], &numBytes); @@ -482,13 +482,13 @@ startOfGlyphObjCmd( Tcl_SetObjResult(interp, Tcl_NewWideIntObj([S length])); return TCL_OK; } - result = indexArg >= 0 ? [S startOfGlyphCluster:indexArg] : -1; + result = indexArg >= 0 ? [S startOfCluster:indexArg] : -1; Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); return TCL_OK; -} +} static int -endOfGlyphObjCmd( +endOfClusterObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -499,7 +499,7 @@ endOfGlyphObjCmd( int numBytes; Tcl_WideInt indexArg; Tcl_WideInt result; - + if ((objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; @@ -517,10 +517,10 @@ endOfGlyphObjCmd( } S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; result = (unsigned long long) indexArg < [S length] ? - [S endOfGlyphCluster:indexArg] : [S length]; + [S endOfCluster:indexArg] : [S length]; Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); return TCL_OK; -} +} #pragma mark - #pragma mark Font handling: @@ -618,8 +618,8 @@ TkpFontPkgInit( [cs release]; } [pool drain]; - Tcl_CreateObjCommand(interp, "startOfGlyph", startOfGlyphObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "endOfGlyph", endOfGlyphObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "startOfCluster", startOfClusterObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "endOfCluster", endOfClusterObjCmd, NULL, NULL); } /* -- cgit v0.12 From 62e24ee93eb2d0dea14cbc814f64328bb6a6510b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 26 Jan 2021 00:09:28 +0000 Subject: Initial attempt at printing tip --- win/makefile.vc | 1 + win/tkWinInit.c | 1 + 2 files changed, 2 insertions(+) diff --git a/win/makefile.vc b/win/makefile.vc index 7b13073..814c13e 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -185,6 +185,7 @@ TKOBJS = \ $(TMP_DIR)\tkWinMenu.obj \ $(TMP_DIR)\tkWinPixmap.obj \ $(TMP_DIR)\tkWinPointer.obj \ + $(TMP_DIR)\tkWinPrint.obj \ $(TMP_DIR)\tkWinRegion.obj \ $(TMP_DIR)\tkWinScrlbr.obj \ $(TMP_DIR)\tkWinSend.obj \ diff --git a/win/tkWinInit.c b/win/tkWinInit.c index 28ba81d..de13627 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -43,6 +43,7 @@ TkpInit( */ WinIcoInit(interp); + PrintInit(interp); TkWinXInit(Tk_GetHINSTANCE()); return TCL_OK; } -- cgit v0.12 From 4ba8d064e7a5e03e130b80581a7bdc548ac89ede Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 26 Jan 2021 01:01:36 +0000 Subject: Add tkWinPrint.c --- win/tkWinPrint.c | 221 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 221 insertions(+) create mode 100644 win/tkWinPrint.c diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c new file mode 100644 index 0000000..d82f699 --- /dev/null +++ b/win/tkWinPrint.c @@ -0,0 +1,221 @@ +/* + * tkWinPrint.c -- + * + * This module implements Win32 printer access. + * + * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. + * Copyright © 2018 Microsoft Corporation. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + + + +#include +#include +#include +#include +#include +#include "tkWinInt.h" +#include +#include +#include /* For floor(), used later */ + +HPALETTE +WinGetSystemPalette(void) +{ + HDC hDC; + HPALETTE hPalette; + DWORD flags; + + hPalette = NULL; + hDC = GetDC(NULL); /* Get the desktop device context */ + flags = GetDeviceCaps(hDC, RASTERCAPS); + if (flags & RC_PALETTE) { + LOGPALETTE *palettePtr; + + palettePtr = (LOGPALETTE *) + GlobalAlloc(GPTR, sizeof(LOGPALETTE) + 256 * sizeof(PALETTEENTRY)); + palettePtr->palVersion = 0x300; + palettePtr->palNumEntries = 256; + GetSystemPaletteEntries(hDC, 0, 256, palettePtr->palPalEntry); + hPalette = CreatePalette(palettePtr); + GlobalFree(palettePtr); + } + ReleaseDC(NULL, hDC); + return hPalette; +} + + +/* + * -------------------------------------------------------------------------- + * + * WinPrint -- + * + * Prints a snapshot of a Tk_Window to the designated printer. + * + * Results: + * Returns a standard Tcl result. If an error occurred + * TCL_ERROR is returned and interp->result will contain an + * error message. + * + * ------------------------------------------------------------------------- + */ +static int +WinPrint( + ClientData clientData, /* Interpreter-specific data. */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) +{ + BITMAPINFO bi; + DIBSECTION ds; + HBITMAP hBitmap; + HPALETTE hPalette; + HDC hDC, printDC, memDC; + void *data; + Tk_Window tkwin; + TkWinDCState state; + int result; + PRINTDLG pd; + DOCINFO di; + double pageWidth, pageHeight; + int jobId; + DEVMODE *dmPtr; + HGLOBAL hMem; + Tcl_DString dString; + char *path; + + Tcl_DStringInit(&dString); + path = Tcl_GetString(objv[3]); + tkwin = Tk_NameToWindow(interp, path, Tk_MainWindow(interp)); + if (tkwin == NULL) { + return TCL_ERROR; + } + if (Tk_WindowId(tkwin) == None) { + Tk_MakeWindowExist(tkwin); + } + + result = TCL_ERROR; + hDC = TkWinGetDrawableDC(Tk_Display(tkwin), Tk_WindowId(tkwin), &state); + + ZeroMemory(&bi, sizeof(bi)); + bi.bmiHeader.biSize = sizeof(BITMAPINFOHEADER); + bi.bmiHeader.biWidth = Tk_Width(tkwin); + bi.bmiHeader.biHeight = Tk_Height(tkwin); + bi.bmiHeader.biPlanes = 1; + bi.bmiHeader.biBitCount = 32; + bi.bmiHeader.biCompression = BI_RGB; + hBitmap = CreateDIBSection(hDC, &bi, DIB_RGB_COLORS, &data, NULL, 0); + memDC = CreateCompatibleDC(hDC); + SelectObject(memDC, hBitmap); + hPalette = WinGetSystemPalette(); + if (hPalette != NULL) { + SelectPalette(hDC, hPalette, FALSE); + RealizePalette(hDC); + SelectPalette(memDC, hPalette, FALSE); + RealizePalette(memDC); + } + /* Copy the window contents to the memory surface. */ + if (!BitBlt(memDC, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), hDC, 0, 0, + SRCCOPY)) { + Tcl_AppendResult(interp, "can't blit \"", Tk_PathName(tkwin), + NULL, (char *)NULL); + goto done; + } + /* Now that the DIB contains the image of the window, get the + * databits and write them to the printer device, stretching the + * image to the fit the printer's resolution. */ + if (GetObject(hBitmap, sizeof(DIBSECTION), &ds) == 0) { + Tcl_AppendResult(interp, "can't get DIB object", NULL, + (char *)NULL); + goto done; + } + if (PrintDlg(&pd) == FALSE) { + return TCL_ERROR; + } else { + printDC = pd.hDC; + // GlobalUnlock(hMem); + // GlobalFree(hMem); + if (printDC == NULL) { + Tcl_AppendResult(interp, "can't allocate printer DC", + NULL, (char *)NULL); + goto done; + } + double scale, sx, sy; + + /* Get the resolution of the printer device. */ + sx = (double)GetDeviceCaps(printDC, HORZRES)/(double)Tk_Width(tkwin); + sy = (double)GetDeviceCaps(printDC, VERTRES)/(double)Tk_Height(tkwin); + scale = fmin(sx, sy); + pageWidth = scale * Tk_Width(tkwin); + pageHeight = scale * Tk_Height(tkwin); + + ZeroMemory(&di, sizeof(di)); + di.cbSize = sizeof(di); + Tcl_DStringAppend(&dString, "Snapshot of \"", -1); + Tcl_DStringAppend(&dString, Tk_PathName(tkwin), -1); + Tcl_DStringAppend(&dString, "\"", -1); + di.lpszDocName = Tcl_DStringValue(&dString); + jobId = StartDoc(printDC, &di); + if (jobId <= 0) { + Tcl_AppendResult(interp, "can't start document", + (char *)NULL); + goto done; + } + if (StartPage(printDC) <= 0) { + Tcl_AppendResult(interp, "error starting page", + (char *)NULL); + goto done; + } + StretchDIBits(printDC, 0, 0, (int) pageWidth, (int) pageHeight, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), ds.dsBm.bmBits, + (LPBITMAPINFO)&ds.dsBmih, DIB_RGB_COLORS, SRCCOPY); + EndPage(printDC); + EndDoc(printDC); + DeleteDC(printDC); + // Tcl_SetResult(interp, Blt_Itoa(jobId), TCL_VOLATILE); + result = TCL_OK; + + done: + Tcl_DStringFree(&dString); + + DeleteObject(hBitmap); + // DeleteDC(memDC); + TkWinReleaseDrawableDC(Tk_WindowId(tkwin), hDC, &state); + if (hPalette != NULL) { + DeleteObject(hPalette); + } + } + + return result; +} + + +/* + *---------------------------------------------------------------------- + * + * PrintInit -- + * + * Initialize this package and create script-level commands. + * + * Results: + * Initialization of code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + +int +PrintInit( + Tcl_Interp *interp) +{ + Tcl_CreateObjCommand(interp, "winprint", WinPrint, NULL, NULL); + return TCL_OK; + +} -- cgit v0.12 From edddec4adb5a5948bbff1d8adcad501038ff2f7b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 26 Jan 2021 03:00:48 +0000 Subject: Remove invalid UTF --- win/tkWinPrint.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index d82f699..cc43b91 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -3,9 +3,9 @@ * * This module implements Win32 printer access. * - * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. - * Copyright © 2018 Microsoft Corporation. - * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. + * Copyright © 2018 Microsoft Corporation. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. -- cgit v0.12 From e95517023596be5136bfa57c6476092a52e51110 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 29 Jan 2021 03:31:34 +0000 Subject: Printing bitmap rendering of canvas works on Win32; on to text printing --- win/tkWinPrint.c | 228 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 125 insertions(+), 103 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 73aac87..dcaebbc 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -1,18 +1,17 @@ /* * tkWinPrint.c -- - * + * * This module implements Win32 printer access. - * - * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. - * Copyright © 2018 Microsoft Corporation. + * + * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. + * Copyright © 2018 018 Microsoft Corporation. * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. - * + * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ - #include #include #include @@ -21,20 +20,40 @@ #include "tkWinInt.h" #include #include -#include /* For floor(), used later */ +#include + +/*Declaration for functions used later in this file.*/ +HPALETTE WinGetSystemPalette(void); +static int WinPrint( TCL_UNUSED(void *), Tcl_Interp * interp, int objc, + Tcl_Obj * const *objv); +int PrintInit(Tcl_Interp * interp;) + +/* + * -------------------------------------------------------------------------- + * + * WinGetSystemPalette -- + * + * Sets a default color palette for bitmap rendering on Win32. + * + * Results: + * + * Sets the palette. + * + * ------------------------------------------------------------------------- + */ HPALETTE WinGetSystemPalette(void) { - HDC hDC; - HPALETTE hPalette; - DWORD flags; + HDC hDC; + HPALETTE hPalette; + DWORD flags; hPalette = NULL; hDC = GetDC(NULL); /* Get the desktop device context */ flags = GetDeviceCaps(hDC, RASTERCAPS); if (flags & RC_PALETTE) { - LOGPALETTE *palettePtr; + LOGPALETTE *palettePtr; palettePtr = (LOGPALETTE *) GlobalAlloc(GPTR, sizeof(LOGPALETTE) + 256 * sizeof(PALETTEENTRY)); @@ -51,40 +70,41 @@ WinGetSystemPalette(void) /* * -------------------------------------------------------------------------- - * + * * WinPrint -- - * - * Prints a snapshot of a Tk_Window to the designated printer. - * - * Results: - * Returns a standard Tcl result. If an error occurred - * TCL_ERROR is returned and interp->result will contain an - * error message. - * + * + * Prints a snapshot of a Tk_Window to the designated printer. + * + * Results: + * Returns a standard Tcl result. If an error occurred TCL_ERROR is + * returned and interp->result will contain an error message. + * * ------------------------------------------------------------------------- */ + static int WinPrint( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int objc, - Tcl_Obj *const *objv) + TCL_UNUSED(void *), + Tcl_Interp * interp, + int objc, + Tcl_Obj * const *objv) { - BITMAPINFO bi; - DIBSECTION ds; - HBITMAP hBitmap; - HPALETTE hPalette; - HDC hDC, printDC, memDC; - void *data; - Tk_Window tkwin; - TkWinDCState state; - int result; - PRINTDLG pd; - DOCINFO di; - double pageWidth, pageHeight; - int jobId; - Tcl_DString dString; - char *path; + BITMAPINFO bi; + DIBSECTION ds; + HBITMAP hBitmap; + HPALETTE hPalette; + HDC hDC, printDC, memDC; + void *data; + Tk_Window tkwin; + TkWinDCState state; + int result; + PRINTDLG pd; + DOCINFO di; + double pageWidth, pageHeight; + int jobId; + Tcl_DString dString; + char *path; + double scale, sx, sy; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "window"); @@ -99,10 +119,11 @@ WinPrint( if (Tk_WindowId(tkwin) == None) { Tk_MakeWindowExist(tkwin); } - result = TCL_ERROR; hDC = TkWinGetDrawableDC(Tk_Display(tkwin), Tk_WindowId(tkwin), &state); + + /* Initialize bitmap to contain window contents/data. */ ZeroMemory(&bi, sizeof(bi)); bi.bmiHeader.biSize = sizeof(BITMAPINFOHEADER); bi.bmiHeader.biWidth = Tk_Width(tkwin); @@ -126,91 +147,92 @@ WinPrint( Tcl_AppendResult(interp, "can't blit \"", Tk_PathName(tkwin), NULL); goto done; } - /* Now that the DIB contains the image of the window, get the - * databits and write them to the printer device, stretching the - * image to the fit the printer's resolution. */ + /* + * Now that the DIB contains the image of the window, get the databits + * and write them to the printer device, stretching the image to the fit + * the printer's resolution. + */ if (GetObject(hBitmap, sizeof(DIBSECTION), &ds) == 0) { - Tcl_AppendResult(interp, "can't get DIB object", NULL); - goto done; - } - if (PrintDlg(&pd) == FALSE) { - return TCL_ERROR; - } else { - printDC = pd.hDC; - // GlobalUnlock(hMem); - // GlobalFree(hMem); - if (printDC == NULL) { - Tcl_AppendResult(interp, "can't allocate printer DC", NULL); + Tcl_AppendResult(interp, "can't get DIB object", NULL); goto done; } - double scale, sx, sy; + /* Initialize print dialog. */ + ZeroMemory(&pd, sizeof(pd)); + pd.lStructSize = sizeof(pd); + pd.Flags = PD_RETURNDC; + + if (PrintDlg(&pd) == TRUE) { + printDC = pd.hDC; + + if (printDC == NULL) { + Tcl_AppendResult(interp, "can't allocate printer DC", NULL); + goto done; + } /* Get the resolution of the printer device. */ - sx = (double)GetDeviceCaps(printDC, HORZRES)/(double)Tk_Width(tkwin); - sy = (double)GetDeviceCaps(printDC, VERTRES)/(double)Tk_Height(tkwin); + sx = (double)GetDeviceCaps(printDC, HORZRES) / (double)Tk_Width(tkwin); + sy = (double)GetDeviceCaps(printDC, VERTRES) / (double)Tk_Height(tkwin); scale = fmin(sx, sy); pageWidth = scale * Tk_Width(tkwin); pageHeight = scale * Tk_Height(tkwin); - ZeroMemory(&di, sizeof(di)); - di.cbSize = sizeof(di); - Tcl_DStringAppend(&dString, "Snapshot of \"", -1); - Tcl_DStringAppend(&dString, Tk_PathName(tkwin), -1); - Tcl_DStringAppend(&dString, "\"", -1); - di.lpszDocName = Tcl_DStringValue(&dString); - jobId = StartDoc(printDC, &di); - if (jobId <= 0) { - Tcl_AppendResult(interp, "can't start document", NULL); - goto done; - } - if (StartPage(printDC) <= 0) { - Tcl_AppendResult(interp, "error starting page", NULL); - goto done; - } - StretchDIBits(printDC, 0, 0, (int) pageWidth, (int) pageHeight, 0, 0, - Tk_Width(tkwin), Tk_Height(tkwin), ds.dsBm.bmBits, - (LPBITMAPINFO)&ds.dsBmih, DIB_RGB_COLORS, SRCCOPY); - EndPage(printDC); - EndDoc(printDC); - DeleteDC(printDC); - // Tcl_SetResult(interp, Blt_Itoa(jobId), TCL_VOLATILE); - result = TCL_OK; - - done: - Tcl_DStringFree(&dString); - - DeleteObject(hBitmap); - // DeleteDC(memDC); - TkWinReleaseDrawableDC(Tk_WindowId(tkwin), hDC, &state); - if (hPalette != NULL) { - DeleteObject(hPalette); + ZeroMemory(&di, sizeof(di)); + di.cbSize = sizeof(di); + Tcl_DStringAppend(&dString, "Snapshot of \"", -1); + Tcl_DStringAppend(&dString, Tk_PathName(tkwin), -1); + Tcl_DStringAppend(&dString, "\"", -1); + di.lpszDocName = Tcl_DStringValue(&dString); + jobId = StartDoc(printDC, &di); + if (jobId <= 0) { + Tcl_AppendResult(interp, "can't start document", NULL); + goto done; + } + if (StartPage(printDC) <= 0) { + Tcl_AppendResult(interp, "error starting page", NULL); + goto done; + } + StretchDIBits(printDC, 0, 0, pageWidth, pageHeight, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), ds.dsBm.bmBits, + (LPBITMAPINFO) & ds.dsBmih, DIB_RGB_COLORS, SRCCOPY); + EndPage(printDC); + EndDoc(printDC); + DeleteDC(printDC); + result = TCL_OK; + +done: + Tcl_DStringFree(&dString); + + DeleteObject(hBitmap); + DeleteDC(memDC); + TkWinReleaseDrawableDC(Tk_WindowId(tkwin), hDC, &state); + if (hPalette != NULL) { + DeleteObject(hPalette); + } + } else { + return TCL_ERROR; } - } return result; } /* - *---------------------------------------------------------------------- - * + * ---------------------------------------------------------------------- + * * PrintInit -- - * - * Initialize this package and create script-level commands. - * - * Results: - * Initialization of code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- + * + * Initialize this package and create script-level commands. + * + * Results: + * Initialization of code. + * + * ---------------------------------------------------------------------- */ int PrintInit( - Tcl_Interp *interp) + Tcl_Interp * interp) { Tcl_CreateObjCommand(interp, "winprint", WinPrint, NULL, NULL); return TCL_OK; -- cgit v0.12 From efd43957b3d6676619d50c6167d06c327c944400 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 29 Jan 2021 03:32:26 +0000 Subject: Fix typo --- win/tkWinPrint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index dcaebbc..4c0f07e 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -4,7 +4,7 @@ * This module implements Win32 printer access. * * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. - * Copyright © 2018 018 Microsoft Corporation. + * Copyright © 2018 Microsoft Corporation. * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of -- cgit v0.12 From ed4875640c27b0db8cc25fda3afe66223064e0c6 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 30 Jan 2021 18:31:21 +0000 Subject: Text printing connects with printer but generates no output; need to look more closely at raw mode --- win/makefile.vc | 2 +- win/tkWinPrint.c | 143 ++++++++++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 133 insertions(+), 12 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index 149e982..e020de6 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -350,7 +350,7 @@ CONFIG_DEFS =/DHAVE_SYS_TYPES_H=1 /DHAVE_SYS_STAT_H=1 \ PRJ_DEFINES = /DBUILD_ttk $(CONFIG_DEFS) /Dinline=__inline /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE # Additional Link libraries needed beyond those in rules.vc -PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib +PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib #--------------------------------------------------------------------- diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 4c0f07e..190c74c 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -3,9 +3,9 @@ * * This module implements Win32 printer access. * - * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. - * Copyright © 2018 Microsoft Corporation. - * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. + * Copyright © 2018 018 Microsoft Corporation. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -13,6 +13,7 @@ #include +#include #include #include #include @@ -24,9 +25,11 @@ /*Declaration for functions used later in this file.*/ HPALETTE WinGetSystemPalette(void); -static int WinPrint( TCL_UNUSED(void *), Tcl_Interp * interp, int objc, +static int WinCanvasPrint(TCL_UNUSED(void *), Tcl_Interp * interp, int objc, + Tcl_Obj * const *objv); +static int WinTextPrint(TCL_UNUSED(void *), Tcl_Interp * interp, int objc, Tcl_Obj * const *objv); -int PrintInit(Tcl_Interp * interp;) +int PrintInit(Tcl_Interp * interp); /* * -------------------------------------------------------------------------- @@ -71,19 +74,18 @@ WinGetSystemPalette(void) /* * -------------------------------------------------------------------------- * - * WinPrint -- + * WinCanvasPrint -- * - * Prints a snapshot of a Tk_Window to the designated printer. + * Prints a snapshot of a Tk_Window/canvas to the designated printer. * * Results: - * Returns a standard Tcl result. If an error occurred TCL_ERROR is - * returned and interp->result will contain an error message. + * Returns a standard Tcl result. * * ------------------------------------------------------------------------- */ static int -WinPrint( +WinCanvasPrint( TCL_UNUSED(void *), Tcl_Interp * interp, int objc, @@ -219,6 +221,114 @@ done: /* * ---------------------------------------------------------------------- * + * WinTextPrint -- + * + * Prints a character buffer to the designated printer. + * + * Results: + * Returns a standard Tcl result. + * + * ---------------------------------------------------------------------- + */ + + +static int WinTextPrint(TCL_UNUSED(void*), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ + + BOOL bStatus; + HANDLE hPrinter; + BOOL printDlgReturn; + PRINTDLG printDlgInfo = { 0 }; + PDEVMODE returnedDevmode = NULL; + PDEVMODE localDevmode = NULL; + DOC_INFO_1 DocInfo; + DWORD dwJob; + DWORD dwBytesWritten; + LPWSTR localPrinterName; + LPBYTE lpData; + DWORD dwCount; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "text"); + return TCL_ERROR; + } + + char *data = Tcl_GetString(objv[1]); + int *len = strlen(data); + + lpData = (LPBYTE) data; + dwCount = (DWORD) len; + + /*Initialize the print dialog box's data structure. */ + printDlgInfo.lStructSize = sizeof(printDlgInfo); + + /*Display the printer dialog and retrieve the printer DC */ + printDlgReturn = PrintDlg(&printDlgInfo); + + /*Lock the handle to get a pointer to the DEVMODE structure. */ + returnedDevmode = (PDEVMODE) GlobalLock(printDlgInfo.hDevMode); + + localDevmode = (LPDEVMODE) HeapAlloc( GetProcessHeap(), + HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, + returnedDevmode->dmSize); + + if (NULL != localDevmode) + { + memcpy( (LPVOID) localDevmode, + (LPVOID) returnedDevmode, + returnedDevmode->dmSize); + + /*Save the printer name from the DEVMODE structure. + /*This is done here just to illustrate how to access + /*the name field. The printer name can also be accessed + /*by referring to the dmDeviceName in the local + /*copy of the DEVMODE structure. */ + localPrinterName = localDevmode->dmDeviceName; + } + + bStatus = OpenPrinter(localPrinterName, &hPrinter, NULL); + + DocInfo.pDocName = (LPTSTR) _T("Tk Output"); + DocInfo.pOutputFile = NULL; + DocInfo.pDatatype = (LPTSTR) _T("RAW"); + + /*Inform the spooler the document is beginning. */ + dwJob = StartDocPrinter(hPrinter, 1, (LPBYTE) &DocInfo); + if (dwJob > 0) + { + /*Start a page. */ + bStatus = StartPagePrinter(hPrinter); + if (bStatus) + { + /*Send the data to the printer. */ + bStatus = WritePrinter(hPrinter, lpData, dwCount, &dwBytesWritten); + EndPagePrinter(hPrinter); + } + /*Inform the spooler that the document is ending. */ + EndDocPrinter(hPrinter); + } + /*Close the printer handle. */ + ClosePrinter(hPrinter); + + /*Check to see if correct number of bytes were written. */ + if (!bStatus || (dwBytesWritten != dwCount)) + { + bStatus = FALSE; + return TCL_ERROR; + } else { + bStatus = TRUE; + return TCL_OK; + } + return TCL_OK; +} + + +/* + * ---------------------------------------------------------------------- + * * PrintInit -- * * Initialize this package and create script-level commands. @@ -234,6 +344,17 @@ int PrintInit( Tcl_Interp * interp) { - Tcl_CreateObjCommand(interp, "winprint", WinPrint, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_printcanvas", WinCanvasPrint, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_printtext", WinTextPrint, NULL, NULL); return TCL_OK; } + + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ -- cgit v0.12 From e884d9a82e63b060c6effcbc7ca08c0351c61db0 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 30 Jan 2021 18:35:38 +0000 Subject: Formatting cleanup --- win/tkWinPrint.c | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 190c74c..8db51ed 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -3,9 +3,9 @@ * * This module implements Win32 printer access. * - * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. - * Copyright © 2018 018 Microsoft Corporation. - * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. + * Copyright © 2018 Microsoft Corporation. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -262,13 +262,13 @@ static int WinTextPrint(TCL_UNUSED(void*), lpData = (LPBYTE) data; dwCount = (DWORD) len; - /*Initialize the print dialog box's data structure. */ + /* Initialize the print dialog box's data structure. */ printDlgInfo.lStructSize = sizeof(printDlgInfo); - /*Display the printer dialog and retrieve the printer DC */ + /* Display the printer dialog and retrieve the printer DC. */ printDlgReturn = PrintDlg(&printDlgInfo); - /*Lock the handle to get a pointer to the DEVMODE structure. */ + /* Lock the handle to get a pointer to the DEVMODE structure. */ returnedDevmode = (PDEVMODE) GlobalLock(printDlgInfo.hDevMode); localDevmode = (LPDEVMODE) HeapAlloc( GetProcessHeap(), @@ -281,11 +281,13 @@ static int WinTextPrint(TCL_UNUSED(void*), (LPVOID) returnedDevmode, returnedDevmode->dmSize); - /*Save the printer name from the DEVMODE structure. - /*This is done here just to illustrate how to access - /*the name field. The printer name can also be accessed - /*by referring to the dmDeviceName in the local - /*copy of the DEVMODE structure. */ + /* + * Save the printer name from the DEVMODE structure. + * This is done here just to illustrate how to access + * the name field. The printer name can also be accessed + * by referring to the dmDeviceName in the local + * copy of the DEVMODE structure. + */ localPrinterName = localDevmode->dmDeviceName; } @@ -295,11 +297,11 @@ static int WinTextPrint(TCL_UNUSED(void*), DocInfo.pOutputFile = NULL; DocInfo.pDatatype = (LPTSTR) _T("RAW"); - /*Inform the spooler the document is beginning. */ + /* Inform the spooler the document is beginning. */ dwJob = StartDocPrinter(hPrinter, 1, (LPBYTE) &DocInfo); if (dwJob > 0) { - /*Start a page. */ + /* Start a page. */ bStatus = StartPagePrinter(hPrinter); if (bStatus) { @@ -307,13 +309,13 @@ static int WinTextPrint(TCL_UNUSED(void*), bStatus = WritePrinter(hPrinter, lpData, dwCount, &dwBytesWritten); EndPagePrinter(hPrinter); } - /*Inform the spooler that the document is ending. */ + /* Inform the spooler that the document is ending. */ EndDocPrinter(hPrinter); } - /*Close the printer handle. */ + /* Close the printer handle. */ ClosePrinter(hPrinter); - /*Check to see if correct number of bytes were written. */ + /* Check to see if correct number of bytes were written. */ if (!bStatus || (dwBytesWritten != dwCount)) { bStatus = FALSE; -- cgit v0.12 From 66069cbf274122ac718b8efe36f359a9ec9a7f27 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 31 Jan 2021 01:24:51 +0000 Subject: Windows printing now sends text to printer but printer cannout output correctly; may need to try another approach --- win/tkWinPrint.c | 44 +++++++++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 8db51ed..d5fdb25 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -153,12 +153,12 @@ WinCanvasPrint( * Now that the DIB contains the image of the window, get the databits * and write them to the printer device, stretching the image to the fit * the printer's resolution. - */ + */ if (GetObject(hBitmap, sizeof(DIBSECTION), &ds) == 0) { Tcl_AppendResult(interp, "can't get DIB object", NULL); goto done; } - /* Initialize print dialog. */ + /* Initialize print dialog. */ ZeroMemory(&pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.Flags = PD_RETURNDC; @@ -241,43 +241,45 @@ static int WinTextPrint(TCL_UNUSED(void*), BOOL bStatus; HANDLE hPrinter; BOOL printDlgReturn; - PRINTDLG printDlgInfo = { 0 }; - PDEVMODE returnedDevmode = NULL; - PDEVMODE localDevmode = NULL; - DOC_INFO_1 DocInfo; + PRINTDLG pd = { 0 }; + PDEVMODE returnedDevmode; + PDEVMODE localDevmode; + DOC_INFO_1 di; DWORD dwJob; DWORD dwBytesWritten; LPWSTR localPrinterName; LPBYTE lpData; DWORD dwCount; + char *data; + int len; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "text"); return TCL_ERROR; } - char *data = Tcl_GetString(objv[1]); - int *len = strlen(data); + data = Tcl_GetString(objv[1]); + len = strlen(data); lpData = (LPBYTE) data; dwCount = (DWORD) len; /* Initialize the print dialog box's data structure. */ - printDlgInfo.lStructSize = sizeof(printDlgInfo); + pd.lStructSize = sizeof(pd); /* Display the printer dialog and retrieve the printer DC. */ - printDlgReturn = PrintDlg(&printDlgInfo); + printDlgReturn = PrintDlg(&pd); /* Lock the handle to get a pointer to the DEVMODE structure. */ - returnedDevmode = (PDEVMODE) GlobalLock(printDlgInfo.hDevMode); + returnedDevmode = (PDEVMODE) GlobalLock(pd.hDevMode); - localDevmode = (LPDEVMODE) HeapAlloc( GetProcessHeap(), + localDevmode = (LPDEVMODE) HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); if (NULL != localDevmode) { - memcpy( (LPVOID) localDevmode, + memcpy((LPVOID) localDevmode, (LPVOID) returnedDevmode, returnedDevmode->dmSize); @@ -293,29 +295,29 @@ static int WinTextPrint(TCL_UNUSED(void*), bStatus = OpenPrinter(localPrinterName, &hPrinter, NULL); - DocInfo.pDocName = (LPTSTR) _T("Tk Output"); - DocInfo.pOutputFile = NULL; - DocInfo.pDatatype = (LPTSTR) _T("RAW"); + di.pDocName = (LPTSTR) ("Tk Output"); + di.pOutputFile = NULL; + di.pDatatype = (LPTSTR) ("XPS_PASS"); /* Inform the spooler the document is beginning. */ - dwJob = StartDocPrinter(hPrinter, 1, (LPBYTE) &DocInfo); + dwJob = StartDocPrinter(hPrinter, 1, (LPBYTE) &di); if (dwJob > 0) { - /* Start a page. */ + /* Start a page. */ bStatus = StartPagePrinter(hPrinter); if (bStatus) { - /*Send the data to the printer. */ + /*Send the data to the printer. */ bStatus = WritePrinter(hPrinter, lpData, dwCount, &dwBytesWritten); EndPagePrinter(hPrinter); } - /* Inform the spooler that the document is ending. */ + /* Inform the spooler that the document is ending. */ EndDocPrinter(hPrinter); } /* Close the printer handle. */ ClosePrinter(hPrinter); - /* Check to see if correct number of bytes were written. */ + /* Check to see if correct number of bytes were written. */ if (!bStatus || (dwBytesWritten != dwCount)) { bStatus = FALSE; -- cgit v0.12 From aa48f3d48214baf975db350240b38ca783904b53 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 31 Jan 2021 02:15:16 +0000 Subject: Tighten comment --- win/tkWinPrint.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index d5fdb25..b1fe903 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -284,11 +284,7 @@ static int WinTextPrint(TCL_UNUSED(void*), returnedDevmode->dmSize); /* - * Save the printer name from the DEVMODE structure. - * This is done here just to illustrate how to access - * the name field. The printer name can also be accessed - * by referring to the dmDeviceName in the local - * copy of the DEVMODE structure. + * Save the printer name from the DEVMODE structure. */ localPrinterName = localDevmode->dmDeviceName; } -- cgit v0.12 From 9c24703c03b19f7e8a6aa9c76e16634aa2948645 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 1 Feb 2021 10:16:33 +0000 Subject: Make it compile with gcc (missing winspool.lib). Use Wide API, for better Unicode support. --- win/configure | 4 +-- win/tcl.m4 | 4 +-- win/tkWinPrint.c | 108 +++++++++++++++++++++++++++---------------------------- 3 files changed, 57 insertions(+), 59 deletions(-) diff --git a/win/configure b/win/configure index 8eac969..3abf706 100755 --- a/win/configure +++ b/win/configure @@ -4429,7 +4429,7 @@ printf %s "checking compiler flags... " >&6; } SHLIB_LD_LIBS='${LIBS}' LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32 -lwinspool" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -4635,7 +4635,7 @@ printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } LINKBIN="link" fi - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib" SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" SHLIB_LD_LIBS='${LIBS}' diff --git a/win/tcl.m4 b/win/tcl.m4 index 852aa33..6edf03c 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -625,7 +625,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_LD_LIBS='${LIBS}' LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32 -lwinspool" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -808,7 +808,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LINKBIN="link" fi - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib" SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" SHLIB_LD_LIBS='${LIBS}' diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index b1fe903..e84f064 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -1,12 +1,12 @@ /* * tkWinPrint.c -- - * + * * This module implements Win32 printer access. - * - * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. - * Copyright © 2018 Microsoft Corporation. + * + * Copyright © 1998 Bell Labs Innovations for Lucent Technologies. + * Copyright © 2018 Microsoft Corporation. * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. - * + * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ @@ -21,27 +21,24 @@ #include "tkWinInt.h" #include #include -#include +#include -/*Declaration for functions used later in this file.*/ -HPALETTE WinGetSystemPalette(void); -static int WinCanvasPrint(TCL_UNUSED(void *), Tcl_Interp * interp, int objc, - Tcl_Obj * const *objv); -static int WinTextPrint(TCL_UNUSED(void *), Tcl_Interp * interp, int objc, - Tcl_Obj * const *objv); -int PrintInit(Tcl_Interp * interp); +/* Declaration for functions used later in this file.*/ +static HPALETTE WinGetSystemPalette(void); +static int WinCanvasPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); +static int WinTextPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); /* * -------------------------------------------------------------------------- - * + * * WinGetSystemPalette -- - * - * Sets a default color palette for bitmap rendering on Win32. - * - * Results: + * + * Sets a default color palette for bitmap rendering on Win32. + * + * Results: * * Sets the palette. - * + * * ------------------------------------------------------------------------- */ @@ -73,23 +70,23 @@ WinGetSystemPalette(void) /* * -------------------------------------------------------------------------- - * + * * WinCanvasPrint -- - * + * * Prints a snapshot of a Tk_Window/canvas to the designated printer. - * - * Results: - * Returns a standard Tcl result. - * + * + * Results: + * Returns a standard Tcl result. + * * ------------------------------------------------------------------------- */ static int WinCanvasPrint( - TCL_UNUSED(void *), - Tcl_Interp * interp, - int objc, - Tcl_Obj * const *objv) + TCL_UNUSED(void *), + Tcl_Interp * interp, + int objc, + Tcl_Obj * const *objv) { BITMAPINFO bi; DIBSECTION ds; @@ -220,19 +217,20 @@ done: /* * ---------------------------------------------------------------------- - * + * * WinTextPrint -- - * + * * Prints a character buffer to the designated printer. - * - * Results: - * Returns a standard Tcl result. - * + * + * Results: + * Returns a standard Tcl result. + * * ---------------------------------------------------------------------- */ -static int WinTextPrint(TCL_UNUSED(void*), +static int WinTextPrint( + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -241,10 +239,10 @@ static int WinTextPrint(TCL_UNUSED(void*), BOOL bStatus; HANDLE hPrinter; BOOL printDlgReturn; - PRINTDLG pd = { 0 }; - PDEVMODE returnedDevmode; - PDEVMODE localDevmode; - DOC_INFO_1 di; + PRINTDLGW pd = { 0 }; + PDEVMODEW returnedDevmode; + PDEVMODEW localDevmode; + DOC_INFO_1W di; DWORD dwJob; DWORD dwBytesWritten; LPWSTR localPrinterName; @@ -268,12 +266,12 @@ static int WinTextPrint(TCL_UNUSED(void*), pd.lStructSize = sizeof(pd); /* Display the printer dialog and retrieve the printer DC. */ - printDlgReturn = PrintDlg(&pd); + printDlgReturn = PrintDlgW(&pd); /* Lock the handle to get a pointer to the DEVMODE structure. */ - returnedDevmode = (PDEVMODE) GlobalLock(pd.hDevMode); + returnedDevmode = (PDEVMODEW) GlobalLock(pd.hDevMode); - localDevmode = (LPDEVMODE) HeapAlloc(GetProcessHeap(), + localDevmode = (LPDEVMODEW) HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); @@ -283,20 +281,20 @@ static int WinTextPrint(TCL_UNUSED(void*), (LPVOID) returnedDevmode, returnedDevmode->dmSize); - /* - * Save the printer name from the DEVMODE structure. + /* + * Save the printer name from the DEVMODE structure. */ localPrinterName = localDevmode->dmDeviceName; } - bStatus = OpenPrinter(localPrinterName, &hPrinter, NULL); + bStatus = OpenPrinterW(localPrinterName, &hPrinter, NULL); - di.pDocName = (LPTSTR) ("Tk Output"); + di.pDocName = (LPWSTR)L"Tk Output"; di.pOutputFile = NULL; - di.pDatatype = (LPTSTR) ("XPS_PASS"); + di.pDatatype = (LPWSTR)L"XPS_PASS"; /* Inform the spooler the document is beginning. */ - dwJob = StartDocPrinter(hPrinter, 1, (LPBYTE) &di); + dwJob = StartDocPrinterW(hPrinter, 1, (LPBYTE) &di); if (dwJob > 0) { /* Start a page. */ @@ -328,21 +326,21 @@ static int WinTextPrint(TCL_UNUSED(void*), /* * ---------------------------------------------------------------------- - * + * * PrintInit -- - * + * * Initialize this package and create script-level commands. - * - * Results: + * + * Results: * Initialization of code. - * + * * ---------------------------------------------------------------------- */ int PrintInit( - Tcl_Interp * interp) + Tcl_Interp * interp) { Tcl_CreateObjCommand(interp, "::tk::print::_printcanvas", WinCanvasPrint, NULL, NULL); Tcl_CreateObjCommand(interp, "::tk::print::_printtext", WinTextPrint, NULL, NULL); -- cgit v0.12 From 2855949489c1f5a4e5af7dda0962063639b203c0 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 3 Feb 2021 04:51:45 +0000 Subject: First attempt at printing text file on Windows --- win/tkWinPrint.c | 218 ++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 143 insertions(+), 75 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index e84f064..eca601b 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -28,6 +28,38 @@ static HPALETTE WinGetSystemPalette(void); static int WinCanvasPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); static int WinTextPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); +/* Declaration for functions used later in this file.*/ +static HPALETTE WinGetSystemPalette(void); +static int WinCanvasPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); +static int WinTextPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); + +/*Utility functions and definitions.*/ + +#define SCALE_FACTOR 100 + +/*Convert milimiters to points.*/ + static int MM_TO_PIXELS (int mm, int dpi) +{ + return MulDiv (mm * 100, dpi, 2540); +} + +/* Calculate the wrapped height of a string. */ +static int calculate_wrapped_string_height (HDC hDC, int width, char *s) +{ + RECT r = { 0, 0, width, 16384 }; + DrawText (hDC, s, strlen(s), &r, DT_CALCRECT | DT_NOPREFIX | DT_WORDBREAK); + return (r.bottom == 16384) ? calculate_wrapped_string_height (hDC, width, " ") : r.bottom; +} + +/* Print a string in the width provided. */ +static void print_string (HDC hDC, int x, int y, int width, const char* s) +{ + RECT r = { x, y, x + width, 16384 }; + DrawText (hDC, s, strlen(s), &r, DT_CALCRECT | DT_NOPREFIX | DT_WORDBREAK); +} + + + /* * -------------------------------------------------------------------------- * @@ -159,6 +191,7 @@ WinCanvasPrint( ZeroMemory(&pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.Flags = PD_RETURNDC; + pd.hwndOwner = GetDesktopWindow(); if (PrintDlg(&pd) == TRUE) { printDC = pd.hDC; @@ -228,97 +261,132 @@ done: * ---------------------------------------------------------------------- */ - static int WinTextPrint( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int objc, - Tcl_Obj *const *objv) + TCL_UNUSED(void * ), + Tcl_Interp * interp, + int objc, + Tcl_Obj * + const * objv) { - BOOL bStatus; - HANDLE hPrinter; - BOOL printDlgReturn; - PRINTDLGW pd = { 0 }; - PDEVMODEW returnedDevmode; - PDEVMODEW localDevmode; - DOC_INFO_1W di; - DWORD dwJob; - DWORD dwBytesWritten; - LPWSTR localPrinterName; - LPBYTE lpData; - DWORD dwCount; - char *data; - int len; - - if (objc != 2) { + Tcl_Channel chan; + Tcl_Obj * printbuffer; + PRINTDLG pd; + HDC hDC; + + int dpi, lpx, lpy, res_x, res_y, left_margin, top_margin, right_margin, bottom_margin, width, y_max, job_id, x, y, pagenum, err, space_needed, max_page, clen; + DOCINFO di; + LOGFONT lf; + HFONT hTextFont, hOldFont; + char * cline; + const char * mode; + + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "text"); return TCL_ERROR; } - data = Tcl_GetString(objv[1]); - len = strlen(data); + mode = "r"; - lpData = (LPBYTE) data; - dwCount = (DWORD) len; - /* Initialize the print dialog box's data structure. */ + /* Initialize print dialog. */ + ZeroMemory( & pd, sizeof(pd)); pd.lStructSize = sizeof(pd); + pd.hwndOwner = GetDesktopWindow(); + pd.Flags = PD_RETURNDC | PD_NOPAGENUMS; + + if (PrintDlg(&pd) == TRUE) { + hDC = pd.hDC; + + if (hDC== NULL) { + Tcl_AppendResult(interp, "can't allocate printer DC", NULL); + return TCL_ERROR; + } + + dpi = 96 * 100 / SCALE_FACTOR; + lpx = GetDeviceCaps(hDC, LOGPIXELSX); + lpy = GetDeviceCaps(hDC, LOGPIXELSX); + res_x = GetDeviceCaps(hDC, HORZRES); + res_y = GetDeviceCaps(hDC, VERTRES); + + /* Margins */ + left_margin = MM_TO_PIXELS(10, dpi); + top_margin = MM_TO_PIXELS(20, dpi); + right_margin = MM_TO_PIXELS(20, dpi); + bottom_margin = MM_TO_PIXELS(20, dpi); + + width = MulDiv(res_x, dpi, lpx) - (left_margin + right_margin); + y_max = MulDiv(res_y, dpi, lpy) - bottom_margin; + + /* Set up for SCALE_FACTOR. */ + SetMapMode(hDC, MM_ANISOTROPIC); + SetWindowExtEx(hDC, dpi, dpi, NULL); + SetViewportExtEx(hDC, lpx, lpy, NULL); + SetStretchBltMode(hDC, HALFTONE); - /* Display the printer dialog and retrieve the printer DC. */ - printDlgReturn = PrintDlgW(&pd); + ZeroMemory(&di, sizeof(di)); + di.cbSize = sizeof(di); + di.lpszDocName = "Tk Output"; + job_id = StartDoc(hDC, & di); - /* Lock the handle to get a pointer to the DEVMODE structure. */ - returnedDevmode = (PDEVMODEW) GlobalLock(pd.hDevMode); + if (job_id <= 0) { + Tcl_AppendResult(interp, "unable to start document", NULL); + DeleteDC(hDC); + return TCL_ERROR; + } - localDevmode = (LPDEVMODEW) HeapAlloc(GetProcessHeap(), - HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, - returnedDevmode->dmSize); + SetBkMode(hDC, TRANSPARENT); + ZeroMemory( & lf, sizeof(lf)); + lf.lfWeight = FW_NORMAL; + lf.lfHeight = 12; + hTextFont = CreateFontIndirect(&lf); + hOldFont = (HFONT) GetCurrentObject(hDC, OBJ_FONT); + SelectObject(hDC, hTextFont); + + x = left_margin; + y = top_margin; + pagenum = 0; + err = StartPage(hDC); + + if (err <= 0) { + Tcl_AppendResult(interp, "unable to start page", NULL); + DeleteDC(hDC); + return TCL_ERROR; + } - if (NULL != localDevmode) - { - memcpy((LPVOID) localDevmode, - (LPVOID) returnedDevmode, - returnedDevmode->dmSize); + /* Printing loop, per line.*/ + chan = Tcl_FSOpenFileChannel(interp, objv[1], mode, 0); + if (chan == NULL) { + Tcl_AppendResult(interp, "unable to open channel to file", NULL); + return TCL_ERROR; + } + printbuffer = Tcl_NewObj(); + Tcl_IncrRefCount(printbuffer); + while (Tcl_GetsObj(chan, printbuffer) != -1) { + max_page = 0; + cline = Tcl_GetStringFromObj(printbuffer, &clen); + space_needed = calculate_wrapped_string_height(hDC, width, cline); + if (space_needed > y_max - y) { + if (pagenum >= max_page) + break; + + if (EndPage(hDC) < 0 || StartPage(hDC) < 0) + break; + } + + print_string(hDC, x, y, width, cline); + y += space_needed; + } + Tcl_Close(interp, chan); + Tcl_DecrRefCount(printbuffer); - /* - * Save the printer name from the DEVMODE structure. - */ - localPrinterName = localDevmode->dmDeviceName; - } + EndPage(hDC); + EndDoc(hDC); + SelectObject(hDC, hOldFont); + DeleteObject(hTextFont); + DeleteDC(hDC); - bStatus = OpenPrinterW(localPrinterName, &hPrinter, NULL); - - di.pDocName = (LPWSTR)L"Tk Output"; - di.pOutputFile = NULL; - di.pDatatype = (LPWSTR)L"XPS_PASS"; - - /* Inform the spooler the document is beginning. */ - dwJob = StartDocPrinterW(hPrinter, 1, (LPBYTE) &di); - if (dwJob > 0) - { - /* Start a page. */ - bStatus = StartPagePrinter(hPrinter); - if (bStatus) - { - /*Send the data to the printer. */ - bStatus = WritePrinter(hPrinter, lpData, dwCount, &dwBytesWritten); - EndPagePrinter(hPrinter); - } - /* Inform the spooler that the document is ending. */ - EndDocPrinter(hPrinter); - } - /* Close the printer handle. */ - ClosePrinter(hPrinter); - - /* Check to see if correct number of bytes were written. */ - if (!bStatus || (dwBytesWritten != dwCount)) - { - bStatus = FALSE; - return TCL_ERROR; - } else { - bStatus = TRUE; - return TCL_OK; + return TCL_OK; } return TCL_OK; } -- cgit v0.12 From 6e06cad432e0c7b05788db58d966b7029d061f80 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 6 Feb 2021 04:19:45 +0000 Subject: Some progress on text printing; need to support multi-page printing, improve layout of text on page --- win/tkWinPrint.c | 267 ++++++++++++++++++++++++++----------------------------- 1 file changed, 125 insertions(+), 142 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index eca601b..cc5163d 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -28,38 +28,6 @@ static HPALETTE WinGetSystemPalette(void); static int WinCanvasPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); static int WinTextPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); -/* Declaration for functions used later in this file.*/ -static HPALETTE WinGetSystemPalette(void); -static int WinCanvasPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); -static int WinTextPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *); - -/*Utility functions and definitions.*/ - -#define SCALE_FACTOR 100 - -/*Convert milimiters to points.*/ - static int MM_TO_PIXELS (int mm, int dpi) -{ - return MulDiv (mm * 100, dpi, 2540); -} - -/* Calculate the wrapped height of a string. */ -static int calculate_wrapped_string_height (HDC hDC, int width, char *s) -{ - RECT r = { 0, 0, width, 16384 }; - DrawText (hDC, s, strlen(s), &r, DT_CALCRECT | DT_NOPREFIX | DT_WORDBREAK); - return (r.bottom == 16384) ? calculate_wrapped_string_height (hDC, width, " ") : r.bottom; -} - -/* Print a string in the width provided. */ -static void print_string (HDC hDC, int x, int y, int width, const char* s) -{ - RECT r = { x, y, x + width, 16384 }; - DrawText (hDC, s, strlen(s), &r, DT_CALCRECT | DT_NOPREFIX | DT_WORDBREAK); -} - - - /* * -------------------------------------------------------------------------- * @@ -84,7 +52,7 @@ WinGetSystemPalette(void) hPalette = NULL; hDC = GetDC(NULL); /* Get the desktop device context */ flags = GetDeviceCaps(hDC, RASTERCAPS); - if (flags & RC_PALETTE) { + if (flags &RC_PALETTE) { LOGPALETTE *palettePtr; palettePtr = (LOGPALETTE *) @@ -225,7 +193,7 @@ WinCanvasPrint( } StretchDIBits(printDC, 0, 0, pageWidth, pageHeight, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), ds.dsBm.bmBits, - (LPBITMAPINFO) & ds.dsBmih, DIB_RGB_COLORS, SRCCOPY); + (LPBITMAPINFO) &ds.dsBmih, DIB_RGB_COLORS, SRCCOPY); EndPage(printDC); EndDoc(printDC); DeleteDC(printDC); @@ -243,7 +211,6 @@ done: } else { return TCL_ERROR; } - return result; } @@ -262,136 +229,152 @@ done: */ static int WinTextPrint( - TCL_UNUSED(void * ), - Tcl_Interp * interp, - int objc, - Tcl_Obj * - const * objv) -{ + TCL_UNUSED(void * ), + Tcl_Interp * interp, + int objc, + Tcl_Obj * + const * objv) { Tcl_Channel chan; Tcl_Obj * printbuffer; PRINTDLG pd; HDC hDC; + TEXTMETRIC tm; + HANDLE printhandle; + int i, countlines; + int dpi_x, dpi_y, margin_left, margin_right, margin_top, margin_bottom; + int printarea_horz, printarea_vert, phys_height, phys_width; + int digital_margin_left, digital_margin_top, digital_margin_right, digital_margin_bottom; + int left_adjust_margin, top_adjust_margin, right_adjust_margin, bottom_adjust_margin; + int page_height, page_width; + int yChar; + int page, lines_per_page, total_pages, header_height; + int result; - int dpi, lpx, lpy, res_x, res_y, left_margin, top_margin, right_margin, bottom_margin, width, y_max, job_id, x, y, pagenum, err, space_needed, max_page, clen; DOCINFO di; - LOGFONT lf; - HFONT hTextFont, hOldFont; + HFONT hFont; char * cline; + int clen; const char * mode; + result = TCL_OK; + if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "text"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "text"); + result = TCL_ERROR; + return result; } mode = "r"; - /* Initialize print dialog. */ - ZeroMemory( & pd, sizeof(pd)); + ZeroMemory( &pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); pd.Flags = PD_RETURNDC | PD_NOPAGENUMS; - if (PrintDlg(&pd) == TRUE) { - hDC = pd.hDC; - - if (hDC== NULL) { - Tcl_AppendResult(interp, "can't allocate printer DC", NULL); - return TCL_ERROR; - } - - dpi = 96 * 100 / SCALE_FACTOR; - lpx = GetDeviceCaps(hDC, LOGPIXELSX); - lpy = GetDeviceCaps(hDC, LOGPIXELSX); - res_x = GetDeviceCaps(hDC, HORZRES); - res_y = GetDeviceCaps(hDC, VERTRES); - - /* Margins */ - left_margin = MM_TO_PIXELS(10, dpi); - top_margin = MM_TO_PIXELS(20, dpi); - right_margin = MM_TO_PIXELS(20, dpi); - bottom_margin = MM_TO_PIXELS(20, dpi); - - width = MulDiv(res_x, dpi, lpx) - (left_margin + right_margin); - y_max = MulDiv(res_y, dpi, lpy) - bottom_margin; - - /* Set up for SCALE_FACTOR. */ - SetMapMode(hDC, MM_ANISOTROPIC); - SetWindowExtEx(hDC, dpi, dpi, NULL); - SetViewportExtEx(hDC, lpx, lpy, NULL); - SetStretchBltMode(hDC, HALFTONE); - - ZeroMemory(&di, sizeof(di)); - di.cbSize = sizeof(di); - di.lpszDocName = "Tk Output"; - job_id = StartDoc(hDC, & di); - - if (job_id <= 0) { - Tcl_AppendResult(interp, "unable to start document", NULL); - DeleteDC(hDC); - return TCL_ERROR; - } - - SetBkMode(hDC, TRANSPARENT); - ZeroMemory( & lf, sizeof(lf)); - lf.lfWeight = FW_NORMAL; - lf.lfHeight = 12; - hTextFont = CreateFontIndirect(&lf); - hOldFont = (HFONT) GetCurrentObject(hDC, OBJ_FONT); - SelectObject(hDC, hTextFont); - - x = left_margin; - y = top_margin; - pagenum = 0; - err = StartPage(hDC); - - if (err <= 0) { - Tcl_AppendResult(interp, "unable to start page", NULL); - DeleteDC(hDC); - return TCL_ERROR; - } - - /* Printing loop, per line.*/ - chan = Tcl_FSOpenFileChannel(interp, objv[1], mode, 0); - if (chan == NULL) { - Tcl_AppendResult(interp, "unable to open channel to file", NULL); - return TCL_ERROR; - } - printbuffer = Tcl_NewObj(); - Tcl_IncrRefCount(printbuffer); - while (Tcl_GetsObj(chan, printbuffer) != -1) { - max_page = 0; - cline = Tcl_GetStringFromObj(printbuffer, &clen); - space_needed = calculate_wrapped_string_height(hDC, width, cline); - if (space_needed > y_max - y) { - if (pagenum >= max_page) - break; - - if (EndPage(hDC) < 0 || StartPage(hDC) < 0) - break; - } - - print_string(hDC, x, y, width, cline); - y += space_needed; - } - Tcl_Close(interp, chan); - Tcl_DecrRefCount(printbuffer); - - EndPage(hDC); - EndDoc(hDC); - SelectObject(hDC, hOldFont); - DeleteObject(hTextFont); - DeleteDC(hDC); - - return TCL_OK; + if (PrintDlg( &pd) == TRUE) { + hDC = pd.hDC; + if (hDC == NULL) { + Tcl_AppendResult(interp, "can't allocate printer DC", NULL); + return TCL_ERROR; + } + + ZeroMemory( &di, sizeof(di)); + di.cbSize = sizeof(di); + di.lpszDocName = "Tk Output"; + + /* Read file for printing and count number of lines in file.*/ + chan = Tcl_FSOpenFileChannel(interp, objv[1], mode, 0); + if (chan == NULL) { + Tcl_AppendResult(interp, "unable to open channel to file", NULL); + result = TCL_ERROR; + return result; + } + printbuffer = Tcl_NewObj(); + Tcl_IncrRefCount(printbuffer); + Tcl_ReadChars(chan, printbuffer, -1, 1); + cline = Tcl_GetStringFromObj(printbuffer, &clen); + countlines = 0; + for (i = 0; i < strlen(cline); i++) { + if (cline[i] == '\n') { + countlines++; + } + } + + Tcl_Close(interp, chan); + Tcl_DecrRefCount(printbuffer); + + /* Get printer resolution. */ + dpi_x = GetDeviceCaps(hDC, LOGPIXELSX); + dpi_y = GetDeviceCaps(hDC, LOGPIXELSY); + + /* Compute physical area and margins. */ + margin_left = GetDeviceCaps(hDC, PHYSICALOFFSETX); + margin_top = GetDeviceCaps(hDC, PHYSICALOFFSETY); + printarea_horz = GetDeviceCaps(hDC, HORZRES); + printarea_vert = GetDeviceCaps(hDC, VERTRES); + phys_width = GetDeviceCaps(hDC, PHYSICALWIDTH); + phys_height = GetDeviceCaps(hDC, PHYSICALHEIGHT); + margin_right = phys_width - printarea_horz - margin_left; + margin_bottom = phys_height - printarea_vert - margin_top; + + /* Convert margins into pixel values the printer understands. */ + digital_margin_left = MulDiv(margin_left, dpi_x, 1000); + digital_margin_top = MulDiv(margin_top, dpi_y, 1000); + digital_margin_right = MulDiv(margin_right, dpi_x, 1000); + digital_margin_bottom = MulDiv(margin_bottom, dpi_y, 1000); + + /* Compute adjusted printer margins in pixels. */ + left_adjust_margin = digital_margin_left - margin_left; + top_adjust_margin = digital_margin_top - margin_top; + right_adjust_margin = digital_margin_right - margin_right; + bottom_adjust_margin = digital_margin_bottom - margin_bottom; + + /* Finally, here is our print area. */ + page_width = printarea_horz - (left_adjust_margin + right_adjust_margin); + page_height = printarea_vert - (top_adjust_margin + bottom_adjust_margin); + + hFont = (HFONT) GetStockObject(ANSI_FIXED_FONT); + + /* Set up the current device context. */ + SetMapMode(hDC, MM_TEXT); + SelectObject(hDC, hFont); + + /* Work out the character dimensions for the current font. */ + GetTextMetrics(hDC, &tm); + yChar = tm.tmHeight; + + /* Work out how much data can be printed onto each page. */ + header_height = 0; + lines_per_page = (page_height - header_height / yChar); + total_pages = (countlines + lines_per_page - 1) / lines_per_page; + + if (StartDoc(hDC, &di) > 0) { + for (page = 0; page < total_pages; page++) { + printhandle = SelectObject(hDC, hFont); + RECT r = { + 10, + 10, + page_width, + page_height + }; + DrawText(hDC, cline, -1, &r, DT_NOPREFIX | DT_WORDBREAK); + } + + EndPage(hDC); + EndDoc(hDC); + DeleteDC(hDC); + + result = TCL_OK; + return result; + } + result = TCL_OK; + return result; } - return TCL_OK; + return result; } - /* * ---------------------------------------------------------------------- * -- cgit v0.12 From ba8d733b465d2b25dfa3eba182aa2edd4f143c74 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 6 Feb 2021 15:50:06 +0000 Subject: Minor adjustments --- win/tkWinPrint.c | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index cc5163d..5951a1c 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -351,11 +351,18 @@ static int WinTextPrint( total_pages = (countlines + lines_per_page - 1) / lines_per_page; if (StartDoc(hDC, &di) > 0) { + if(StartPage(pd.hDC) < 0) { + Tcl_AppendResult(interp, "unable to start page", NULL); + result = TCL_ERROR; + return result; + } + + SetViewportOrgEx(hDC, left_adjust_margin, top_adjust_margin, NULL); for (page = 0; page < total_pages; page++) { printhandle = SelectObject(hDC, hFont); RECT r = { - 10, - 10, + 0, + 0, page_width, page_height }; -- cgit v0.12 From 4f55775c96b51d4af6e8fedd2542f3bd7dc1fe82 Mon Sep 17 00:00:00 2001 From: oehhar Date: Sat, 6 Feb 2021 18:26:05 +0000 Subject: Make compile with MS-VC2015. As any warning stops compilation, the signed/unsigned warning must be corrected, sorry. --- win/tkWinPrint.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 5951a1c..7ee79b1 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -241,7 +241,8 @@ static int WinTextPrint( HDC hDC; TEXTMETRIC tm; HANDLE printhandle; - int i, countlines; + size_t lineCur; + int countlines; int dpi_x, dpi_y, margin_left, margin_right, margin_top, margin_bottom; int printarea_horz, printarea_vert, phys_height, phys_width; int digital_margin_left, digital_margin_top, digital_margin_right, digital_margin_bottom; @@ -296,8 +297,8 @@ static int WinTextPrint( Tcl_ReadChars(chan, printbuffer, -1, 1); cline = Tcl_GetStringFromObj(printbuffer, &clen); countlines = 0; - for (i = 0; i < strlen(cline); i++) { - if (cline[i] == '\n') { + for (lineCur = 0; lineCur < strlen(cline); lineCur++) { + if (cline[lineCur] == '\n') { countlines++; } } -- cgit v0.12 From f25261fff123a4f4d1df6042db641ab36b1b0a26 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 19 Feb 2021 02:21:41 +0000 Subject: Some progress with text printing on Windows --- win/tkWinPrint.c | 310 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 185 insertions(+), 125 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 7ee79b1..ab8d927 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -229,160 +229,220 @@ done: */ static int WinTextPrint( - TCL_UNUSED(void * ), - Tcl_Interp * interp, - int objc, - Tcl_Obj * - const * objv) { - - Tcl_Channel chan; - Tcl_Obj * printbuffer; + TCL_UNUSED(void * ), + Tcl_Interp * interp, + int objc, + Tcl_Obj * + const * objv) { PRINTDLG pd; HDC hDC; TEXTMETRIC tm; - HANDLE printhandle; size_t lineCur; int countlines; + int yChar; + int lines_per_page, total_pages, chars_per_line; + int result; + int page; + DOCINFO di; + HFONT hFont = NULL; + char * data; + const char * tmptxt; + LPCTSTR printbuffer; + LONG bufferlen; + int output; int dpi_x, dpi_y, margin_left, margin_right, margin_top, margin_bottom; int printarea_horz, printarea_vert, phys_height, phys_width; int digital_margin_left, digital_margin_top, digital_margin_right, digital_margin_bottom; int left_adjust_margin, top_adjust_margin, right_adjust_margin, bottom_adjust_margin; int page_height, page_width; - int yChar; - int page, lines_per_page, total_pages, header_height; - int result; - - DOCINFO di; - HFONT hFont; - char * cline; - int clen; - const char * mode; result = TCL_OK; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "text"); - result = TCL_ERROR; - return result; + Tcl_WrongNumArgs(interp, 1, objv, "text"); + result = TCL_ERROR; + return result; } - mode = "r"; - - /* Initialize print dialog. */ + /* + *Initialize print dialog. + */ ZeroMemory( &pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); - pd.Flags = PD_RETURNDC | PD_NOPAGENUMS; + pd.Flags = PD_RETURNDC | PD_NOPAGENUMS | PD_ALLPAGES | PD_USEDEVMODECOPIESANDCOLLATE; if (PrintDlg( &pd) == TRUE) { - hDC = pd.hDC; - if (hDC == NULL) { - Tcl_AppendResult(interp, "can't allocate printer DC", NULL); - return TCL_ERROR; - } - - ZeroMemory( &di, sizeof(di)); - di.cbSize = sizeof(di); - di.lpszDocName = "Tk Output"; - - /* Read file for printing and count number of lines in file.*/ - chan = Tcl_FSOpenFileChannel(interp, objv[1], mode, 0); - if (chan == NULL) { - Tcl_AppendResult(interp, "unable to open channel to file", NULL); - result = TCL_ERROR; - return result; - } - printbuffer = Tcl_NewObj(); - Tcl_IncrRefCount(printbuffer); - Tcl_ReadChars(chan, printbuffer, -1, 1); - cline = Tcl_GetStringFromObj(printbuffer, &clen); - countlines = 0; - for (lineCur = 0; lineCur < strlen(cline); lineCur++) { - if (cline[lineCur] == '\n') { - countlines++; - } - } - - Tcl_Close(interp, chan); - Tcl_DecrRefCount(printbuffer); - - /* Get printer resolution. */ - dpi_x = GetDeviceCaps(hDC, LOGPIXELSX); - dpi_y = GetDeviceCaps(hDC, LOGPIXELSY); - - /* Compute physical area and margins. */ - margin_left = GetDeviceCaps(hDC, PHYSICALOFFSETX); - margin_top = GetDeviceCaps(hDC, PHYSICALOFFSETY); - printarea_horz = GetDeviceCaps(hDC, HORZRES); - printarea_vert = GetDeviceCaps(hDC, VERTRES); - phys_width = GetDeviceCaps(hDC, PHYSICALWIDTH); - phys_height = GetDeviceCaps(hDC, PHYSICALHEIGHT); - margin_right = phys_width - printarea_horz - margin_left; - margin_bottom = phys_height - printarea_vert - margin_top; - - /* Convert margins into pixel values the printer understands. */ - digital_margin_left = MulDiv(margin_left, dpi_x, 1000); - digital_margin_top = MulDiv(margin_top, dpi_y, 1000); - digital_margin_right = MulDiv(margin_right, dpi_x, 1000); - digital_margin_bottom = MulDiv(margin_bottom, dpi_y, 1000); - - /* Compute adjusted printer margins in pixels. */ - left_adjust_margin = digital_margin_left - margin_left; - top_adjust_margin = digital_margin_top - margin_top; - right_adjust_margin = digital_margin_right - margin_right; - bottom_adjust_margin = digital_margin_bottom - margin_bottom; - - /* Finally, here is our print area. */ - page_width = printarea_horz - (left_adjust_margin + right_adjust_margin); - page_height = printarea_vert - (top_adjust_margin + bottom_adjust_margin); - - hFont = (HFONT) GetStockObject(ANSI_FIXED_FONT); - - /* Set up the current device context. */ - SetMapMode(hDC, MM_TEXT); - SelectObject(hDC, hFont); - - /* Work out the character dimensions for the current font. */ + hDC = pd.hDC; + if (hDC == NULL) { + Tcl_AppendResult(interp, "can't allocate printer DC", NULL); + return TCL_ERROR; + } + + ZeroMemory( &di, sizeof(di)); + di.cbSize = sizeof(di); + di.lpszDocName = "Tk Output"; + + data = Tcl_GetString(objv[1]); + countlines = 0; + for (lineCur = 0; lineCur < strlen(data); lineCur++) { + if (data[lineCur] == '\n') { + countlines++; + } + } + + /* + * Work out the character dimensions for the current font. + */ GetTextMetrics(hDC, &tm); - yChar = tm.tmHeight; + yChar = tm.tmHeight + tm.tmExternalLeading; - /* Work out how much data can be printed onto each page. */ - header_height = 0; - lines_per_page = (page_height - header_height / yChar); + /* + * Work out how much data can be printed onto each page. + */ + chars_per_line = GetDeviceCaps (hDC, HORZRES) / tm.tmAveCharWidth ; + lines_per_page = GetDeviceCaps (hDC, VERTRES) / yChar ; total_pages = (countlines + lines_per_page - 1) / lines_per_page; + + /* + * Convert input text into a format Windows can use for printing. + */ + tmptxt = data; + printbuffer = (LPCTSTR) tmptxt; + bufferlen = lstrlen(printbuffer); + + /* + * Get printer resolution. + */ + dpi_x = GetDeviceCaps(hDC, LOGPIXELSX); + dpi_y = GetDeviceCaps(hDC, LOGPIXELSY); + + /* + * Compute physical area and margins. + */ + margin_left = GetDeviceCaps(hDC, PHYSICALOFFSETX); + margin_top = GetDeviceCaps(hDC, PHYSICALOFFSETY); + printarea_horz = GetDeviceCaps(hDC, HORZRES); + printarea_vert = GetDeviceCaps(hDC, VERTRES); + phys_width = GetDeviceCaps(hDC, PHYSICALWIDTH); + phys_height = GetDeviceCaps(hDC, PHYSICALHEIGHT); + margin_right = phys_width - printarea_horz - margin_left; + margin_bottom = phys_height - printarea_vert - margin_top; + + /* + * Convert margins into pixel values the printer understands. + */ + digital_margin_left = MulDiv(margin_left, dpi_x, 1000); + digital_margin_top = MulDiv(margin_top, dpi_y, 1000); + digital_margin_right = MulDiv(margin_right, dpi_x, 1000); + digital_margin_bottom = MulDiv(margin_bottom, dpi_y, 1000); + + /* + *Compute adjusted printer margins in pixels. + */ + left_adjust_margin = digital_margin_left - margin_left; + top_adjust_margin = digital_margin_top - margin_top; + right_adjust_margin = digital_margin_right - margin_right; + bottom_adjust_margin = digital_margin_bottom - margin_bottom; + + /* + *Finally, here is our print area. + */ + page_width = printarea_horz - (left_adjust_margin + right_adjust_margin); + page_height = printarea_vert - (top_adjust_margin + bottom_adjust_margin); + + /* + Set font and define variables for printing. + */ + hFont = (HFONT) GetStockObject(ANSI_FIXED_FONT); + + LONG printlen = bufferlen; + int text_done = 0; + LPCTSTR begin_text; + int testheight = 0; + + /* + * Start printing. + */ + output = StartDoc(hDC, &di); + if (output = 0) { + Tcl_AppendResult(interp, "unable to start document", NULL); + return TCL_ERROR; + } + + RECT r, testrect; + r.left = 100; + r.top = 100; + r.right = (page_width - 100); + r.bottom = (page_height - 100); + + begin_text = printbuffer; + + /* + * Loop through the text until it is all printed. We are + * drawing to a dummy rect with the DT_CALCRECT flag set to + * calculate the full area of the text buffer; see + * https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-drawtext. + */ + for (page = pd.nMinPage; (output >= 0) && (text_done < printlen); page++) + { + int textrange_low = 0; + int textrange_high = printlen - text_done; + int textcount = textrange_high; + + output = StartPage(hDC); + if (output = 0) { + Tcl_AppendResult(interp, "unable to start page", NULL); + return TCL_ERROR; + break; + } + + SetMapMode(hDC, MM_TEXT); + SelectObject(hDC, hFont); + + testrect = r; + while (textrange_low < textrange_high) { + testrect.right = r.right; + testheight = DrawText(hDC, begin_text, textcount, &testrect, DT_CALCRECT|DT_WORDBREAK|DT_NOCLIP|DT_EXPANDTABS|DT_NOPREFIX); + if (testheight < r.bottom) + textrange_low = textcount; + if (testheight > r.bottom) + textrange_high = textcount; + if (textrange_low == textrange_high - 1) + textrange_low = textrange_high; + if (textrange_low < textrange_high) + textcount = textrange_low + (textrange_high - textrange_low)/2; + break; + } + output = DrawText(hDC, begin_text, textcount, &r, DT_WORDBREAK|DT_NOCLIP|DT_EXPANDTABS|DT_NOPREFIX); + if (output = 0) { + Tcl_AppendResult(interp, "unable to draw text", NULL); + return TCL_ERROR; + } + /* + * Recalculate each of these values to draw on the next page + * until the buffer is empty, then end that page. + */ + begin_text += textcount; + text_done += textcount; + + output = EndPage(hDC); + if (output = 0) { + Tcl_AppendResult(interp, "unable to end page", NULL); + return TCL_ERROR; + } + } + EndDoc(hDC); + DeleteDC(hDC); - if (StartDoc(hDC, &di) > 0) { - if(StartPage(pd.hDC) < 0) { - Tcl_AppendResult(interp, "unable to start page", NULL); - result = TCL_ERROR; - return result; - } - - SetViewportOrgEx(hDC, left_adjust_margin, top_adjust_margin, NULL); - for (page = 0; page < total_pages; page++) { - printhandle = SelectObject(hDC, hFont); - RECT r = { - 0, - 0, - page_width, - page_height - }; - DrawText(hDC, cline, -1, &r, DT_NOPREFIX | DT_WORDBREAK); - } - - EndPage(hDC); - EndDoc(hDC); - DeleteDC(hDC); - - result = TCL_OK; - return result; - } - result = TCL_OK; - return result; + result = TCL_OK; + return result; } return result; } + + /* * ---------------------------------------------------------------------- * -- cgit v0.12 From ef35a66ab2ddddce51adf40ae7e88ac3d88a3299 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 21 Feb 2021 04:28:19 +0000 Subject: Trying different approach based on TextOut rather than DrawText. Currently prints narrow column on page, but will do further refinement. --- win/tkWinPrint.c | 209 +++++++++++++++++++------------------------------------ 1 file changed, 70 insertions(+), 139 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index bc8bd26..acf627b 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -236,27 +236,22 @@ static int WinTextPrint( const * objv) { PRINTDLG pd; HDC hDC; + HWND hwndEdit; TEXTMETRIC tm; - size_t lineCur; - int countlines; - int yChar; - int lines_per_page, total_pages, chars_per_line; int result; - int page; DOCINFO di; HFONT hFont = NULL; char * data; const char * tmptxt; LPCTSTR printbuffer; LONG bufferlen; - int output; - int dpi_x, dpi_y, margin_left, margin_right, margin_top, margin_bottom; - int printarea_horz, printarea_vert, phys_height, phys_width; - int digital_margin_left, digital_margin_top, digital_margin_right, digital_margin_bottom; - int left_adjust_margin, top_adjust_margin, right_adjust_margin, bottom_adjust_margin; - int page_height, page_width; - + int yChar, chars_per_line, lines_per_page, total_lines, + total_pages, page, line, line_number; + PTSTR linebuffer; + BOOL success; + result = TCL_OK; + success = TRUE; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "text"); @@ -267,42 +262,26 @@ static int WinTextPrint( /* *Initialize print dialog. */ - ZeroMemory( &pd, sizeof(pd)); + ZeroMemory( & pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); pd.Flags = PD_RETURNDC | PD_NOPAGENUMS | PD_ALLPAGES | PD_USEDEVMODECOPIESANDCOLLATE; - if (PrintDlg( &pd) == TRUE) { + if (PrintDlg( & pd) == TRUE) { hDC = pd.hDC; if (hDC == NULL) { Tcl_AppendResult(interp, "can't allocate printer DC", NULL); return TCL_ERROR; } - ZeroMemory( &di, sizeof(di)); + ZeroMemory( & di, sizeof(di)); di.cbSize = sizeof(di); di.lpszDocName = "Tk Output"; - data = Tcl_GetString(objv[1]); - countlines = 0; - for (lineCur = 0; lineCur < strlen(data); lineCur++) { - if (data[lineCur] == '\n') { - countlines++; - } - } - - /* - * Work out the character dimensions for the current font. - */ - GetTextMetrics(hDC, &tm); - yChar = tm.tmHeight + tm.tmExternalLeading; - /* - * Work out how much data can be printed onto each page. + * Get text for printing. */ - chars_per_line = GetDeviceCaps (hDC, HORZRES) / tm.tmAveCharWidth ; - lines_per_page = GetDeviceCaps (hDC, VERTRES) / yChar ; - total_pages = (countlines + lines_per_page - 1) / lines_per_page; + data = Tcl_GetString(objv[1]); /* * Convert input text into a format Windows can use for printing. @@ -312,134 +291,86 @@ static int WinTextPrint( bufferlen = lstrlen(printbuffer); /* - * Get printer resolution. - */ - dpi_x = GetDeviceCaps(hDC, LOGPIXELSX); - dpi_y = GetDeviceCaps(hDC, LOGPIXELSY); - - /* - * Compute physical area and margins. + * Place text into a hidden Windows multi-line edit control + * to make it easier to parse for printing. */ - margin_left = GetDeviceCaps(hDC, PHYSICALOFFSETX); - margin_top = GetDeviceCaps(hDC, PHYSICALOFFSETY); - printarea_horz = GetDeviceCaps(hDC, HORZRES); - printarea_vert = GetDeviceCaps(hDC, VERTRES); - phys_width = GetDeviceCaps(hDC, PHYSICALWIDTH); - phys_height = GetDeviceCaps(hDC, PHYSICALHEIGHT); - margin_right = phys_width - printarea_horz - margin_left; - margin_bottom = phys_height - printarea_vert - margin_top; - /* - * Convert margins into pixel values the printer understands. - */ - digital_margin_left = MulDiv(margin_left, dpi_x, 1000); - digital_margin_top = MulDiv(margin_top, dpi_y, 1000); - digital_margin_right = MulDiv(margin_right, dpi_x, 1000); - digital_margin_bottom = MulDiv(margin_bottom, dpi_y, 1000); - - /* - *Compute adjusted printer margins in pixels. - */ - left_adjust_margin = digital_margin_left - margin_left; - top_adjust_margin = digital_margin_top - margin_top; - right_adjust_margin = digital_margin_right - margin_right; - bottom_adjust_margin = digital_margin_bottom - margin_bottom; + hwndEdit = CreateWindowEx( + 0, "EDIT", + NULL, + WS_POPUP | ES_MULTILINE, + 0, 0, 0, 0, + NULL, + NULL, + NULL, + NULL); /* - *Finally, here is our print area. + * Add text to the window. */ - page_width = printarea_horz - (left_adjust_margin + right_adjust_margin); - page_height = printarea_vert - (top_adjust_margin + bottom_adjust_margin); - - /* - Set font and define variables for printing. - */ - hFont = (HFONT) GetStockObject(ANSI_FIXED_FONT); + SendMessage(hwndEdit, WM_SETTEXT, 0, (LPARAM) printbuffer); - LONG printlen = bufferlen; - int text_done = 0; - LPCTSTR begin_text; - int testheight = 0; + if (0 == (total_lines = SendMessage(hwndEdit, EM_GETLINECOUNT, 0, 0))) + return TCL_OK; /* - * Start printing. + * Determine how text will fit on page. */ - output = StartDoc(hDC, &di); - if (output == 0) { - Tcl_AppendResult(interp, "unable to start document", NULL); - return TCL_ERROR; - } - - RECT r, testrect; - r.left = 100; - r.top = 100; - r.right = (page_width - 100); - r.bottom = (page_height - 100); - - begin_text = printbuffer; + GetTextMetrics(hDC, & tm); + yChar = tm.tmHeight + tm.tmExternalLeading; + chars_per_line = GetDeviceCaps(hDC, HORZRES) / tm.tmAveCharWidth; + lines_per_page = GetDeviceCaps(hDC, VERTRES) / yChar; + total_pages = (total_lines + lines_per_page - 1) / lines_per_page; /* - * Loop through the text until it is all printed. We are - * drawing to a dummy rect with the DT_CALCRECT flag set to - * calculate the full area of the text buffer; see - * https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-drawtext. + * Allocate a buffer for each line of text. */ - for (page = pd.nMinPage; (output >= 0) && (text_done < printlen); page++) - { - int textrange_low = 0; - int textrange_high = printlen - text_done; - int textcount = textrange_high; - - output = StartPage(hDC); - if (output == 0) { - Tcl_AppendResult(interp, "unable to start page", NULL); - return TCL_ERROR; - break; + linebuffer = ckalloc(sizeof(TCHAR) * (chars_per_line + 1)); + + if (StartDoc(pd.hDC, & di) > 0) { + for (page = 0 ; page < total_pages ; page++) { + if (StartPage(hDC) < 0) { + success = FALSE; + result = TCL_ERROR; + return result; } - SetMapMode(hDC, MM_TEXT); - SelectObject(hDC, hFont); - - testrect = r; - while (textrange_low < textrange_high) { - testrect.right = r.right; - testheight = DrawText(hDC, begin_text, textcount, &testrect, DT_CALCRECT|DT_WORDBREAK|DT_NOCLIP|DT_EXPANDTABS|DT_NOPREFIX); - if (testheight < r.bottom) - textrange_low = textcount; - if (testheight > r.bottom) - textrange_high = textcount; - if (textrange_low == textrange_high - 1) - textrange_low = textrange_high; - if (textrange_low < textrange_high) - textcount = textrange_low + (textrange_high - textrange_low)/2; - break; - } - output = DrawText(hDC, begin_text, textcount, &r, DT_WORDBREAK|DT_NOCLIP|DT_EXPANDTABS|DT_NOPREFIX); - if (output == 0) { - Tcl_AppendResult(interp, "unable to draw text", NULL); - return TCL_ERROR; - } - /* - * Recalculate each of these values to draw on the next page - * until the buffer is empty, then end that page. + /* + * For each page, print the lines. */ - begin_text += textcount; - text_done += textcount; - - output = EndPage(hDC); - if (output == 0) { - Tcl_AppendResult(interp, "unable to end page", NULL); - return TCL_ERROR; + for (line = 0; line < lines_per_page; line++) { + line_number = lines_per_page * page + line; + if (line_number > total_lines) + break; + *(int * ) linebuffer = chars_per_line; + TextOut(hDC, 100, yChar * line, linebuffer, + (int) SendMessage(hwndEdit, EM_GETLINE, + (WPARAM) line_number, (LPARAM) linebuffer)); + } + if (EndPage(hDC) < 0) { + success = FALSE; + result = TCL_ERROR; + return result; } } - EndDoc(hDC); - DeleteDC(hDC); - + if (!success) { + result = TCL_ERROR; + return result; + } + if (success){ + EndDoc(hDC); + DestroyWindow(hwndEdit); + } + } + ckfree(linebuffer); + DeleteDC(pd.hDC); result = TCL_OK; return result; } return result; } + + -- cgit v0.12 From 1e4967476d036d15872bf52495fb316098a50394 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 21 Feb 2021 04:37:44 +0000 Subject: Fix minor typos --- win/tkWinPrint.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index acf627b..86a1d60 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -267,14 +267,14 @@ static int WinTextPrint( pd.hwndOwner = GetDesktopWindow(); pd.Flags = PD_RETURNDC | PD_NOPAGENUMS | PD_ALLPAGES | PD_USEDEVMODECOPIESANDCOLLATE; - if (PrintDlg( & pd) == TRUE) { + if (PrintDlg( &pd) == TRUE) { hDC = pd.hDC; if (hDC == NULL) { Tcl_AppendResult(interp, "can't allocate printer DC", NULL); return TCL_ERROR; } - ZeroMemory( & di, sizeof(di)); + ZeroMemory( &di, sizeof(di)); di.cbSize = sizeof(di); di.lpszDocName = "Tk Output"; @@ -316,7 +316,7 @@ static int WinTextPrint( /* * Determine how text will fit on page. */ - GetTextMetrics(hDC, & tm); + GetTextMetrics(hDC, &tm); yChar = tm.tmHeight + tm.tmExternalLeading; chars_per_line = GetDeviceCaps(hDC, HORZRES) / tm.tmAveCharWidth; lines_per_page = GetDeviceCaps(hDC, VERTRES) / yChar; -- cgit v0.12 From db0c28a7590585a90b1956549ea94c558fc11b70 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 6 Mar 2021 01:26:10 +0000 Subject: Add tkWinGDI.c --- win/tkWinGDI.c | 4789 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 4789 insertions(+) create mode 100644 win/tkWinGDI.c diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c new file mode 100644 index 0000000..1c2c29b --- /dev/null +++ b/win/tkWinGDI.c @@ -0,0 +1,4789 @@ +/* + * tkWinGDI.c -- + * + * This module implements access to the Win32 GDI API. + * + * Copyright © 1991-1996 Microsoft Corp. + * Copyright © 2009, Michael I. Schwartz. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + + +/* Remove Deprecation Warnings. */ +#define _CRT_SECURE_NO_WARNINGS + +#include +#include +#include + + +#if defined(__WIN32__) || defined (__WIN32S__) || defined (WIN32S) + #ifndef STATIC_BUILD + # if defined(_MSC_VER) + # include /* Ensure to include WINAPI definition */ + # define EXPORT(a,b) __declspec(dllexport) a b + # define IMPORT(a,b) __declspec(dllimport) a b + # define DllEntryPoint DllMain + # define strcmpi(l,r) _stricmp(l,r) + # define strncmpi(l,r,c) _strnicmp(l,r,c) + # else + # if defined(__BORLANDC__) + # define EXPORT(a,b) a _export b + # define IMPORT(a,b) a _import b + # else + # define EXPORT(a,b) a b + # define IMPORT(a,b) a b + # endif + # endif + # define hypot(dx,dy) _hypot(dx,dy) + #endif +#else + # error "Extension is only for Windows" +#endif + +#include +/* #include */ +#include + +/* New macros for tcl8.0.3 and later */ +#if defined(TCL_STORAGE_CLASS) +# undef TCL_STORAGE_CLASS +#endif + +#define TCL_STORAGE_CLASS DLLEXPORT + +#if ! defined(EXTERN) +# define EXTERN +#endif + +/* Defined at the bottom so we can import the symbols */ +static HWND tk_gethwnd (Window window); +static HWND tkwingetwrapperwindow(Window tkwin); + +#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION <= 5 +/* In this case, must replace Tcl_Alloc(), Tcl_Realloc(), and Tcl_Free() +* with ckalloc(), ckrealloc(), and ckfree() +*/ + +#define Tcl_Alloc(x) ckalloc(x) +#define Tcl_Free(x) ckfree(x) +#define Tcl_Realloc(x,y) ckrealloc(x,y) + +#endif + + +/* Main dispatcher for commands */ +static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +/* Main dispatcher for subcommands */ +static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); + +/* Real functions */ +static int GdiConfig (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiArc (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiBitmap (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiCharWidths (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiImage (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiPhoto (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiLine (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiOval (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiPolygon (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiRectangle(ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiText (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int Version (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); + +static int GdiMap (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); +static int GdiCopyBits (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); + +/* Local copies of similar routines elsewhere in Tcl/Tk */ +static int GdiParseColor (const char *name, unsigned long *color); +static int GdiGetColor (const char *name, unsigned long *color); +static int TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints); + +/* Routines imported from irox */ +static int PrintTextCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char *argv); + +/* +* Hash table support +* +* Provided by the hdc extension +*/ +static int hdc_loaded = 0; +static void init_hdc_functions(Tcl_Interp *interp); +static int (*hdc_init) (Tcl_Interp *interp); +static const char * (*hdc_create) (Tcl_Interp *interp, void *ptr, int type); +static int (*hdc_valid) (Tcl_Interp *interp, const char *hdcname, int type); +static int (*hdc_delete) (Tcl_Interp *interp, const char *hdcname); +static void * (*hdc_get) (Tcl_Interp *interp, const char *hdcname); +static int (*hdc_typeof) (Tcl_Interp *interp, const char *hdcname); +static const char * (*hdc_prefixof) (Tcl_Interp *interp, int type, const char *newprefix); +static int (*hdc_list) (Tcl_Interp *interp, int type, const char *out[], int *poutlen); + +static HDC get_dc(Tcl_Interp *interp, const char *name); + +/* +* Helper functions +*/ +static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC hDC); +static int GdiMakePen(Tcl_Interp *interp, int width, + int dashstyle, const char *dashstyledata, + int capstyle, + int joinstyle, + int stipplestyle, const char *stippledata, + unsigned long color, + HDC hDC, HGDIOBJ *oldPen); +static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen); +static int GdiMakeBrush (Tcl_Interp *interp, unsigned int style, unsigned long color, + long hatch, LOGBRUSH *lb, HDC hDC, HGDIOBJ *oldBrush); +static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBrush); +static int GdiGetHdcInfo( HDC hdc, + LPPOINT worigin, LPSIZE wextent, + LPPOINT vorigin, LPSIZE vextent); + +/* Helper functions for printing the window client area */ +enum PrintType { PTWindow=0, PTClient=1, PTScreen=2 }; +static HANDLE CopyToDIB ( HWND wnd, enum PrintType type ); +static HBITMAP CopyScreenToBitmap(LPRECT lpRect); +static HANDLE BitmapToDIB (HBITMAP hb, HPALETTE hp); +static HANDLE CopyScreenToDIB(LPRECT lpRect); +static int DIBNumColors(LPBITMAPINFOHEADER lpDIB); +static int PalEntriesOnDevice(HDC hDC); +static HPALETTE GetSystemPalette(void); +static void GetDisplaySize (LONG *width, LONG *height); + +static char usage_message[] = "gdi [arc|characters|copybits|line|map|oval|" + "photo|polygon|rectangle|text|version]\n" + "\thdc parameters can be generated by the printer extension"; +static char msgbuf[1024]; + +/* +* This is the top-level routine for the GDI command +* It strips off the first word of the command (gdi) and +* sends the result to the switch +*/ +static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + if ( argc > 1 && strcmp(*argv, "gdi") == 0 ) + { + argc--; + argv++; + return Gdi(unused, interp, argc, argv); + } + + Tcl_SetResult (interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* To make the "subcommands" follow a standard convention, +* add them to this array. The first element is the subcommand +* name, and the second a standard Tcl command handler. +*/ +struct gdi_command +{ + char *command_string; + int (*command) (ClientData, Tcl_Interp *, int, const char *); +} gdi_commands[] = +{ + { "arc", GdiArc }, + { "bitmap", GdiBitmap }, + { "characters", GdiCharWidths }, + { "configure", GdiConfig }, + { "image", GdiImage }, + { "line", GdiLine }, + { "map", GdiMap }, + { "oval", GdiOval }, + { "photo", GdiPhoto }, + { "polygon", GdiPolygon }, + { "rectangle", GdiRectangle }, + { "text", GdiText }, +#if TEXTWIDGET_CMD + { "textwidget", PrintTextCmd }, +#endif + { "copybits", GdiCopyBits }, + { "version", Version }, + +}; + +/* +* This is the GDI subcommand dispatcher +*/ +static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + int i; + + for (i=0; i= 1 ) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if ( hDC == (HDC) 0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + argc--; + argv++; + } + else + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + /* Now check for other arguments */ + while ( argc >= 1 ) + { + if ( strcmp(argv[0], "-bg") == 0 || strcmp(argv[0], "-background") == 0 ) + { + unsigned long color; + argc--; + argv++; + if ( argc >= 1 ) + { + if ( GdiParseColor(argv[0], &color) > 0 ) /* OK */ + SetBkColor(hDC, color); + else + { + Tcl_AppendResult(interp, + "{ {gdi configure: color parsing error for background ", + argv[0], + "} }", + 0); + status = TCL_ERROR; + } + } + } + argc--; + argv++; + } + + if ( (c = GetBkColor(hDC)) == CLR_INVALID ) + { + Tcl_AppendResult(interp, "{ -background INVALID }", 0); + status = TCL_ERROR; + } + else + { + sprintf(clrhex, "#%02x%02x%02x", GetRValue(c), GetGValue(c), GetBValue(c)); + Tcl_AppendResult(interp, "{ -background ", clrhex, " }", 0); + } + + return status; +} + +/* +* Arc command +* Create a standard "DrawFunc" to make this more workable.... +*/ +#ifdef _MSC_VER +typedef BOOL (WINAPI *DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie */ +#else +typedef BOOL WINAPI (*DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie */ +#endif + +static int GdiArc (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + int x1, y1, x2, y2; + int xr0, yr0, xr1, yr1; + HDC hDC; + double extent = 0.0 , start = 0.0 ; + DrawFunc drawfunc; + int width = 0; + HPEN hPen; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + HBRUSH hBrush; + LOGBRUSH lbrush; + HGDIOBJ oldobj; + int dodash = 0; + const char *dashdata = 0; + + static char usage_message[] = "gdi arc hdc x1 y1 x2 y2 " + "-extent degrees " + "-fill color -outline color " + "-outlinestipple bitmap " + "-start degrees -stipple bitmap " + "-dash pattern " + "-style [pieslice|chord|arc] -width linewid"; + + drawfunc = Pie; + + /* Verrrrrry simple for now... */ + if (argc >= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + x1 = atoi(argv[1]); + y1 = atoi(argv[2]); + x2 = atoi(argv[3]); + y2 = atoi(argv[4]); + + argc -= 5; + argv += 5; + while ( argc >= 2 ) + { + if ( strcmp (argv[0], "-extent") == 0 ) + extent = atof(argv[1]); + else if ( strcmp (argv[0], "-start") == 0 ) + start = atof(argv[1]); + else if ( strcmp (argv[0], "-style") == 0 ) + { + if ( strcmp (argv[1], "pieslice") == 0 ) + drawfunc = Pie; + else if ( strcmp(argv[1], "arc") == 0 ) + drawfunc = Arc; + else if ( strcmp(argv[1], "chord") == 0 ) + drawfunc = Chord; + } + /* Handle all args, even if we don't use them yet */ + else if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( GdiGetColor(argv[1], &fillcolor) ) + dofillcolor=1; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor=1; + } + else if (strcmp(argv[0], "-outlinestipple") == 0 ) + { + } + else if (strcmp(argv[0], "-stipple") == 0 ) + { + } + else if (strcmp(argv[0], "-width") == 0 ) + { + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + argc -= 2; + argv += 2; + } + xr0 = xr1 = ( x1 + x2 ) / 2; + yr0 = yr1 = ( y1 + y2 ) / 2; + + + /* + * The angle used by the arc must be "warped" by the eccentricity of the ellipse. + * Thanks to Nigel Dodd for bringing a nice example. + */ + xr0 += (int)(100.0 * (x2 - x1) * cos( (start * 2.0 * 3.14159265) / 360.0 ) ); + yr0 -= (int)(100.0 * (y2 - y1) * sin( (start * 2.0 * 3.14159265) / 360.0 ) ); + xr1 += (int)(100.0 * (x2 - x1) * cos( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); + yr1 -= (int)(100.0 * (y2 - y1) * sin( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); + + /* Under Win95, SetArcDirection isn't implemented--so we have to + assume that arcs are drawn counterclockwise (e.g., positive extent) + So if it's negative, switch the coordinates! + */ + if ( extent < 0 ) + { + int xr2 = xr0; + int yr2 = yr0; + xr0 = xr1; + xr1 = xr2; + yr0 = yr1; + yr1 = yr2; + } + + if ( dofillcolor ) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH) ); + + if ( width || dolinecolor ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + + (*drawfunc)(hDC, x1, y1, x2, y2, xr0, yr0, xr1, yr1); + + if ( width || dolinecolor ) + GdiFreePen(interp, hDC, hPen); + if ( dofillcolor ) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject(hDC, oldobj); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Bitmap command +* Unimplemented for now. +* Should use the same techniques as CanvasPsBitmap (tkCanvPs.c) +*/ +static int GdiBitmap (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi bitmap hdc x y " + "-anchor [center|n|e|s|w] -background color " + "-bitmap bitmap -foreground color\n" + "Not implemented yet. Sorry!"; + + /* Skip this for now.... */ + /* Should be based on common code with the copybits command */ + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Image command +* Unimplemented for now. +* Should switch on image type and call either GdiPhoto or GdiImage +* (or other registered function(?)) +* This code is similar to that in the tkx.y.z/win/tkWinImage.c code? +*/ +static int GdiImage (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi image hdc x y -anchor [center|n|e|s|w] -image name\n" + "Not implemented yet. Sorry!"; + + /* Skip this for now.... */ + /* Should be based on common code with the copybits command */ + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + /* Normally, usage results in TCL_ERROR--but wait til' it's implemented */ + return TCL_OK; +} + +/* +* Gdi Photo +* Contributed by Lukas Rosenthaler +* Note: The canvas doesn't directly support photos (only as images), +* so this is the first gdi command without an equivalent canvas command. +* This code may be modified to support photo images on the canvas. +*/ +static int GdiPhoto (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi photo hdc [-destination x y [w [h]]] -photo name\n"; + HDC dst; + int dst_x = 0, dst_y = 0, dst_w = 0, dst_h = 0; + int nx, ny, sll; + const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char * */ + Tk_PhotoHandle photo_handle; + Tk_PhotoImageBlock img_block; + BITMAPINFO bitmapinfo; /* Since we don't need the bmiColors table, + there is no need for dynamic allocation */ + int oldmode; /* For saving the old stretch mode */ + POINT pt; /* For saving the brush org */ + char *pbuf = NULL; + int i, j, k; + int retval = TCL_OK; + + /* + * Parse the arguments. + */ + /* HDC is required */ + if ( argc < 1 ) { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + dst = get_dc(interp, argv[0]); + + /* Check hDC */ + if (dst == (HDC) 0) { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for gdi photo\n", 0); + Tcl_AppendResult(interp, usage_message, 0); + return TCL_ERROR; + } + + /* + * Next, check to see if 'dst' can support BitBlt. + * If not, raise an error + */ + if ( (GetDeviceCaps (dst, RASTERCAPS) & RC_STRETCHDIB) == 0 ) { + sprintf(msgbuf, "gdi photo not supported on device context (0x%s)", argv[0]); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + + /* Parse the command line arguments */ + for (j = 1; j < argc; j++) + { + if (strcmp (argv[j], "-destination") == 0) + { + double x, y, w, h; + int count = 0; + + if ( j < argc ) + count = sscanf(argv[++j], "%lf%lf%lf%lf", &x, &y, &w, &h); + + if ( count < 2 ) /* Destination must provide at least 2 arguments */ + { + Tcl_AppendResult(interp, "-destination requires a list of at least 2 numbers\n", + usage_message, 0); + return TCL_ERROR; + } + else + { + dst_x = (int) x; + dst_y = (int) y; + if ( count == 3 ) + { + dst_w = (int) w; + dst_h = -1; + } + else if ( count == 4 ) + { + dst_w = (int) w; + dst_h = (int) h; + } + } + } + else if (strcmp (argv[j], "-photo") == 0) + photoname = argv[++j]; + } + + if ( photoname == 0 ) /* No photo provided */ + { + Tcl_AppendResult(interp, "No photo name provided to gdi photo\n", usage_message, 0); + return TCL_ERROR; + } + + photo_handle = Tk_FindPhoto (interp, photoname); + if ( photo_handle == 0 ) + { + Tcl_AppendResult(interp, "gdi photo: Photo name ", photoname, " can't be located\n", + usage_message, 0); + return TCL_ERROR; + } + Tk_PhotoGetImage (photo_handle, &img_block); + + + nx = img_block.width; + ny = img_block.height; + sll = ((3*nx + 3) / 4)*4; /* must be multiple of 4 */ + + pbuf = (char *) Tcl_Alloc (sll*ny*sizeof (char)); + if ( pbuf == 0 ) /* Memory allocation failure */ + { + Tcl_AppendResult(interp, "gdi photo failed--out of memory", 0); + return TCL_ERROR; + } + + /* After this, all returns must go through retval */ + + /* BITMAP expects BGR; photo provides RGB */ + for (k = 0; k < ny; k++) + { + for (i = 0; i < nx; i++) + { + pbuf[k*sll + 3*i] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[2]]; + pbuf[k*sll + 3*i + 1] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[1]]; + pbuf[k*sll + 3*i + 2] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[0]]; + } + } + + memset (&bitmapinfo, 0L, sizeof (BITMAPINFO)); + + bitmapinfo.bmiHeader.biSize = sizeof (BITMAPINFOHEADER); + bitmapinfo.bmiHeader.biWidth = nx; + bitmapinfo.bmiHeader.biHeight = -ny; + bitmapinfo.bmiHeader.biPlanes = 1; + bitmapinfo.bmiHeader.biBitCount = 24; + bitmapinfo.bmiHeader.biCompression = BI_RGB; + bitmapinfo.bmiHeader.biSizeImage = 0; /* sll*ny; */ + bitmapinfo.bmiHeader.biXPelsPerMeter = 0; + bitmapinfo.bmiHeader.biYPelsPerMeter = 0; + bitmapinfo.bmiHeader.biClrUsed = 0; + bitmapinfo.bmiHeader.biClrImportant = 0; + + oldmode = SetStretchBltMode (dst, HALFTONE); + /* According to the Win32 Programmer's Manual, we have to set the brush org, now */ + SetBrushOrgEx(dst, 0, 0, &pt); + + if (dst_w <= 0) + { + dst_w = nx; + dst_h = ny; + } + else if (dst_h <= 0) + { + dst_h = ny*dst_w / nx; + } + + if (StretchDIBits (dst, dst_x, dst_y, dst_w, dst_h, 0, 0, nx, ny, + pbuf, &bitmapinfo, DIB_RGB_COLORS, SRCCOPY) == GDI_ERROR) { + int errcode; + + errcode = GetLastError(); + sprintf(msgbuf, "gdi photo internal failure: StretchDIBits error code %ld", errcode); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + retval = TCL_ERROR; + } + + /* Clean up the hDC */ + if (oldmode != 0 ) + { + SetStretchBltMode(dst, oldmode); + SetBrushOrgEx(dst, pt.x, pt.y, &pt); + } + + Tcl_Free (pbuf); + + if ( retval == TCL_OK ) + { + sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + } + + return retval; +} + +/* +* Interface to Tk's line smoother, used for lines and pollies +* Provided by Jasper Taylor +*/ +int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { + /* First, translate my points into a list of doubles */ + double *inPointList, *outPointList; + int n; + int nbpoints = 0; + POINT* bpoints; + + + inPointList=(double *)Tcl_Alloc(2*sizeof(double)*npoly); + if ( inPointList == 0 ) { + return nbpoints; /* 0 */ + } + + for (n=0;n= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) + { + Tcl_SetResult(interp, "Out of memory in GdiLine", TCL_STATIC); + return TCL_ERROR; + } + polypoints[0].x = atol(argv[1]); + polypoints[0].y = atol(argv[2]); + polypoints[1].x = atol(argv[3]); + polypoints[1].y = atol(argv[4]); + argc -= 5; + argv += 5; + npoly = 2; + + while ( argc >= 2 ) + { + /* Check for a number */ + x = strtoul(argv[0], &strend, 0); + if ( strend > argv[0] ) + { + /* One number... */ + y = strtoul (argv[1], &strend, 0); + if ( strend > argv[1] ) + { + /* TWO numbers! */ + polypoints[npoly].x = x; + polypoints[npoly].y = y; + npoly++; + argc-=2; + argv+=2; + } + else + { + /* Only one number... Assume a usage error */ + Tcl_Free((void *)polypoints); + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + } + else + { + if ( strcmp(*argv, "-arrow") == 0 ) + { + if ( strcmp(argv[1], "none") == 0 ) + doarrow = 0; + else if ( strcmp(argv[1], "both") == 0 ) + doarrow = 3; + else if ( strcmp(argv[1], "first") == 0 ) + doarrow = 2; + else if ( strcmp(argv[1], "last") == 0 ) + doarrow = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-arrowshape") == 0 ) + { + /* List of 3 numbers--set arrowshape array */ + int a1, a2, a3; + + if ( sscanf(argv[1], "%d%d%d", &a1, &a2, &a3) == 3 ) + { + if (a1 > 0 && a2 > 0 && a3 > 0 ) + { + arrowshape[0] = a1; + arrowshape[1] = a2; + arrowshape[2] = a3; + } + /* Else the numbers are bad */ + } + /* Else the argument was bad */ + + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-capstyle") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-fill") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-joinstyle") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-smooth") == 0 ) + { + /* Argument is true/false or 1/0 or bezier */ + if ( argv[1] ) { + switch ( argv[1][0] ) { + case 't': case 'T': + case '1': + case 'b': case 'B': /* bezier */ + dosmooth = 1; + break; + default: + dosmooth = 0; + break; + } + argv+=2; + argc-=2; + } + } + else if ( strcmp(*argv, "-splinesteps") == 0 ) + { + nStep = atoi(argv[1]); + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-dash" ) == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + argv += 2; + argc -= 2; + } + else if ( strcmp(*argv, "-dashoffset" ) == 0 ) + { + argv += 2; + argc -= 2; + } + else if ( strcmp(*argv, "-stipple") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-width") == 0 ) + { + width = atoi(argv[1]); + argv+=2; + argc-=2; + } + else /* It's an unknown argument! */ + { + argc--; + argv++; + } + /* Check for arguments + * Most of the arguments affect the "Pen" + */ + } + } + + if (width || dolinecolor || dodash ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + if ( doarrow != 0 ) + GdiMakeBrush(interp, 0, linecolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + + if (dosmooth) /* Use PolyBezier */ + { + int nbpoints; + POINT *bpoints = 0; + nbpoints = Bezierize(polypoints,npoly,nStep,&bpoints); + if (nbpoints > 0 ) + Polyline(hDC, bpoints, nbpoints); + else + Polyline(hDC, polypoints, npoly); /* out of memory? just draw a regular line */ + if ( bpoints != 0 ) + Tcl_Free((void *)bpoints); + } + else + Polyline(hDC, polypoints, npoly); + + if ( dodash && doarrow ) /* Don't use dashed or thick pen for the arrows! */ + { + GdiFreePen(interp, hDC, hPen); + GdiMakePen(interp, width, + 0, 0, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + } + + /* Now the arrowheads, if any */ + if ( doarrow & 1 ) + { + /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y */ + POINT ahead[6]; + double dx, dy, length; + double backup, sinTheta, cosTheta; + double vertX, vertY, temp; + double fracHeight; + + fracHeight = 2.0 / arrowshape[2]; + backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; + + ahead[0].x = ahead[5].x = polypoints[npoly-1].x; + ahead[0].y = ahead[5].y = polypoints[npoly-1].y; + dx = ahead[0].x - polypoints[npoly-2].x; + dy = ahead[0].y - polypoints[npoly-2].y; + if ( (length = hypot(dx, dy)) == 0 ) + sinTheta = cosTheta = 0.0; + else + { + sinTheta = dy / length; + cosTheta = dx / length; + } + vertX = ahead[0].x - arrowshape[0]*cosTheta; + vertY = ahead[0].y - arrowshape[0]*sinTheta; + temp = arrowshape[2]*sinTheta; + ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); + ahead[4].x = (long)(ahead[1].x - 2 * temp); + temp = arrowshape[2]*cosTheta; + ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); + ahead[4].y = (long)(ahead[1].y + 2 * temp); + ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); + ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); + + Polygon(hDC, ahead, 6); + + } + + if ( doarrow & 2 ) + { + /* Arrowhead at end = polypoints[0].x, polypoints[0].y */ + POINT ahead[6]; + double dx, dy, length; + double backup, sinTheta, cosTheta; + double vertX, vertY, temp; + double fracHeight; + + fracHeight = 2.0 / arrowshape[2]; + backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; + + ahead[0].x = ahead[5].x = polypoints[0].x; + ahead[0].y = ahead[5].y = polypoints[0].y; + dx = ahead[0].x - polypoints[1].x; + dy = ahead[0].y - polypoints[1].y; + if ( (length = hypot(dx, dy)) == 0 ) + sinTheta = cosTheta = 0.0; + else + { + sinTheta = dy / length; + cosTheta = dx / length; + } + vertX = ahead[0].x - arrowshape[0]*cosTheta; + vertY = ahead[0].y - arrowshape[0]*sinTheta; + temp = arrowshape[2]*sinTheta; + ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); + ahead[4].x = (long)(ahead[1].x - 2 * temp); + temp = arrowshape[2]*cosTheta; + ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); + ahead[4].y = (long)(ahead[1].y + 2 * temp); + ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); + ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); + + Polygon(hDC, ahead, 6); + } + + + if (width || dolinecolor || dodash ) + GdiFreePen(interp, hDC, hPen); + if ( doarrow ) + GdiFreeBrush(interp, hDC, hBrush); + + Tcl_Free((void *)polypoints); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Oval command +*/ +static int GdiOval (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi oval hdc x1 y1 x2 y2 -fill color -outline color " + "-stipple bitmap -width linewid"; + int x1, y1, x2, y2; + HDC hDC; + HPEN hPen; + int width=0; + COLORREF linecolor = 0, fillcolor = 0; + int dolinecolor = 0, dofillcolor = 0; + HBRUSH hBrush; + LOGBRUSH lbrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now... */ + if (argc >= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + x1 = atol(argv[1]); + y1 = atol(argv[2]); + x2 = atol(argv[3]); + y2 = atol(argv[4]); + if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } + if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } + argc -= 5; + argv += 5; + + while ( argc > 0 ) + { + /* Now handle any other arguments that occur */ + if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( argv[1] ) + if ( GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( argv[1] ) + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-stipple") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-width") == 0 ) + { + if (argv[1]) + width = atoi(argv[1]); + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + argv+=2; + argc-=2; + } + } + + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject( hDC, GetStockObject(HOLLOW_BRUSH) ); + + if (width || dolinecolor) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ + Ellipse (hDC, x1, y1, x2+1, y2+1); + if (width || dolinecolor) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject (hDC, oldobj ); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Polygon command +*/ +static int GdiPolygon (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi polygon hdc x1 y1 ... xn yn " + "-fill color -outline color -smooth [true|false|bezier] " + "-splinesteps number -stipple bitmap -width linewid"; + + char *strend; + POINT *polypoints; + int npoly; + int dosmooth = 0; + int nStep = 12; + int x, y; + HDC hDC; + HPEN hPen; + int width = 0; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + LOGBRUSH lbrush; + HBRUSH hBrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now... */ + if (argc >= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) + { + Tcl_SetResult(interp, "Out of memory in GdiLine", TCL_STATIC); + return TCL_ERROR; + } + polypoints[0].x = atol(argv[1]); + polypoints[0].y = atol(argv[2]); + polypoints[1].x = atol(argv[3]); + polypoints[1].y = atol(argv[4]); + argc -= 5; + argv += 5; + npoly = 2; + + while ( argc >= 2 ) + { + /* Check for a number */ + x = strtoul(argv[0], &strend, 0); + if ( strend > argv[0] ) + { + /* One number... */ + y = strtoul (argv[1], &strend, 0); + if ( strend > argv[1] ) + { + /* TWO numbers! */ + polypoints[npoly].x = x; + polypoints[npoly].y = y; + npoly++; + argc-=2; + argv+=2; + } + else + { + /* Only one number... Assume a usage error */ + Tcl_Free((void *)polypoints); + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + } + else + { + if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( argv[1] && GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 0; + } + else if ( strcmp(argv[0], "-smooth") == 0 ) { + if ( argv[1] ) { + switch ( argv[1][0] ) { + case 't': case 'T': + case '1': + case 'b': case 'B': /* bezier */ + dosmooth = 1; + break; + default: + dosmooth = 0; + break; + } + } + } + else if ( strcmp(argv[0], "-splinesteps") == 0 ) + { + if ( argv[1] ) + nStep = atoi(argv[1]); + } + else if (strcmp(argv[0], "-stipple") == 0 ) + { + } + else if (strcmp(argv[0], "-width") == 0 ) + { + if (argv[1]) + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + argc -= 2; + argv += 2; + /* Check for arguments + * Most of the arguments affect the "Pen" and "Brush" + */ + } + } + + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); + + if (width || dolinecolor) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + + if ( dosmooth) + { + int nbpoints; + POINT *bpoints = 0; + nbpoints = Bezierize(polypoints,npoly,nStep,&bpoints); + if ( nbpoints > 0 ) + Polygon(hDC, bpoints, nbpoints); + else + Polygon(hDC, polypoints, npoly); + if ( bpoints != 0 ) + Tcl_Free((void *)bpoints); + } + else + Polygon(hDC, polypoints, npoly); + + if (width || dolinecolor) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject (hDC, oldobj); + + Tcl_Free((void *)polypoints); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Rectangle command +*/ +static int GdiRectangle(ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi rectangle hdc x1 y1 x2 y2 " + "-fill color -outline color " + "-stipple bitmap -width linewid"; + + int x1, y1, x2, y2; + HDC hDC; + HPEN hPen; + int width = 0; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + LOGBRUSH lbrush; + HBRUSH hBrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now... */ + if (argc >= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + x1 = atol(argv[1]); + y1 = atol(argv[2]); + x2 = atol(argv[3]); + y2 = atol(argv[4]); + if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } + if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } + argc -= 5; + argv += 5; + + /* Now handle any other arguments that occur */ + while (argc > 1) + { + if ( strcmp(argv[0], "-fill") == 0 ) + { + if (argv[1]) + if (GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + } + else if ( strcmp(argv[0], "-outline") == 0) + { + if (argv[1]) + if (GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + } + else if ( strcmp(argv[0], "-stipple") == 0) + { + } + else if ( strcmp(argv[0], "-width") == 0) + { + if (argv[1] ) + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + + argc -= 2; + argv += 2; + } + + /* Note: If any fill is specified, the function must create a brush and + * put the coordinates in a RECTANGLE structure, and call FillRect. + * FillRect requires a BRUSH / color. + * If not, the function Rectangle must be called + */ + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); + + if ( width || dolinecolor ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ + Rectangle (hDC, x1, y1, x2+1, y2+1); + if ( width || dolinecolor ) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject(hDC, oldobj); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* characters command +* Need some way to get accurate data on character widths. +* This is completely inadequate for typesetting, but should work +* for simple text manipulation. +*/ +static int GdiCharWidths (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi characters hdc [-font fontname] [-array ary]"; + /* Returns widths of characters from font in an associative array + * Font is currently selected font for HDC if not specified + * Array name is GdiCharWidths if not specified + * Widths should be in the same measures as all other values (1/1000 inch). + */ + HDC hDC; + LOGFONT lf; + HFONT hfont, oldfont; + int made_font = 0; + const char *aryvarname = "GdiCharWidths"; + /* For now, assume 256 characters in the font... */ + int widths[256]; + int retval; + + if ( argc < 1 ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + argc--; + argv++; + + while ( argc > 0 ) + { + if ( strcmp(argv[0], "-font") == 0 ) + { + argc--; + argv++; + if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) + if ( (hfont = CreateFontIndirect(&lf)) != NULL ) + { + made_font = 1; + oldfont = SelectObject(hDC, hfont); + } + /* Else leave the font alone! */ + } + else if ( strcmp(argv[0], "-array") == 0 ) + { + argv++; + argc--; + if ( argc > 0 ) + { + aryvarname=argv[0]; + } + } + argv++; + argc--; + } + + /* Now, get the widths using the correct function for this windows version */ +#ifdef WIN32 + /* Try the correct function. If it fails (as has been reported on some + * versions of Windows 95), try the "old" function + */ + if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) + { + retval = GetCharWidth (hDC, 0, 255, widths ); + } +#else + retval = GetCharWidth (hDC, 0, 255, widths); +#endif + /* Retval should be 1 (TRUE) if the function succeeded. If the function fails, + * get the "extended" error code and return. Be sure to deallocate the font if + * necessary. + */ + if (retval == FALSE) + { + DWORD val = GetLastError(); + char intstr[12+1]; + sprintf (intstr, "%ld", val ); + Tcl_AppendResult (interp, "gdi character failed with code ", intstr, 0); + if ( made_font ) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + return TCL_ERROR; + } + + { + int i; + char numbuf[11+1]; + char ind[2]; + ind[1] = '\0'; + + for (i = 0; i < 255; i++ ) + { + /* May need to convert the widths here(?) */ + sprintf(numbuf, "%d", widths[i]); + ind[0] = i; + Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); + } + } + /* Now, remove the font if we created it only for this function */ + if ( made_font ) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + + /* The return value should be the array name(?) */ + Tcl_SetResult(interp, (char *)aryvarname, TCL_VOLATILE); + return TCL_OK; +} + +/* +* Text command +* Q: Add -clip/-noclip? Add -single? +* Q: To match canvas semantics, this should respect newlines, +* and treat no width supplied (width of 0) to output as +* a single line EXCEPT that it respects newlines. +*/ +static int GdiText (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi text hdc x y -anchor [center|n|e|s|w] " + "-fill color -font fontname " + "-justify [left|right|center] " + "-stipple bitmap -text string -width linelen " + "-single -backfill" + "-encoding [input encoding] -unicode"; + + HDC hDC; + int x, y; + const char *string = 0; + RECT sizerect; + UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas */ + Tk_Anchor anchor = 0; + LOGFONT lf; + HFONT hfont, oldfont; + int made_font = 0; + int retval; + int dotextcolor=0; + int dobgmode=0; + int dounicodeoutput=0; /* If non-zero, output will be drawn in Unicode */ + int bgmode; + COLORREF textcolor = 0; + int usewidth=0; + int usesingle = 0; + const char *encoding_name = 0; + +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + TCHAR *ostring; + Tcl_DString tds; + Tcl_Encoding encoding = NULL; + int tds_len; +#endif + + if ( argc >= 4 ) + { + /* Parse the command */ + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + x = atol(argv[1]); + y = atol(argv[2]); + argc -= 3; + argv += 3; + + sizerect.left = sizerect.right = x; + sizerect.top = sizerect.bottom = y; + + while ( argc > 0 ) + { + if ( strcmp(argv[0], "-anchor") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + Tk_GetAnchor(interp, argv[0], &anchor); + } + else if ( strcmp(argv[0], "-justify") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + { + if ( strcmp(argv[0], "left") == 0 ) + format_flags |= DT_LEFT; + else if ( strcmp(argv[0], "center") == 0 ) + format_flags |= DT_CENTER; + else if ( strcmp(argv[0], "right") == 0 ) + format_flags |= DT_RIGHT; + } + } + else if ( strcmp(argv[0], "-text") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + string = argv[0]; + } + else if ( strcmp(argv[0], "-font") == 0 ) + { + argc--; + argv++; + if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) + if ( (hfont = CreateFontIndirect(&lf)) != NULL ) + { + made_font = 1; + oldfont = SelectObject(hDC, hfont); + } + /* Else leave the font alone! */ + } + else if ( strcmp(argv[0], "-stipple") == 0 ) + { + argc--; + argv++; + /* Not implemented yet */ + } + else if ( strcmp(argv[0], "-fill") == 0 ) + { + argc--; + argv++; + /* Get text color */ + if ( GdiGetColor(argv[0], &textcolor) ) + dotextcolor = 1; + } + else if ( strcmp(argv[0], "-width") == 0 ) + { + argc--; + argv++; + if ( argc > 0 ) + sizerect.right += atol(argv[0]); + /* If a width is specified, break at words. */ + format_flags |= DT_WORDBREAK; + usewidth = 1; + } + else if ( strcmp(argv[0], "-single") == 0 ) + { + usesingle = 1; + } + else if ( strcmp(argv[0], "-backfill") == 0 ) + dobgmode = 1; + else if ( strcmp(argv[0], "-unicode") == 0 ) + { + dounicodeoutput = 1; + /* Set the encoding name to utf-8, but can be overridden */ + if ( encoding_name == 0 ) + encoding_name = "utf-8"; + } + else if ( strcmp(argv[0], "-encoding") == 0 ) { + argc--; + argv++; + if ( argc > 0 ) { + encoding_name = argv[0]; + } + } + + argc--; + argv++; + } + +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + /* Handle the encoding, if present */ + if ( encoding_name != 0 ) + { + Tcl_Encoding tmp_encoding; + tmp_encoding = Tcl_GetEncoding(interp,encoding_name); + if (tmp_encoding != NULL) + encoding = tmp_encoding; + } +#endif + + if (string == 0 ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + /* Set the format flags for -single: Overrides -width */ + if ( usesingle == 1 ) + { + format_flags |= DT_SINGLELINE; + format_flags |= DT_NOCLIP; + format_flags &= ~DT_WORDBREAK; + } + + /* Calculate the rectangle */ +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + Tcl_DStringInit(&tds); + Tcl_UtfToExternalDString(encoding, string, -1, &tds); + ostring = Tcl_DStringValue(&tds); + tds_len = Tcl_DStringLength(&tds); + /* Just for fun, let's try translating ostring to unicode */ + if (dounicodeoutput) /* Convert UTF-8 to unicode */ + { + Tcl_UniChar *ustring; + Tcl_DString tds2; + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); + DrawTextW(hDC, (LPWSTR)ustring, Tcl_UniCharLen(ustring), &sizerect, format_flags | DT_CALCRECT); + Tcl_DStringFree(&tds2); + } + else /* Use UTF-8/local code page output */ + { + DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); + } +#else + DrawText (hDC, string, -1, &sizerect, format_flags | DT_CALCRECT); +#endif + + /* Adjust the rectangle according to the anchor */ + x = y = 0; + switch ( anchor ) + { + case TK_ANCHOR_N: + x = ( sizerect.right - sizerect.left ) / 2; + break; + case TK_ANCHOR_S: + x = ( sizerect.right - sizerect.left ) / 2; + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_E: + x = ( sizerect.right - sizerect.left ); + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + case TK_ANCHOR_W: + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + case TK_ANCHOR_NE: + x = ( sizerect.right - sizerect.left ); + break; + case TK_ANCHOR_NW: + break; + case TK_ANCHOR_SE: + x = ( sizerect.right - sizerect.left ); + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_SW: + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_CENTER: + x = ( sizerect.right - sizerect.left ) / 2; + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + } + sizerect.right -= x; + sizerect.left -= x; + sizerect.top -= y; + sizerect.bottom -= y; + + /* Get the color right */ + if ( dotextcolor ) + textcolor = SetTextColor(hDC, textcolor); + + if ( dobgmode ) + bgmode = SetBkMode(hDC, OPAQUE); + else + bgmode = SetBkMode(hDC, TRANSPARENT); + + + /* Print the text */ +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + if (dounicodeoutput) /* Convert UTF-8 to unicode */ + { + Tcl_UniChar *ustring; + Tcl_DString tds2; + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); + retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_UniCharLen(ustring), &sizerect, format_flags); + Tcl_DStringFree(&tds2); + } + else + { + retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); + } + Tcl_DStringFree(&tds); +#else + retval = DrawText (hDC, string, -1, &sizerect, format_flags); +#endif + + /* Get the color set back */ + if ( dotextcolor ) + textcolor = SetTextColor(hDC, textcolor); + + SetBkMode(hDC, bgmode); + + if (made_font) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + + /* In this case, the return value is the height of the text */ + sprintf(msgbuf, "%d", retval); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* GdiGetHdcInfo +* Return salient characteristics of the CTM. +* The return value is 0 if any failure occurs--in which case +* none of the other values are meaningful. +* Otherwise the return value is the current mapping mode +* (this may be VERY windows-specific). +*/ +static int GdiGetHdcInfo( HDC hdc, + LPPOINT worigin, LPSIZE wextent, + LPPOINT vorigin, LPSIZE vextent) +{ + int mapmode; + int retval; + + memset (worigin, 0, sizeof(POINT)); + memset (vorigin, 0, sizeof(POINT)); + memset (wextent, 0, sizeof(SIZE)); + memset (vextent, 0, sizeof(SIZE)); + + if ( (mapmode = GetMapMode(hdc)) == 0 ) + { + /* Failed! */ + retval=0; + } + else + retval = mapmode; + + if ( GetWindowExtEx(hdc, wextent) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetViewportExtEx (hdc, vextent) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetWindowOrgEx(hdc, worigin) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetViewportOrgEx(hdc, vorigin) == FALSE ) + { + /* Failed! */ + retval = 0; + } + + return retval; +} + +/* +* Converts Windows mapping mode names to values in the .h +*/ +static int GdiNameToMode(const char *name) +{ + static struct gdimodes { + int mode; + const char *name; + } modes[] = { + { MM_ANISOTROPIC, "MM_ANISOTROPIC" }, + { MM_HIENGLISH, "MM_HIENGLISH" }, + { MM_HIMETRIC, "MM_HIMETRIC" }, + { MM_ISOTROPIC, "MM_ISOTROPIC" }, + { MM_LOENGLISH, "MM_LOENGLISH" }, + { MM_LOMETRIC, "MM_LOMETRIC" }, + { MM_TEXT, "MM_TEXT" }, + { MM_TWIPS, "MM_TWIPS" } + }; + + int i; + for (i=0; i < sizeof(modes) / sizeof(struct gdimodes); i++) + { + if ( strcmp(modes[i].name, name) == 0 ) + return modes[i].mode; + } + return atoi(name); +} + +/* +* Mode to Name converts the mode number to a printable form +*/ +static const char *GdiModeToName(int mode) +{ + static struct gdi_modes { + int mode; + const char *name; + } modes[] = { + { MM_ANISOTROPIC, "Anisotropic" }, + { MM_HIENGLISH, "1/1000 inch" }, + { MM_HIMETRIC, "1/100 mm" }, + { MM_ISOTROPIC, "Isotropic" }, + { MM_LOENGLISH, "1/100 inch" }, + { MM_LOMETRIC, "1/10 mm" }, + { MM_TEXT, "1 to 1" }, + { MM_TWIPS, "1/1440 inch" } + }; + + int i; + for (i=0; i < sizeof(modes) / sizeof(struct gdi_modes); i++) + { + if ( modes[i].mode == mode ) + return modes[i].name; + } + return "Unknown"; +} + +/* +* GdiMap - +* Set mapping mode between logical and physical device space +* Syntax for this is intended to be more-or-less independent of +* Windows/Mac/X--that is, equally difficult to use with each. +* Alternative: +* Possibly this could be a feature of the HDC extension itself? +*/ +static int GdiMap (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + static char usage_message[] = "gdi map hdc " + "[-logical x[y]] [-physical x[y]] " + "[-offset {x y} ] [-default] [-mode mode]" + ; + HDC hdc; + int mapmode; /* Mapping mode */ + SIZE wextent; /* Device extent */ + SIZE vextent; /* Viewport extent */ + POINT worigin; /* Device origin */ + POINT vorigin; /* Viewport origin */ + int argno; + + /* Keep track of what parts of the function need to be executed */ + int need_usage = 0; + int use_logical = 0; + int use_physical = 0; + int use_offset = 0; + int use_default = 0; + int use_mode = 0; + + /* Required parameter: HDC for printer */ + if ( argc >= 1 ) + { + hdc = get_dc(interp, argv[0]); + /* Check hDC */ + if (hdc == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) + { + /* Failed! */ + Tcl_SetResult(interp, "Cannot get current HDC info", TCL_STATIC); + return TCL_ERROR; + } + + /* Parse remaining arguments */ + for (argno = 1; argno < argc; argno++) + { + if ( strcmp(argv[argno], "-default") == 0 ) + { + vextent.cx = vextent.cy = wextent.cx = wextent.cy = 1; + vorigin.x = vorigin.y = worigin.x = worigin.y = 0; + mapmode = MM_TEXT; + use_default = 1; + } + else if ( strcmp (argv[argno], "-mode" ) == 0 ) + { + if ( argno + 1 >= argc ) + need_usage = 1; + else + { + mapmode = GdiNameToMode(argv[argno+1]); + use_mode = 1; + argno++; + } + } + else if ( strcmp (argv[argno], "-offset") == 0 ) + { + if (argno + 1 >= argc) + need_usage = 1; + else + { + /* It would be nice if this parsed units as well... */ + if ( sscanf(argv[argno+1], "%ld%ld", &vorigin.x, &vorigin.y) == 2 ) + use_offset = 1; + else + need_usage = 1; + argno ++; + } + } + else if ( strcmp (argv[argno], "-logical") == 0 ) + { + if ( argno+1 >= argc) + need_usage = 1; + else + { + int count; + argno++; + /* In "real-life", this should parse units as well. */ + if ( (count = sscanf(argv[argno], "%ld%ld", &wextent.cx, &wextent.cy)) != 2 ) + { + if ( count == 1 ) + { + mapmode = MM_ISOTROPIC; + use_logical = 1; + wextent.cy = wextent.cx; /* Make them the same */ + } + else + need_usage = 1; + } + else + { + mapmode = MM_ANISOTROPIC; + use_logical = 2; + } + } + } + else if ( strcmp (argv[argno], "-physical") == 0 ) + { + if ( argno+1 >= argc) + need_usage = 1; + else + { + int count; + + argno++; + /* In "real-life", this should parse units as well. */ + if ( (count = sscanf(argv[argno], "%ld%ld", &vextent.cx, &vextent.cy)) != 2 ) + { + if ( count == 1 ) + { + mapmode = MM_ISOTROPIC; + use_physical = 1; + vextent.cy = vextent.cx; /* Make them the same */ + } + else + need_usage = 1; + } + else + { + mapmode = MM_ANISOTROPIC; + use_physical = 2; + } + } + } + } + + /* Check for any impossible combinations */ + if ( use_logical != use_physical ) + need_usage = 1; + if ( use_default && (use_logical || use_offset || use_mode ) ) + need_usage = 1; + if ( use_mode && use_logical && + (mapmode != MM_ISOTROPIC && mapmode != MM_ANISOTROPIC) + ) + need_usage = 1; + + if ( need_usage == 0 ) + { + /* Call Windows CTM functions */ + if ( use_logical || use_default || use_mode ) /* Don't call for offset only */ + { + SetMapMode(hdc, mapmode); + } + + if ( use_offset || use_default ) + { + POINT oldorg; + SetViewportOrgEx (hdc, vorigin.x, vorigin.y, &oldorg); + SetWindowOrgEx (hdc, worigin.x, worigin.y, &oldorg); + } + + if ( use_logical ) /* Same as use_physical */ + { + SIZE oldsiz; + SetWindowExtEx (hdc, wextent.cx, wextent.cy, &oldsiz); + SetViewportExtEx (hdc, vextent.cx, vextent.cy, &oldsiz); + } + + /* Since we may not have set up every parameter, get them again for + * the report: + */ + mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent); + + /* Output current CTM info */ + /* Note: This should really be in terms that can be used in a gdi map command! */ + sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " + "Origin: \"(%ld, %ld)\" " + "MappingMode: \"%s\"", + vextent.cx, vextent.cy, wextent.cx, wextent.cy, + vorigin.x, vorigin.y, + GdiModeToName(mapmode)); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_OK; + } + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* GdiCopyBits +*/ +static int GdiCopyBits (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + /* Goal: get the Tk_Window from the top-level + convert it to an HWND + get the HDC + Do a bitblt to the given hdc + Use an optional parameter to point to an arbitrary window instead of the main + Use optional parameters to map to the width and height required for the dest. + */ + static char usage_message[] = "gdi copybits hdc [-window w|-screen] [-client] " + "[-source \"a b c d\"] " + "[-destination \"a b c d\"] [-scale number] [-calc]"; + + Tk_Window mainWin; + Tk_Window workwin; + Window w; + HDC src; + HDC dst; + HWND wnd = 0; + + HANDLE hDib; /* handle for device-independent bitmap */ + LPBITMAPINFOHEADER lpDIBHdr; + LPSTR lpBits; + enum PrintType wintype = PTWindow; + + int hgt, wid; + char *strend; + long errcode; + + /* Variables to remember what we saw in the arguments */ + int do_window=0; + int do_screen=0; + int do_scale=0; + int do_print=1; + + /* Variables to remember the values in the arguments */ + const char *window_spec; + double scale=1.0; + int src_x=0, src_y=0, src_w=0, src_h=0; + int dst_x=0, dst_y=0, dst_w=0, dst_h=0; + int is_toplevel = 0; + + /* + * The following steps are peculiar to the top level window. + * There is likely a clever way to do the mapping of a + * widget pathname to the proper window, to support the idea of + * using a parameter for this purpose. + */ + if ( (workwin = mainWin = Tk_MainWindow(interp)) == 0 ) + { + Tcl_SetResult(interp, "Can't find main Tk window", TCL_STATIC); + return TCL_ERROR; + } + + /* + * Parse the arguments. + */ + /* HDC is required */ + if ( argc < 1 ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + dst = get_dc(interp, argv[0]); + + /* Check hDC */ + if (dst == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for BitBlt destination", 0); + return TCL_ERROR; + } + + /* + * Next, check to see if 'dst' can support BitBlt. + * If not, raise an error + */ + if ( ( GetDeviceCaps (dst, RASTERCAPS) & RC_BITBLT ) == 0 ) + { + sprintf(msgbuf, "Can't do bitmap operations on device context (0x%lx)", dst); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + + /* Loop through the remaining arguments */ + { + int k; + for (k=1; k= 100.0 ) + { + sprintf(msgbuf, "Unreasonable scale specification %s", argv[k]); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + do_scale = 1; + } + } + else if ( strcmp(argv[k], "-noprint") == 0 || strncmp(argv[k], "-calc", 5) == 0 ) + { + /* This option suggested by Pascal Bouvier to get sizes without printing */ + do_print = 0; + } + } + } + + /* + * Check to ensure no incompatible arguments were used + */ + if ( do_window && do_screen ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + /* + * Get the MS Window we want to copy. + */ + /* Given the HDC, we can get the "Window" */ + if (wnd == 0 ) + { + if ( Tk_IsTopLevel(workwin) ) + is_toplevel = 1; + + if ( (w = Tk_WindowId(workwin)) == 0 ) + { + Tcl_SetResult(interp, "Can't get id for Tk window", TCL_STATIC); + return TCL_ERROR; + } + + /* Given the "Window" we can get a Microsoft Windows HWND */ + + if ( (wnd = tk_gethwnd(w)) == 0 ) + { + Tcl_SetResult(interp, "Can't get Windows handle for Tk window", TCL_STATIC); + return TCL_ERROR; + } + + /* If it's a toplevel, give it special treatment: Get the top-level window instead. + * If the user only wanted the client, the -client flag will take care of it. + * This uses "windows" tricks rather than Tk since the obvious method of + * getting the wrapper window didn't seem to work. + */ + if ( is_toplevel ) + { + HWND tmpWnd = wnd; + while ( (tmpWnd = GetParent( tmpWnd ) ) != 0 ) + wnd = tmpWnd; + } + } + + /* Given the HWND, we can get the window's device context */ + if ( (src = GetWindowDC(wnd)) == 0 ) + { + Tcl_SetResult(interp, "Can't get device context for Tk window", TCL_STATIC); + return TCL_ERROR; + } + + if ( do_screen ) + { + LONG w, h; + GetDisplaySize(&w, &h); + wid = w; + hgt = h; + } + else if ( is_toplevel ) + { + RECT tl; + GetWindowRect(wnd, &tl); + wid = tl.right - tl.left; + hgt = tl.bottom - tl.top; + } + else + { + if ( (hgt = Tk_Height(workwin)) <= 0 ) + { + Tcl_SetResult(interp, "Can't get height of Tk window", TCL_STATIC); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + if ( (wid = Tk_Width(workwin)) <= 0 ) + { + Tcl_SetResult(interp, "Can't get width of Tk window", TCL_STATIC); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + } + + /* + * Ensure all the widths and heights are set up right + * A: No dimensions are negative + * B: No dimensions exceed the maximums + * C: The dimensions don't lead to a 0 width or height image. + */ + if ( src_x < 0 ) + src_x = 0; + if ( src_y < 0 ) + src_y = 0; + if ( dst_x < 0 ) + dst_x = 0; + if ( dst_y < 0 ) + dst_y = 0; + + if ( src_w > wid || src_w <= 0 ) + src_w = wid; + + if ( src_h > hgt || src_h <= 0 ) + src_h = hgt; + + if ( do_scale && dst_w == 0 ) + { + /* Calculate destination width and height based on scale */ + dst_w = (int)(scale * src_w); + dst_h = (int)(scale * src_h); + } + + if ( dst_h == -1 ) + dst_h = (int) (((long)src_h * dst_w) / (src_w + 1)) + 1; + + if ( dst_h == 0 || dst_w == 0 ) + { + dst_h = src_h; + dst_w = src_w; + } + + if ( do_print ) + { + /* + * Based on notes from Heiko Schock and Arndt Roger Schneider, + * create this as a DIBitmap, to allow output to a greater range of + * devices. This approach will also allow selection of + * a) Whole screen + * b) Whole window + * c) Client window only + * for the "grab" + */ + hDib = CopyToDIB( wnd, wintype ); + + /* GdiFlush(); */ + + if (!hDib) { + Tcl_SetResult(interp, "Can't create DIB", TCL_STATIC); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + lpDIBHdr = (LPBITMAPINFOHEADER)GlobalLock(hDib); + if (!lpDIBHdr) { + Tcl_SetResult(interp, "Can't get DIB header", TCL_STATIC); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + lpBits = (LPSTR)lpDIBHdr + lpDIBHdr->biSize + DIBNumColors(lpDIBHdr) * sizeof(RGBQUAD); + + /* stretch the DIBbitmap directly in the target device */ + + if (StretchDIBits(dst, + dst_x, dst_y, dst_w, dst_h, + src_x, src_y, src_w, src_h, + lpBits, (LPBITMAPINFO)lpDIBHdr, DIB_RGB_COLORS, + SRCCOPY) == GDI_ERROR) + { + errcode = GetLastError(); + GlobalUnlock(hDib); + GlobalFree(hDib); + ReleaseDC(wnd,src); + sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + + /* free allocated memory */ + GlobalUnlock(hDib); + GlobalFree(hDib); + } + + ReleaseDC(wnd,src); + + /* The return value should relate to the size in the destination space. + * At least the height should be returned (for page layout purposes) + */ + sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + + return TCL_OK; +} + +/* +* Computes the number of colors required for a DIB palette +*/ +static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) +{ + WORD wBitCount; // DIB bit count + DWORD dwClrUsed; + + // If this is a Windows-style DIB, the number of colors in the + // color table can be less than the number of bits per pixel + // allows for (i.e. lpbi->biClrUsed can be set to some value). + // If this is the case, return the appropriate value. + + + dwClrUsed = (lpDIB)->biClrUsed; + if (dwClrUsed) + return (WORD)dwClrUsed; + + // Calculate the number of colors in the color table based on + // the number of bits per pixel for the DIB. + + wBitCount = (lpDIB)->biBitCount; + + // return number of colors based on bits per pixel + + switch (wBitCount) + { + case 1: + return 2; + + case 4: + return 16; + + case 8: + return 256; + + default: + return 0; + } +} + +/* +* Helper functions +*/ +static int GdiWordToWeight(const char *str); +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs); +/* +* ParseFontWords converts various keywords to modifyers of a +* font specification. +* For all words, later occurances override earlier occurances. +* Overstrike and underline cannot be "undone" by other words +*/ +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs) +{ + int i; + int retval = 0; /* Number of words that could not be parsed */ + for (i=0; ilfWeight = wt; + else if ( strcmp(str[i], "roman") == 0 ) + lf->lfItalic = FALSE; + else if ( strcmp(str[i], "italic") == 0 ) + lf->lfItalic = TRUE; + else if ( strcmp(str[i], "underline") == 0 ) + lf->lfUnderline = TRUE; + else if ( strcmp(str[i], "overstrike") == 0 ) + lf->lfStrikeOut = TRUE; + else + retval++; + } + } + return retval; +} + +/* +* GdiWordToWeight converts keywords to font weights. +* This is used to help set the proper font for GDI rendering. +*/ +static int GdiWordToWeight(const char *str) +{ + int retval = -1; + int i; + static struct font_weight + { + const char *name; + int weight; + } font_weights[] = + { + { "thin", FW_THIN }, + { "extralight", FW_EXTRALIGHT }, + { "ultralight", FW_EXTRALIGHT }, + { "light", FW_LIGHT }, + { "normal", FW_NORMAL }, + { "regular", FW_NORMAL }, + { "medium", FW_MEDIUM }, + { "semibold", FW_SEMIBOLD }, + { "demibold", FW_SEMIBOLD }, + { "bold", FW_BOLD }, + { "extrabold", FW_EXTRABOLD }, + { "ultrabold", FW_EXTRABOLD }, + { "heavy", FW_HEAVY }, + { "black", FW_HEAVY }, + }; + + if ( str == 0 ) + return -1; + + for (i=0; ilfWeight = FW_NORMAL; + lf->lfCharSet = DEFAULT_CHARSET; + lf->lfOutPrecision = OUT_DEFAULT_PRECIS; + lf->lfClipPrecision = CLIP_DEFAULT_PRECIS; + lf->lfQuality = DEFAULT_QUALITY; + lf->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; + + /* The cast to (char *) is silly, based on prototype of Tcl_SplitList */ + if ( Tcl_SplitList(interp, (char *)str, &count, &list) != TCL_OK ) + return 0; + + /* Now we have the font structure broken into name, size, weight */ + if ( count >= 1 ) + strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); + else + return 0; + + if ( count >= 2 ) + { + int siz; + char *strend; + siz = strtol(list[1], &strend, 0); + + /* Assumptions: + * 1) Like canvas, if a positive number is specified, it's in points + * 2) Like canvas, if a negative number is specified, it's in pixels + */ + if ( strend > list[1] ) /* If it looks like a number, it is a number... */ + { + if ( siz > 0 ) /* Size is in points */ + { + SIZE wextent, vextent; + POINT worigin, vorigin; + double factor; + + switch ( GdiGetHdcInfo(hDC, &worigin, &wextent, &vorigin, &vextent) ) + { + case MM_ISOTROPIC: + if ( vextent.cy < -1 || vextent.cy > 1 ) + { + factor = (double)wextent.cy / vextent.cy; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else if ( vextent.cx < -1 || vextent.cx > 1 ) + { + factor = (double)wextent.cx / vextent.cx; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else + lf->lfHeight = -siz; /* This is bad news... */ + break; + case MM_ANISOTROPIC: + if ( vextent.cy != 0 ) + { + factor = (double)wextent.cy / vextent.cy; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else + lf->lfHeight = -siz; /* This is bad news... */ + break; + case MM_TEXT: + default: + /* If mapping mode is MM_TEXT, use the documented formula */ + lf->lfHeight = -MulDiv(siz, GetDeviceCaps(hDC, LOGPIXELSY), 72); + break; + case MM_HIENGLISH: + lf->lfHeight = -MulDiv(siz, 1000, 72); + break; + case MM_LOENGLISH: + lf->lfHeight = -MulDiv(siz, 100, 72); + break; + case MM_HIMETRIC: + lf->lfHeight = -MulDiv(siz, (int)(1000*2.54), 72); + break; + case MM_LOMETRIC: + lf->lfHeight = -MulDiv(siz, (int)(100*2.54), 72); + break; + case MM_TWIPS: + lf->lfHeight = -MulDiv(siz, 1440, 72); + break; + } + } + else if ( siz == 0 ) /* Use default size of 12 points */ + lf->lfHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72); + else /* Use pixel size */ + { + lf->lfHeight = siz; /* Leave this negative */ + } + } + else + GdiParseFontWords(interp, lf, list+1, count-1); + } + + if ( count >= 3 ) + GdiParseFontWords(interp, lf, list+2, count-2); + + Tcl_Free((char *)list); + return 1; +} + +/* +* This command creates a logical pen based on input +* parameters and selects it into the HDC +*/ +/* The LOGPEN structure takes the following dash options: + * PS_SOLID: a solid pen + * PS_DASH: a dashed pen + * PS_DOT: a dotted pen + * PS_DASHDOT: a pen with a dash followed by a dot + * PS_DASHDOTDOT: a pen with a dash followed by 2 dots + * + * It seems that converting to ExtCreatePen may be more advantageous, as it matches + * the Tk canvas pens much better--but not for Win95, which does not support PS_USERSTYLE + * An explicit test (or storage in a static after first failure) may suffice for working + * around this. The ExtCreatePen is not supported at all under Win32s. +*/ +static int GdiMakePen(Tcl_Interp *interp, int width, + int dashstyle, const char *dashstyledata, + int capstyle, /* Ignored for now */ + int joinstyle, /* Ignored for now */ + int stipplestyle, const char *stippledata, /* Ignored for now */ + unsigned long color, + HDC hDC, HGDIOBJ *oldPen) +{ + HPEN hPen; + LOGBRUSH lBrush; + DWORD pStyle = PS_SOLID; /* -dash should override*/ + DWORD endStyle = PS_ENDCAP_ROUND; /* -capstyle should override */ + DWORD joinStyle = PS_JOIN_ROUND; /* -joinstyle should override */ + DWORD styleCount = 0; + DWORD *styleArray = 0; + + /* To limit the propagation of allocated memory, the dashes will have a maximum here. + * If one wishes to remove the static allocation, please be sure to update GdiFreePen + * and ensure that the array is NOT freed if the LOGPEN option is used. + */ + static DWORD pStyleData[24]; + if ( dashstyle != 0 && dashstyledata != 0 ) + { + const char *cp; + int i; + char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); + if (dup) + strcpy(dup, dashstyledata); + /* DEBUG */ + Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", dashstyledata, "|\n", 0); + + /* Parse the dash spec */ + if ( isdigit(dashstyledata[0]) ) { + cp = strtok(dup, " \t,;"); + for ( i = 0; cp && i < sizeof(pStyleData) / sizeof (DWORD); i++ ) { + pStyleData[styleCount++] = atoi(cp); + cp = strtok(NULL, " \t,;"); + } + } else { + for (i=0; dashstyledata[i] != '\0' && i< sizeof(pStyleData) / sizeof(DWORD); i++ ) { + switch ( dashstyledata[i] ) { + case ' ': + pStyleData[styleCount++] = 8; + break; + case ',': + pStyleData[styleCount++] = 4; + break; + case '_': + pStyleData[styleCount++] = 6; + break; + case '-': + pStyleData[styleCount++] = 4; + break; + case '.': + pStyleData[styleCount++] = 2; + break; + default: + break; + } + } + } + if ( styleCount > 0 ) + styleArray = pStyleData; + else + dashstyle = 0; + if (dup) + Tcl_Free(dup); + } + + if ( dashstyle != 0 ) + pStyle = PS_USERSTYLE; + + /* -stipple could affect this... */ + lBrush.lbStyle = BS_SOLID; + lBrush.lbColor = color; + lBrush.lbHatch = 0; + + /* We only use geometric pens, even for 1-pixel drawing */ + hPen = ExtCreatePen ( PS_GEOMETRIC|pStyle|endStyle|joinStyle, + width, + &lBrush, + styleCount, + styleArray); + + if ( hPen == 0 ) { /* Failed for some reason...Fall back on CreatePenIndirect */ + LOGPEN lf; + lf.lopnWidth.x = width; + lf.lopnWidth.y = 0; /* Unused in LOGPEN */ + if ( dashstyle == 0 ) + lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future */ + else + lf.lopnStyle = PS_DASH; /* REALLLLY simple for now */ + lf.lopnColor = color; /* Assume we're getting a COLORREF */ + /* Now we have a logical pen. Create the "real" pen and put it in the hDC */ + hPen = CreatePenIndirect(&lf); + } + + *oldPen = SelectObject(hDC, hPen); + return 1; +} + +/* +* FreePen wraps the protocol to delete a created pen +*/ +static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen) +{ + HGDIOBJ gonePen; + gonePen = SelectObject (hDC, oldPen); + DeleteObject (gonePen); + return 1; +} + +/* +* MakeBrush creates a logical brush based on input parameters, +* creates it, and selects it into the hdc. +*/ +static int GdiMakeBrush (Tcl_Interp *interp, unsigned int style, unsigned long color, + long hatch, LOGBRUSH *lb, HDC hDC, HGDIOBJ *oldBrush) +{ + HBRUSH hBrush; + lb->lbStyle = BS_SOLID; /* Support other styles later */ + lb->lbColor = color; /* Assume this is a COLORREF */ + lb->lbHatch = hatch; /* Ignored for now, given BS_SOLID in the Style */ + /* Now we have the logical brush. Create the "real" brush and put it in the hDC */ + hBrush = CreateBrushIndirect(lb); + *oldBrush = SelectObject(hDC, hBrush); + return 1; +} + +/* +* FreeBrush wraps the protocol to delete a created brush +*/ +static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBrush) +{ + HGDIOBJ goneBrush; + goneBrush = SelectObject (hDC, oldBrush); + DeleteObject(goneBrush); + return 1; +} + +/* +* Copied functions from elsewhere in Tcl. +* Functions have removed reliance on X and Tk libraries, +* as well as removing the need for TkWindows. +* GdiGetColor is a copy of a TkpGetColor from tkWinColor.c +* GdiParseColor is a copy of XParseColor from xcolors.c +*/ +typedef struct { + char *name; + int index; +} SystemColorEntry; + + +static SystemColorEntry sysColors[] = { + "3dDarkShadow", COLOR_3DDKSHADOW, + "3dLight", COLOR_3DLIGHT, + "ActiveBorder", COLOR_ACTIVEBORDER, + "ActiveCaption", COLOR_ACTIVECAPTION, + "AppWorkspace", COLOR_APPWORKSPACE, + "Background", COLOR_BACKGROUND, + "ButtonFace", COLOR_BTNFACE, + "ButtonHighlight", COLOR_BTNHIGHLIGHT, + "ButtonShadow", COLOR_BTNSHADOW, + "ButtonText", COLOR_BTNTEXT, + "CaptionText", COLOR_CAPTIONTEXT, + "DisabledText", COLOR_GRAYTEXT, + "GrayText", COLOR_GRAYTEXT, + "Highlight", COLOR_HIGHLIGHT, + "HighlightText", COLOR_HIGHLIGHTTEXT, + "InactiveBorder", COLOR_INACTIVEBORDER, + "InactiveCaption", COLOR_INACTIVECAPTION, + "InactiveCaptionText", COLOR_INACTIVECAPTIONTEXT, + "InfoBackground", COLOR_INFOBK, + "InfoText", COLOR_INFOTEXT, + "Menu", COLOR_MENU, + "MenuText", COLOR_MENUTEXT, + "Scrollbar", COLOR_SCROLLBAR, + "Window", COLOR_WINDOW, + "WindowFrame", COLOR_WINDOWFRAME, + "WindowText", COLOR_WINDOWTEXT, +}; + +static int numsyscolors = 0; + +typedef struct { + char *name; + unsigned char red; + unsigned char green; + unsigned char blue; +} XColorEntry; + +static XColorEntry xColors[] = { + {"alice blue", 240, 248, 255}, + {"AliceBlue", 240, 248, 255}, + {"antique white", 250, 235, 215}, + {"AntiqueWhite", 250, 235, 215}, + {"AntiqueWhite1", 255, 239, 219}, + {"AntiqueWhite2", 238, 223, 204}, + {"AntiqueWhite3", 205, 192, 176}, + {"AntiqueWhite4", 139, 131, 120}, + {"aquamarine", 127, 255, 212}, + {"aquamarine1", 127, 255, 212}, + {"aquamarine2", 118, 238, 198}, + {"aquamarine3", 102, 205, 170}, + {"aquamarine4", 69, 139, 116}, + {"azure", 240, 255, 255}, + {"azure1", 240, 255, 255}, + {"azure2", 224, 238, 238}, + {"azure3", 193, 205, 205}, + {"azure4", 131, 139, 139}, + {"beige", 245, 245, 220}, + {"bisque", 255, 228, 196}, + {"bisque1", 255, 228, 196}, + {"bisque2", 238, 213, 183}, + {"bisque3", 205, 183, 158}, + {"bisque4", 139, 125, 107}, + {"black", 0, 0, 0}, + {"blanched almond", 255, 235, 205}, + {"BlanchedAlmond", 255, 235, 205}, + {"blue", 0, 0, 255}, + {"blue violet", 138, 43, 226}, + {"blue1", 0, 0, 255}, + {"blue2", 0, 0, 238}, + {"blue3", 0, 0, 205}, + {"blue4", 0, 0, 139}, + {"BlueViolet", 138, 43, 226}, + {"brown", 165, 42, 42}, + {"brown1", 255, 64, 64}, + {"brown2", 238, 59, 59}, + {"brown3", 205, 51, 51}, + {"brown4", 139, 35, 35}, + {"burlywood", 222, 184, 135}, + {"burlywood1", 255, 211, 155}, + {"burlywood2", 238, 197, 145}, + {"burlywood3", 205, 170, 125}, + {"burlywood4", 139, 115, 85}, + {"cadet blue", 95, 158, 160}, + {"CadetBlue", 95, 158, 160}, + {"CadetBlue1", 152, 245, 255}, + {"CadetBlue2", 142, 229, 238}, + {"CadetBlue3", 122, 197, 205}, + {"CadetBlue4", 83, 134, 139}, + {"chartreuse", 127, 255, 0}, + {"chartreuse1", 127, 255, 0}, + {"chartreuse2", 118, 238, 0}, + {"chartreuse3", 102, 205, 0}, + {"chartreuse4", 69, 139, 0}, + {"chocolate", 210, 105, 30}, + {"chocolate1", 255, 127, 36}, + {"chocolate2", 238, 118, 33}, + {"chocolate3", 205, 102, 29}, + {"chocolate4", 139, 69, 19}, + {"coral", 255, 127, 80}, + {"coral1", 255, 114, 86}, + {"coral2", 238, 106, 80}, + {"coral3", 205, 91, 69}, + {"coral4", 139, 62, 47}, + {"cornflower blue", 100, 149, 237}, + {"CornflowerBlue", 100, 149, 237}, + {"cornsilk", 255, 248, 220}, + {"cornsilk1", 255, 248, 220}, + {"cornsilk2", 238, 232, 205}, + {"cornsilk3", 205, 200, 177}, + {"cornsilk4", 139, 136, 120}, + {"cyan", 0, 255, 255}, + {"cyan1", 0, 255, 255}, + {"cyan2", 0, 238, 238}, + {"cyan3", 0, 205, 205}, + {"cyan4", 0, 139, 139}, + {"dark goldenrod", 184, 134, 11}, + {"dark green", 0, 100, 0}, + {"dark khaki", 189, 183, 107}, + {"dark olive green", 85, 107, 47}, + {"dark orange", 255, 140, 0}, + {"dark orchid", 153, 50, 204}, + {"dark salmon", 233, 150, 122}, + {"dark sea green", 143, 188, 143}, + {"dark slate blue", 72, 61, 139}, + {"dark slate gray", 47, 79, 79}, + {"dark slate grey", 47, 79, 79}, + {"dark turquoise", 0, 206, 209}, + {"dark violet", 148, 0, 211}, + {"DarkGoldenrod", 184, 134, 11}, + {"DarkGoldenrod1", 255, 185, 15}, + {"DarkGoldenrod2", 238, 173, 14}, + {"DarkGoldenrod3", 205, 149, 12}, + {"DarkGoldenrod4", 139, 101, 8}, + {"DarkGreen", 0, 100, 0}, + {"DarkKhaki", 189, 183, 107}, + {"DarkOliveGreen", 85, 107, 47}, + {"DarkOliveGreen1", 202, 255, 112}, + {"DarkOliveGreen2", 188, 238, 104}, + {"DarkOliveGreen3", 162, 205, 90}, + {"DarkOliveGreen4", 110, 139, 61}, + {"DarkOrange", 255, 140, 0}, + {"DarkOrange1", 255, 127, 0}, + {"DarkOrange2", 238, 118, 0}, + {"DarkOrange3", 205, 102, 0}, + {"DarkOrange4", 139, 69, 0}, + {"DarkOrchid", 153, 50, 204}, + {"DarkOrchid1", 191, 62, 255}, + {"DarkOrchid2", 178, 58, 238}, + {"DarkOrchid3", 154, 50, 205}, + {"DarkOrchid4", 104, 34, 139}, + {"DarkSalmon", 233, 150, 122}, + {"DarkSeaGreen", 143, 188, 143}, + {"DarkSeaGreen1", 193, 255, 193}, + {"DarkSeaGreen2", 180, 238, 180}, + {"DarkSeaGreen3", 155, 205, 155}, + {"DarkSeaGreen4", 105, 139, 105}, + {"DarkSlateBlue", 72, 61, 139}, + {"DarkSlateGray", 47, 79, 79}, + {"DarkSlateGray1", 151, 255, 255}, + {"DarkSlateGray2", 141, 238, 238}, + {"DarkSlateGray3", 121, 205, 205}, + {"DarkSlateGray4", 82, 139, 139}, + {"DarkSlateGrey", 47, 79, 79}, + {"DarkTurquoise", 0, 206, 209}, + {"DarkViolet", 148, 0, 211}, + {"deep pink", 255, 20, 147}, + {"deep sky blue", 0, 191, 255}, + {"DeepPink", 255, 20, 147}, + {"DeepPink1", 255, 20, 147}, + {"DeepPink2", 238, 18, 137}, + {"DeepPink3", 205, 16, 118}, + {"DeepPink4", 139, 10, 80}, + {"DeepSkyBlue", 0, 191, 255}, + {"DeepSkyBlue1", 0, 191, 255}, + {"DeepSkyBlue2", 0, 178, 238}, + {"DeepSkyBlue3", 0, 154, 205}, + {"DeepSkyBlue4", 0, 104, 139}, + {"dim gray", 105, 105, 105}, + {"dim grey", 105, 105, 105}, + {"DimGray", 105, 105, 105}, + {"DimGrey", 105, 105, 105}, + {"dodger blue", 30, 144, 255}, + {"DodgerBlue", 30, 144, 255}, + {"DodgerBlue1", 30, 144, 255}, + {"DodgerBlue2", 28, 134, 238}, + {"DodgerBlue3", 24, 116, 205}, + {"DodgerBlue4", 16, 78, 139}, + {"firebrick", 178, 34, 34}, + {"firebrick1", 255, 48, 48}, + {"firebrick2", 238, 44, 44}, + {"firebrick3", 205, 38, 38}, + {"firebrick4", 139, 26, 26}, + {"floral white", 255, 250, 240}, + {"FloralWhite", 255, 250, 240}, + {"forest green", 34, 139, 34}, + {"ForestGreen", 34, 139, 34}, + {"gainsboro", 220, 220, 220}, + {"ghost white", 248, 248, 255}, + {"GhostWhite", 248, 248, 255}, + {"gold", 255, 215, 0}, + {"gold1", 255, 215, 0}, + {"gold2", 238, 201, 0}, + {"gold3", 205, 173, 0}, + {"gold4", 139, 117, 0}, + {"goldenrod", 218, 165, 32}, + {"goldenrod1", 255, 193, 37}, + {"goldenrod2", 238, 180, 34}, + {"goldenrod3", 205, 155, 29}, + {"goldenrod4", 139, 105, 20}, + {"gray", 190, 190, 190}, + {"gray0", 0, 0, 0}, + {"gray1", 3, 3, 3}, + {"gray10", 26, 26, 26}, + {"gray100", 255, 255, 255}, + {"gray11", 28, 28, 28}, + {"gray12", 31, 31, 31}, + {"gray13", 33, 33, 33}, + {"gray14", 36, 36, 36}, + {"gray15", 38, 38, 38}, + {"gray16", 41, 41, 41}, + {"gray17", 43, 43, 43}, + {"gray18", 46, 46, 46}, + {"gray19", 48, 48, 48}, + {"gray2", 5, 5, 5}, + {"gray20", 51, 51, 51}, + {"gray21", 54, 54, 54}, + {"gray22", 56, 56, 56}, + {"gray23", 59, 59, 59}, + {"gray24", 61, 61, 61}, + {"gray25", 64, 64, 64}, + {"gray26", 66, 66, 66}, + {"gray27", 69, 69, 69}, + {"gray28", 71, 71, 71}, + {"gray29", 74, 74, 74}, + {"gray3", 8, 8, 8}, + {"gray30", 77, 77, 77}, + {"gray31", 79, 79, 79}, + {"gray32", 82, 82, 82}, + {"gray33", 84, 84, 84}, + {"gray34", 87, 87, 87}, + {"gray35", 89, 89, 89}, + {"gray36", 92, 92, 92}, + {"gray37", 94, 94, 94}, + {"gray38", 97, 97, 97}, + {"gray39", 99, 99, 99}, + {"gray4", 10, 10, 10}, + {"gray40", 102, 102, 102}, + {"gray41", 105, 105, 105}, + {"gray42", 107, 107, 107}, + {"gray43", 110, 110, 110}, + {"gray44", 112, 112, 112}, + {"gray45", 115, 115, 115}, + {"gray46", 117, 117, 117}, + {"gray47", 120, 120, 120}, + {"gray48", 122, 122, 122}, + {"gray49", 125, 125, 125}, + {"gray5", 13, 13, 13}, + {"gray50", 127, 127, 127}, + {"gray51", 130, 130, 130}, + {"gray52", 133, 133, 133}, + {"gray53", 135, 135, 135}, + {"gray54", 138, 138, 138}, + {"gray55", 140, 140, 140}, + {"gray56", 143, 143, 143}, + {"gray57", 145, 145, 145}, + {"gray58", 148, 148, 148}, + {"gray59", 150, 150, 150}, + {"gray6", 15, 15, 15}, + {"gray60", 153, 153, 153}, + {"gray61", 156, 156, 156}, + {"gray62", 158, 158, 158}, + {"gray63", 161, 161, 161}, + {"gray64", 163, 163, 163}, + {"gray65", 166, 166, 166}, + {"gray66", 168, 168, 168}, + {"gray67", 171, 171, 171}, + {"gray68", 173, 173, 173}, + {"gray69", 176, 176, 176}, + {"gray7", 18, 18, 18}, + {"gray70", 179, 179, 179}, + {"gray71", 181, 181, 181}, + {"gray72", 184, 184, 184}, + {"gray73", 186, 186, 186}, + {"gray74", 189, 189, 189}, + {"gray75", 191, 191, 191}, + {"gray76", 194, 194, 194}, + {"gray77", 196, 196, 196}, + {"gray78", 199, 199, 199}, + {"gray79", 201, 201, 201}, + {"gray8", 20, 20, 20}, + {"gray80", 204, 204, 204}, + {"gray81", 207, 207, 207}, + {"gray82", 209, 209, 209}, + {"gray83", 212, 212, 212}, + {"gray84", 214, 214, 214}, + {"gray85", 217, 217, 217}, + {"gray86", 219, 219, 219}, + {"gray87", 222, 222, 222}, + {"gray88", 224, 224, 224}, + {"gray89", 227, 227, 227}, + {"gray9", 23, 23, 23}, + {"gray90", 229, 229, 229}, + {"gray91", 232, 232, 232}, + {"gray92", 235, 235, 235}, + {"gray93", 237, 237, 237}, + {"gray94", 240, 240, 240}, + {"gray95", 242, 242, 242}, + {"gray96", 245, 245, 245}, + {"gray97", 247, 247, 247}, + {"gray98", 250, 250, 250}, + {"gray99", 252, 252, 252}, + {"green", 0, 255, 0}, + {"green yellow", 173, 255, 47}, + {"green1", 0, 255, 0}, + {"green2", 0, 238, 0}, + {"green3", 0, 205, 0}, + {"green4", 0, 139, 0}, + {"GreenYellow", 173, 255, 47}, + {"grey", 190, 190, 190}, + {"grey0", 0, 0, 0}, + {"grey1", 3, 3, 3}, + {"grey10", 26, 26, 26}, + {"grey100", 255, 255, 255}, + {"grey11", 28, 28, 28}, + {"grey12", 31, 31, 31}, + {"grey13", 33, 33, 33}, + {"grey14", 36, 36, 36}, + {"grey15", 38, 38, 38}, + {"grey16", 41, 41, 41}, + {"grey17", 43, 43, 43}, + {"grey18", 46, 46, 46}, + {"grey19", 48, 48, 48}, + {"grey2", 5, 5, 5}, + {"grey20", 51, 51, 51}, + {"grey21", 54, 54, 54}, + {"grey22", 56, 56, 56}, + {"grey23", 59, 59, 59}, + {"grey24", 61, 61, 61}, + {"grey25", 64, 64, 64}, + {"grey26", 66, 66, 66}, + {"grey27", 69, 69, 69}, + {"grey28", 71, 71, 71}, + {"grey29", 74, 74, 74}, + {"grey3", 8, 8, 8}, + {"grey30", 77, 77, 77}, + {"grey31", 79, 79, 79}, + {"grey32", 82, 82, 82}, + {"grey33", 84, 84, 84}, + {"grey34", 87, 87, 87}, + {"grey35", 89, 89, 89}, + {"grey36", 92, 92, 92}, + {"grey37", 94, 94, 94}, + {"grey38", 97, 97, 97}, + {"grey39", 99, 99, 99}, + {"grey4", 10, 10, 10}, + {"grey40", 102, 102, 102}, + {"grey41", 105, 105, 105}, + {"grey42", 107, 107, 107}, + {"grey43", 110, 110, 110}, + {"grey44", 112, 112, 112}, + {"grey45", 115, 115, 115}, + {"grey46", 117, 117, 117}, + {"grey47", 120, 120, 120}, + {"grey48", 122, 122, 122}, + {"grey49", 125, 125, 125}, + {"grey5", 13, 13, 13}, + {"grey50", 127, 127, 127}, + {"grey51", 130, 130, 130}, + {"grey52", 133, 133, 133}, + {"grey53", 135, 135, 135}, + {"grey54", 138, 138, 138}, + {"grey55", 140, 140, 140}, + {"grey56", 143, 143, 143}, + {"grey57", 145, 145, 145}, + {"grey58", 148, 148, 148}, + {"grey59", 150, 150, 150}, + {"grey6", 15, 15, 15}, + {"grey60", 153, 153, 153}, + {"grey61", 156, 156, 156}, + {"grey62", 158, 158, 158}, + {"grey63", 161, 161, 161}, + {"grey64", 163, 163, 163}, + {"grey65", 166, 166, 166}, + {"grey66", 168, 168, 168}, + {"grey67", 171, 171, 171}, + {"grey68", 173, 173, 173}, + {"grey69", 176, 176, 176}, + {"grey7", 18, 18, 18}, + {"grey70", 179, 179, 179}, + {"grey71", 181, 181, 181}, + {"grey72", 184, 184, 184}, + {"grey73", 186, 186, 186}, + {"grey74", 189, 189, 189}, + {"grey75", 191, 191, 191}, + {"grey76", 194, 194, 194}, + {"grey77", 196, 196, 196}, + {"grey78", 199, 199, 199}, + {"grey79", 201, 201, 201}, + {"grey8", 20, 20, 20}, + {"grey80", 204, 204, 204}, + {"grey81", 207, 207, 207}, + {"grey82", 209, 209, 209}, + {"grey83", 212, 212, 212}, + {"grey84", 214, 214, 214}, + {"grey85", 217, 217, 217}, + {"grey86", 219, 219, 219}, + {"grey87", 222, 222, 222}, + {"grey88", 224, 224, 224}, + {"grey89", 227, 227, 227}, + {"grey9", 23, 23, 23}, + {"grey90", 229, 229, 229}, + {"grey91", 232, 232, 232}, + {"grey92", 235, 235, 235}, + {"grey93", 237, 237, 237}, + {"grey94", 240, 240, 240}, + {"grey95", 242, 242, 242}, + {"grey96", 245, 245, 245}, + {"grey97", 247, 247, 247}, + {"grey98", 250, 250, 250}, + {"grey99", 252, 252, 252}, + {"honeydew", 240, 255, 240}, + {"honeydew1", 240, 255, 240}, + {"honeydew2", 224, 238, 224}, + {"honeydew3", 193, 205, 193}, + {"honeydew4", 131, 139, 131}, + {"hot pink", 255, 105, 180}, + {"HotPink", 255, 105, 180}, + {"HotPink1", 255, 110, 180}, + {"HotPink2", 238, 106, 167}, + {"HotPink3", 205, 96, 144}, + {"HotPink4", 139, 58, 98}, + {"indian red", 205, 92, 92}, + {"IndianRed", 205, 92, 92}, + {"IndianRed1", 255, 106, 106}, + {"IndianRed2", 238, 99, 99}, + {"IndianRed3", 205, 85, 85}, + {"IndianRed4", 139, 58, 58}, + {"ivory", 255, 255, 240}, + {"ivory1", 255, 255, 240}, + {"ivory2", 238, 238, 224}, + {"ivory3", 205, 205, 193}, + {"ivory4", 139, 139, 131}, + {"khaki", 240, 230, 140}, + {"khaki1", 255, 246, 143}, + {"khaki2", 238, 230, 133}, + {"khaki3", 205, 198, 115}, + {"khaki4", 139, 134, 78}, + {"lavender", 230, 230, 250}, + {"lavender blush", 255, 240, 245}, + {"LavenderBlush", 255, 240, 245}, + {"LavenderBlush1", 255, 240, 245}, + {"LavenderBlush2", 238, 224, 229}, + {"LavenderBlush3", 205, 193, 197}, + {"LavenderBlush4", 139, 131, 134}, + {"lawn green", 124, 252, 0}, + {"LawnGreen", 124, 252, 0}, + {"lemon chiffon", 255, 250, 205}, + {"LemonChiffon", 255, 250, 205}, + {"LemonChiffon1", 255, 250, 205}, + {"LemonChiffon2", 238, 233, 191}, + {"LemonChiffon3", 205, 201, 165}, + {"LemonChiffon4", 139, 137, 112}, + {"light blue", 173, 216, 230}, + {"light coral", 240, 128, 128}, + {"light cyan", 224, 255, 255}, + {"light goldenrod", 238, 221, 130}, + {"light goldenrod yellow", 250, 250, 210}, + {"light gray", 211, 211, 211}, + {"light grey", 211, 211, 211}, + {"light pink", 255, 182, 193}, + {"light salmon", 255, 160, 122}, + {"light sea green", 32, 178, 170}, + {"light sky blue", 135, 206, 250}, + {"light slate blue", 132, 112, 255}, + {"light slate gray", 119, 136, 153}, + {"light slate grey", 119, 136, 153}, + {"light steel blue", 176, 196, 222}, + {"light yellow", 255, 255, 224}, + {"LightBlue", 173, 216, 230}, + {"LightBlue1", 191, 239, 255}, + {"LightBlue2", 178, 223, 238}, + {"LightBlue3", 154, 192, 205}, + {"LightBlue4", 104, 131, 139}, + {"LightCoral", 240, 128, 128}, + {"LightCyan", 224, 255, 255}, + {"LightCyan1", 224, 255, 255}, + {"LightCyan2", 209, 238, 238}, + {"LightCyan3", 180, 205, 205}, + {"LightCyan4", 122, 139, 139}, + {"LightGoldenrod", 238, 221, 130}, + {"LightGoldenrod1", 255, 236, 139}, + {"LightGoldenrod2", 238, 220, 130}, + {"LightGoldenrod3", 205, 190, 112}, + {"LightGoldenrod4", 139, 129, 76}, + {"LightGoldenrodYellow", 250, 250, 210}, + {"LightGray", 211, 211, 211}, + {"LightGrey", 211, 211, 211}, + {"LightPink", 255, 182, 193}, + {"LightPink1", 255, 174, 185}, + {"LightPink2", 238, 162, 173}, + {"LightPink3", 205, 140, 149}, + {"LightPink4", 139, 95, 101}, + {"LightSalmon", 255, 160, 122}, + {"LightSalmon1", 255, 160, 122}, + {"LightSalmon2", 238, 149, 114}, + {"LightSalmon3", 205, 129, 98}, + {"LightSalmon4", 139, 87, 66}, + {"LightSeaGreen", 32, 178, 170}, + {"LightSkyBlue", 135, 206, 250}, + {"LightSkyBlue1", 176, 226, 255}, + {"LightSkyBlue2", 164, 211, 238}, + {"LightSkyBlue3", 141, 182, 205}, + {"LightSkyBlue4", 96, 123, 139}, + {"LightSlateBlue", 132, 112, 255}, + {"LightSlateGray", 119, 136, 153}, + {"LightSlateGrey", 119, 136, 153}, + {"LightSteelBlue", 176, 196, 222}, + {"LightSteelBlue1", 202, 225, 255}, + {"LightSteelBlue2", 188, 210, 238}, + {"LightSteelBlue3", 162, 181, 205}, + {"LightSteelBlue4", 110, 123, 139}, + {"LightYellow", 255, 255, 224}, + {"LightYellow1", 255, 255, 224}, + {"LightYellow2", 238, 238, 209}, + {"LightYellow3", 205, 205, 180}, + {"LightYellow4", 139, 139, 122}, + {"lime green", 50, 205, 50}, + {"LimeGreen", 50, 205, 50}, + {"linen", 250, 240, 230}, + {"magenta", 255, 0, 255}, + {"magenta1", 255, 0, 255}, + {"magenta2", 238, 0, 238}, + {"magenta3", 205, 0, 205}, + {"magenta4", 139, 0, 139}, + {"maroon", 176, 48, 96}, + {"maroon1", 255, 52, 179}, + {"maroon2", 238, 48, 167}, + {"maroon3", 205, 41, 144}, + {"maroon4", 139, 28, 98}, + {"medium aquamarine", 102, 205, 170}, + {"medium blue", 0, 0, 205}, + {"medium orchid", 186, 85, 211}, + {"medium purple", 147, 112, 219}, + {"medium sea green", 60, 179, 113}, + {"medium slate blue", 123, 104, 238}, + {"medium spring green", 0, 250, 154}, + {"medium turquoise", 72, 209, 204}, + {"medium violet red", 199, 21, 133}, + {"MediumAquamarine", 102, 205, 170}, + {"MediumBlue", 0, 0, 205}, + {"MediumOrchid", 186, 85, 211}, + {"MediumOrchid1", 224, 102, 255}, + {"MediumOrchid2", 209, 95, 238}, + {"MediumOrchid3", 180, 82, 205}, + {"MediumOrchid4", 122, 55, 139}, + {"MediumPurple", 147, 112, 219}, + {"MediumPurple1", 171, 130, 255}, + {"MediumPurple2", 159, 121, 238}, + {"MediumPurple3", 137, 104, 205}, + {"MediumPurple4", 93, 71, 139}, + {"MediumSeaGreen", 60, 179, 113}, + {"MediumSlateBlue", 123, 104, 238}, + {"MediumSpringGreen", 0, 250, 154}, + {"MediumTurquoise", 72, 209, 204}, + {"MediumVioletRed", 199, 21, 133}, + {"midnight blue", 25, 25, 112}, + {"MidnightBlue", 25, 25, 112}, + {"mint cream", 245, 255, 250}, + {"MintCream", 245, 255, 250}, + {"misty rose", 255, 228, 225}, + {"MistyRose", 255, 228, 225}, + {"MistyRose1", 255, 228, 225}, + {"MistyRose2", 238, 213, 210}, + {"MistyRose3", 205, 183, 181}, + {"MistyRose4", 139, 125, 123}, + {"moccasin", 255, 228, 181}, + {"navajo white", 255, 222, 173}, + {"NavajoWhite", 255, 222, 173}, + {"NavajoWhite1", 255, 222, 173}, + {"NavajoWhite2", 238, 207, 161}, + {"NavajoWhite3", 205, 179, 139}, + {"NavajoWhite4", 139, 121, 94}, + {"navy", 0, 0, 128}, + {"navy blue", 0, 0, 128}, + {"NavyBlue", 0, 0, 128}, + {"old lace", 253, 245, 230}, + {"OldLace", 253, 245, 230}, + {"olive drab", 107, 142, 35}, + {"OliveDrab", 107, 142, 35}, + {"OliveDrab1", 192, 255, 62}, + {"OliveDrab2", 179, 238, 58}, + {"OliveDrab3", 154, 205, 50}, + {"OliveDrab4", 105, 139, 34}, + {"orange", 255, 165, 0}, + {"orange red", 255, 69, 0}, + {"orange1", 255, 165, 0}, + {"orange2", 238, 154, 0}, + {"orange3", 205, 133, 0}, + {"orange4", 139, 90, 0}, + {"OrangeRed", 255, 69, 0}, + {"OrangeRed1", 255, 69, 0}, + {"OrangeRed2", 238, 64, 0}, + {"OrangeRed3", 205, 55, 0}, + {"OrangeRed4", 139, 37, 0}, + {"orchid", 218, 112, 214}, + {"orchid1", 255, 131, 250}, + {"orchid2", 238, 122, 233}, + {"orchid3", 205, 105, 201}, + {"orchid4", 139, 71, 137}, + {"pale goldenrod", 238, 232, 170}, + {"pale green", 152, 251, 152}, + {"pale turquoise", 175, 238, 238}, + {"pale violet red", 219, 112, 147}, + {"PaleGoldenrod", 238, 232, 170}, + {"PaleGreen", 152, 251, 152}, + {"PaleGreen1", 154, 255, 154}, + {"PaleGreen2", 144, 238, 144}, + {"PaleGreen3", 124, 205, 124}, + {"PaleGreen4", 84, 139, 84}, + {"PaleTurquoise", 175, 238, 238}, + {"PaleTurquoise1", 187, 255, 255}, + {"PaleTurquoise2", 174, 238, 238}, + {"PaleTurquoise3", 150, 205, 205}, + {"PaleTurquoise4", 102, 139, 139}, + {"PaleVioletRed", 219, 112, 147}, + {"PaleVioletRed1", 255, 130, 171}, + {"PaleVioletRed2", 238, 121, 159}, + {"PaleVioletRed3", 205, 104, 137}, + {"PaleVioletRed4", 139, 71, 93}, + {"papaya whip", 255, 239, 213}, + {"PapayaWhip", 255, 239, 213}, + {"peach puff", 255, 218, 185}, + {"PeachPuff", 255, 218, 185}, + {"PeachPuff1", 255, 218, 185}, + {"PeachPuff2", 238, 203, 173}, + {"PeachPuff3", 205, 175, 149}, + {"PeachPuff4", 139, 119, 101}, + {"peru", 205, 133, 63}, + {"pink", 255, 192, 203}, + {"pink1", 255, 181, 197}, + {"pink2", 238, 169, 184}, + {"pink3", 205, 145, 158}, + {"pink4", 139, 99, 108}, + {"plum", 221, 160, 221}, + {"plum1", 255, 187, 255}, + {"plum2", 238, 174, 238}, + {"plum3", 205, 150, 205}, + {"plum4", 139, 102, 139}, + {"powder blue", 176, 224, 230}, + {"PowderBlue", 176, 224, 230}, + {"purple", 160, 32, 240}, + {"purple1", 155, 48, 255}, + {"purple2", 145, 44, 238}, + {"purple3", 125, 38, 205}, + {"purple4", 85, 26, 139}, + {"red", 255, 0, 0}, + {"red1", 255, 0, 0}, + {"red2", 238, 0, 0}, + {"red3", 205, 0, 0}, + {"red4", 139, 0, 0}, + {"rosy brown", 188, 143, 143}, + {"RosyBrown", 188, 143, 143}, + {"RosyBrown1", 255, 193, 193}, + {"RosyBrown2", 238, 180, 180}, + {"RosyBrown3", 205, 155, 155}, + {"RosyBrown4", 139, 105, 105}, + {"royal blue", 65, 105, 225}, + {"RoyalBlue", 65, 105, 225}, + {"RoyalBlue1", 72, 118, 255}, + {"RoyalBlue2", 67, 110, 238}, + {"RoyalBlue3", 58, 95, 205}, + {"RoyalBlue4", 39, 64, 139}, + {"saddle brown", 139, 69, 19}, + {"SaddleBrown", 139, 69, 19}, + {"salmon", 250, 128, 114}, + {"salmon1", 255, 140, 105}, + {"salmon2", 238, 130, 98}, + {"salmon3", 205, 112, 84}, + {"salmon4", 139, 76, 57}, + {"sandy brown", 244, 164, 96}, + {"SandyBrown", 244, 164, 96}, + {"sea green", 46, 139, 87}, + {"SeaGreen", 46, 139, 87}, + {"SeaGreen1", 84, 255, 159}, + {"SeaGreen2", 78, 238, 148}, + {"SeaGreen3", 67, 205, 128}, + {"SeaGreen4", 46, 139, 87}, + {"seashell", 255, 245, 238}, + {"seashell1", 255, 245, 238}, + {"seashell2", 238, 229, 222}, + {"seashell3", 205, 197, 191}, + {"seashell4", 139, 134, 130}, + {"sienna", 160, 82, 45}, + {"sienna1", 255, 130, 71}, + {"sienna2", 238, 121, 66}, + {"sienna3", 205, 104, 57}, + {"sienna4", 139, 71, 38}, + {"sky blue", 135, 206, 235}, + {"SkyBlue", 135, 206, 235}, + {"SkyBlue1", 135, 206, 255}, + {"SkyBlue2", 126, 192, 238}, + {"SkyBlue3", 108, 166, 205}, + {"SkyBlue4", 74, 112, 139}, + {"slate blue", 106, 90, 205}, + {"slate gray", 112, 128, 144}, + {"slate grey", 112, 128, 144}, + {"SlateBlue", 106, 90, 205}, + {"SlateBlue1", 131, 111, 255}, + {"SlateBlue2", 122, 103, 238}, + {"SlateBlue3", 105, 89, 205}, + {"SlateBlue4", 71, 60, 139}, + {"SlateGray", 112, 128, 144}, + {"SlateGray1", 198, 226, 255}, + {"SlateGray2", 185, 211, 238}, + {"SlateGray3", 159, 182, 205}, + {"SlateGray4", 108, 123, 139}, + {"SlateGrey", 112, 128, 144}, + {"snow", 255, 250, 250}, + {"snow1", 255, 250, 250}, + {"snow2", 238, 233, 233}, + {"snow3", 205, 201, 201}, + {"snow4", 139, 137, 137}, + {"spring green", 0, 255, 127}, + {"SpringGreen", 0, 255, 127}, + {"SpringGreen1", 0, 255, 127}, + {"SpringGreen2", 0, 238, 118}, + {"SpringGreen3", 0, 205, 102}, + {"SpringGreen4", 0, 139, 69}, + {"steel blue", 70, 130, 180}, + {"SteelBlue", 70, 130, 180}, + {"SteelBlue1", 99, 184, 255}, + {"SteelBlue2", 92, 172, 238}, + {"SteelBlue3", 79, 148, 205}, + {"SteelBlue4", 54, 100, 139}, + {"tan", 210, 180, 140}, + {"tan1", 255, 165, 79}, + {"tan2", 238, 154, 73}, + {"tan3", 205, 133, 63}, + {"tan4", 139, 90, 43}, + {"thistle", 216, 191, 216}, + {"thistle1", 255, 225, 255}, + {"thistle2", 238, 210, 238}, + {"thistle3", 205, 181, 205}, + {"thistle4", 139, 123, 139}, + {"tomato", 255, 99, 71}, + {"tomato1", 255, 99, 71}, + {"tomato2", 238, 92, 66}, + {"tomato3", 205, 79, 57}, + {"tomato4", 139, 54, 38}, + {"turquoise", 64, 224, 208}, + {"turquoise1", 0, 245, 255}, + {"turquoise2", 0, 229, 238}, + {"turquoise3", 0, 197, 205}, + {"turquoise4", 0, 134, 139}, + {"violet", 238, 130, 238}, + {"violet red", 208, 32, 144}, + {"VioletRed", 208, 32, 144}, + {"VioletRed1", 255, 62, 150}, + {"VioletRed2", 238, 58, 140}, + {"VioletRed3", 205, 50, 120}, + {"VioletRed4", 139, 34, 82}, + {"wheat", 245, 222, 179}, + {"wheat1", 255, 231, 186}, + {"wheat2", 238, 216, 174}, + {"wheat3", 205, 186, 150}, + {"wheat4", 139, 126, 102}, + {"white", 255, 255, 255}, + {"white smoke", 245, 245, 245}, + {"WhiteSmoke", 245, 245, 245}, + {"yellow", 255, 255, 0}, + {"yellow green", 154, 205, 50}, + {"yellow1", 255, 255, 0}, + {"yellow2", 238, 238, 0}, + {"yellow3", 205, 205, 0}, + {"yellow4", 139, 139, 0}, + {"YellowGreen", 154, 205, 50}, +}; + +static int numxcolors=0; + +/* +* Convert color name to color specification +*/ +static int GdiGetColor(const char *name, unsigned long *color) +{ + if ( numsyscolors == 0 ) + numsyscolors = sizeof ( sysColors ) / sizeof (SystemColorEntry); + if ( strncmpi(name, "system", 6) == 0 ) + { + int i, l, u, r; + l = 0; + u = numsyscolors; + while ( l <= u ) + { + i = (l + u) / 2; + if ( (r = strcmpi(name+6, sysColors[i].name)) == 0 ) + break; + if ( r < 0 ) + u = i - 1; + else + l = i + 1; + } + if ( l > u ) + return 0; + *color = GetSysColor(sysColors[i].index); + return 1; + } + else + return GdiParseColor(name, color); +} + +/* +* Convert color specification string (which could be an RGB string) +* to a color RGB triple +*/ +static int GdiParseColor (const char *name, unsigned long *color) +{ + if ( name[0] == '#' ) + { + char fmt[16]; + int i; + unsigned red, green, blue; + + if ( (i = strlen(name+1))%3 != 0 || i > 12 || i < 3) + return 0; + i /= 3; + sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i); + if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { + return 0; + } + /* Now this is windows specific -- each component is at most 8 bits */ + switch ( i ) + { + case 1: + red <<= 4; + green <<= 4; + blue <<= 4; + break; + case 2: + break; + case 3: + red >>= 4; + green >>= 4; + blue >>= 4; + break; + case 4: + red >>= 8; + green >>= 8; + blue >>= 8; + break; + } + *color = RGB(red, green, blue); + return 1; + } + else + { + int i, u, r, l; + if ( numxcolors == 0 ) + numxcolors = sizeof(xColors) / sizeof(XColorEntry); + l = 0; + u = numxcolors; + + while ( l <= u) + { + i = (l + u) / 2; + if ( (r = strcmpi(name, xColors[i].name)) == 0 ) + break; + if ( r < 0 ) + u = i-1; + else + l = i+1; + } + if ( l > u ) + return 0; + *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); + return 1; + } +} + +/* +* Beginning of functions for screen-to-dib translations +* Several of these functions are based on those in the WINCAP32 +* program provided as a sample by Microsoft on the VC++ 5.0 +* disk. The copyright on these functions is retained, even for +* those with significant changes. +* I do not understand the meaning of this copyright in this +* context, since the example is present to provide insight into +* the rather baroque mechanism used to manipulate DIBs. +*/ + +static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) +{ + HANDLE hDIB; + HBITMAP hBitmap; + HPALETTE hPalette; + + /* check for a valid window handle */ + + if (!hWnd) + return NULL; + + switch (type) + { + case PTWindow: /* copy entire window */ + { + RECT rectWnd; + + /* get the window rectangle */ + + GetWindowRect(hWnd, &rectWnd); + + /* get the DIB of the window by calling + * CopyScreenToDIB and passing it the window rect + */ + + hDIB = CopyScreenToDIB(&rectWnd); + break; + } + + case PTClient: /* copy client area */ + { + RECT rectClient; + POINT pt1, pt2; + + /* get the client area dimensions */ + + GetClientRect(hWnd, &rectClient); + + /* convert client coords to screen coords */ + + pt1.x = rectClient.left; + pt1.y = rectClient.top; + pt2.x = rectClient.right; + pt2.y = rectClient.bottom; + ClientToScreen(hWnd, &pt1); + ClientToScreen(hWnd, &pt2); + rectClient.left = pt1.x; + rectClient.top = pt1.y; + rectClient.right = pt2.x; + rectClient.bottom = pt2.y; + + /* get the DIB of the client area by calling + * CopyScreenToDIB and passing it the client rect + */ + + hDIB = CopyScreenToDIB(&rectClient); + break; + } + + case PTScreen: /* Entire screen */ + { + RECT Rect; + + /* get the device-dependent bitmap in lpRect by calling + * CopyScreenToBitmap and passing it the rectangle to grab + */ + Rect.top = Rect.left = 0; + GetDisplaySize(&Rect.right, &Rect.bottom); + + hBitmap = CopyScreenToBitmap(&Rect); + + /* check for a valid bitmap handle */ + + if (!hBitmap) + return NULL; + + /* get the current palette */ + + hPalette = GetSystemPalette(); + + /* convert the bitmap to a DIB */ + + hDIB = BitmapToDIB(hBitmap, hPalette); + + /* clean up */ + + DeleteObject(hPalette); + DeleteObject(hBitmap); + + /* return handle to the packed-DIB */ + } + break; + default: /* invalid print area */ + return NULL; + } + + /* return the handle to the DIB */ + return hDIB; +} + +/* +* GetDisplaySize does just that. +* There may be an easier way, but I just haven't found it. +*/ +static void GetDisplaySize (LONG *width, LONG *height) +{ + HDC hDC; + + hDC = CreateDC("DISPLAY", 0, 0, 0); + *width = GetDeviceCaps (hDC, HORZRES); + *height = GetDeviceCaps (hDC, VERTRES); + DeleteDC(hDC); +} + + +static HBITMAP CopyScreenToBitmap(LPRECT lpRect) +{ + HDC hScrDC, hMemDC; /* screen DC and memory DC */ + HBITMAP hBitmap, hOldBitmap; /* handles to deice-dependent bitmaps */ + int nX, nY, nX2, nY2; /* coordinates of rectangle to grab */ + int nWidth, nHeight; /* DIB width and height */ + int xScrn, yScrn; /* screen resolution */ + + /* check for an empty rectangle */ + + if (IsRectEmpty(lpRect)) + return NULL; + + /* create a DC for the screen and create + * a memory DC compatible to screen DC + */ + + hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL); + hMemDC = CreateCompatibleDC(hScrDC); + + /* get points of rectangle to grab */ + + nX = lpRect->left; + nY = lpRect->top; + nX2 = lpRect->right; + nY2 = lpRect->bottom; + + /* get screen resolution */ + + xScrn = GetDeviceCaps(hScrDC, HORZRES); + yScrn = GetDeviceCaps(hScrDC, VERTRES); + + /* make sure bitmap rectangle is visible */ + + if (nX < 0) + nX = 0; + if (nY < 0) + nY = 0; + if (nX2 > xScrn) + nX2 = xScrn; + if (nY2 > yScrn) + nY2 = yScrn; + + nWidth = nX2 - nX; + nHeight = nY2 - nY; + + /* create a bitmap compatible with the screen DC */ + hBitmap = CreateCompatibleBitmap(hScrDC, nWidth, nHeight); + + /* select new bitmap into memory DC */ + hOldBitmap = SelectObject(hMemDC, hBitmap); + + /* bitblt screen DC to memory DC */ + BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY); + + /* select old bitmap back into memory DC and get handle to + * bitmap of the screen + */ + + hBitmap = SelectObject(hMemDC, hOldBitmap); + + /* clean up */ + + DeleteDC(hScrDC); + DeleteDC(hMemDC); + + /* return handle to the bitmap */ + + return hBitmap; +} + + +static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) +{ + BITMAP bm; + BITMAPINFOHEADER bi; + LPBITMAPINFOHEADER lpbi; + DWORD dwLen; + HANDLE hDIB; + HANDLE h; + HDC hDC; + WORD biBits; + + /* check if bitmap handle is valid */ + + if (!hBitmap) + return NULL; + + /* fill in BITMAP structure, return NULL if it didn't work */ + + if (!GetObject(hBitmap, sizeof(bm), (LPSTR)&bm)) + return NULL; + + /* if no palette is specified, use default palette */ + + if (hPal == NULL) + hPal = GetStockObject(DEFAULT_PALETTE); + + /* calculate bits per pixel */ + + biBits = bm.bmPlanes * bm.bmBitsPixel; + + /* make sure bits per pixel is valid */ + + if (biBits <= 1) + biBits = 1; + else if (biBits <= 4) + biBits = 4; + else if (biBits <= 8) + biBits = 8; + else /* if greater than 8-bit, force to 24-bit */ + biBits = 24; + + /* initialize BITMAPINFOHEADER */ + + bi.biSize = sizeof(BITMAPINFOHEADER); + bi.biWidth = bm.bmWidth; + bi.biHeight = bm.bmHeight; + bi.biPlanes = 1; + bi.biBitCount = biBits; + bi.biCompression = BI_RGB; + bi.biSizeImage = 0; + bi.biXPelsPerMeter = 0; + bi.biYPelsPerMeter = 0; + bi.biClrUsed = 0; + bi.biClrImportant = 0; + + /* calculate size of memory block required to store BITMAPINFO */ + + dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD); + + /* get a DC */ + + hDC = GetDC(NULL); + + /* select and realize our palette */ + + hPal = SelectPalette(hDC, hPal, FALSE); + RealizePalette(hDC); + + /* alloc memory block to store our bitmap */ + + hDIB = GlobalAlloc(GHND, dwLen); + + /* if we couldn't get memory block */ + + if (!hDIB) + { + /* clean up and return NULL */ + + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } + + /* lock memory and get pointer to it */ + + lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDIB); + + /* use our bitmap info. to fill BITMAPINFOHEADER */ + + *lpbi = bi; + + /* call GetDIBits with a NULL lpBits param, so it will calculate the + * biSizeImage field for us + */ + + GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, NULL, (LPBITMAPINFO)lpbi, + DIB_RGB_COLORS); + + /* get the info. returned by GetDIBits and unlock memory block */ + + bi = *lpbi; + GlobalUnlock(hDIB); + + /* if the driver did not fill in the biSizeImage field, make one up */ + if (bi.biSizeImage == 0) + bi.biSizeImage = (((((DWORD)bm.bmWidth * biBits) + 31) / 32) * 4) * bm.bmHeight; + + /* realloc the buffer big enough to hold all the bits */ + + dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD) + bi.biSizeImage; + + if ((h = GlobalReAlloc(hDIB, dwLen, 0)) != 0) + hDIB = h; + else + { + /* clean up and return NULL */ + + GlobalFree(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } + + /* lock memory block and get pointer to it */ + + lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDIB); + + /* call GetDIBits with a NON-NULL lpBits param, and actualy get the + * bits this time + */ + + if (GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, (LPSTR)lpbi + + (WORD)lpbi->biSize + DIBNumColors(lpbi) * sizeof(RGBQUAD), (LPBITMAPINFO)lpbi, + DIB_RGB_COLORS) == 0) + { + /* clean up and return NULL */ + + GlobalUnlock(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } + + bi = *lpbi; + + /* clean up */ + GlobalUnlock(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + + /* return handle to the DIB */ + return hDIB; +} + + +static HANDLE CopyScreenToDIB(LPRECT lpRect) +{ + HBITMAP hBitmap; + HPALETTE hPalette; + HANDLE hDIB; + + /* get the device-dependent bitmap in lpRect by calling + * CopyScreenToBitmap and passing it the rectangle to grab + */ + + hBitmap = CopyScreenToBitmap(lpRect); + + /* check for a valid bitmap handle */ + + if (!hBitmap) + return NULL; + + /* get the current palette */ + + hPalette = GetSystemPalette(); + + /* convert the bitmap to a DIB */ + + hDIB = BitmapToDIB(hBitmap, hPalette); + + /* clean up */ + + DeleteObject(hPalette); + DeleteObject(hBitmap); + + /* return handle to the packed-DIB */ + return hDIB; +} + + +static HPALETTE GetSystemPalette(void) +{ + HDC hDC; // handle to a DC + static HPALETTE hPal = NULL; // handle to a palette + HANDLE hLogPal; // handle to a logical palette + LPLOGPALETTE lpLogPal; // pointer to a logical palette + int nColors; // number of colors + + // Find out how many palette entries we want. + + hDC = GetDC(NULL); + + if (!hDC) + return NULL; + + nColors = PalEntriesOnDevice(hDC); // Number of palette entries + + // Allocate room for the palette and lock it. + + hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + nColors * + sizeof(PALETTEENTRY)); + + // if we didn't get a logical palette, return NULL + + if (!hLogPal) + return NULL; + + // get a pointer to the logical palette + + lpLogPal = (LPLOGPALETTE)GlobalLock(hLogPal); + + // set some important fields + + lpLogPal->palVersion = 0x300; + lpLogPal->palNumEntries = nColors; + + // Copy the current system palette into our logical palette + + GetSystemPaletteEntries(hDC, 0, nColors, + (LPPALETTEENTRY)(lpLogPal->palPalEntry)); + + // Go ahead and create the palette. Once it's created, + // we no longer need the LOGPALETTE, so free it. + + hPal = CreatePalette(lpLogPal); + + // clean up + + GlobalUnlock(hLogPal); + GlobalFree(hLogPal); + ReleaseDC(NULL, hDC); + + return hPal; +} + + +static int PalEntriesOnDevice(HDC hDC) +{ + return (1 << (GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES))); +} + + +/* +* This is the version information/command +* The static data should also be used by pkg_provide, etc. +*/ +/* Version information */ +static char version_string[] = "0.9.9.15"; + +/* Version command */ +static int Version(ClientData unused, Tcl_Interp *interp, int argc, const char *argv) +{ + Tcl_SetResult(interp, version_string, TCL_STATIC); + return TCL_OK; +} + +/* +* Initialization procedures +* These are the only public procedures in the file. +* These are OS independent +*/ +/* Initialization Procedures */ +EXPORT(int,Gdi_Init) (Tcl_Interp *interp) +{ + +#if TCL_MAJOR_VERSION <= 7 + Tcl_CreateCommand(interp, "gdi", gdi, + (ClientData)0, 0); +#else + #if defined(USE_TCL_STUBS) + Tcl_InitStubs(interp, TCL_VERSION, 0 ); + #endif + #if defined(USE_TK_STUBS) + Tk_InitStubs (interp, TCL_VERSION, 0 ); + #endif + /* Wanted to use namespaces, but "unknown" isn't smart enough yet */ + /* Since this package is so full of numbers, this would be a great place + * to introduce a TclCmdObj + */ + Tcl_CreateCommand(interp, "gdi", gdi, + (ClientData)0, (Tcl_CmdDeleteProc *)0); +#endif + + /* Make this package work whether hdc is loaded or not */ + if ( Tcl_PkgRequire(interp, "hdc", "0.2", 0) ) + { + init_hdc_functions(interp); + if ( hdc_create == 0 ) + hdc_loaded = 0; + else + hdc_loaded = 1; + } + else + hdc_loaded = 0; + + Tcl_PkgProvide (interp, "gdi", version_string); + + return TCL_OK; +} + +/* The gdi function is considered safe. */ +EXPORT (int,Gdi_SafeInit) (Tcl_Interp *interp) +{ + return Gdi_Init(interp); +} + +/* Exported symbols */ +BOOL APIENTRY DllEntryPoint (HINSTANCE hInstance, DWORD reason, LPVOID lpCmdLine) +{ + switch (reason) + { + case DLL_PROCESS_ATTACH: + break; + case DLL_THREAD_ATTACH: + break; + case DLL_PROCESS_DETACH: + /* Since GDI doesn't create DCs, just uses them, no cleanup is required */ + break; + case DLL_THREAD_DETACH: + break; + } + /* Don't do anything, so just return true */ + return TRUE; +} + +static void init_hdc_functions(Tcl_Interp *interp) +{ + void *fn[7]; + int result; + const char *cp; + Tcl_Eval(interp, "hdc FunctionVector"); + cp = Tcl_GetStringResult(interp); + /* Does cp need to be freed when I'm done? */ + result = sscanf(cp, "%lx%lx%lx%lx%lx%lx%lx", &fn[0], &fn[1], &fn[2], &fn[3], + &fn[4], &fn[5], &fn[6]); + if ( result == 7) + { + hdc_create = fn[0]; + hdc_delete = fn[1]; + hdc_get = fn[2]; + hdc_typeof = fn[3]; + hdc_prefixof = fn[4]; + hdc_list = fn[5]; + hdc_valid = fn[6]; + } +} + +static HDC get_dc(Tcl_Interp *interp, const char *name) +{ + /* ANY type of DC should be ok here */ + if ( hdc_loaded == 0 || hdc_valid == 0 || hdc_valid(interp, name, -1) == 0 ) + { + char *strend; + unsigned long tmp; + + /* Perhaps it is a numeric DC */ + tmp = strtoul(name, &strend, 0); + if ( strend != 0 && strend > name ) + { + DWORD objtype = GetObjectType((HGDIOBJ)tmp); + switch (objtype) + { + /* Any of the DC types are OK. */ + case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: + break; + /* Anything else is invalid */ + case 0: /* Function failed */ + default: + tmp = 0; + Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", + "need a drawing context, got non-context address: ", name, "\n", 0); + break; + } + return (HDC)tmp; + } + else + { + Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", + "need a drawing context, got: ", name, "\n", 0); + return 0; + } + } + + { + HDC hdc = (HDC)hdc_get(interp, name); + DWORD objtype = GetObjectType((HGDIOBJ)hdc); + switch (objtype) + { + /* Any of the DC types are OK. */ + case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: + break; + /* Anything else is invalid */ + case 0: /* Function failed */ + default: + hdc = 0; + Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", + "need a drawing context, got: ", name, "\n", 0); + break; + } + return hdc; + } +} + +#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION <= 6 + /* Under version 8.0, there is a nice function called Tk_GetHWND + * to do the real work.. + */ + + /* + * Copy a piece of tkWinInt.h + * This is easier to deal with than including tkWinInt.h, + * though it does mean one has to check when compiling + * against a new version! + */ + typedef struct { + int type; + HWND handle; + void *winPtr; /* Really a TkWindow */ + } TkWinWindow, TkWinDrawable; + + #define Tk_GetHWND(w) (((TkWinWindow *)w)->handle) +#elif defined(USE_TK_STUBS) + #include "tkPlatDecls.h" +#else + IMPORT(HWND,Tk_GetHWND) _ANSI_ARGS_((Window window)); +#endif + + +static HWND tk_gethwnd (Window window) +{ + return Tk_GetHWND(window); +} + +/* +* Something new: Include 'irox@cygnus.com' text widget printer +*/ +#if TEXTWIDGET_CMD +#include "tkWinPrintText.c" +#endif + +/* +* The following functions are copied from tkTrig.c, since they +* are not available in the stubs library. +*/ + +/* + *-------------------------------------------------------------- + * + * TkBezierScreenPoints -- + * + * Given four control points, create a larger set of XPoints + * for a Bezier spline based on the points. + * + * Results: + * The array at *xPointPtr gets filled in with numSteps XPoints + * corresponding to the Bezier spline defined by the four + * control points. Note: no output point is generated for the + * first input point, but an output point *is* generated for + * the last input point. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +TkBezierScreenPoints(canvas, control, numSteps, xPointPtr) + Tk_Canvas canvas; /* Canvas in which curve is to be + * drawn. */ + double control[]; /* Array of coordinates for four + * control points: x0, y0, x1, y1, + * ... x3 y3. */ + int numSteps; /* Number of curve points to + * generate. */ + register XPoint *xPointPtr; /* Where to put new points. */ +{ + int i; + double u, u2, u3, t, t2, t3; + + for (i = 1; i <= numSteps; i++, xPointPtr++) { + t = ((double) i)/((double) numSteps); + t2 = t*t; + t3 = t2*t; + u = 1.0 - t; + u2 = u*u; + u3 = u2*u; + Tk_CanvasDrawableCoords(canvas, + (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + + control[6]*t3), + (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + + control[7]*t3), + &xPointPtr->x, &xPointPtr->y); + } +} + +/* + *-------------------------------------------------------------- + * + * TkBezierPoints -- + * + * Given four control points, create a larger set of points + * for a Bezier spline based on the points. + * + * Results: + * The array at *coordPtr gets filled in with 2*numSteps + * coordinates, which correspond to the Bezier spline defined + * by the four control points. Note: no output point is + * generated for the first input point, but an output point + * *is* generated for the last input point. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +TkBezierPoints(control, numSteps, coordPtr) + double control[]; /* Array of coordinates for four + * control points: x0, y0, x1, y1, + * ... x3 y3. */ + int numSteps; /* Number of curve points to + * generate. */ + register double *coordPtr; /* Where to put new points. */ +{ + int i; + double u, u2, u3, t, t2, t3; + + for (i = 1; i <= numSteps; i++, coordPtr += 2) { + t = ((double) i)/((double) numSteps); + t2 = t*t; + t3 = t2*t; + u = 1.0 - t; + u2 = u*u; + u3 = u2*u; + coordPtr[0] = control[0]*u3 + + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; + coordPtr[1] = control[1]*u3 + + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; + } +} + +/* + *-------------------------------------------------------------- + * + * TkMakeBezierCurve -- + * + * Given a set of points, create a new set of points that fit + * parabolic splines to the line segments connecting the original + * points. Produces output points in either of two forms. + * + * Note: in spite of this procedure's name, it does *not* generate + * Bezier curves. Since only three control points are used for + * each curve segment, not four, the curves are actually just + * parabolic. + * + * Results: + * Either or both of the xPoints or dblPoints arrays are filled + * in. The return value is the number of points placed in the + * arrays. Note: if the first and last points are the same, then + * a closed curve is generated. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints) + Tk_Canvas canvas; /* Canvas in which curve is to be + * drawn. */ + double *pointPtr; /* Array of input coordinates: x0, + * y0, x1, y1, etc.. */ + int numPoints; /* Number of points at pointPtr. */ + int numSteps; /* Number of steps to use for each + * spline segments (determines + * smoothness of curve). */ + XPoint xPoints[]; /* Array of XPoints to fill in (e.g. + * for display. NULL means don't + * fill in any XPoints. */ + double dblPoints[]; /* Array of points to fill in as + * doubles, in the form x0, y0, + * x1, y1, .... NULL means don't + * fill in anything in this form. + * Caller must make sure that this + * array has enough space. */ +{ + int closed, outputPoints, i; + int numCoords = numPoints*2; + double control[8]; + + /* + * If the curve is a closed one then generate a special spline + * that spans the last points and the first ones. Otherwise + * just put the first point into the output. + */ + + if (!pointPtr) { + /* Of pointPtr == NULL, this function returns an upper limit. + * of the array size to store the coordinates. This can be + * used to allocate storage, before the actual coordinates + * are calculated. */ + return 1 + numPoints * numSteps; + } + + outputPoints = 0; + if ((pointPtr[0] == pointPtr[numCoords-2]) + && (pointPtr[1] == pointPtr[numCoords-1])) { + closed = 1; + control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0]; + control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1]; + control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0]; + control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1]; + control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2]; + control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3]; + control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; + control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; + if (xPoints != NULL) { + Tk_CanvasDrawableCoords(canvas, control[0], control[1], + &xPoints->x, &xPoints->y); + TkBezierScreenPoints(canvas, control, numSteps, xPoints+1); + xPoints += numSteps+1; + } + if (dblPoints != NULL) { + dblPoints[0] = control[0]; + dblPoints[1] = control[1]; + TkBezierPoints(control, numSteps, dblPoints+2); + dblPoints += 2*(numSteps+1); + } + outputPoints += numSteps+1; + } else { + closed = 0; + if (xPoints != NULL) { + Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1], + &xPoints->x, &xPoints->y); + xPoints += 1; + } + if (dblPoints != NULL) { + dblPoints[0] = pointPtr[0]; + dblPoints[1] = pointPtr[1]; + dblPoints += 2; + } + outputPoints += 1; + } + + for (i = 2; i < numPoints; i++, pointPtr += 2) { + /* + * Set up the first two control points. This is done + * differently for the first spline of an open curve + * than for other cases. + */ + + if ((i == 2) && !closed) { + control[0] = pointPtr[0]; + control[1] = pointPtr[1]; + control[2] = 0.333*pointPtr[0] + 0.667*pointPtr[2]; + control[3] = 0.333*pointPtr[1] + 0.667*pointPtr[3]; + } else { + control[0] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; + control[1] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; + control[2] = 0.167*pointPtr[0] + 0.833*pointPtr[2]; + control[3] = 0.167*pointPtr[1] + 0.833*pointPtr[3]; + } + + /* + * Set up the last two control points. This is done + * differently for the last spline of an open curve + * than for other cases. + */ + + if ((i == (numPoints-1)) && !closed) { + control[4] = .667*pointPtr[2] + .333*pointPtr[4]; + control[5] = .667*pointPtr[3] + .333*pointPtr[5]; + control[6] = pointPtr[4]; + control[7] = pointPtr[5]; + } else { + control[4] = .833*pointPtr[2] + .167*pointPtr[4]; + control[5] = .833*pointPtr[3] + .167*pointPtr[5]; + control[6] = 0.5*pointPtr[2] + 0.5*pointPtr[4]; + control[7] = 0.5*pointPtr[3] + 0.5*pointPtr[5]; + } + + /* + * If the first two points coincide, or if the last + * two points coincide, then generate a single + * straight-line segment by outputting the last control + * point. + */ + + if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3])) + || ((pointPtr[2] == pointPtr[4]) + && (pointPtr[3] == pointPtr[5]))) { + if (xPoints != NULL) { + Tk_CanvasDrawableCoords(canvas, control[6], control[7], + &xPoints[0].x, &xPoints[0].y); + xPoints++; + } + if (dblPoints != NULL) { + dblPoints[0] = control[6]; + dblPoints[1] = control[7]; + dblPoints += 2; + } + outputPoints += 1; + continue; + } + + /* + * Generate a Bezier spline using the control points. + */ + + + if (xPoints != NULL) { + TkBezierScreenPoints(canvas, control, numSteps, xPoints); + xPoints += numSteps; + } + if (dblPoints != NULL) { + TkBezierPoints(control, numSteps, dblPoints); + dblPoints += 2*numSteps; + } + outputPoints += numSteps; + } + return outputPoints; +} + -- cgit v0.12 From aefd42f17b84bcae993ce7ca8e4153090f20a2d2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 8 Mar 2021 13:37:13 +0000 Subject: Make tkWinGID.c and tkWinPrint.c compile. Still various compiler warnings --- win/tkWinGDI.c | 9502 +++++++++++++++++++++++++++--------------------------- win/tkWinInit.c | 2 +- win/tkWinInt.h | 2 +- win/tkWinPrint.c | 436 +-- 4 files changed, 4935 insertions(+), 5007 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 1c2c29b..4741752 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1,4789 +1,4713 @@ -/* - * tkWinGDI.c -- - * - * This module implements access to the Win32 GDI API. - * - * Copyright © 1991-1996 Microsoft Corp. - * Copyright © 2009, Michael I. Schwartz. - * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - - -/* Remove Deprecation Warnings. */ -#define _CRT_SECURE_NO_WARNINGS - -#include -#include -#include - - -#if defined(__WIN32__) || defined (__WIN32S__) || defined (WIN32S) - #ifndef STATIC_BUILD - # if defined(_MSC_VER) - # include /* Ensure to include WINAPI definition */ - # define EXPORT(a,b) __declspec(dllexport) a b - # define IMPORT(a,b) __declspec(dllimport) a b - # define DllEntryPoint DllMain - # define strcmpi(l,r) _stricmp(l,r) - # define strncmpi(l,r,c) _strnicmp(l,r,c) - # else - # if defined(__BORLANDC__) - # define EXPORT(a,b) a _export b - # define IMPORT(a,b) a _import b - # else - # define EXPORT(a,b) a b - # define IMPORT(a,b) a b - # endif - # endif - # define hypot(dx,dy) _hypot(dx,dy) - #endif -#else - # error "Extension is only for Windows" -#endif - -#include -/* #include */ -#include - -/* New macros for tcl8.0.3 and later */ -#if defined(TCL_STORAGE_CLASS) -# undef TCL_STORAGE_CLASS -#endif - -#define TCL_STORAGE_CLASS DLLEXPORT - -#if ! defined(EXTERN) -# define EXTERN -#endif - -/* Defined at the bottom so we can import the symbols */ -static HWND tk_gethwnd (Window window); -static HWND tkwingetwrapperwindow(Window tkwin); - -#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION <= 5 -/* In this case, must replace Tcl_Alloc(), Tcl_Realloc(), and Tcl_Free() -* with ckalloc(), ckrealloc(), and ckfree() -*/ - -#define Tcl_Alloc(x) ckalloc(x) -#define Tcl_Free(x) ckfree(x) -#define Tcl_Realloc(x,y) ckrealloc(x,y) - -#endif - - -/* Main dispatcher for commands */ -static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -/* Main dispatcher for subcommands */ -static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); - -/* Real functions */ -static int GdiConfig (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiArc (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiBitmap (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiCharWidths (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiImage (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiPhoto (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiLine (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiOval (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiPolygon (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiRectangle(ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiText (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int Version (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); - -static int GdiMap (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); -static int GdiCopyBits (ClientData unused, Tcl_Interp *interp, int argc, const char *argv); - -/* Local copies of similar routines elsewhere in Tcl/Tk */ -static int GdiParseColor (const char *name, unsigned long *color); -static int GdiGetColor (const char *name, unsigned long *color); -static int TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints); - -/* Routines imported from irox */ -static int PrintTextCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char *argv); - -/* -* Hash table support -* -* Provided by the hdc extension -*/ -static int hdc_loaded = 0; -static void init_hdc_functions(Tcl_Interp *interp); -static int (*hdc_init) (Tcl_Interp *interp); -static const char * (*hdc_create) (Tcl_Interp *interp, void *ptr, int type); -static int (*hdc_valid) (Tcl_Interp *interp, const char *hdcname, int type); -static int (*hdc_delete) (Tcl_Interp *interp, const char *hdcname); -static void * (*hdc_get) (Tcl_Interp *interp, const char *hdcname); -static int (*hdc_typeof) (Tcl_Interp *interp, const char *hdcname); -static const char * (*hdc_prefixof) (Tcl_Interp *interp, int type, const char *newprefix); -static int (*hdc_list) (Tcl_Interp *interp, int type, const char *out[], int *poutlen); - -static HDC get_dc(Tcl_Interp *interp, const char *name); - -/* -* Helper functions -*/ -static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC hDC); -static int GdiMakePen(Tcl_Interp *interp, int width, - int dashstyle, const char *dashstyledata, - int capstyle, - int joinstyle, - int stipplestyle, const char *stippledata, - unsigned long color, - HDC hDC, HGDIOBJ *oldPen); -static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen); -static int GdiMakeBrush (Tcl_Interp *interp, unsigned int style, unsigned long color, - long hatch, LOGBRUSH *lb, HDC hDC, HGDIOBJ *oldBrush); -static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBrush); -static int GdiGetHdcInfo( HDC hdc, - LPPOINT worigin, LPSIZE wextent, - LPPOINT vorigin, LPSIZE vextent); - -/* Helper functions for printing the window client area */ -enum PrintType { PTWindow=0, PTClient=1, PTScreen=2 }; -static HANDLE CopyToDIB ( HWND wnd, enum PrintType type ); -static HBITMAP CopyScreenToBitmap(LPRECT lpRect); -static HANDLE BitmapToDIB (HBITMAP hb, HPALETTE hp); -static HANDLE CopyScreenToDIB(LPRECT lpRect); -static int DIBNumColors(LPBITMAPINFOHEADER lpDIB); -static int PalEntriesOnDevice(HDC hDC); -static HPALETTE GetSystemPalette(void); -static void GetDisplaySize (LONG *width, LONG *height); - -static char usage_message[] = "gdi [arc|characters|copybits|line|map|oval|" - "photo|polygon|rectangle|text|version]\n" - "\thdc parameters can be generated by the printer extension"; -static char msgbuf[1024]; - -/* -* This is the top-level routine for the GDI command -* It strips off the first word of the command (gdi) and -* sends the result to the switch -*/ -static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - if ( argc > 1 && strcmp(*argv, "gdi") == 0 ) - { - argc--; - argv++; - return Gdi(unused, interp, argc, argv); - } - - Tcl_SetResult (interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* To make the "subcommands" follow a standard convention, -* add them to this array. The first element is the subcommand -* name, and the second a standard Tcl command handler. -*/ -struct gdi_command -{ - char *command_string; - int (*command) (ClientData, Tcl_Interp *, int, const char *); -} gdi_commands[] = -{ - { "arc", GdiArc }, - { "bitmap", GdiBitmap }, - { "characters", GdiCharWidths }, - { "configure", GdiConfig }, - { "image", GdiImage }, - { "line", GdiLine }, - { "map", GdiMap }, - { "oval", GdiOval }, - { "photo", GdiPhoto }, - { "polygon", GdiPolygon }, - { "rectangle", GdiRectangle }, - { "text", GdiText }, -#if TEXTWIDGET_CMD - { "textwidget", PrintTextCmd }, -#endif - { "copybits", GdiCopyBits }, - { "version", Version }, - -}; - -/* -* This is the GDI subcommand dispatcher -*/ -static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - int i; - - for (i=0; i= 1 ) - { - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if ( hDC == (HDC) 0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - argc--; - argv++; - } - else - { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - /* Now check for other arguments */ - while ( argc >= 1 ) - { - if ( strcmp(argv[0], "-bg") == 0 || strcmp(argv[0], "-background") == 0 ) - { - unsigned long color; - argc--; - argv++; - if ( argc >= 1 ) - { - if ( GdiParseColor(argv[0], &color) > 0 ) /* OK */ - SetBkColor(hDC, color); - else - { - Tcl_AppendResult(interp, - "{ {gdi configure: color parsing error for background ", - argv[0], - "} }", - 0); - status = TCL_ERROR; - } - } - } - argc--; - argv++; - } - - if ( (c = GetBkColor(hDC)) == CLR_INVALID ) - { - Tcl_AppendResult(interp, "{ -background INVALID }", 0); - status = TCL_ERROR; - } - else - { - sprintf(clrhex, "#%02x%02x%02x", GetRValue(c), GetGValue(c), GetBValue(c)); - Tcl_AppendResult(interp, "{ -background ", clrhex, " }", 0); - } - - return status; -} - -/* -* Arc command -* Create a standard "DrawFunc" to make this more workable.... -*/ -#ifdef _MSC_VER -typedef BOOL (WINAPI *DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie */ -#else -typedef BOOL WINAPI (*DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie */ -#endif - -static int GdiArc (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - int x1, y1, x2, y2; - int xr0, yr0, xr1, yr1; - HDC hDC; - double extent = 0.0 , start = 0.0 ; - DrawFunc drawfunc; - int width = 0; - HPEN hPen; - COLORREF linecolor=0, fillcolor=BS_NULL; - int dolinecolor=0, dofillcolor=0; - HBRUSH hBrush; - LOGBRUSH lbrush; - HGDIOBJ oldobj; - int dodash = 0; - const char *dashdata = 0; - - static char usage_message[] = "gdi arc hdc x1 y1 x2 y2 " - "-extent degrees " - "-fill color -outline color " - "-outlinestipple bitmap " - "-start degrees -stipple bitmap " - "-dash pattern " - "-style [pieslice|chord|arc] -width linewid"; - - drawfunc = Pie; - - /* Verrrrrry simple for now... */ - if (argc >= 5) - { - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - - x1 = atoi(argv[1]); - y1 = atoi(argv[2]); - x2 = atoi(argv[3]); - y2 = atoi(argv[4]); - - argc -= 5; - argv += 5; - while ( argc >= 2 ) - { - if ( strcmp (argv[0], "-extent") == 0 ) - extent = atof(argv[1]); - else if ( strcmp (argv[0], "-start") == 0 ) - start = atof(argv[1]); - else if ( strcmp (argv[0], "-style") == 0 ) - { - if ( strcmp (argv[1], "pieslice") == 0 ) - drawfunc = Pie; - else if ( strcmp(argv[1], "arc") == 0 ) - drawfunc = Arc; - else if ( strcmp(argv[1], "chord") == 0 ) - drawfunc = Chord; - } - /* Handle all args, even if we don't use them yet */ - else if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( GdiGetColor(argv[1], &fillcolor) ) - dofillcolor=1; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor=1; - } - else if (strcmp(argv[0], "-outlinestipple") == 0 ) - { - } - else if (strcmp(argv[0], "-stipple") == 0 ) - { - } - else if (strcmp(argv[0], "-width") == 0 ) - { - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } - argc -= 2; - argv += 2; - } - xr0 = xr1 = ( x1 + x2 ) / 2; - yr0 = yr1 = ( y1 + y2 ) / 2; - - - /* - * The angle used by the arc must be "warped" by the eccentricity of the ellipse. - * Thanks to Nigel Dodd for bringing a nice example. - */ - xr0 += (int)(100.0 * (x2 - x1) * cos( (start * 2.0 * 3.14159265) / 360.0 ) ); - yr0 -= (int)(100.0 * (y2 - y1) * sin( (start * 2.0 * 3.14159265) / 360.0 ) ); - xr1 += (int)(100.0 * (x2 - x1) * cos( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); - yr1 -= (int)(100.0 * (y2 - y1) * sin( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); - - /* Under Win95, SetArcDirection isn't implemented--so we have to - assume that arcs are drawn counterclockwise (e.g., positive extent) - So if it's negative, switch the coordinates! - */ - if ( extent < 0 ) - { - int xr2 = xr0; - int yr2 = yr0; - xr0 = xr1; - xr1 = xr2; - yr0 = yr1; - yr1 = yr2; - } - - if ( dofillcolor ) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH) ); - - if ( width || dolinecolor ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - - (*drawfunc)(hDC, x1, y1, x2, y2, xr0, yr0, xr1, yr1); - - if ( width || dolinecolor ) - GdiFreePen(interp, hDC, hPen); - if ( dofillcolor ) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject(hDC, oldobj); - - return TCL_OK; - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* Bitmap command -* Unimplemented for now. -* Should use the same techniques as CanvasPsBitmap (tkCanvPs.c) -*/ -static int GdiBitmap (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi bitmap hdc x y " - "-anchor [center|n|e|s|w] -background color " - "-bitmap bitmap -foreground color\n" - "Not implemented yet. Sorry!"; - - /* Skip this for now.... */ - /* Should be based on common code with the copybits command */ - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* Image command -* Unimplemented for now. -* Should switch on image type and call either GdiPhoto or GdiImage -* (or other registered function(?)) -* This code is similar to that in the tkx.y.z/win/tkWinImage.c code? -*/ -static int GdiImage (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi image hdc x y -anchor [center|n|e|s|w] -image name\n" - "Not implemented yet. Sorry!"; - - /* Skip this for now.... */ - /* Should be based on common code with the copybits command */ - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - /* Normally, usage results in TCL_ERROR--but wait til' it's implemented */ - return TCL_OK; -} - -/* -* Gdi Photo -* Contributed by Lukas Rosenthaler -* Note: The canvas doesn't directly support photos (only as images), -* so this is the first gdi command without an equivalent canvas command. -* This code may be modified to support photo images on the canvas. -*/ -static int GdiPhoto (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi photo hdc [-destination x y [w [h]]] -photo name\n"; - HDC dst; - int dst_x = 0, dst_y = 0, dst_w = 0, dst_h = 0; - int nx, ny, sll; - const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char * */ - Tk_PhotoHandle photo_handle; - Tk_PhotoImageBlock img_block; - BITMAPINFO bitmapinfo; /* Since we don't need the bmiColors table, - there is no need for dynamic allocation */ - int oldmode; /* For saving the old stretch mode */ - POINT pt; /* For saving the brush org */ - char *pbuf = NULL; - int i, j, k; - int retval = TCL_OK; - - /* - * Parse the arguments. - */ - /* HDC is required */ - if ( argc < 1 ) { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - dst = get_dc(interp, argv[0]); - - /* Check hDC */ - if (dst == (HDC) 0) { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for gdi photo\n", 0); - Tcl_AppendResult(interp, usage_message, 0); - return TCL_ERROR; - } - - /* - * Next, check to see if 'dst' can support BitBlt. - * If not, raise an error - */ - if ( (GetDeviceCaps (dst, RASTERCAPS) & RC_STRETCHDIB) == 0 ) { - sprintf(msgbuf, "gdi photo not supported on device context (0x%s)", argv[0]); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - return TCL_ERROR; - } - - /* Parse the command line arguments */ - for (j = 1; j < argc; j++) - { - if (strcmp (argv[j], "-destination") == 0) - { - double x, y, w, h; - int count = 0; - - if ( j < argc ) - count = sscanf(argv[++j], "%lf%lf%lf%lf", &x, &y, &w, &h); - - if ( count < 2 ) /* Destination must provide at least 2 arguments */ - { - Tcl_AppendResult(interp, "-destination requires a list of at least 2 numbers\n", - usage_message, 0); - return TCL_ERROR; - } - else - { - dst_x = (int) x; - dst_y = (int) y; - if ( count == 3 ) - { - dst_w = (int) w; - dst_h = -1; - } - else if ( count == 4 ) - { - dst_w = (int) w; - dst_h = (int) h; - } - } - } - else if (strcmp (argv[j], "-photo") == 0) - photoname = argv[++j]; - } - - if ( photoname == 0 ) /* No photo provided */ - { - Tcl_AppendResult(interp, "No photo name provided to gdi photo\n", usage_message, 0); - return TCL_ERROR; - } - - photo_handle = Tk_FindPhoto (interp, photoname); - if ( photo_handle == 0 ) - { - Tcl_AppendResult(interp, "gdi photo: Photo name ", photoname, " can't be located\n", - usage_message, 0); - return TCL_ERROR; - } - Tk_PhotoGetImage (photo_handle, &img_block); - - - nx = img_block.width; - ny = img_block.height; - sll = ((3*nx + 3) / 4)*4; /* must be multiple of 4 */ - - pbuf = (char *) Tcl_Alloc (sll*ny*sizeof (char)); - if ( pbuf == 0 ) /* Memory allocation failure */ - { - Tcl_AppendResult(interp, "gdi photo failed--out of memory", 0); - return TCL_ERROR; - } - - /* After this, all returns must go through retval */ - - /* BITMAP expects BGR; photo provides RGB */ - for (k = 0; k < ny; k++) - { - for (i = 0; i < nx; i++) - { - pbuf[k*sll + 3*i] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[2]]; - pbuf[k*sll + 3*i + 1] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[1]]; - pbuf[k*sll + 3*i + 2] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[0]]; - } - } - - memset (&bitmapinfo, 0L, sizeof (BITMAPINFO)); - - bitmapinfo.bmiHeader.biSize = sizeof (BITMAPINFOHEADER); - bitmapinfo.bmiHeader.biWidth = nx; - bitmapinfo.bmiHeader.biHeight = -ny; - bitmapinfo.bmiHeader.biPlanes = 1; - bitmapinfo.bmiHeader.biBitCount = 24; - bitmapinfo.bmiHeader.biCompression = BI_RGB; - bitmapinfo.bmiHeader.biSizeImage = 0; /* sll*ny; */ - bitmapinfo.bmiHeader.biXPelsPerMeter = 0; - bitmapinfo.bmiHeader.biYPelsPerMeter = 0; - bitmapinfo.bmiHeader.biClrUsed = 0; - bitmapinfo.bmiHeader.biClrImportant = 0; - - oldmode = SetStretchBltMode (dst, HALFTONE); - /* According to the Win32 Programmer's Manual, we have to set the brush org, now */ - SetBrushOrgEx(dst, 0, 0, &pt); - - if (dst_w <= 0) - { - dst_w = nx; - dst_h = ny; - } - else if (dst_h <= 0) - { - dst_h = ny*dst_w / nx; - } - - if (StretchDIBits (dst, dst_x, dst_y, dst_w, dst_h, 0, 0, nx, ny, - pbuf, &bitmapinfo, DIB_RGB_COLORS, SRCCOPY) == GDI_ERROR) { - int errcode; - - errcode = GetLastError(); - sprintf(msgbuf, "gdi photo internal failure: StretchDIBits error code %ld", errcode); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - retval = TCL_ERROR; - } - - /* Clean up the hDC */ - if (oldmode != 0 ) - { - SetStretchBltMode(dst, oldmode); - SetBrushOrgEx(dst, pt.x, pt.y, &pt); - } - - Tcl_Free (pbuf); - - if ( retval == TCL_OK ) - { - sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - } - - return retval; -} - -/* -* Interface to Tk's line smoother, used for lines and pollies -* Provided by Jasper Taylor -*/ -int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { - /* First, translate my points into a list of doubles */ - double *inPointList, *outPointList; - int n; - int nbpoints = 0; - POINT* bpoints; - - - inPointList=(double *)Tcl_Alloc(2*sizeof(double)*npoly); - if ( inPointList == 0 ) { - return nbpoints; /* 0 */ - } - - for (n=0;n= 5) - { - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - - if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) - { - Tcl_SetResult(interp, "Out of memory in GdiLine", TCL_STATIC); - return TCL_ERROR; - } - polypoints[0].x = atol(argv[1]); - polypoints[0].y = atol(argv[2]); - polypoints[1].x = atol(argv[3]); - polypoints[1].y = atol(argv[4]); - argc -= 5; - argv += 5; - npoly = 2; - - while ( argc >= 2 ) - { - /* Check for a number */ - x = strtoul(argv[0], &strend, 0); - if ( strend > argv[0] ) - { - /* One number... */ - y = strtoul (argv[1], &strend, 0); - if ( strend > argv[1] ) - { - /* TWO numbers! */ - polypoints[npoly].x = x; - polypoints[npoly].y = y; - npoly++; - argc-=2; - argv+=2; - } - else - { - /* Only one number... Assume a usage error */ - Tcl_Free((void *)polypoints); - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - } - else - { - if ( strcmp(*argv, "-arrow") == 0 ) - { - if ( strcmp(argv[1], "none") == 0 ) - doarrow = 0; - else if ( strcmp(argv[1], "both") == 0 ) - doarrow = 3; - else if ( strcmp(argv[1], "first") == 0 ) - doarrow = 2; - else if ( strcmp(argv[1], "last") == 0 ) - doarrow = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-arrowshape") == 0 ) - { - /* List of 3 numbers--set arrowshape array */ - int a1, a2, a3; - - if ( sscanf(argv[1], "%d%d%d", &a1, &a2, &a3) == 3 ) - { - if (a1 > 0 && a2 > 0 && a3 > 0 ) - { - arrowshape[0] = a1; - arrowshape[1] = a2; - arrowshape[2] = a3; - } - /* Else the numbers are bad */ - } - /* Else the argument was bad */ - - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-capstyle") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-fill") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-joinstyle") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-smooth") == 0 ) - { - /* Argument is true/false or 1/0 or bezier */ - if ( argv[1] ) { - switch ( argv[1][0] ) { - case 't': case 'T': - case '1': - case 'b': case 'B': /* bezier */ - dosmooth = 1; - break; - default: - dosmooth = 0; - break; - } - argv+=2; - argc-=2; - } - } - else if ( strcmp(*argv, "-splinesteps") == 0 ) - { - nStep = atoi(argv[1]); - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-dash" ) == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - argv += 2; - argc -= 2; - } - else if ( strcmp(*argv, "-dashoffset" ) == 0 ) - { - argv += 2; - argc -= 2; - } - else if ( strcmp(*argv, "-stipple") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-width") == 0 ) - { - width = atoi(argv[1]); - argv+=2; - argc-=2; - } - else /* It's an unknown argument! */ - { - argc--; - argv++; - } - /* Check for arguments - * Most of the arguments affect the "Pen" - */ - } - } - - if (width || dolinecolor || dodash ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - if ( doarrow != 0 ) - GdiMakeBrush(interp, 0, linecolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - - if (dosmooth) /* Use PolyBezier */ - { - int nbpoints; - POINT *bpoints = 0; - nbpoints = Bezierize(polypoints,npoly,nStep,&bpoints); - if (nbpoints > 0 ) - Polyline(hDC, bpoints, nbpoints); - else - Polyline(hDC, polypoints, npoly); /* out of memory? just draw a regular line */ - if ( bpoints != 0 ) - Tcl_Free((void *)bpoints); - } - else - Polyline(hDC, polypoints, npoly); - - if ( dodash && doarrow ) /* Don't use dashed or thick pen for the arrows! */ - { - GdiFreePen(interp, hDC, hPen); - GdiMakePen(interp, width, - 0, 0, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - } - - /* Now the arrowheads, if any */ - if ( doarrow & 1 ) - { - /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y */ - POINT ahead[6]; - double dx, dy, length; - double backup, sinTheta, cosTheta; - double vertX, vertY, temp; - double fracHeight; - - fracHeight = 2.0 / arrowshape[2]; - backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; - - ahead[0].x = ahead[5].x = polypoints[npoly-1].x; - ahead[0].y = ahead[5].y = polypoints[npoly-1].y; - dx = ahead[0].x - polypoints[npoly-2].x; - dy = ahead[0].y - polypoints[npoly-2].y; - if ( (length = hypot(dx, dy)) == 0 ) - sinTheta = cosTheta = 0.0; - else - { - sinTheta = dy / length; - cosTheta = dx / length; - } - vertX = ahead[0].x - arrowshape[0]*cosTheta; - vertY = ahead[0].y - arrowshape[0]*sinTheta; - temp = arrowshape[2]*sinTheta; - ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); - ahead[4].x = (long)(ahead[1].x - 2 * temp); - temp = arrowshape[2]*cosTheta; - ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); - ahead[4].y = (long)(ahead[1].y + 2 * temp); - ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); - ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); - - Polygon(hDC, ahead, 6); - - } - - if ( doarrow & 2 ) - { - /* Arrowhead at end = polypoints[0].x, polypoints[0].y */ - POINT ahead[6]; - double dx, dy, length; - double backup, sinTheta, cosTheta; - double vertX, vertY, temp; - double fracHeight; - - fracHeight = 2.0 / arrowshape[2]; - backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; - - ahead[0].x = ahead[5].x = polypoints[0].x; - ahead[0].y = ahead[5].y = polypoints[0].y; - dx = ahead[0].x - polypoints[1].x; - dy = ahead[0].y - polypoints[1].y; - if ( (length = hypot(dx, dy)) == 0 ) - sinTheta = cosTheta = 0.0; - else - { - sinTheta = dy / length; - cosTheta = dx / length; - } - vertX = ahead[0].x - arrowshape[0]*cosTheta; - vertY = ahead[0].y - arrowshape[0]*sinTheta; - temp = arrowshape[2]*sinTheta; - ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); - ahead[4].x = (long)(ahead[1].x - 2 * temp); - temp = arrowshape[2]*cosTheta; - ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); - ahead[4].y = (long)(ahead[1].y + 2 * temp); - ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); - ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); - - Polygon(hDC, ahead, 6); - } - - - if (width || dolinecolor || dodash ) - GdiFreePen(interp, hDC, hPen); - if ( doarrow ) - GdiFreeBrush(interp, hDC, hBrush); - - Tcl_Free((void *)polypoints); - - return TCL_OK; - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* Oval command -*/ -static int GdiOval (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi oval hdc x1 y1 x2 y2 -fill color -outline color " - "-stipple bitmap -width linewid"; - int x1, y1, x2, y2; - HDC hDC; - HPEN hPen; - int width=0; - COLORREF linecolor = 0, fillcolor = 0; - int dolinecolor = 0, dofillcolor = 0; - HBRUSH hBrush; - LOGBRUSH lbrush; - HGDIOBJ oldobj; - - int dodash = 0; - const char *dashdata = 0; - - /* Verrrrrry simple for now... */ - if (argc >= 5) - { - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - - x1 = atol(argv[1]); - y1 = atol(argv[2]); - x2 = atol(argv[3]); - y2 = atol(argv[4]); - if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } - if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } - argc -= 5; - argv += 5; - - while ( argc > 0 ) - { - /* Now handle any other arguments that occur */ - if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( argv[1] ) - if ( GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( argv[1] ) - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-stipple") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-width") == 0 ) - { - if (argv[1]) - width = atoi(argv[1]); - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - argv+=2; - argc-=2; - } - } - - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject( hDC, GetStockObject(HOLLOW_BRUSH) ); - - if (width || dolinecolor) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - /* - * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and - * earlier documentation, canvas rectangle does not. Thus, add 1 to - * right and lower bounds to get appropriate behavior. - */ - Ellipse (hDC, x1, y1, x2+1, y2+1); - if (width || dolinecolor) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject (hDC, oldobj ); - - return TCL_OK; - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* Polygon command -*/ -static int GdiPolygon (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi polygon hdc x1 y1 ... xn yn " - "-fill color -outline color -smooth [true|false|bezier] " - "-splinesteps number -stipple bitmap -width linewid"; - - char *strend; - POINT *polypoints; - int npoly; - int dosmooth = 0; - int nStep = 12; - int x, y; - HDC hDC; - HPEN hPen; - int width = 0; - COLORREF linecolor=0, fillcolor=BS_NULL; - int dolinecolor=0, dofillcolor=0; - LOGBRUSH lbrush; - HBRUSH hBrush; - HGDIOBJ oldobj; - - int dodash = 0; - const char *dashdata = 0; - - /* Verrrrrry simple for now... */ - if (argc >= 5) - { - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - - if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) - { - Tcl_SetResult(interp, "Out of memory in GdiLine", TCL_STATIC); - return TCL_ERROR; - } - polypoints[0].x = atol(argv[1]); - polypoints[0].y = atol(argv[2]); - polypoints[1].x = atol(argv[3]); - polypoints[1].y = atol(argv[4]); - argc -= 5; - argv += 5; - npoly = 2; - - while ( argc >= 2 ) - { - /* Check for a number */ - x = strtoul(argv[0], &strend, 0); - if ( strend > argv[0] ) - { - /* One number... */ - y = strtoul (argv[1], &strend, 0); - if ( strend > argv[1] ) - { - /* TWO numbers! */ - polypoints[npoly].x = x; - polypoints[npoly].y = y; - npoly++; - argc-=2; - argv+=2; - } - else - { - /* Only one number... Assume a usage error */ - Tcl_Free((void *)polypoints); - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - } - else - { - if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( argv[1] && GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 0; - } - else if ( strcmp(argv[0], "-smooth") == 0 ) { - if ( argv[1] ) { - switch ( argv[1][0] ) { - case 't': case 'T': - case '1': - case 'b': case 'B': /* bezier */ - dosmooth = 1; - break; - default: - dosmooth = 0; - break; - } - } - } - else if ( strcmp(argv[0], "-splinesteps") == 0 ) - { - if ( argv[1] ) - nStep = atoi(argv[1]); - } - else if (strcmp(argv[0], "-stipple") == 0 ) - { - } - else if (strcmp(argv[0], "-width") == 0 ) - { - if (argv[1]) - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } - argc -= 2; - argv += 2; - /* Check for arguments - * Most of the arguments affect the "Pen" and "Brush" - */ - } - } - - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); - - if (width || dolinecolor) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - - if ( dosmooth) - { - int nbpoints; - POINT *bpoints = 0; - nbpoints = Bezierize(polypoints,npoly,nStep,&bpoints); - if ( nbpoints > 0 ) - Polygon(hDC, bpoints, nbpoints); - else - Polygon(hDC, polypoints, npoly); - if ( bpoints != 0 ) - Tcl_Free((void *)bpoints); - } - else - Polygon(hDC, polypoints, npoly); - - if (width || dolinecolor) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject (hDC, oldobj); - - Tcl_Free((void *)polypoints); - - return TCL_OK; - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* Rectangle command -*/ -static int GdiRectangle(ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi rectangle hdc x1 y1 x2 y2 " - "-fill color -outline color " - "-stipple bitmap -width linewid"; - - int x1, y1, x2, y2; - HDC hDC; - HPEN hPen; - int width = 0; - COLORREF linecolor=0, fillcolor=BS_NULL; - int dolinecolor=0, dofillcolor=0; - LOGBRUSH lbrush; - HBRUSH hBrush; - HGDIOBJ oldobj; - - int dodash = 0; - const char *dashdata = 0; - - /* Verrrrrry simple for now... */ - if (argc >= 5) - { - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - - x1 = atol(argv[1]); - y1 = atol(argv[2]); - x2 = atol(argv[3]); - y2 = atol(argv[4]); - if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } - if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } - argc -= 5; - argv += 5; - - /* Now handle any other arguments that occur */ - while (argc > 1) - { - if ( strcmp(argv[0], "-fill") == 0 ) - { - if (argv[1]) - if (GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - } - else if ( strcmp(argv[0], "-outline") == 0) - { - if (argv[1]) - if (GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - } - else if ( strcmp(argv[0], "-stipple") == 0) - { - } - else if ( strcmp(argv[0], "-width") == 0) - { - if (argv[1] ) - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } - - argc -= 2; - argv += 2; - } - - /* Note: If any fill is specified, the function must create a brush and - * put the coordinates in a RECTANGLE structure, and call FillRect. - * FillRect requires a BRUSH / color. - * If not, the function Rectangle must be called - */ - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); - - if ( width || dolinecolor ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - /* - * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and - * earlier documentation, canvas rectangle does not. Thus, add 1 to - * right and lower bounds to get appropriate behavior. - */ - Rectangle (hDC, x1, y1, x2+1, y2+1); - if ( width || dolinecolor ) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject(hDC, oldobj); - - return TCL_OK; - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* characters command -* Need some way to get accurate data on character widths. -* This is completely inadequate for typesetting, but should work -* for simple text manipulation. -*/ -static int GdiCharWidths (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi characters hdc [-font fontname] [-array ary]"; - /* Returns widths of characters from font in an associative array - * Font is currently selected font for HDC if not specified - * Array name is GdiCharWidths if not specified - * Widths should be in the same measures as all other values (1/1000 inch). - */ - HDC hDC; - LOGFONT lf; - HFONT hfont, oldfont; - int made_font = 0; - const char *aryvarname = "GdiCharWidths"; - /* For now, assume 256 characters in the font... */ - int widths[256]; - int retval; - - if ( argc < 1 ) - { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - - argc--; - argv++; - - while ( argc > 0 ) - { - if ( strcmp(argv[0], "-font") == 0 ) - { - argc--; - argv++; - if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) - if ( (hfont = CreateFontIndirect(&lf)) != NULL ) - { - made_font = 1; - oldfont = SelectObject(hDC, hfont); - } - /* Else leave the font alone! */ - } - else if ( strcmp(argv[0], "-array") == 0 ) - { - argv++; - argc--; - if ( argc > 0 ) - { - aryvarname=argv[0]; - } - } - argv++; - argc--; - } - - /* Now, get the widths using the correct function for this windows version */ -#ifdef WIN32 - /* Try the correct function. If it fails (as has been reported on some - * versions of Windows 95), try the "old" function - */ - if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) - { - retval = GetCharWidth (hDC, 0, 255, widths ); - } -#else - retval = GetCharWidth (hDC, 0, 255, widths); -#endif - /* Retval should be 1 (TRUE) if the function succeeded. If the function fails, - * get the "extended" error code and return. Be sure to deallocate the font if - * necessary. - */ - if (retval == FALSE) - { - DWORD val = GetLastError(); - char intstr[12+1]; - sprintf (intstr, "%ld", val ); - Tcl_AppendResult (interp, "gdi character failed with code ", intstr, 0); - if ( made_font ) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } - return TCL_ERROR; - } - - { - int i; - char numbuf[11+1]; - char ind[2]; - ind[1] = '\0'; - - for (i = 0; i < 255; i++ ) - { - /* May need to convert the widths here(?) */ - sprintf(numbuf, "%d", widths[i]); - ind[0] = i; - Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); - } - } - /* Now, remove the font if we created it only for this function */ - if ( made_font ) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } - - /* The return value should be the array name(?) */ - Tcl_SetResult(interp, (char *)aryvarname, TCL_VOLATILE); - return TCL_OK; -} - -/* -* Text command -* Q: Add -clip/-noclip? Add -single? -* Q: To match canvas semantics, this should respect newlines, -* and treat no width supplied (width of 0) to output as -* a single line EXCEPT that it respects newlines. -*/ -static int GdiText (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi text hdc x y -anchor [center|n|e|s|w] " - "-fill color -font fontname " - "-justify [left|right|center] " - "-stipple bitmap -text string -width linelen " - "-single -backfill" - "-encoding [input encoding] -unicode"; - - HDC hDC; - int x, y; - const char *string = 0; - RECT sizerect; - UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas */ - Tk_Anchor anchor = 0; - LOGFONT lf; - HFONT hfont, oldfont; - int made_font = 0; - int retval; - int dotextcolor=0; - int dobgmode=0; - int dounicodeoutput=0; /* If non-zero, output will be drawn in Unicode */ - int bgmode; - COLORREF textcolor = 0; - int usewidth=0; - int usesingle = 0; - const char *encoding_name = 0; - -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - TCHAR *ostring; - Tcl_DString tds; - Tcl_Encoding encoding = NULL; - int tds_len; -#endif - - if ( argc >= 4 ) - { - /* Parse the command */ - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - - x = atol(argv[1]); - y = atol(argv[2]); - argc -= 3; - argv += 3; - - sizerect.left = sizerect.right = x; - sizerect.top = sizerect.bottom = y; - - while ( argc > 0 ) - { - if ( strcmp(argv[0], "-anchor") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - Tk_GetAnchor(interp, argv[0], &anchor); - } - else if ( strcmp(argv[0], "-justify") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - { - if ( strcmp(argv[0], "left") == 0 ) - format_flags |= DT_LEFT; - else if ( strcmp(argv[0], "center") == 0 ) - format_flags |= DT_CENTER; - else if ( strcmp(argv[0], "right") == 0 ) - format_flags |= DT_RIGHT; - } - } - else if ( strcmp(argv[0], "-text") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - string = argv[0]; - } - else if ( strcmp(argv[0], "-font") == 0 ) - { - argc--; - argv++; - if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) - if ( (hfont = CreateFontIndirect(&lf)) != NULL ) - { - made_font = 1; - oldfont = SelectObject(hDC, hfont); - } - /* Else leave the font alone! */ - } - else if ( strcmp(argv[0], "-stipple") == 0 ) - { - argc--; - argv++; - /* Not implemented yet */ - } - else if ( strcmp(argv[0], "-fill") == 0 ) - { - argc--; - argv++; - /* Get text color */ - if ( GdiGetColor(argv[0], &textcolor) ) - dotextcolor = 1; - } - else if ( strcmp(argv[0], "-width") == 0 ) - { - argc--; - argv++; - if ( argc > 0 ) - sizerect.right += atol(argv[0]); - /* If a width is specified, break at words. */ - format_flags |= DT_WORDBREAK; - usewidth = 1; - } - else if ( strcmp(argv[0], "-single") == 0 ) - { - usesingle = 1; - } - else if ( strcmp(argv[0], "-backfill") == 0 ) - dobgmode = 1; - else if ( strcmp(argv[0], "-unicode") == 0 ) - { - dounicodeoutput = 1; - /* Set the encoding name to utf-8, but can be overridden */ - if ( encoding_name == 0 ) - encoding_name = "utf-8"; - } - else if ( strcmp(argv[0], "-encoding") == 0 ) { - argc--; - argv++; - if ( argc > 0 ) { - encoding_name = argv[0]; - } - } - - argc--; - argv++; - } - -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - /* Handle the encoding, if present */ - if ( encoding_name != 0 ) - { - Tcl_Encoding tmp_encoding; - tmp_encoding = Tcl_GetEncoding(interp,encoding_name); - if (tmp_encoding != NULL) - encoding = tmp_encoding; - } -#endif - - if (string == 0 ) - { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - /* Set the format flags for -single: Overrides -width */ - if ( usesingle == 1 ) - { - format_flags |= DT_SINGLELINE; - format_flags |= DT_NOCLIP; - format_flags &= ~DT_WORDBREAK; - } - - /* Calculate the rectangle */ -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - Tcl_DStringInit(&tds); - Tcl_UtfToExternalDString(encoding, string, -1, &tds); - ostring = Tcl_DStringValue(&tds); - tds_len = Tcl_DStringLength(&tds); - /* Just for fun, let's try translating ostring to unicode */ - if (dounicodeoutput) /* Convert UTF-8 to unicode */ - { - Tcl_UniChar *ustring; - Tcl_DString tds2; - Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - DrawTextW(hDC, (LPWSTR)ustring, Tcl_UniCharLen(ustring), &sizerect, format_flags | DT_CALCRECT); - Tcl_DStringFree(&tds2); - } - else /* Use UTF-8/local code page output */ - { - DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); - } -#else - DrawText (hDC, string, -1, &sizerect, format_flags | DT_CALCRECT); -#endif - - /* Adjust the rectangle according to the anchor */ - x = y = 0; - switch ( anchor ) - { - case TK_ANCHOR_N: - x = ( sizerect.right - sizerect.left ) / 2; - break; - case TK_ANCHOR_S: - x = ( sizerect.right - sizerect.left ) / 2; - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_E: - x = ( sizerect.right - sizerect.left ); - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - case TK_ANCHOR_W: - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - case TK_ANCHOR_NE: - x = ( sizerect.right - sizerect.left ); - break; - case TK_ANCHOR_NW: - break; - case TK_ANCHOR_SE: - x = ( sizerect.right - sizerect.left ); - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_SW: - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_CENTER: - x = ( sizerect.right - sizerect.left ) / 2; - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - } - sizerect.right -= x; - sizerect.left -= x; - sizerect.top -= y; - sizerect.bottom -= y; - - /* Get the color right */ - if ( dotextcolor ) - textcolor = SetTextColor(hDC, textcolor); - - if ( dobgmode ) - bgmode = SetBkMode(hDC, OPAQUE); - else - bgmode = SetBkMode(hDC, TRANSPARENT); - - - /* Print the text */ -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - if (dounicodeoutput) /* Convert UTF-8 to unicode */ - { - Tcl_UniChar *ustring; - Tcl_DString tds2; - Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_UniCharLen(ustring), &sizerect, format_flags); - Tcl_DStringFree(&tds2); - } - else - { - retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); - } - Tcl_DStringFree(&tds); -#else - retval = DrawText (hDC, string, -1, &sizerect, format_flags); -#endif - - /* Get the color set back */ - if ( dotextcolor ) - textcolor = SetTextColor(hDC, textcolor); - - SetBkMode(hDC, bgmode); - - if (made_font) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } - - /* In this case, the return value is the height of the text */ - sprintf(msgbuf, "%d", retval); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - - return TCL_OK; - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* GdiGetHdcInfo -* Return salient characteristics of the CTM. -* The return value is 0 if any failure occurs--in which case -* none of the other values are meaningful. -* Otherwise the return value is the current mapping mode -* (this may be VERY windows-specific). -*/ -static int GdiGetHdcInfo( HDC hdc, - LPPOINT worigin, LPSIZE wextent, - LPPOINT vorigin, LPSIZE vextent) -{ - int mapmode; - int retval; - - memset (worigin, 0, sizeof(POINT)); - memset (vorigin, 0, sizeof(POINT)); - memset (wextent, 0, sizeof(SIZE)); - memset (vextent, 0, sizeof(SIZE)); - - if ( (mapmode = GetMapMode(hdc)) == 0 ) - { - /* Failed! */ - retval=0; - } - else - retval = mapmode; - - if ( GetWindowExtEx(hdc, wextent) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetViewportExtEx (hdc, vextent) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetWindowOrgEx(hdc, worigin) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetViewportOrgEx(hdc, vorigin) == FALSE ) - { - /* Failed! */ - retval = 0; - } - - return retval; -} - -/* -* Converts Windows mapping mode names to values in the .h -*/ -static int GdiNameToMode(const char *name) -{ - static struct gdimodes { - int mode; - const char *name; - } modes[] = { - { MM_ANISOTROPIC, "MM_ANISOTROPIC" }, - { MM_HIENGLISH, "MM_HIENGLISH" }, - { MM_HIMETRIC, "MM_HIMETRIC" }, - { MM_ISOTROPIC, "MM_ISOTROPIC" }, - { MM_LOENGLISH, "MM_LOENGLISH" }, - { MM_LOMETRIC, "MM_LOMETRIC" }, - { MM_TEXT, "MM_TEXT" }, - { MM_TWIPS, "MM_TWIPS" } - }; - - int i; - for (i=0; i < sizeof(modes) / sizeof(struct gdimodes); i++) - { - if ( strcmp(modes[i].name, name) == 0 ) - return modes[i].mode; - } - return atoi(name); -} - -/* -* Mode to Name converts the mode number to a printable form -*/ -static const char *GdiModeToName(int mode) -{ - static struct gdi_modes { - int mode; - const char *name; - } modes[] = { - { MM_ANISOTROPIC, "Anisotropic" }, - { MM_HIENGLISH, "1/1000 inch" }, - { MM_HIMETRIC, "1/100 mm" }, - { MM_ISOTROPIC, "Isotropic" }, - { MM_LOENGLISH, "1/100 inch" }, - { MM_LOMETRIC, "1/10 mm" }, - { MM_TEXT, "1 to 1" }, - { MM_TWIPS, "1/1440 inch" } - }; - - int i; - for (i=0; i < sizeof(modes) / sizeof(struct gdi_modes); i++) - { - if ( modes[i].mode == mode ) - return modes[i].name; - } - return "Unknown"; -} - -/* -* GdiMap - -* Set mapping mode between logical and physical device space -* Syntax for this is intended to be more-or-less independent of -* Windows/Mac/X--that is, equally difficult to use with each. -* Alternative: -* Possibly this could be a feature of the HDC extension itself? -*/ -static int GdiMap (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - static char usage_message[] = "gdi map hdc " - "[-logical x[y]] [-physical x[y]] " - "[-offset {x y} ] [-default] [-mode mode]" - ; - HDC hdc; - int mapmode; /* Mapping mode */ - SIZE wextent; /* Device extent */ - SIZE vextent; /* Viewport extent */ - POINT worigin; /* Device origin */ - POINT vorigin; /* Viewport origin */ - int argno; - - /* Keep track of what parts of the function need to be executed */ - int need_usage = 0; - int use_logical = 0; - int use_physical = 0; - int use_offset = 0; - int use_default = 0; - int use_mode = 0; - - /* Required parameter: HDC for printer */ - if ( argc >= 1 ) - { - hdc = get_dc(interp, argv[0]); - /* Check hDC */ - if (hdc == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); - return TCL_ERROR; - } - - if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) - { - /* Failed! */ - Tcl_SetResult(interp, "Cannot get current HDC info", TCL_STATIC); - return TCL_ERROR; - } - - /* Parse remaining arguments */ - for (argno = 1; argno < argc; argno++) - { - if ( strcmp(argv[argno], "-default") == 0 ) - { - vextent.cx = vextent.cy = wextent.cx = wextent.cy = 1; - vorigin.x = vorigin.y = worigin.x = worigin.y = 0; - mapmode = MM_TEXT; - use_default = 1; - } - else if ( strcmp (argv[argno], "-mode" ) == 0 ) - { - if ( argno + 1 >= argc ) - need_usage = 1; - else - { - mapmode = GdiNameToMode(argv[argno+1]); - use_mode = 1; - argno++; - } - } - else if ( strcmp (argv[argno], "-offset") == 0 ) - { - if (argno + 1 >= argc) - need_usage = 1; - else - { - /* It would be nice if this parsed units as well... */ - if ( sscanf(argv[argno+1], "%ld%ld", &vorigin.x, &vorigin.y) == 2 ) - use_offset = 1; - else - need_usage = 1; - argno ++; - } - } - else if ( strcmp (argv[argno], "-logical") == 0 ) - { - if ( argno+1 >= argc) - need_usage = 1; - else - { - int count; - argno++; - /* In "real-life", this should parse units as well. */ - if ( (count = sscanf(argv[argno], "%ld%ld", &wextent.cx, &wextent.cy)) != 2 ) - { - if ( count == 1 ) - { - mapmode = MM_ISOTROPIC; - use_logical = 1; - wextent.cy = wextent.cx; /* Make them the same */ - } - else - need_usage = 1; - } - else - { - mapmode = MM_ANISOTROPIC; - use_logical = 2; - } - } - } - else if ( strcmp (argv[argno], "-physical") == 0 ) - { - if ( argno+1 >= argc) - need_usage = 1; - else - { - int count; - - argno++; - /* In "real-life", this should parse units as well. */ - if ( (count = sscanf(argv[argno], "%ld%ld", &vextent.cx, &vextent.cy)) != 2 ) - { - if ( count == 1 ) - { - mapmode = MM_ISOTROPIC; - use_physical = 1; - vextent.cy = vextent.cx; /* Make them the same */ - } - else - need_usage = 1; - } - else - { - mapmode = MM_ANISOTROPIC; - use_physical = 2; - } - } - } - } - - /* Check for any impossible combinations */ - if ( use_logical != use_physical ) - need_usage = 1; - if ( use_default && (use_logical || use_offset || use_mode ) ) - need_usage = 1; - if ( use_mode && use_logical && - (mapmode != MM_ISOTROPIC && mapmode != MM_ANISOTROPIC) - ) - need_usage = 1; - - if ( need_usage == 0 ) - { - /* Call Windows CTM functions */ - if ( use_logical || use_default || use_mode ) /* Don't call for offset only */ - { - SetMapMode(hdc, mapmode); - } - - if ( use_offset || use_default ) - { - POINT oldorg; - SetViewportOrgEx (hdc, vorigin.x, vorigin.y, &oldorg); - SetWindowOrgEx (hdc, worigin.x, worigin.y, &oldorg); - } - - if ( use_logical ) /* Same as use_physical */ - { - SIZE oldsiz; - SetWindowExtEx (hdc, wextent.cx, wextent.cy, &oldsiz); - SetViewportExtEx (hdc, vextent.cx, vextent.cy, &oldsiz); - } - - /* Since we may not have set up every parameter, get them again for - * the report: - */ - mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent); - - /* Output current CTM info */ - /* Note: This should really be in terms that can be used in a gdi map command! */ - sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " - "Origin: \"(%ld, %ld)\" " - "MappingMode: \"%s\"", - vextent.cx, vextent.cy, wextent.cx, wextent.cy, - vorigin.x, vorigin.y, - GdiModeToName(mapmode)); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - return TCL_OK; - } - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* -* GdiCopyBits -*/ -static int GdiCopyBits (ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - /* Goal: get the Tk_Window from the top-level - convert it to an HWND - get the HDC - Do a bitblt to the given hdc - Use an optional parameter to point to an arbitrary window instead of the main - Use optional parameters to map to the width and height required for the dest. - */ - static char usage_message[] = "gdi copybits hdc [-window w|-screen] [-client] " - "[-source \"a b c d\"] " - "[-destination \"a b c d\"] [-scale number] [-calc]"; - - Tk_Window mainWin; - Tk_Window workwin; - Window w; - HDC src; - HDC dst; - HWND wnd = 0; - - HANDLE hDib; /* handle for device-independent bitmap */ - LPBITMAPINFOHEADER lpDIBHdr; - LPSTR lpBits; - enum PrintType wintype = PTWindow; - - int hgt, wid; - char *strend; - long errcode; - - /* Variables to remember what we saw in the arguments */ - int do_window=0; - int do_screen=0; - int do_scale=0; - int do_print=1; - - /* Variables to remember the values in the arguments */ - const char *window_spec; - double scale=1.0; - int src_x=0, src_y=0, src_w=0, src_h=0; - int dst_x=0, dst_y=0, dst_w=0, dst_h=0; - int is_toplevel = 0; - - /* - * The following steps are peculiar to the top level window. - * There is likely a clever way to do the mapping of a - * widget pathname to the proper window, to support the idea of - * using a parameter for this purpose. - */ - if ( (workwin = mainWin = Tk_MainWindow(interp)) == 0 ) - { - Tcl_SetResult(interp, "Can't find main Tk window", TCL_STATIC); - return TCL_ERROR; - } - - /* - * Parse the arguments. - */ - /* HDC is required */ - if ( argc < 1 ) - { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - dst = get_dc(interp, argv[0]); - - /* Check hDC */ - if (dst == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for BitBlt destination", 0); - return TCL_ERROR; - } - - /* - * Next, check to see if 'dst' can support BitBlt. - * If not, raise an error - */ - if ( ( GetDeviceCaps (dst, RASTERCAPS) & RC_BITBLT ) == 0 ) - { - sprintf(msgbuf, "Can't do bitmap operations on device context (0x%lx)", dst); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - return TCL_ERROR; - } - - /* Loop through the remaining arguments */ - { - int k; - for (k=1; k= 100.0 ) - { - sprintf(msgbuf, "Unreasonable scale specification %s", argv[k]); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - return TCL_ERROR; - } - do_scale = 1; - } - } - else if ( strcmp(argv[k], "-noprint") == 0 || strncmp(argv[k], "-calc", 5) == 0 ) - { - /* This option suggested by Pascal Bouvier to get sizes without printing */ - do_print = 0; - } - } - } - - /* - * Check to ensure no incompatible arguments were used - */ - if ( do_window && do_screen ) - { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - /* - * Get the MS Window we want to copy. - */ - /* Given the HDC, we can get the "Window" */ - if (wnd == 0 ) - { - if ( Tk_IsTopLevel(workwin) ) - is_toplevel = 1; - - if ( (w = Tk_WindowId(workwin)) == 0 ) - { - Tcl_SetResult(interp, "Can't get id for Tk window", TCL_STATIC); - return TCL_ERROR; - } - - /* Given the "Window" we can get a Microsoft Windows HWND */ - - if ( (wnd = tk_gethwnd(w)) == 0 ) - { - Tcl_SetResult(interp, "Can't get Windows handle for Tk window", TCL_STATIC); - return TCL_ERROR; - } - - /* If it's a toplevel, give it special treatment: Get the top-level window instead. - * If the user only wanted the client, the -client flag will take care of it. - * This uses "windows" tricks rather than Tk since the obvious method of - * getting the wrapper window didn't seem to work. - */ - if ( is_toplevel ) - { - HWND tmpWnd = wnd; - while ( (tmpWnd = GetParent( tmpWnd ) ) != 0 ) - wnd = tmpWnd; - } - } - - /* Given the HWND, we can get the window's device context */ - if ( (src = GetWindowDC(wnd)) == 0 ) - { - Tcl_SetResult(interp, "Can't get device context for Tk window", TCL_STATIC); - return TCL_ERROR; - } - - if ( do_screen ) - { - LONG w, h; - GetDisplaySize(&w, &h); - wid = w; - hgt = h; - } - else if ( is_toplevel ) - { - RECT tl; - GetWindowRect(wnd, &tl); - wid = tl.right - tl.left; - hgt = tl.bottom - tl.top; - } - else - { - if ( (hgt = Tk_Height(workwin)) <= 0 ) - { - Tcl_SetResult(interp, "Can't get height of Tk window", TCL_STATIC); - ReleaseDC(wnd,src); - return TCL_ERROR; - } - - if ( (wid = Tk_Width(workwin)) <= 0 ) - { - Tcl_SetResult(interp, "Can't get width of Tk window", TCL_STATIC); - ReleaseDC(wnd,src); - return TCL_ERROR; - } - } - - /* - * Ensure all the widths and heights are set up right - * A: No dimensions are negative - * B: No dimensions exceed the maximums - * C: The dimensions don't lead to a 0 width or height image. - */ - if ( src_x < 0 ) - src_x = 0; - if ( src_y < 0 ) - src_y = 0; - if ( dst_x < 0 ) - dst_x = 0; - if ( dst_y < 0 ) - dst_y = 0; - - if ( src_w > wid || src_w <= 0 ) - src_w = wid; - - if ( src_h > hgt || src_h <= 0 ) - src_h = hgt; - - if ( do_scale && dst_w == 0 ) - { - /* Calculate destination width and height based on scale */ - dst_w = (int)(scale * src_w); - dst_h = (int)(scale * src_h); - } - - if ( dst_h == -1 ) - dst_h = (int) (((long)src_h * dst_w) / (src_w + 1)) + 1; - - if ( dst_h == 0 || dst_w == 0 ) - { - dst_h = src_h; - dst_w = src_w; - } - - if ( do_print ) - { - /* - * Based on notes from Heiko Schock and Arndt Roger Schneider, - * create this as a DIBitmap, to allow output to a greater range of - * devices. This approach will also allow selection of - * a) Whole screen - * b) Whole window - * c) Client window only - * for the "grab" - */ - hDib = CopyToDIB( wnd, wintype ); - - /* GdiFlush(); */ - - if (!hDib) { - Tcl_SetResult(interp, "Can't create DIB", TCL_STATIC); - ReleaseDC(wnd,src); - return TCL_ERROR; - } - - lpDIBHdr = (LPBITMAPINFOHEADER)GlobalLock(hDib); - if (!lpDIBHdr) { - Tcl_SetResult(interp, "Can't get DIB header", TCL_STATIC); - ReleaseDC(wnd,src); - return TCL_ERROR; - } - - lpBits = (LPSTR)lpDIBHdr + lpDIBHdr->biSize + DIBNumColors(lpDIBHdr) * sizeof(RGBQUAD); - - /* stretch the DIBbitmap directly in the target device */ - - if (StretchDIBits(dst, - dst_x, dst_y, dst_w, dst_h, - src_x, src_y, src_w, src_h, - lpBits, (LPBITMAPINFO)lpDIBHdr, DIB_RGB_COLORS, - SRCCOPY) == GDI_ERROR) - { - errcode = GetLastError(); - GlobalUnlock(hDib); - GlobalFree(hDib); - ReleaseDC(wnd,src); - sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - return TCL_ERROR; - } - - /* free allocated memory */ - GlobalUnlock(hDib); - GlobalFree(hDib); - } - - ReleaseDC(wnd,src); - - /* The return value should relate to the size in the destination space. - * At least the height should be returned (for page layout purposes) - */ - sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - - return TCL_OK; -} - -/* -* Computes the number of colors required for a DIB palette -*/ -static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) -{ - WORD wBitCount; // DIB bit count - DWORD dwClrUsed; - - // If this is a Windows-style DIB, the number of colors in the - // color table can be less than the number of bits per pixel - // allows for (i.e. lpbi->biClrUsed can be set to some value). - // If this is the case, return the appropriate value. - - - dwClrUsed = (lpDIB)->biClrUsed; - if (dwClrUsed) - return (WORD)dwClrUsed; - - // Calculate the number of colors in the color table based on - // the number of bits per pixel for the DIB. - - wBitCount = (lpDIB)->biBitCount; - - // return number of colors based on bits per pixel - - switch (wBitCount) - { - case 1: - return 2; - - case 4: - return 16; - - case 8: - return 256; - - default: - return 0; - } -} - -/* -* Helper functions -*/ -static int GdiWordToWeight(const char *str); -static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs); -/* -* ParseFontWords converts various keywords to modifyers of a -* font specification. -* For all words, later occurances override earlier occurances. -* Overstrike and underline cannot be "undone" by other words -*/ -static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs) -{ - int i; - int retval = 0; /* Number of words that could not be parsed */ - for (i=0; ilfWeight = wt; - else if ( strcmp(str[i], "roman") == 0 ) - lf->lfItalic = FALSE; - else if ( strcmp(str[i], "italic") == 0 ) - lf->lfItalic = TRUE; - else if ( strcmp(str[i], "underline") == 0 ) - lf->lfUnderline = TRUE; - else if ( strcmp(str[i], "overstrike") == 0 ) - lf->lfStrikeOut = TRUE; - else - retval++; - } - } - return retval; -} - -/* -* GdiWordToWeight converts keywords to font weights. -* This is used to help set the proper font for GDI rendering. -*/ -static int GdiWordToWeight(const char *str) -{ - int retval = -1; - int i; - static struct font_weight - { - const char *name; - int weight; - } font_weights[] = - { - { "thin", FW_THIN }, - { "extralight", FW_EXTRALIGHT }, - { "ultralight", FW_EXTRALIGHT }, - { "light", FW_LIGHT }, - { "normal", FW_NORMAL }, - { "regular", FW_NORMAL }, - { "medium", FW_MEDIUM }, - { "semibold", FW_SEMIBOLD }, - { "demibold", FW_SEMIBOLD }, - { "bold", FW_BOLD }, - { "extrabold", FW_EXTRABOLD }, - { "ultrabold", FW_EXTRABOLD }, - { "heavy", FW_HEAVY }, - { "black", FW_HEAVY }, - }; - - if ( str == 0 ) - return -1; - - for (i=0; ilfWeight = FW_NORMAL; - lf->lfCharSet = DEFAULT_CHARSET; - lf->lfOutPrecision = OUT_DEFAULT_PRECIS; - lf->lfClipPrecision = CLIP_DEFAULT_PRECIS; - lf->lfQuality = DEFAULT_QUALITY; - lf->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; - - /* The cast to (char *) is silly, based on prototype of Tcl_SplitList */ - if ( Tcl_SplitList(interp, (char *)str, &count, &list) != TCL_OK ) - return 0; - - /* Now we have the font structure broken into name, size, weight */ - if ( count >= 1 ) - strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); - else - return 0; - - if ( count >= 2 ) - { - int siz; - char *strend; - siz = strtol(list[1], &strend, 0); - - /* Assumptions: - * 1) Like canvas, if a positive number is specified, it's in points - * 2) Like canvas, if a negative number is specified, it's in pixels - */ - if ( strend > list[1] ) /* If it looks like a number, it is a number... */ - { - if ( siz > 0 ) /* Size is in points */ - { - SIZE wextent, vextent; - POINT worigin, vorigin; - double factor; - - switch ( GdiGetHdcInfo(hDC, &worigin, &wextent, &vorigin, &vextent) ) - { - case MM_ISOTROPIC: - if ( vextent.cy < -1 || vextent.cy > 1 ) - { - factor = (double)wextent.cy / vextent.cy; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else if ( vextent.cx < -1 || vextent.cx > 1 ) - { - factor = (double)wextent.cx / vextent.cx; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else - lf->lfHeight = -siz; /* This is bad news... */ - break; - case MM_ANISOTROPIC: - if ( vextent.cy != 0 ) - { - factor = (double)wextent.cy / vextent.cy; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else - lf->lfHeight = -siz; /* This is bad news... */ - break; - case MM_TEXT: - default: - /* If mapping mode is MM_TEXT, use the documented formula */ - lf->lfHeight = -MulDiv(siz, GetDeviceCaps(hDC, LOGPIXELSY), 72); - break; - case MM_HIENGLISH: - lf->lfHeight = -MulDiv(siz, 1000, 72); - break; - case MM_LOENGLISH: - lf->lfHeight = -MulDiv(siz, 100, 72); - break; - case MM_HIMETRIC: - lf->lfHeight = -MulDiv(siz, (int)(1000*2.54), 72); - break; - case MM_LOMETRIC: - lf->lfHeight = -MulDiv(siz, (int)(100*2.54), 72); - break; - case MM_TWIPS: - lf->lfHeight = -MulDiv(siz, 1440, 72); - break; - } - } - else if ( siz == 0 ) /* Use default size of 12 points */ - lf->lfHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72); - else /* Use pixel size */ - { - lf->lfHeight = siz; /* Leave this negative */ - } - } - else - GdiParseFontWords(interp, lf, list+1, count-1); - } - - if ( count >= 3 ) - GdiParseFontWords(interp, lf, list+2, count-2); - - Tcl_Free((char *)list); - return 1; -} - -/* -* This command creates a logical pen based on input -* parameters and selects it into the HDC -*/ -/* The LOGPEN structure takes the following dash options: - * PS_SOLID: a solid pen - * PS_DASH: a dashed pen - * PS_DOT: a dotted pen - * PS_DASHDOT: a pen with a dash followed by a dot - * PS_DASHDOTDOT: a pen with a dash followed by 2 dots - * - * It seems that converting to ExtCreatePen may be more advantageous, as it matches - * the Tk canvas pens much better--but not for Win95, which does not support PS_USERSTYLE - * An explicit test (or storage in a static after first failure) may suffice for working - * around this. The ExtCreatePen is not supported at all under Win32s. -*/ -static int GdiMakePen(Tcl_Interp *interp, int width, - int dashstyle, const char *dashstyledata, - int capstyle, /* Ignored for now */ - int joinstyle, /* Ignored for now */ - int stipplestyle, const char *stippledata, /* Ignored for now */ - unsigned long color, - HDC hDC, HGDIOBJ *oldPen) -{ - HPEN hPen; - LOGBRUSH lBrush; - DWORD pStyle = PS_SOLID; /* -dash should override*/ - DWORD endStyle = PS_ENDCAP_ROUND; /* -capstyle should override */ - DWORD joinStyle = PS_JOIN_ROUND; /* -joinstyle should override */ - DWORD styleCount = 0; - DWORD *styleArray = 0; - - /* To limit the propagation of allocated memory, the dashes will have a maximum here. - * If one wishes to remove the static allocation, please be sure to update GdiFreePen - * and ensure that the array is NOT freed if the LOGPEN option is used. - */ - static DWORD pStyleData[24]; - if ( dashstyle != 0 && dashstyledata != 0 ) - { - const char *cp; - int i; - char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); - if (dup) - strcpy(dup, dashstyledata); - /* DEBUG */ - Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", dashstyledata, "|\n", 0); - - /* Parse the dash spec */ - if ( isdigit(dashstyledata[0]) ) { - cp = strtok(dup, " \t,;"); - for ( i = 0; cp && i < sizeof(pStyleData) / sizeof (DWORD); i++ ) { - pStyleData[styleCount++] = atoi(cp); - cp = strtok(NULL, " \t,;"); - } - } else { - for (i=0; dashstyledata[i] != '\0' && i< sizeof(pStyleData) / sizeof(DWORD); i++ ) { - switch ( dashstyledata[i] ) { - case ' ': - pStyleData[styleCount++] = 8; - break; - case ',': - pStyleData[styleCount++] = 4; - break; - case '_': - pStyleData[styleCount++] = 6; - break; - case '-': - pStyleData[styleCount++] = 4; - break; - case '.': - pStyleData[styleCount++] = 2; - break; - default: - break; - } - } - } - if ( styleCount > 0 ) - styleArray = pStyleData; - else - dashstyle = 0; - if (dup) - Tcl_Free(dup); - } - - if ( dashstyle != 0 ) - pStyle = PS_USERSTYLE; - - /* -stipple could affect this... */ - lBrush.lbStyle = BS_SOLID; - lBrush.lbColor = color; - lBrush.lbHatch = 0; - - /* We only use geometric pens, even for 1-pixel drawing */ - hPen = ExtCreatePen ( PS_GEOMETRIC|pStyle|endStyle|joinStyle, - width, - &lBrush, - styleCount, - styleArray); - - if ( hPen == 0 ) { /* Failed for some reason...Fall back on CreatePenIndirect */ - LOGPEN lf; - lf.lopnWidth.x = width; - lf.lopnWidth.y = 0; /* Unused in LOGPEN */ - if ( dashstyle == 0 ) - lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future */ - else - lf.lopnStyle = PS_DASH; /* REALLLLY simple for now */ - lf.lopnColor = color; /* Assume we're getting a COLORREF */ - /* Now we have a logical pen. Create the "real" pen and put it in the hDC */ - hPen = CreatePenIndirect(&lf); - } - - *oldPen = SelectObject(hDC, hPen); - return 1; -} - -/* -* FreePen wraps the protocol to delete a created pen -*/ -static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen) -{ - HGDIOBJ gonePen; - gonePen = SelectObject (hDC, oldPen); - DeleteObject (gonePen); - return 1; -} - -/* -* MakeBrush creates a logical brush based on input parameters, -* creates it, and selects it into the hdc. -*/ -static int GdiMakeBrush (Tcl_Interp *interp, unsigned int style, unsigned long color, - long hatch, LOGBRUSH *lb, HDC hDC, HGDIOBJ *oldBrush) -{ - HBRUSH hBrush; - lb->lbStyle = BS_SOLID; /* Support other styles later */ - lb->lbColor = color; /* Assume this is a COLORREF */ - lb->lbHatch = hatch; /* Ignored for now, given BS_SOLID in the Style */ - /* Now we have the logical brush. Create the "real" brush and put it in the hDC */ - hBrush = CreateBrushIndirect(lb); - *oldBrush = SelectObject(hDC, hBrush); - return 1; -} - -/* -* FreeBrush wraps the protocol to delete a created brush -*/ -static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBrush) -{ - HGDIOBJ goneBrush; - goneBrush = SelectObject (hDC, oldBrush); - DeleteObject(goneBrush); - return 1; -} - -/* -* Copied functions from elsewhere in Tcl. -* Functions have removed reliance on X and Tk libraries, -* as well as removing the need for TkWindows. -* GdiGetColor is a copy of a TkpGetColor from tkWinColor.c -* GdiParseColor is a copy of XParseColor from xcolors.c -*/ -typedef struct { - char *name; - int index; -} SystemColorEntry; - - -static SystemColorEntry sysColors[] = { - "3dDarkShadow", COLOR_3DDKSHADOW, - "3dLight", COLOR_3DLIGHT, - "ActiveBorder", COLOR_ACTIVEBORDER, - "ActiveCaption", COLOR_ACTIVECAPTION, - "AppWorkspace", COLOR_APPWORKSPACE, - "Background", COLOR_BACKGROUND, - "ButtonFace", COLOR_BTNFACE, - "ButtonHighlight", COLOR_BTNHIGHLIGHT, - "ButtonShadow", COLOR_BTNSHADOW, - "ButtonText", COLOR_BTNTEXT, - "CaptionText", COLOR_CAPTIONTEXT, - "DisabledText", COLOR_GRAYTEXT, - "GrayText", COLOR_GRAYTEXT, - "Highlight", COLOR_HIGHLIGHT, - "HighlightText", COLOR_HIGHLIGHTTEXT, - "InactiveBorder", COLOR_INACTIVEBORDER, - "InactiveCaption", COLOR_INACTIVECAPTION, - "InactiveCaptionText", COLOR_INACTIVECAPTIONTEXT, - "InfoBackground", COLOR_INFOBK, - "InfoText", COLOR_INFOTEXT, - "Menu", COLOR_MENU, - "MenuText", COLOR_MENUTEXT, - "Scrollbar", COLOR_SCROLLBAR, - "Window", COLOR_WINDOW, - "WindowFrame", COLOR_WINDOWFRAME, - "WindowText", COLOR_WINDOWTEXT, -}; - -static int numsyscolors = 0; - -typedef struct { - char *name; - unsigned char red; - unsigned char green; - unsigned char blue; -} XColorEntry; - -static XColorEntry xColors[] = { - {"alice blue", 240, 248, 255}, - {"AliceBlue", 240, 248, 255}, - {"antique white", 250, 235, 215}, - {"AntiqueWhite", 250, 235, 215}, - {"AntiqueWhite1", 255, 239, 219}, - {"AntiqueWhite2", 238, 223, 204}, - {"AntiqueWhite3", 205, 192, 176}, - {"AntiqueWhite4", 139, 131, 120}, - {"aquamarine", 127, 255, 212}, - {"aquamarine1", 127, 255, 212}, - {"aquamarine2", 118, 238, 198}, - {"aquamarine3", 102, 205, 170}, - {"aquamarine4", 69, 139, 116}, - {"azure", 240, 255, 255}, - {"azure1", 240, 255, 255}, - {"azure2", 224, 238, 238}, - {"azure3", 193, 205, 205}, - {"azure4", 131, 139, 139}, - {"beige", 245, 245, 220}, - {"bisque", 255, 228, 196}, - {"bisque1", 255, 228, 196}, - {"bisque2", 238, 213, 183}, - {"bisque3", 205, 183, 158}, - {"bisque4", 139, 125, 107}, - {"black", 0, 0, 0}, - {"blanched almond", 255, 235, 205}, - {"BlanchedAlmond", 255, 235, 205}, - {"blue", 0, 0, 255}, - {"blue violet", 138, 43, 226}, - {"blue1", 0, 0, 255}, - {"blue2", 0, 0, 238}, - {"blue3", 0, 0, 205}, - {"blue4", 0, 0, 139}, - {"BlueViolet", 138, 43, 226}, - {"brown", 165, 42, 42}, - {"brown1", 255, 64, 64}, - {"brown2", 238, 59, 59}, - {"brown3", 205, 51, 51}, - {"brown4", 139, 35, 35}, - {"burlywood", 222, 184, 135}, - {"burlywood1", 255, 211, 155}, - {"burlywood2", 238, 197, 145}, - {"burlywood3", 205, 170, 125}, - {"burlywood4", 139, 115, 85}, - {"cadet blue", 95, 158, 160}, - {"CadetBlue", 95, 158, 160}, - {"CadetBlue1", 152, 245, 255}, - {"CadetBlue2", 142, 229, 238}, - {"CadetBlue3", 122, 197, 205}, - {"CadetBlue4", 83, 134, 139}, - {"chartreuse", 127, 255, 0}, - {"chartreuse1", 127, 255, 0}, - {"chartreuse2", 118, 238, 0}, - {"chartreuse3", 102, 205, 0}, - {"chartreuse4", 69, 139, 0}, - {"chocolate", 210, 105, 30}, - {"chocolate1", 255, 127, 36}, - {"chocolate2", 238, 118, 33}, - {"chocolate3", 205, 102, 29}, - {"chocolate4", 139, 69, 19}, - {"coral", 255, 127, 80}, - {"coral1", 255, 114, 86}, - {"coral2", 238, 106, 80}, - {"coral3", 205, 91, 69}, - {"coral4", 139, 62, 47}, - {"cornflower blue", 100, 149, 237}, - {"CornflowerBlue", 100, 149, 237}, - {"cornsilk", 255, 248, 220}, - {"cornsilk1", 255, 248, 220}, - {"cornsilk2", 238, 232, 205}, - {"cornsilk3", 205, 200, 177}, - {"cornsilk4", 139, 136, 120}, - {"cyan", 0, 255, 255}, - {"cyan1", 0, 255, 255}, - {"cyan2", 0, 238, 238}, - {"cyan3", 0, 205, 205}, - {"cyan4", 0, 139, 139}, - {"dark goldenrod", 184, 134, 11}, - {"dark green", 0, 100, 0}, - {"dark khaki", 189, 183, 107}, - {"dark olive green", 85, 107, 47}, - {"dark orange", 255, 140, 0}, - {"dark orchid", 153, 50, 204}, - {"dark salmon", 233, 150, 122}, - {"dark sea green", 143, 188, 143}, - {"dark slate blue", 72, 61, 139}, - {"dark slate gray", 47, 79, 79}, - {"dark slate grey", 47, 79, 79}, - {"dark turquoise", 0, 206, 209}, - {"dark violet", 148, 0, 211}, - {"DarkGoldenrod", 184, 134, 11}, - {"DarkGoldenrod1", 255, 185, 15}, - {"DarkGoldenrod2", 238, 173, 14}, - {"DarkGoldenrod3", 205, 149, 12}, - {"DarkGoldenrod4", 139, 101, 8}, - {"DarkGreen", 0, 100, 0}, - {"DarkKhaki", 189, 183, 107}, - {"DarkOliveGreen", 85, 107, 47}, - {"DarkOliveGreen1", 202, 255, 112}, - {"DarkOliveGreen2", 188, 238, 104}, - {"DarkOliveGreen3", 162, 205, 90}, - {"DarkOliveGreen4", 110, 139, 61}, - {"DarkOrange", 255, 140, 0}, - {"DarkOrange1", 255, 127, 0}, - {"DarkOrange2", 238, 118, 0}, - {"DarkOrange3", 205, 102, 0}, - {"DarkOrange4", 139, 69, 0}, - {"DarkOrchid", 153, 50, 204}, - {"DarkOrchid1", 191, 62, 255}, - {"DarkOrchid2", 178, 58, 238}, - {"DarkOrchid3", 154, 50, 205}, - {"DarkOrchid4", 104, 34, 139}, - {"DarkSalmon", 233, 150, 122}, - {"DarkSeaGreen", 143, 188, 143}, - {"DarkSeaGreen1", 193, 255, 193}, - {"DarkSeaGreen2", 180, 238, 180}, - {"DarkSeaGreen3", 155, 205, 155}, - {"DarkSeaGreen4", 105, 139, 105}, - {"DarkSlateBlue", 72, 61, 139}, - {"DarkSlateGray", 47, 79, 79}, - {"DarkSlateGray1", 151, 255, 255}, - {"DarkSlateGray2", 141, 238, 238}, - {"DarkSlateGray3", 121, 205, 205}, - {"DarkSlateGray4", 82, 139, 139}, - {"DarkSlateGrey", 47, 79, 79}, - {"DarkTurquoise", 0, 206, 209}, - {"DarkViolet", 148, 0, 211}, - {"deep pink", 255, 20, 147}, - {"deep sky blue", 0, 191, 255}, - {"DeepPink", 255, 20, 147}, - {"DeepPink1", 255, 20, 147}, - {"DeepPink2", 238, 18, 137}, - {"DeepPink3", 205, 16, 118}, - {"DeepPink4", 139, 10, 80}, - {"DeepSkyBlue", 0, 191, 255}, - {"DeepSkyBlue1", 0, 191, 255}, - {"DeepSkyBlue2", 0, 178, 238}, - {"DeepSkyBlue3", 0, 154, 205}, - {"DeepSkyBlue4", 0, 104, 139}, - {"dim gray", 105, 105, 105}, - {"dim grey", 105, 105, 105}, - {"DimGray", 105, 105, 105}, - {"DimGrey", 105, 105, 105}, - {"dodger blue", 30, 144, 255}, - {"DodgerBlue", 30, 144, 255}, - {"DodgerBlue1", 30, 144, 255}, - {"DodgerBlue2", 28, 134, 238}, - {"DodgerBlue3", 24, 116, 205}, - {"DodgerBlue4", 16, 78, 139}, - {"firebrick", 178, 34, 34}, - {"firebrick1", 255, 48, 48}, - {"firebrick2", 238, 44, 44}, - {"firebrick3", 205, 38, 38}, - {"firebrick4", 139, 26, 26}, - {"floral white", 255, 250, 240}, - {"FloralWhite", 255, 250, 240}, - {"forest green", 34, 139, 34}, - {"ForestGreen", 34, 139, 34}, - {"gainsboro", 220, 220, 220}, - {"ghost white", 248, 248, 255}, - {"GhostWhite", 248, 248, 255}, - {"gold", 255, 215, 0}, - {"gold1", 255, 215, 0}, - {"gold2", 238, 201, 0}, - {"gold3", 205, 173, 0}, - {"gold4", 139, 117, 0}, - {"goldenrod", 218, 165, 32}, - {"goldenrod1", 255, 193, 37}, - {"goldenrod2", 238, 180, 34}, - {"goldenrod3", 205, 155, 29}, - {"goldenrod4", 139, 105, 20}, - {"gray", 190, 190, 190}, - {"gray0", 0, 0, 0}, - {"gray1", 3, 3, 3}, - {"gray10", 26, 26, 26}, - {"gray100", 255, 255, 255}, - {"gray11", 28, 28, 28}, - {"gray12", 31, 31, 31}, - {"gray13", 33, 33, 33}, - {"gray14", 36, 36, 36}, - {"gray15", 38, 38, 38}, - {"gray16", 41, 41, 41}, - {"gray17", 43, 43, 43}, - {"gray18", 46, 46, 46}, - {"gray19", 48, 48, 48}, - {"gray2", 5, 5, 5}, - {"gray20", 51, 51, 51}, - {"gray21", 54, 54, 54}, - {"gray22", 56, 56, 56}, - {"gray23", 59, 59, 59}, - {"gray24", 61, 61, 61}, - {"gray25", 64, 64, 64}, - {"gray26", 66, 66, 66}, - {"gray27", 69, 69, 69}, - {"gray28", 71, 71, 71}, - {"gray29", 74, 74, 74}, - {"gray3", 8, 8, 8}, - {"gray30", 77, 77, 77}, - {"gray31", 79, 79, 79}, - {"gray32", 82, 82, 82}, - {"gray33", 84, 84, 84}, - {"gray34", 87, 87, 87}, - {"gray35", 89, 89, 89}, - {"gray36", 92, 92, 92}, - {"gray37", 94, 94, 94}, - {"gray38", 97, 97, 97}, - {"gray39", 99, 99, 99}, - {"gray4", 10, 10, 10}, - {"gray40", 102, 102, 102}, - {"gray41", 105, 105, 105}, - {"gray42", 107, 107, 107}, - {"gray43", 110, 110, 110}, - {"gray44", 112, 112, 112}, - {"gray45", 115, 115, 115}, - {"gray46", 117, 117, 117}, - {"gray47", 120, 120, 120}, - {"gray48", 122, 122, 122}, - {"gray49", 125, 125, 125}, - {"gray5", 13, 13, 13}, - {"gray50", 127, 127, 127}, - {"gray51", 130, 130, 130}, - {"gray52", 133, 133, 133}, - {"gray53", 135, 135, 135}, - {"gray54", 138, 138, 138}, - {"gray55", 140, 140, 140}, - {"gray56", 143, 143, 143}, - {"gray57", 145, 145, 145}, - {"gray58", 148, 148, 148}, - {"gray59", 150, 150, 150}, - {"gray6", 15, 15, 15}, - {"gray60", 153, 153, 153}, - {"gray61", 156, 156, 156}, - {"gray62", 158, 158, 158}, - {"gray63", 161, 161, 161}, - {"gray64", 163, 163, 163}, - {"gray65", 166, 166, 166}, - {"gray66", 168, 168, 168}, - {"gray67", 171, 171, 171}, - {"gray68", 173, 173, 173}, - {"gray69", 176, 176, 176}, - {"gray7", 18, 18, 18}, - {"gray70", 179, 179, 179}, - {"gray71", 181, 181, 181}, - {"gray72", 184, 184, 184}, - {"gray73", 186, 186, 186}, - {"gray74", 189, 189, 189}, - {"gray75", 191, 191, 191}, - {"gray76", 194, 194, 194}, - {"gray77", 196, 196, 196}, - {"gray78", 199, 199, 199}, - {"gray79", 201, 201, 201}, - {"gray8", 20, 20, 20}, - {"gray80", 204, 204, 204}, - {"gray81", 207, 207, 207}, - {"gray82", 209, 209, 209}, - {"gray83", 212, 212, 212}, - {"gray84", 214, 214, 214}, - {"gray85", 217, 217, 217}, - {"gray86", 219, 219, 219}, - {"gray87", 222, 222, 222}, - {"gray88", 224, 224, 224}, - {"gray89", 227, 227, 227}, - {"gray9", 23, 23, 23}, - {"gray90", 229, 229, 229}, - {"gray91", 232, 232, 232}, - {"gray92", 235, 235, 235}, - {"gray93", 237, 237, 237}, - {"gray94", 240, 240, 240}, - {"gray95", 242, 242, 242}, - {"gray96", 245, 245, 245}, - {"gray97", 247, 247, 247}, - {"gray98", 250, 250, 250}, - {"gray99", 252, 252, 252}, - {"green", 0, 255, 0}, - {"green yellow", 173, 255, 47}, - {"green1", 0, 255, 0}, - {"green2", 0, 238, 0}, - {"green3", 0, 205, 0}, - {"green4", 0, 139, 0}, - {"GreenYellow", 173, 255, 47}, - {"grey", 190, 190, 190}, - {"grey0", 0, 0, 0}, - {"grey1", 3, 3, 3}, - {"grey10", 26, 26, 26}, - {"grey100", 255, 255, 255}, - {"grey11", 28, 28, 28}, - {"grey12", 31, 31, 31}, - {"grey13", 33, 33, 33}, - {"grey14", 36, 36, 36}, - {"grey15", 38, 38, 38}, - {"grey16", 41, 41, 41}, - {"grey17", 43, 43, 43}, - {"grey18", 46, 46, 46}, - {"grey19", 48, 48, 48}, - {"grey2", 5, 5, 5}, - {"grey20", 51, 51, 51}, - {"grey21", 54, 54, 54}, - {"grey22", 56, 56, 56}, - {"grey23", 59, 59, 59}, - {"grey24", 61, 61, 61}, - {"grey25", 64, 64, 64}, - {"grey26", 66, 66, 66}, - {"grey27", 69, 69, 69}, - {"grey28", 71, 71, 71}, - {"grey29", 74, 74, 74}, - {"grey3", 8, 8, 8}, - {"grey30", 77, 77, 77}, - {"grey31", 79, 79, 79}, - {"grey32", 82, 82, 82}, - {"grey33", 84, 84, 84}, - {"grey34", 87, 87, 87}, - {"grey35", 89, 89, 89}, - {"grey36", 92, 92, 92}, - {"grey37", 94, 94, 94}, - {"grey38", 97, 97, 97}, - {"grey39", 99, 99, 99}, - {"grey4", 10, 10, 10}, - {"grey40", 102, 102, 102}, - {"grey41", 105, 105, 105}, - {"grey42", 107, 107, 107}, - {"grey43", 110, 110, 110}, - {"grey44", 112, 112, 112}, - {"grey45", 115, 115, 115}, - {"grey46", 117, 117, 117}, - {"grey47", 120, 120, 120}, - {"grey48", 122, 122, 122}, - {"grey49", 125, 125, 125}, - {"grey5", 13, 13, 13}, - {"grey50", 127, 127, 127}, - {"grey51", 130, 130, 130}, - {"grey52", 133, 133, 133}, - {"grey53", 135, 135, 135}, - {"grey54", 138, 138, 138}, - {"grey55", 140, 140, 140}, - {"grey56", 143, 143, 143}, - {"grey57", 145, 145, 145}, - {"grey58", 148, 148, 148}, - {"grey59", 150, 150, 150}, - {"grey6", 15, 15, 15}, - {"grey60", 153, 153, 153}, - {"grey61", 156, 156, 156}, - {"grey62", 158, 158, 158}, - {"grey63", 161, 161, 161}, - {"grey64", 163, 163, 163}, - {"grey65", 166, 166, 166}, - {"grey66", 168, 168, 168}, - {"grey67", 171, 171, 171}, - {"grey68", 173, 173, 173}, - {"grey69", 176, 176, 176}, - {"grey7", 18, 18, 18}, - {"grey70", 179, 179, 179}, - {"grey71", 181, 181, 181}, - {"grey72", 184, 184, 184}, - {"grey73", 186, 186, 186}, - {"grey74", 189, 189, 189}, - {"grey75", 191, 191, 191}, - {"grey76", 194, 194, 194}, - {"grey77", 196, 196, 196}, - {"grey78", 199, 199, 199}, - {"grey79", 201, 201, 201}, - {"grey8", 20, 20, 20}, - {"grey80", 204, 204, 204}, - {"grey81", 207, 207, 207}, - {"grey82", 209, 209, 209}, - {"grey83", 212, 212, 212}, - {"grey84", 214, 214, 214}, - {"grey85", 217, 217, 217}, - {"grey86", 219, 219, 219}, - {"grey87", 222, 222, 222}, - {"grey88", 224, 224, 224}, - {"grey89", 227, 227, 227}, - {"grey9", 23, 23, 23}, - {"grey90", 229, 229, 229}, - {"grey91", 232, 232, 232}, - {"grey92", 235, 235, 235}, - {"grey93", 237, 237, 237}, - {"grey94", 240, 240, 240}, - {"grey95", 242, 242, 242}, - {"grey96", 245, 245, 245}, - {"grey97", 247, 247, 247}, - {"grey98", 250, 250, 250}, - {"grey99", 252, 252, 252}, - {"honeydew", 240, 255, 240}, - {"honeydew1", 240, 255, 240}, - {"honeydew2", 224, 238, 224}, - {"honeydew3", 193, 205, 193}, - {"honeydew4", 131, 139, 131}, - {"hot pink", 255, 105, 180}, - {"HotPink", 255, 105, 180}, - {"HotPink1", 255, 110, 180}, - {"HotPink2", 238, 106, 167}, - {"HotPink3", 205, 96, 144}, - {"HotPink4", 139, 58, 98}, - {"indian red", 205, 92, 92}, - {"IndianRed", 205, 92, 92}, - {"IndianRed1", 255, 106, 106}, - {"IndianRed2", 238, 99, 99}, - {"IndianRed3", 205, 85, 85}, - {"IndianRed4", 139, 58, 58}, - {"ivory", 255, 255, 240}, - {"ivory1", 255, 255, 240}, - {"ivory2", 238, 238, 224}, - {"ivory3", 205, 205, 193}, - {"ivory4", 139, 139, 131}, - {"khaki", 240, 230, 140}, - {"khaki1", 255, 246, 143}, - {"khaki2", 238, 230, 133}, - {"khaki3", 205, 198, 115}, - {"khaki4", 139, 134, 78}, - {"lavender", 230, 230, 250}, - {"lavender blush", 255, 240, 245}, - {"LavenderBlush", 255, 240, 245}, - {"LavenderBlush1", 255, 240, 245}, - {"LavenderBlush2", 238, 224, 229}, - {"LavenderBlush3", 205, 193, 197}, - {"LavenderBlush4", 139, 131, 134}, - {"lawn green", 124, 252, 0}, - {"LawnGreen", 124, 252, 0}, - {"lemon chiffon", 255, 250, 205}, - {"LemonChiffon", 255, 250, 205}, - {"LemonChiffon1", 255, 250, 205}, - {"LemonChiffon2", 238, 233, 191}, - {"LemonChiffon3", 205, 201, 165}, - {"LemonChiffon4", 139, 137, 112}, - {"light blue", 173, 216, 230}, - {"light coral", 240, 128, 128}, - {"light cyan", 224, 255, 255}, - {"light goldenrod", 238, 221, 130}, - {"light goldenrod yellow", 250, 250, 210}, - {"light gray", 211, 211, 211}, - {"light grey", 211, 211, 211}, - {"light pink", 255, 182, 193}, - {"light salmon", 255, 160, 122}, - {"light sea green", 32, 178, 170}, - {"light sky blue", 135, 206, 250}, - {"light slate blue", 132, 112, 255}, - {"light slate gray", 119, 136, 153}, - {"light slate grey", 119, 136, 153}, - {"light steel blue", 176, 196, 222}, - {"light yellow", 255, 255, 224}, - {"LightBlue", 173, 216, 230}, - {"LightBlue1", 191, 239, 255}, - {"LightBlue2", 178, 223, 238}, - {"LightBlue3", 154, 192, 205}, - {"LightBlue4", 104, 131, 139}, - {"LightCoral", 240, 128, 128}, - {"LightCyan", 224, 255, 255}, - {"LightCyan1", 224, 255, 255}, - {"LightCyan2", 209, 238, 238}, - {"LightCyan3", 180, 205, 205}, - {"LightCyan4", 122, 139, 139}, - {"LightGoldenrod", 238, 221, 130}, - {"LightGoldenrod1", 255, 236, 139}, - {"LightGoldenrod2", 238, 220, 130}, - {"LightGoldenrod3", 205, 190, 112}, - {"LightGoldenrod4", 139, 129, 76}, - {"LightGoldenrodYellow", 250, 250, 210}, - {"LightGray", 211, 211, 211}, - {"LightGrey", 211, 211, 211}, - {"LightPink", 255, 182, 193}, - {"LightPink1", 255, 174, 185}, - {"LightPink2", 238, 162, 173}, - {"LightPink3", 205, 140, 149}, - {"LightPink4", 139, 95, 101}, - {"LightSalmon", 255, 160, 122}, - {"LightSalmon1", 255, 160, 122}, - {"LightSalmon2", 238, 149, 114}, - {"LightSalmon3", 205, 129, 98}, - {"LightSalmon4", 139, 87, 66}, - {"LightSeaGreen", 32, 178, 170}, - {"LightSkyBlue", 135, 206, 250}, - {"LightSkyBlue1", 176, 226, 255}, - {"LightSkyBlue2", 164, 211, 238}, - {"LightSkyBlue3", 141, 182, 205}, - {"LightSkyBlue4", 96, 123, 139}, - {"LightSlateBlue", 132, 112, 255}, - {"LightSlateGray", 119, 136, 153}, - {"LightSlateGrey", 119, 136, 153}, - {"LightSteelBlue", 176, 196, 222}, - {"LightSteelBlue1", 202, 225, 255}, - {"LightSteelBlue2", 188, 210, 238}, - {"LightSteelBlue3", 162, 181, 205}, - {"LightSteelBlue4", 110, 123, 139}, - {"LightYellow", 255, 255, 224}, - {"LightYellow1", 255, 255, 224}, - {"LightYellow2", 238, 238, 209}, - {"LightYellow3", 205, 205, 180}, - {"LightYellow4", 139, 139, 122}, - {"lime green", 50, 205, 50}, - {"LimeGreen", 50, 205, 50}, - {"linen", 250, 240, 230}, - {"magenta", 255, 0, 255}, - {"magenta1", 255, 0, 255}, - {"magenta2", 238, 0, 238}, - {"magenta3", 205, 0, 205}, - {"magenta4", 139, 0, 139}, - {"maroon", 176, 48, 96}, - {"maroon1", 255, 52, 179}, - {"maroon2", 238, 48, 167}, - {"maroon3", 205, 41, 144}, - {"maroon4", 139, 28, 98}, - {"medium aquamarine", 102, 205, 170}, - {"medium blue", 0, 0, 205}, - {"medium orchid", 186, 85, 211}, - {"medium purple", 147, 112, 219}, - {"medium sea green", 60, 179, 113}, - {"medium slate blue", 123, 104, 238}, - {"medium spring green", 0, 250, 154}, - {"medium turquoise", 72, 209, 204}, - {"medium violet red", 199, 21, 133}, - {"MediumAquamarine", 102, 205, 170}, - {"MediumBlue", 0, 0, 205}, - {"MediumOrchid", 186, 85, 211}, - {"MediumOrchid1", 224, 102, 255}, - {"MediumOrchid2", 209, 95, 238}, - {"MediumOrchid3", 180, 82, 205}, - {"MediumOrchid4", 122, 55, 139}, - {"MediumPurple", 147, 112, 219}, - {"MediumPurple1", 171, 130, 255}, - {"MediumPurple2", 159, 121, 238}, - {"MediumPurple3", 137, 104, 205}, - {"MediumPurple4", 93, 71, 139}, - {"MediumSeaGreen", 60, 179, 113}, - {"MediumSlateBlue", 123, 104, 238}, - {"MediumSpringGreen", 0, 250, 154}, - {"MediumTurquoise", 72, 209, 204}, - {"MediumVioletRed", 199, 21, 133}, - {"midnight blue", 25, 25, 112}, - {"MidnightBlue", 25, 25, 112}, - {"mint cream", 245, 255, 250}, - {"MintCream", 245, 255, 250}, - {"misty rose", 255, 228, 225}, - {"MistyRose", 255, 228, 225}, - {"MistyRose1", 255, 228, 225}, - {"MistyRose2", 238, 213, 210}, - {"MistyRose3", 205, 183, 181}, - {"MistyRose4", 139, 125, 123}, - {"moccasin", 255, 228, 181}, - {"navajo white", 255, 222, 173}, - {"NavajoWhite", 255, 222, 173}, - {"NavajoWhite1", 255, 222, 173}, - {"NavajoWhite2", 238, 207, 161}, - {"NavajoWhite3", 205, 179, 139}, - {"NavajoWhite4", 139, 121, 94}, - {"navy", 0, 0, 128}, - {"navy blue", 0, 0, 128}, - {"NavyBlue", 0, 0, 128}, - {"old lace", 253, 245, 230}, - {"OldLace", 253, 245, 230}, - {"olive drab", 107, 142, 35}, - {"OliveDrab", 107, 142, 35}, - {"OliveDrab1", 192, 255, 62}, - {"OliveDrab2", 179, 238, 58}, - {"OliveDrab3", 154, 205, 50}, - {"OliveDrab4", 105, 139, 34}, - {"orange", 255, 165, 0}, - {"orange red", 255, 69, 0}, - {"orange1", 255, 165, 0}, - {"orange2", 238, 154, 0}, - {"orange3", 205, 133, 0}, - {"orange4", 139, 90, 0}, - {"OrangeRed", 255, 69, 0}, - {"OrangeRed1", 255, 69, 0}, - {"OrangeRed2", 238, 64, 0}, - {"OrangeRed3", 205, 55, 0}, - {"OrangeRed4", 139, 37, 0}, - {"orchid", 218, 112, 214}, - {"orchid1", 255, 131, 250}, - {"orchid2", 238, 122, 233}, - {"orchid3", 205, 105, 201}, - {"orchid4", 139, 71, 137}, - {"pale goldenrod", 238, 232, 170}, - {"pale green", 152, 251, 152}, - {"pale turquoise", 175, 238, 238}, - {"pale violet red", 219, 112, 147}, - {"PaleGoldenrod", 238, 232, 170}, - {"PaleGreen", 152, 251, 152}, - {"PaleGreen1", 154, 255, 154}, - {"PaleGreen2", 144, 238, 144}, - {"PaleGreen3", 124, 205, 124}, - {"PaleGreen4", 84, 139, 84}, - {"PaleTurquoise", 175, 238, 238}, - {"PaleTurquoise1", 187, 255, 255}, - {"PaleTurquoise2", 174, 238, 238}, - {"PaleTurquoise3", 150, 205, 205}, - {"PaleTurquoise4", 102, 139, 139}, - {"PaleVioletRed", 219, 112, 147}, - {"PaleVioletRed1", 255, 130, 171}, - {"PaleVioletRed2", 238, 121, 159}, - {"PaleVioletRed3", 205, 104, 137}, - {"PaleVioletRed4", 139, 71, 93}, - {"papaya whip", 255, 239, 213}, - {"PapayaWhip", 255, 239, 213}, - {"peach puff", 255, 218, 185}, - {"PeachPuff", 255, 218, 185}, - {"PeachPuff1", 255, 218, 185}, - {"PeachPuff2", 238, 203, 173}, - {"PeachPuff3", 205, 175, 149}, - {"PeachPuff4", 139, 119, 101}, - {"peru", 205, 133, 63}, - {"pink", 255, 192, 203}, - {"pink1", 255, 181, 197}, - {"pink2", 238, 169, 184}, - {"pink3", 205, 145, 158}, - {"pink4", 139, 99, 108}, - {"plum", 221, 160, 221}, - {"plum1", 255, 187, 255}, - {"plum2", 238, 174, 238}, - {"plum3", 205, 150, 205}, - {"plum4", 139, 102, 139}, - {"powder blue", 176, 224, 230}, - {"PowderBlue", 176, 224, 230}, - {"purple", 160, 32, 240}, - {"purple1", 155, 48, 255}, - {"purple2", 145, 44, 238}, - {"purple3", 125, 38, 205}, - {"purple4", 85, 26, 139}, - {"red", 255, 0, 0}, - {"red1", 255, 0, 0}, - {"red2", 238, 0, 0}, - {"red3", 205, 0, 0}, - {"red4", 139, 0, 0}, - {"rosy brown", 188, 143, 143}, - {"RosyBrown", 188, 143, 143}, - {"RosyBrown1", 255, 193, 193}, - {"RosyBrown2", 238, 180, 180}, - {"RosyBrown3", 205, 155, 155}, - {"RosyBrown4", 139, 105, 105}, - {"royal blue", 65, 105, 225}, - {"RoyalBlue", 65, 105, 225}, - {"RoyalBlue1", 72, 118, 255}, - {"RoyalBlue2", 67, 110, 238}, - {"RoyalBlue3", 58, 95, 205}, - {"RoyalBlue4", 39, 64, 139}, - {"saddle brown", 139, 69, 19}, - {"SaddleBrown", 139, 69, 19}, - {"salmon", 250, 128, 114}, - {"salmon1", 255, 140, 105}, - {"salmon2", 238, 130, 98}, - {"salmon3", 205, 112, 84}, - {"salmon4", 139, 76, 57}, - {"sandy brown", 244, 164, 96}, - {"SandyBrown", 244, 164, 96}, - {"sea green", 46, 139, 87}, - {"SeaGreen", 46, 139, 87}, - {"SeaGreen1", 84, 255, 159}, - {"SeaGreen2", 78, 238, 148}, - {"SeaGreen3", 67, 205, 128}, - {"SeaGreen4", 46, 139, 87}, - {"seashell", 255, 245, 238}, - {"seashell1", 255, 245, 238}, - {"seashell2", 238, 229, 222}, - {"seashell3", 205, 197, 191}, - {"seashell4", 139, 134, 130}, - {"sienna", 160, 82, 45}, - {"sienna1", 255, 130, 71}, - {"sienna2", 238, 121, 66}, - {"sienna3", 205, 104, 57}, - {"sienna4", 139, 71, 38}, - {"sky blue", 135, 206, 235}, - {"SkyBlue", 135, 206, 235}, - {"SkyBlue1", 135, 206, 255}, - {"SkyBlue2", 126, 192, 238}, - {"SkyBlue3", 108, 166, 205}, - {"SkyBlue4", 74, 112, 139}, - {"slate blue", 106, 90, 205}, - {"slate gray", 112, 128, 144}, - {"slate grey", 112, 128, 144}, - {"SlateBlue", 106, 90, 205}, - {"SlateBlue1", 131, 111, 255}, - {"SlateBlue2", 122, 103, 238}, - {"SlateBlue3", 105, 89, 205}, - {"SlateBlue4", 71, 60, 139}, - {"SlateGray", 112, 128, 144}, - {"SlateGray1", 198, 226, 255}, - {"SlateGray2", 185, 211, 238}, - {"SlateGray3", 159, 182, 205}, - {"SlateGray4", 108, 123, 139}, - {"SlateGrey", 112, 128, 144}, - {"snow", 255, 250, 250}, - {"snow1", 255, 250, 250}, - {"snow2", 238, 233, 233}, - {"snow3", 205, 201, 201}, - {"snow4", 139, 137, 137}, - {"spring green", 0, 255, 127}, - {"SpringGreen", 0, 255, 127}, - {"SpringGreen1", 0, 255, 127}, - {"SpringGreen2", 0, 238, 118}, - {"SpringGreen3", 0, 205, 102}, - {"SpringGreen4", 0, 139, 69}, - {"steel blue", 70, 130, 180}, - {"SteelBlue", 70, 130, 180}, - {"SteelBlue1", 99, 184, 255}, - {"SteelBlue2", 92, 172, 238}, - {"SteelBlue3", 79, 148, 205}, - {"SteelBlue4", 54, 100, 139}, - {"tan", 210, 180, 140}, - {"tan1", 255, 165, 79}, - {"tan2", 238, 154, 73}, - {"tan3", 205, 133, 63}, - {"tan4", 139, 90, 43}, - {"thistle", 216, 191, 216}, - {"thistle1", 255, 225, 255}, - {"thistle2", 238, 210, 238}, - {"thistle3", 205, 181, 205}, - {"thistle4", 139, 123, 139}, - {"tomato", 255, 99, 71}, - {"tomato1", 255, 99, 71}, - {"tomato2", 238, 92, 66}, - {"tomato3", 205, 79, 57}, - {"tomato4", 139, 54, 38}, - {"turquoise", 64, 224, 208}, - {"turquoise1", 0, 245, 255}, - {"turquoise2", 0, 229, 238}, - {"turquoise3", 0, 197, 205}, - {"turquoise4", 0, 134, 139}, - {"violet", 238, 130, 238}, - {"violet red", 208, 32, 144}, - {"VioletRed", 208, 32, 144}, - {"VioletRed1", 255, 62, 150}, - {"VioletRed2", 238, 58, 140}, - {"VioletRed3", 205, 50, 120}, - {"VioletRed4", 139, 34, 82}, - {"wheat", 245, 222, 179}, - {"wheat1", 255, 231, 186}, - {"wheat2", 238, 216, 174}, - {"wheat3", 205, 186, 150}, - {"wheat4", 139, 126, 102}, - {"white", 255, 255, 255}, - {"white smoke", 245, 245, 245}, - {"WhiteSmoke", 245, 245, 245}, - {"yellow", 255, 255, 0}, - {"yellow green", 154, 205, 50}, - {"yellow1", 255, 255, 0}, - {"yellow2", 238, 238, 0}, - {"yellow3", 205, 205, 0}, - {"yellow4", 139, 139, 0}, - {"YellowGreen", 154, 205, 50}, -}; - -static int numxcolors=0; - -/* -* Convert color name to color specification -*/ -static int GdiGetColor(const char *name, unsigned long *color) -{ - if ( numsyscolors == 0 ) - numsyscolors = sizeof ( sysColors ) / sizeof (SystemColorEntry); - if ( strncmpi(name, "system", 6) == 0 ) - { - int i, l, u, r; - l = 0; - u = numsyscolors; - while ( l <= u ) - { - i = (l + u) / 2; - if ( (r = strcmpi(name+6, sysColors[i].name)) == 0 ) - break; - if ( r < 0 ) - u = i - 1; - else - l = i + 1; - } - if ( l > u ) - return 0; - *color = GetSysColor(sysColors[i].index); - return 1; - } - else - return GdiParseColor(name, color); -} - -/* -* Convert color specification string (which could be an RGB string) -* to a color RGB triple -*/ -static int GdiParseColor (const char *name, unsigned long *color) -{ - if ( name[0] == '#' ) - { - char fmt[16]; - int i; - unsigned red, green, blue; - - if ( (i = strlen(name+1))%3 != 0 || i > 12 || i < 3) - return 0; - i /= 3; - sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i); - if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { - return 0; - } - /* Now this is windows specific -- each component is at most 8 bits */ - switch ( i ) - { - case 1: - red <<= 4; - green <<= 4; - blue <<= 4; - break; - case 2: - break; - case 3: - red >>= 4; - green >>= 4; - blue >>= 4; - break; - case 4: - red >>= 8; - green >>= 8; - blue >>= 8; - break; - } - *color = RGB(red, green, blue); - return 1; - } - else - { - int i, u, r, l; - if ( numxcolors == 0 ) - numxcolors = sizeof(xColors) / sizeof(XColorEntry); - l = 0; - u = numxcolors; - - while ( l <= u) - { - i = (l + u) / 2; - if ( (r = strcmpi(name, xColors[i].name)) == 0 ) - break; - if ( r < 0 ) - u = i-1; - else - l = i+1; - } - if ( l > u ) - return 0; - *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); - return 1; - } -} - -/* -* Beginning of functions for screen-to-dib translations -* Several of these functions are based on those in the WINCAP32 -* program provided as a sample by Microsoft on the VC++ 5.0 -* disk. The copyright on these functions is retained, even for -* those with significant changes. -* I do not understand the meaning of this copyright in this -* context, since the example is present to provide insight into -* the rather baroque mechanism used to manipulate DIBs. -*/ - -static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) -{ - HANDLE hDIB; - HBITMAP hBitmap; - HPALETTE hPalette; - - /* check for a valid window handle */ - - if (!hWnd) - return NULL; - - switch (type) - { - case PTWindow: /* copy entire window */ - { - RECT rectWnd; - - /* get the window rectangle */ - - GetWindowRect(hWnd, &rectWnd); - - /* get the DIB of the window by calling - * CopyScreenToDIB and passing it the window rect - */ - - hDIB = CopyScreenToDIB(&rectWnd); - break; - } - - case PTClient: /* copy client area */ - { - RECT rectClient; - POINT pt1, pt2; - - /* get the client area dimensions */ - - GetClientRect(hWnd, &rectClient); - - /* convert client coords to screen coords */ - - pt1.x = rectClient.left; - pt1.y = rectClient.top; - pt2.x = rectClient.right; - pt2.y = rectClient.bottom; - ClientToScreen(hWnd, &pt1); - ClientToScreen(hWnd, &pt2); - rectClient.left = pt1.x; - rectClient.top = pt1.y; - rectClient.right = pt2.x; - rectClient.bottom = pt2.y; - - /* get the DIB of the client area by calling - * CopyScreenToDIB and passing it the client rect - */ - - hDIB = CopyScreenToDIB(&rectClient); - break; - } - - case PTScreen: /* Entire screen */ - { - RECT Rect; - - /* get the device-dependent bitmap in lpRect by calling - * CopyScreenToBitmap and passing it the rectangle to grab - */ - Rect.top = Rect.left = 0; - GetDisplaySize(&Rect.right, &Rect.bottom); - - hBitmap = CopyScreenToBitmap(&Rect); - - /* check for a valid bitmap handle */ - - if (!hBitmap) - return NULL; - - /* get the current palette */ - - hPalette = GetSystemPalette(); - - /* convert the bitmap to a DIB */ - - hDIB = BitmapToDIB(hBitmap, hPalette); - - /* clean up */ - - DeleteObject(hPalette); - DeleteObject(hBitmap); - - /* return handle to the packed-DIB */ - } - break; - default: /* invalid print area */ - return NULL; - } - - /* return the handle to the DIB */ - return hDIB; -} - -/* -* GetDisplaySize does just that. -* There may be an easier way, but I just haven't found it. -*/ -static void GetDisplaySize (LONG *width, LONG *height) -{ - HDC hDC; - - hDC = CreateDC("DISPLAY", 0, 0, 0); - *width = GetDeviceCaps (hDC, HORZRES); - *height = GetDeviceCaps (hDC, VERTRES); - DeleteDC(hDC); -} - - -static HBITMAP CopyScreenToBitmap(LPRECT lpRect) -{ - HDC hScrDC, hMemDC; /* screen DC and memory DC */ - HBITMAP hBitmap, hOldBitmap; /* handles to deice-dependent bitmaps */ - int nX, nY, nX2, nY2; /* coordinates of rectangle to grab */ - int nWidth, nHeight; /* DIB width and height */ - int xScrn, yScrn; /* screen resolution */ - - /* check for an empty rectangle */ - - if (IsRectEmpty(lpRect)) - return NULL; - - /* create a DC for the screen and create - * a memory DC compatible to screen DC - */ - - hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL); - hMemDC = CreateCompatibleDC(hScrDC); - - /* get points of rectangle to grab */ - - nX = lpRect->left; - nY = lpRect->top; - nX2 = lpRect->right; - nY2 = lpRect->bottom; - - /* get screen resolution */ - - xScrn = GetDeviceCaps(hScrDC, HORZRES); - yScrn = GetDeviceCaps(hScrDC, VERTRES); - - /* make sure bitmap rectangle is visible */ - - if (nX < 0) - nX = 0; - if (nY < 0) - nY = 0; - if (nX2 > xScrn) - nX2 = xScrn; - if (nY2 > yScrn) - nY2 = yScrn; - - nWidth = nX2 - nX; - nHeight = nY2 - nY; - - /* create a bitmap compatible with the screen DC */ - hBitmap = CreateCompatibleBitmap(hScrDC, nWidth, nHeight); - - /* select new bitmap into memory DC */ - hOldBitmap = SelectObject(hMemDC, hBitmap); - - /* bitblt screen DC to memory DC */ - BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY); - - /* select old bitmap back into memory DC and get handle to - * bitmap of the screen - */ - - hBitmap = SelectObject(hMemDC, hOldBitmap); - - /* clean up */ - - DeleteDC(hScrDC); - DeleteDC(hMemDC); - - /* return handle to the bitmap */ - - return hBitmap; -} - - -static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) -{ - BITMAP bm; - BITMAPINFOHEADER bi; - LPBITMAPINFOHEADER lpbi; - DWORD dwLen; - HANDLE hDIB; - HANDLE h; - HDC hDC; - WORD biBits; - - /* check if bitmap handle is valid */ - - if (!hBitmap) - return NULL; - - /* fill in BITMAP structure, return NULL if it didn't work */ - - if (!GetObject(hBitmap, sizeof(bm), (LPSTR)&bm)) - return NULL; - - /* if no palette is specified, use default palette */ - - if (hPal == NULL) - hPal = GetStockObject(DEFAULT_PALETTE); - - /* calculate bits per pixel */ - - biBits = bm.bmPlanes * bm.bmBitsPixel; - - /* make sure bits per pixel is valid */ - - if (biBits <= 1) - biBits = 1; - else if (biBits <= 4) - biBits = 4; - else if (biBits <= 8) - biBits = 8; - else /* if greater than 8-bit, force to 24-bit */ - biBits = 24; - - /* initialize BITMAPINFOHEADER */ - - bi.biSize = sizeof(BITMAPINFOHEADER); - bi.biWidth = bm.bmWidth; - bi.biHeight = bm.bmHeight; - bi.biPlanes = 1; - bi.biBitCount = biBits; - bi.biCompression = BI_RGB; - bi.biSizeImage = 0; - bi.biXPelsPerMeter = 0; - bi.biYPelsPerMeter = 0; - bi.biClrUsed = 0; - bi.biClrImportant = 0; - - /* calculate size of memory block required to store BITMAPINFO */ - - dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD); - - /* get a DC */ - - hDC = GetDC(NULL); - - /* select and realize our palette */ - - hPal = SelectPalette(hDC, hPal, FALSE); - RealizePalette(hDC); - - /* alloc memory block to store our bitmap */ - - hDIB = GlobalAlloc(GHND, dwLen); - - /* if we couldn't get memory block */ - - if (!hDIB) - { - /* clean up and return NULL */ - - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } - - /* lock memory and get pointer to it */ - - lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDIB); - - /* use our bitmap info. to fill BITMAPINFOHEADER */ - - *lpbi = bi; - - /* call GetDIBits with a NULL lpBits param, so it will calculate the - * biSizeImage field for us - */ - - GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, NULL, (LPBITMAPINFO)lpbi, - DIB_RGB_COLORS); - - /* get the info. returned by GetDIBits and unlock memory block */ - - bi = *lpbi; - GlobalUnlock(hDIB); - - /* if the driver did not fill in the biSizeImage field, make one up */ - if (bi.biSizeImage == 0) - bi.biSizeImage = (((((DWORD)bm.bmWidth * biBits) + 31) / 32) * 4) * bm.bmHeight; - - /* realloc the buffer big enough to hold all the bits */ - - dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD) + bi.biSizeImage; - - if ((h = GlobalReAlloc(hDIB, dwLen, 0)) != 0) - hDIB = h; - else - { - /* clean up and return NULL */ - - GlobalFree(hDIB); - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } - - /* lock memory block and get pointer to it */ - - lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDIB); - - /* call GetDIBits with a NON-NULL lpBits param, and actualy get the - * bits this time - */ - - if (GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, (LPSTR)lpbi + - (WORD)lpbi->biSize + DIBNumColors(lpbi) * sizeof(RGBQUAD), (LPBITMAPINFO)lpbi, - DIB_RGB_COLORS) == 0) - { - /* clean up and return NULL */ - - GlobalUnlock(hDIB); - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } - - bi = *lpbi; - - /* clean up */ - GlobalUnlock(hDIB); - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - - /* return handle to the DIB */ - return hDIB; -} - - -static HANDLE CopyScreenToDIB(LPRECT lpRect) -{ - HBITMAP hBitmap; - HPALETTE hPalette; - HANDLE hDIB; - - /* get the device-dependent bitmap in lpRect by calling - * CopyScreenToBitmap and passing it the rectangle to grab - */ - - hBitmap = CopyScreenToBitmap(lpRect); - - /* check for a valid bitmap handle */ - - if (!hBitmap) - return NULL; - - /* get the current palette */ - - hPalette = GetSystemPalette(); - - /* convert the bitmap to a DIB */ - - hDIB = BitmapToDIB(hBitmap, hPalette); - - /* clean up */ - - DeleteObject(hPalette); - DeleteObject(hBitmap); - - /* return handle to the packed-DIB */ - return hDIB; -} - - -static HPALETTE GetSystemPalette(void) -{ - HDC hDC; // handle to a DC - static HPALETTE hPal = NULL; // handle to a palette - HANDLE hLogPal; // handle to a logical palette - LPLOGPALETTE lpLogPal; // pointer to a logical palette - int nColors; // number of colors - - // Find out how many palette entries we want. - - hDC = GetDC(NULL); - - if (!hDC) - return NULL; - - nColors = PalEntriesOnDevice(hDC); // Number of palette entries - - // Allocate room for the palette and lock it. - - hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + nColors * - sizeof(PALETTEENTRY)); - - // if we didn't get a logical palette, return NULL - - if (!hLogPal) - return NULL; - - // get a pointer to the logical palette - - lpLogPal = (LPLOGPALETTE)GlobalLock(hLogPal); - - // set some important fields - - lpLogPal->palVersion = 0x300; - lpLogPal->palNumEntries = nColors; - - // Copy the current system palette into our logical palette - - GetSystemPaletteEntries(hDC, 0, nColors, - (LPPALETTEENTRY)(lpLogPal->palPalEntry)); - - // Go ahead and create the palette. Once it's created, - // we no longer need the LOGPALETTE, so free it. - - hPal = CreatePalette(lpLogPal); - - // clean up - - GlobalUnlock(hLogPal); - GlobalFree(hLogPal); - ReleaseDC(NULL, hDC); - - return hPal; -} - - -static int PalEntriesOnDevice(HDC hDC) -{ - return (1 << (GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES))); -} - - -/* -* This is the version information/command -* The static data should also be used by pkg_provide, etc. -*/ -/* Version information */ -static char version_string[] = "0.9.9.15"; - -/* Version command */ -static int Version(ClientData unused, Tcl_Interp *interp, int argc, const char *argv) -{ - Tcl_SetResult(interp, version_string, TCL_STATIC); - return TCL_OK; -} - -/* -* Initialization procedures -* These are the only public procedures in the file. -* These are OS independent -*/ -/* Initialization Procedures */ -EXPORT(int,Gdi_Init) (Tcl_Interp *interp) -{ - -#if TCL_MAJOR_VERSION <= 7 - Tcl_CreateCommand(interp, "gdi", gdi, - (ClientData)0, 0); -#else - #if defined(USE_TCL_STUBS) - Tcl_InitStubs(interp, TCL_VERSION, 0 ); - #endif - #if defined(USE_TK_STUBS) - Tk_InitStubs (interp, TCL_VERSION, 0 ); - #endif - /* Wanted to use namespaces, but "unknown" isn't smart enough yet */ - /* Since this package is so full of numbers, this would be a great place - * to introduce a TclCmdObj - */ - Tcl_CreateCommand(interp, "gdi", gdi, - (ClientData)0, (Tcl_CmdDeleteProc *)0); -#endif - - /* Make this package work whether hdc is loaded or not */ - if ( Tcl_PkgRequire(interp, "hdc", "0.2", 0) ) - { - init_hdc_functions(interp); - if ( hdc_create == 0 ) - hdc_loaded = 0; - else - hdc_loaded = 1; - } - else - hdc_loaded = 0; - - Tcl_PkgProvide (interp, "gdi", version_string); - - return TCL_OK; -} - -/* The gdi function is considered safe. */ -EXPORT (int,Gdi_SafeInit) (Tcl_Interp *interp) -{ - return Gdi_Init(interp); -} - -/* Exported symbols */ -BOOL APIENTRY DllEntryPoint (HINSTANCE hInstance, DWORD reason, LPVOID lpCmdLine) -{ - switch (reason) - { - case DLL_PROCESS_ATTACH: - break; - case DLL_THREAD_ATTACH: - break; - case DLL_PROCESS_DETACH: - /* Since GDI doesn't create DCs, just uses them, no cleanup is required */ - break; - case DLL_THREAD_DETACH: - break; - } - /* Don't do anything, so just return true */ - return TRUE; -} - -static void init_hdc_functions(Tcl_Interp *interp) -{ - void *fn[7]; - int result; - const char *cp; - Tcl_Eval(interp, "hdc FunctionVector"); - cp = Tcl_GetStringResult(interp); - /* Does cp need to be freed when I'm done? */ - result = sscanf(cp, "%lx%lx%lx%lx%lx%lx%lx", &fn[0], &fn[1], &fn[2], &fn[3], - &fn[4], &fn[5], &fn[6]); - if ( result == 7) - { - hdc_create = fn[0]; - hdc_delete = fn[1]; - hdc_get = fn[2]; - hdc_typeof = fn[3]; - hdc_prefixof = fn[4]; - hdc_list = fn[5]; - hdc_valid = fn[6]; - } -} - -static HDC get_dc(Tcl_Interp *interp, const char *name) -{ - /* ANY type of DC should be ok here */ - if ( hdc_loaded == 0 || hdc_valid == 0 || hdc_valid(interp, name, -1) == 0 ) - { - char *strend; - unsigned long tmp; - - /* Perhaps it is a numeric DC */ - tmp = strtoul(name, &strend, 0); - if ( strend != 0 && strend > name ) - { - DWORD objtype = GetObjectType((HGDIOBJ)tmp); - switch (objtype) - { - /* Any of the DC types are OK. */ - case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: - break; - /* Anything else is invalid */ - case 0: /* Function failed */ - default: - tmp = 0; - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", - "need a drawing context, got non-context address: ", name, "\n", 0); - break; - } - return (HDC)tmp; - } - else - { - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", - "need a drawing context, got: ", name, "\n", 0); - return 0; - } - } - - { - HDC hdc = (HDC)hdc_get(interp, name); - DWORD objtype = GetObjectType((HGDIOBJ)hdc); - switch (objtype) - { - /* Any of the DC types are OK. */ - case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: - break; - /* Anything else is invalid */ - case 0: /* Function failed */ - default: - hdc = 0; - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", - "need a drawing context, got: ", name, "\n", 0); - break; - } - return hdc; - } -} - -#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION <= 6 - /* Under version 8.0, there is a nice function called Tk_GetHWND - * to do the real work.. - */ - - /* - * Copy a piece of tkWinInt.h - * This is easier to deal with than including tkWinInt.h, - * though it does mean one has to check when compiling - * against a new version! - */ - typedef struct { - int type; - HWND handle; - void *winPtr; /* Really a TkWindow */ - } TkWinWindow, TkWinDrawable; - - #define Tk_GetHWND(w) (((TkWinWindow *)w)->handle) -#elif defined(USE_TK_STUBS) - #include "tkPlatDecls.h" -#else - IMPORT(HWND,Tk_GetHWND) _ANSI_ARGS_((Window window)); -#endif - - -static HWND tk_gethwnd (Window window) -{ - return Tk_GetHWND(window); -} - -/* -* Something new: Include 'irox@cygnus.com' text widget printer -*/ -#if TEXTWIDGET_CMD -#include "tkWinPrintText.c" -#endif - -/* -* The following functions are copied from tkTrig.c, since they -* are not available in the stubs library. -*/ - -/* - *-------------------------------------------------------------- - * - * TkBezierScreenPoints -- - * - * Given four control points, create a larger set of XPoints - * for a Bezier spline based on the points. - * - * Results: - * The array at *xPointPtr gets filled in with numSteps XPoints - * corresponding to the Bezier spline defined by the four - * control points. Note: no output point is generated for the - * first input point, but an output point *is* generated for - * the last input point. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ - -static void -TkBezierScreenPoints(canvas, control, numSteps, xPointPtr) - Tk_Canvas canvas; /* Canvas in which curve is to be - * drawn. */ - double control[]; /* Array of coordinates for four - * control points: x0, y0, x1, y1, - * ... x3 y3. */ - int numSteps; /* Number of curve points to - * generate. */ - register XPoint *xPointPtr; /* Where to put new points. */ -{ - int i; - double u, u2, u3, t, t2, t3; - - for (i = 1; i <= numSteps; i++, xPointPtr++) { - t = ((double) i)/((double) numSteps); - t2 = t*t; - t3 = t2*t; - u = 1.0 - t; - u2 = u*u; - u3 = u2*u; - Tk_CanvasDrawableCoords(canvas, - (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) - + control[6]*t3), - (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) - + control[7]*t3), - &xPointPtr->x, &xPointPtr->y); - } -} - -/* - *-------------------------------------------------------------- - * - * TkBezierPoints -- - * - * Given four control points, create a larger set of points - * for a Bezier spline based on the points. - * - * Results: - * The array at *coordPtr gets filled in with 2*numSteps - * coordinates, which correspond to the Bezier spline defined - * by the four control points. Note: no output point is - * generated for the first input point, but an output point - * *is* generated for the last input point. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ - -static void -TkBezierPoints(control, numSteps, coordPtr) - double control[]; /* Array of coordinates for four - * control points: x0, y0, x1, y1, - * ... x3 y3. */ - int numSteps; /* Number of curve points to - * generate. */ - register double *coordPtr; /* Where to put new points. */ -{ - int i; - double u, u2, u3, t, t2, t3; - - for (i = 1; i <= numSteps; i++, coordPtr += 2) { - t = ((double) i)/((double) numSteps); - t2 = t*t; - t3 = t2*t; - u = 1.0 - t; - u2 = u*u; - u3 = u2*u; - coordPtr[0] = control[0]*u3 - + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; - coordPtr[1] = control[1]*u3 - + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; - } -} - -/* - *-------------------------------------------------------------- - * - * TkMakeBezierCurve -- - * - * Given a set of points, create a new set of points that fit - * parabolic splines to the line segments connecting the original - * points. Produces output points in either of two forms. - * - * Note: in spite of this procedure's name, it does *not* generate - * Bezier curves. Since only three control points are used for - * each curve segment, not four, the curves are actually just - * parabolic. - * - * Results: - * Either or both of the xPoints or dblPoints arrays are filled - * in. The return value is the number of points placed in the - * arrays. Note: if the first and last points are the same, then - * a closed curve is generated. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ - -static int -TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints) - Tk_Canvas canvas; /* Canvas in which curve is to be - * drawn. */ - double *pointPtr; /* Array of input coordinates: x0, - * y0, x1, y1, etc.. */ - int numPoints; /* Number of points at pointPtr. */ - int numSteps; /* Number of steps to use for each - * spline segments (determines - * smoothness of curve). */ - XPoint xPoints[]; /* Array of XPoints to fill in (e.g. - * for display. NULL means don't - * fill in any XPoints. */ - double dblPoints[]; /* Array of points to fill in as - * doubles, in the form x0, y0, - * x1, y1, .... NULL means don't - * fill in anything in this form. - * Caller must make sure that this - * array has enough space. */ -{ - int closed, outputPoints, i; - int numCoords = numPoints*2; - double control[8]; - - /* - * If the curve is a closed one then generate a special spline - * that spans the last points and the first ones. Otherwise - * just put the first point into the output. - */ - - if (!pointPtr) { - /* Of pointPtr == NULL, this function returns an upper limit. - * of the array size to store the coordinates. This can be - * used to allocate storage, before the actual coordinates - * are calculated. */ - return 1 + numPoints * numSteps; - } - - outputPoints = 0; - if ((pointPtr[0] == pointPtr[numCoords-2]) - && (pointPtr[1] == pointPtr[numCoords-1])) { - closed = 1; - control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0]; - control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1]; - control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0]; - control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1]; - control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2]; - control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3]; - control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; - control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; - if (xPoints != NULL) { - Tk_CanvasDrawableCoords(canvas, control[0], control[1], - &xPoints->x, &xPoints->y); - TkBezierScreenPoints(canvas, control, numSteps, xPoints+1); - xPoints += numSteps+1; - } - if (dblPoints != NULL) { - dblPoints[0] = control[0]; - dblPoints[1] = control[1]; - TkBezierPoints(control, numSteps, dblPoints+2); - dblPoints += 2*(numSteps+1); - } - outputPoints += numSteps+1; - } else { - closed = 0; - if (xPoints != NULL) { - Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1], - &xPoints->x, &xPoints->y); - xPoints += 1; - } - if (dblPoints != NULL) { - dblPoints[0] = pointPtr[0]; - dblPoints[1] = pointPtr[1]; - dblPoints += 2; - } - outputPoints += 1; - } - - for (i = 2; i < numPoints; i++, pointPtr += 2) { - /* - * Set up the first two control points. This is done - * differently for the first spline of an open curve - * than for other cases. - */ - - if ((i == 2) && !closed) { - control[0] = pointPtr[0]; - control[1] = pointPtr[1]; - control[2] = 0.333*pointPtr[0] + 0.667*pointPtr[2]; - control[3] = 0.333*pointPtr[1] + 0.667*pointPtr[3]; - } else { - control[0] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; - control[1] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; - control[2] = 0.167*pointPtr[0] + 0.833*pointPtr[2]; - control[3] = 0.167*pointPtr[1] + 0.833*pointPtr[3]; - } - - /* - * Set up the last two control points. This is done - * differently for the last spline of an open curve - * than for other cases. - */ - - if ((i == (numPoints-1)) && !closed) { - control[4] = .667*pointPtr[2] + .333*pointPtr[4]; - control[5] = .667*pointPtr[3] + .333*pointPtr[5]; - control[6] = pointPtr[4]; - control[7] = pointPtr[5]; - } else { - control[4] = .833*pointPtr[2] + .167*pointPtr[4]; - control[5] = .833*pointPtr[3] + .167*pointPtr[5]; - control[6] = 0.5*pointPtr[2] + 0.5*pointPtr[4]; - control[7] = 0.5*pointPtr[3] + 0.5*pointPtr[5]; - } - - /* - * If the first two points coincide, or if the last - * two points coincide, then generate a single - * straight-line segment by outputting the last control - * point. - */ - - if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3])) - || ((pointPtr[2] == pointPtr[4]) - && (pointPtr[3] == pointPtr[5]))) { - if (xPoints != NULL) { - Tk_CanvasDrawableCoords(canvas, control[6], control[7], - &xPoints[0].x, &xPoints[0].y); - xPoints++; - } - if (dblPoints != NULL) { - dblPoints[0] = control[6]; - dblPoints[1] = control[7]; - dblPoints += 2; - } - outputPoints += 1; - continue; - } - - /* - * Generate a Bezier spline using the control points. - */ - - - if (xPoints != NULL) { - TkBezierScreenPoints(canvas, control, numSteps, xPoints); - xPoints += numSteps; - } - if (dblPoints != NULL) { - TkBezierPoints(control, numSteps, dblPoints); - dblPoints += 2*numSteps; - } - outputPoints += numSteps; - } - return outputPoints; -} - +/* + * tkWinGDI.c -- + * + * This module implements access to the Win32 GDI API. + * + * Copyright © 1991-1996 Microsoft Corp. + * Copyright © 2009, Michael I. Schwartz. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + + +/* Remove Deprecation Warnings. */ +#define _CRT_SECURE_NO_WARNINGS + +#include +#include +#include + + +#include /* Ensure to include WINAPI definition */ + +#include +/* #include */ +#include + +/* Main dispatcher for commands */ +static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +/* Main dispatcher for subcommands */ +static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); + +/* Real functions */ +static int GdiConfig (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiArc (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiBitmap (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiCharWidths (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiImage (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiPhoto (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiLine (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiOval (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiPolygon (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiRectangle(ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiText (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int Version (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); + +static int GdiMap (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiCopyBits (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); + +/* Local copies of similar routines elsewhere in Tcl/Tk */ +static int GdiParseColor (const char *name, unsigned long *color); +static int GdiGetColor (const char *name, unsigned long *color); +static int TkGdiMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints); + +/* Routines imported from irox */ +static int PrintTextCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); + +/* +* Hash table support +* +* Provided by the hdc extension +*/ +static int hdc_loaded = 0; +static void init_hdc_functions(Tcl_Interp *interp); +static int (*hdc_init) (Tcl_Interp *interp); +static const char * (*hdc_create) (Tcl_Interp *interp, void *ptr, int type); +static int (*hdc_valid) (Tcl_Interp *interp, const char *hdcname, int type); +static int (*hdc_delete) (Tcl_Interp *interp, const char *hdcname); +static void * (*hdc_get) (Tcl_Interp *interp, const char *hdcname); +static int (*hdc_typeof) (Tcl_Interp *interp, const char *hdcname); +static const char * (*hdc_prefixof) (Tcl_Interp *interp, int type, const char *newprefix); +static int (*hdc_list) (Tcl_Interp *interp, int type, const char *out[], int *poutlen); + +static HDC get_dc(Tcl_Interp *interp, const char *name); + +/* +* Helper functions +*/ +static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC hDC); +static int GdiMakePen(Tcl_Interp *interp, int width, + int dashstyle, const char *dashstyledata, + int capstyle, + int joinstyle, + int stipplestyle, const char *stippledata, + unsigned long color, + HDC hDC, HGDIOBJ *oldPen); +static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen); +static int GdiMakeBrush (Tcl_Interp *interp, unsigned int style, unsigned long color, + long hatch, LOGBRUSH *lb, HDC hDC, HGDIOBJ *oldBrush); +static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBrush); +static int GdiGetHdcInfo( HDC hdc, + LPPOINT worigin, LPSIZE wextent, + LPPOINT vorigin, LPSIZE vextent); + +/* Helper functions for printing the window client area */ +enum PrintType { PTWindow=0, PTClient=1, PTScreen=2 }; +static HANDLE CopyToDIB ( HWND wnd, enum PrintType type ); +static HBITMAP CopyScreenToBitmap(LPRECT lpRect); +static HANDLE BitmapToDIB (HBITMAP hb, HPALETTE hp); +static HANDLE CopyScreenToDIB(LPRECT lpRect); +static int DIBNumColors(LPBITMAPINFOHEADER lpDIB); +static int PalEntriesOnDevice(HDC hDC); +static HPALETTE GetSystemPalette(void); +static void GetDisplaySize (LONG *width, LONG *height); + +static const char gdi_usage_message[] = "gdi [arc|characters|copybits|line|map|oval|" + "photo|polygon|rectangle|text|version]\n" + "\thdc parameters can be generated by the printer extension"; +static char msgbuf[1024]; + +/* +* This is the top-level routine for the GDI command +* It strips off the first word of the command (gdi) and +* sends the result to the switch +*/ +static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + if ( argc > 1 && strcmp(*argv, "gdi") == 0 ) + { + argc--; + argv++; + return Gdi(unused, interp, argc, argv); + } + + Tcl_SetResult (interp, gdi_usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* To make the "subcommands" follow a standard convention, +* add them to this array. The first element is the subcommand +* name, and the second a standard Tcl command handler. +*/ +struct gdi_command +{ + const char *command_string; + int (*command) (ClientData, Tcl_Interp *, int, const char **); +} gdi_commands[] = +{ + { "arc", GdiArc }, + { "bitmap", GdiBitmap }, + { "characters", GdiCharWidths }, + { "configure", GdiConfig }, + { "image", GdiImage }, + { "line", GdiLine }, + { "map", GdiMap }, + { "oval", GdiOval }, + { "photo", GdiPhoto }, + { "polygon", GdiPolygon }, + { "rectangle", GdiRectangle }, + { "text", GdiText }, +#ifdef TEXTWIDGET_CMD + { "textwidget", PrintTextCmd }, +#endif + { "copybits", GdiCopyBits }, + { "version", Version }, + +}; + +/* +* This is the GDI subcommand dispatcher +*/ +static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + size_t i; + + for (i=0; i= 1 ) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if ( hDC == (HDC) 0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + argc--; + argv++; + } + else + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + /* Now check for other arguments */ + while ( argc >= 1 ) + { + if ( strcmp(argv[0], "-bg") == 0 || strcmp(argv[0], "-background") == 0 ) + { + unsigned long color; + argc--; + argv++; + if ( argc >= 1 ) + { + if ( GdiParseColor(argv[0], &color) > 0 ) /* OK */ + SetBkColor(hDC, color); + else + { + Tcl_AppendResult(interp, + "{ {gdi configure: color parsing error for background ", + argv[0], + "} }", + 0); + status = TCL_ERROR; + } + } + } + argc--; + argv++; + } + + if ( (c = GetBkColor(hDC)) == CLR_INVALID ) + { + Tcl_AppendResult(interp, "{ -background INVALID }", 0); + status = TCL_ERROR; + } + else + { + sprintf(clrhex, "#%02x%02x%02x", GetRValue(c), GetGValue(c), GetBValue(c)); + Tcl_AppendResult(interp, "{ -background ", clrhex, " }", 0); + } + + return status; +} + +/* +* Arc command +* Create a standard "DrawFunc" to make this more workable.... +*/ +#ifdef _MSC_VER +typedef BOOL (WINAPI *DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie */ +#else +typedef BOOL WINAPI (*DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie */ +#endif + +static int GdiArc (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + int x1, y1, x2, y2; + int xr0, yr0, xr1, yr1; + HDC hDC; + double extent = 0.0 , start = 0.0 ; + DrawFunc drawfunc; + int width = 0; + HPEN hPen; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + HBRUSH hBrush; + LOGBRUSH lbrush; + HGDIOBJ oldobj; + int dodash = 0; + const char *dashdata = 0; + + static const char usage_message[] = "gdi arc hdc x1 y1 x2 y2 " + "-extent degrees " + "-fill color -outline color " + "-outlinestipple bitmap " + "-start degrees -stipple bitmap " + "-dash pattern " + "-style [pieslice|chord|arc] -width linewid"; + + drawfunc = Pie; + + /* Verrrrrry simple for now... */ + if (argc >= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + x1 = atoi(argv[1]); + y1 = atoi(argv[2]); + x2 = atoi(argv[3]); + y2 = atoi(argv[4]); + + argc -= 5; + argv += 5; + while ( argc >= 2 ) + { + if ( strcmp (argv[0], "-extent") == 0 ) + extent = atof(argv[1]); + else if ( strcmp (argv[0], "-start") == 0 ) + start = atof(argv[1]); + else if ( strcmp (argv[0], "-style") == 0 ) + { + if ( strcmp (argv[1], "pieslice") == 0 ) + drawfunc = Pie; + else if ( strcmp(argv[1], "arc") == 0 ) + drawfunc = Arc; + else if ( strcmp(argv[1], "chord") == 0 ) + drawfunc = Chord; + } + /* Handle all args, even if we don't use them yet */ + else if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( GdiGetColor(argv[1], &fillcolor) ) + dofillcolor=1; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor=1; + } + else if (strcmp(argv[0], "-outlinestipple") == 0 ) + { + } + else if (strcmp(argv[0], "-stipple") == 0 ) + { + } + else if (strcmp(argv[0], "-width") == 0 ) + { + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + argc -= 2; + argv += 2; + } + xr0 = xr1 = ( x1 + x2 ) / 2; + yr0 = yr1 = ( y1 + y2 ) / 2; + + + /* + * The angle used by the arc must be "warped" by the eccentricity of the ellipse. + * Thanks to Nigel Dodd for bringing a nice example. + */ + xr0 += (int)(100.0 * (x2 - x1) * cos( (start * 2.0 * 3.14159265) / 360.0 ) ); + yr0 -= (int)(100.0 * (y2 - y1) * sin( (start * 2.0 * 3.14159265) / 360.0 ) ); + xr1 += (int)(100.0 * (x2 - x1) * cos( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); + yr1 -= (int)(100.0 * (y2 - y1) * sin( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); + + /* Under Win95, SetArcDirection isn't implemented--so we have to + assume that arcs are drawn counterclockwise (e.g., positive extent) + So if it's negative, switch the coordinates! + */ + if ( extent < 0 ) + { + int xr2 = xr0; + int yr2 = yr0; + xr0 = xr1; + xr1 = xr2; + yr0 = yr1; + yr1 = yr2; + } + + if ( dofillcolor ) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH) ); + + if ( width || dolinecolor ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + + (*drawfunc)(hDC, x1, y1, x2, y2, xr0, yr0, xr1, yr1); + + if ( width || dolinecolor ) + GdiFreePen(interp, hDC, hPen); + if ( dofillcolor ) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject(hDC, oldobj); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Bitmap command +* Unimplemented for now. +* Should use the same techniques as CanvasPsBitmap (tkCanvPs.c) +*/ +static int GdiBitmap (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi bitmap hdc x y " + "-anchor [center|n|e|s|w] -background color " + "-bitmap bitmap -foreground color\n" + "Not implemented yet. Sorry!"; + + /* Skip this for now.... */ + /* Should be based on common code with the copybits command */ + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Image command +* Unimplemented for now. +* Should switch on image type and call either GdiPhoto or GdiImage +* (or other registered function(?)) +* This code is similar to that in the tkx.y.z/win/tkWinImage.c code? +*/ +static int GdiImage (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi image hdc x y -anchor [center|n|e|s|w] -image name\n" + "Not implemented yet. Sorry!"; + + /* Skip this for now.... */ + /* Should be based on common code with the copybits command */ + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + /* Normally, usage results in TCL_ERROR--but wait til' it's implemented */ + return TCL_OK; +} + +/* +* Gdi Photo +* Contributed by Lukas Rosenthaler +* Note: The canvas doesn't directly support photos (only as images), +* so this is the first gdi command without an equivalent canvas command. +* This code may be modified to support photo images on the canvas. +*/ +static int GdiPhoto (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi photo hdc [-destination x y [w [h]]] -photo name\n"; + HDC dst; + int dst_x = 0, dst_y = 0, dst_w = 0, dst_h = 0; + int nx, ny, sll; + const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char * */ + Tk_PhotoHandle photo_handle; + Tk_PhotoImageBlock img_block; + BITMAPINFO bitmapinfo; /* Since we don't need the bmiColors table, + there is no need for dynamic allocation */ + int oldmode; /* For saving the old stretch mode */ + POINT pt; /* For saving the brush org */ + char *pbuf = NULL; + int i, j, k; + int retval = TCL_OK; + + /* + * Parse the arguments. + */ + /* HDC is required */ + if ( argc < 1 ) { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + dst = get_dc(interp, argv[0]); + + /* Check hDC */ + if (dst == (HDC) 0) { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for gdi photo\n", 0); + Tcl_AppendResult(interp, usage_message, 0); + return TCL_ERROR; + } + + /* + * Next, check to see if 'dst' can support BitBlt. + * If not, raise an error + */ + if ( (GetDeviceCaps (dst, RASTERCAPS) & RC_STRETCHDIB) == 0 ) { + sprintf(msgbuf, "gdi photo not supported on device context (0x%s)", argv[0]); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + + /* Parse the command line arguments */ + for (j = 1; j < argc; j++) + { + if (strcmp (argv[j], "-destination") == 0) + { + double x, y, w, h; + int count = 0; + + if ( j < argc ) + count = sscanf(argv[++j], "%lf%lf%lf%lf", &x, &y, &w, &h); + + if ( count < 2 ) /* Destination must provide at least 2 arguments */ + { + Tcl_AppendResult(interp, "-destination requires a list of at least 2 numbers\n", + usage_message, 0); + return TCL_ERROR; + } + else + { + dst_x = (int) x; + dst_y = (int) y; + if ( count == 3 ) + { + dst_w = (int) w; + dst_h = -1; + } + else if ( count == 4 ) + { + dst_w = (int) w; + dst_h = (int) h; + } + } + } + else if (strcmp (argv[j], "-photo") == 0) + photoname = argv[++j]; + } + + if ( photoname == 0 ) /* No photo provided */ + { + Tcl_AppendResult(interp, "No photo name provided to gdi photo\n", usage_message, 0); + return TCL_ERROR; + } + + photo_handle = Tk_FindPhoto (interp, photoname); + if ( photo_handle == 0 ) + { + Tcl_AppendResult(interp, "gdi photo: Photo name ", photoname, " can't be located\n", + usage_message, 0); + return TCL_ERROR; + } + Tk_PhotoGetImage (photo_handle, &img_block); + + + nx = img_block.width; + ny = img_block.height; + sll = ((3*nx + 3) / 4)*4; /* must be multiple of 4 */ + + pbuf = (char *) Tcl_Alloc (sll*ny*sizeof (char)); + if ( pbuf == 0 ) /* Memory allocation failure */ + { + Tcl_AppendResult(interp, "gdi photo failed--out of memory", 0); + return TCL_ERROR; + } + + /* After this, all returns must go through retval */ + + /* BITMAP expects BGR; photo provides RGB */ + for (k = 0; k < ny; k++) + { + for (i = 0; i < nx; i++) + { + pbuf[k*sll + 3*i] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[2]]; + pbuf[k*sll + 3*i + 1] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[1]]; + pbuf[k*sll + 3*i + 2] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[0]]; + } + } + + memset (&bitmapinfo, 0L, sizeof (BITMAPINFO)); + + bitmapinfo.bmiHeader.biSize = sizeof (BITMAPINFOHEADER); + bitmapinfo.bmiHeader.biWidth = nx; + bitmapinfo.bmiHeader.biHeight = -ny; + bitmapinfo.bmiHeader.biPlanes = 1; + bitmapinfo.bmiHeader.biBitCount = 24; + bitmapinfo.bmiHeader.biCompression = BI_RGB; + bitmapinfo.bmiHeader.biSizeImage = 0; /* sll*ny; */ + bitmapinfo.bmiHeader.biXPelsPerMeter = 0; + bitmapinfo.bmiHeader.biYPelsPerMeter = 0; + bitmapinfo.bmiHeader.biClrUsed = 0; + bitmapinfo.bmiHeader.biClrImportant = 0; + + oldmode = SetStretchBltMode (dst, HALFTONE); + /* According to the Win32 Programmer's Manual, we have to set the brush org, now */ + SetBrushOrgEx(dst, 0, 0, &pt); + + if (dst_w <= 0) + { + dst_w = nx; + dst_h = ny; + } + else if (dst_h <= 0) + { + dst_h = ny*dst_w / nx; + } + + if (StretchDIBits (dst, dst_x, dst_y, dst_w, dst_h, 0, 0, nx, ny, + pbuf, &bitmapinfo, DIB_RGB_COLORS, SRCCOPY) == GDI_ERROR) { + int errcode; + + errcode = GetLastError(); + sprintf(msgbuf, "gdi photo internal failure: StretchDIBits error code %ld", errcode); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + retval = TCL_ERROR; + } + + /* Clean up the hDC */ + if (oldmode != 0 ) + { + SetStretchBltMode(dst, oldmode); + SetBrushOrgEx(dst, pt.x, pt.y, &pt); + } + + Tcl_Free (pbuf); + + if ( retval == TCL_OK ) + { + sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + } + + return retval; +} + +/* +* Interface to Tk's line smoother, used for lines and pollies +* Provided by Jasper Taylor +*/ +int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { + /* First, translate my points into a list of doubles */ + double *inPointList, *outPointList; + int n; + int nbpoints = 0; + POINT* bpoints; + + + inPointList=(double *)Tcl_Alloc(2*sizeof(double)*npoly); + if ( inPointList == 0 ) { + return nbpoints; /* 0 */ + } + + for (n=0;n= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) + { + Tcl_SetResult(interp, "Out of memory in GdiLine", TCL_STATIC); + return TCL_ERROR; + } + polypoints[0].x = atol(argv[1]); + polypoints[0].y = atol(argv[2]); + polypoints[1].x = atol(argv[3]); + polypoints[1].y = atol(argv[4]); + argc -= 5; + argv += 5; + npoly = 2; + + while ( argc >= 2 ) + { + /* Check for a number */ + x = strtoul(argv[0], &strend, 0); + if ( strend > argv[0] ) + { + /* One number... */ + y = strtoul (argv[1], &strend, 0); + if ( strend > argv[1] ) + { + /* TWO numbers! */ + polypoints[npoly].x = x; + polypoints[npoly].y = y; + npoly++; + argc-=2; + argv+=2; + } + else + { + /* Only one number... Assume a usage error */ + Tcl_Free((void *)polypoints); + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + } + else + { + if ( strcmp(*argv, "-arrow") == 0 ) + { + if ( strcmp(argv[1], "none") == 0 ) + doarrow = 0; + else if ( strcmp(argv[1], "both") == 0 ) + doarrow = 3; + else if ( strcmp(argv[1], "first") == 0 ) + doarrow = 2; + else if ( strcmp(argv[1], "last") == 0 ) + doarrow = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-arrowshape") == 0 ) + { + /* List of 3 numbers--set arrowshape array */ + int a1, a2, a3; + + if ( sscanf(argv[1], "%d%d%d", &a1, &a2, &a3) == 3 ) + { + if (a1 > 0 && a2 > 0 && a3 > 0 ) + { + arrowshape[0] = a1; + arrowshape[1] = a2; + arrowshape[2] = a3; + } + /* Else the numbers are bad */ + } + /* Else the argument was bad */ + + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-capstyle") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-fill") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-joinstyle") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-smooth") == 0 ) + { + /* Argument is true/false or 1/0 or bezier */ + if ( argv[1] ) { + switch ( argv[1][0] ) { + case 't': case 'T': + case '1': + case 'b': case 'B': /* bezier */ + dosmooth = 1; + break; + default: + dosmooth = 0; + break; + } + argv+=2; + argc-=2; + } + } + else if ( strcmp(*argv, "-splinesteps") == 0 ) + { + nStep = atoi(argv[1]); + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-dash" ) == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + argv += 2; + argc -= 2; + } + else if ( strcmp(*argv, "-dashoffset" ) == 0 ) + { + argv += 2; + argc -= 2; + } + else if ( strcmp(*argv, "-stipple") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-width") == 0 ) + { + width = atoi(argv[1]); + argv+=2; + argc-=2; + } + else /* It's an unknown argument! */ + { + argc--; + argv++; + } + /* Check for arguments + * Most of the arguments affect the "Pen" + */ + } + } + + if (width || dolinecolor || dodash ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + if ( doarrow != 0 ) + GdiMakeBrush(interp, 0, linecolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + + if (dosmooth) /* Use PolyBezier */ + { + int nbpoints; + POINT *bpoints = 0; + nbpoints = Bezierize(polypoints,npoly,nStep,&bpoints); + if (nbpoints > 0 ) + Polyline(hDC, bpoints, nbpoints); + else + Polyline(hDC, polypoints, npoly); /* out of memory? just draw a regular line */ + if ( bpoints != 0 ) + Tcl_Free((void *)bpoints); + } + else + Polyline(hDC, polypoints, npoly); + + if ( dodash && doarrow ) /* Don't use dashed or thick pen for the arrows! */ + { + GdiFreePen(interp, hDC, hPen); + GdiMakePen(interp, width, + 0, 0, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + } + + /* Now the arrowheads, if any */ + if ( doarrow & 1 ) + { + /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y */ + POINT ahead[6]; + double dx, dy, length; + double backup, sinTheta, cosTheta; + double vertX, vertY, temp; + double fracHeight; + + fracHeight = 2.0 / arrowshape[2]; + backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; + + ahead[0].x = ahead[5].x = polypoints[npoly-1].x; + ahead[0].y = ahead[5].y = polypoints[npoly-1].y; + dx = ahead[0].x - polypoints[npoly-2].x; + dy = ahead[0].y - polypoints[npoly-2].y; + if ( (length = hypot(dx, dy)) == 0 ) + sinTheta = cosTheta = 0.0; + else + { + sinTheta = dy / length; + cosTheta = dx / length; + } + vertX = ahead[0].x - arrowshape[0]*cosTheta; + vertY = ahead[0].y - arrowshape[0]*sinTheta; + temp = arrowshape[2]*sinTheta; + ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); + ahead[4].x = (long)(ahead[1].x - 2 * temp); + temp = arrowshape[2]*cosTheta; + ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); + ahead[4].y = (long)(ahead[1].y + 2 * temp); + ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); + ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); + + Polygon(hDC, ahead, 6); + + } + + if ( doarrow & 2 ) + { + /* Arrowhead at end = polypoints[0].x, polypoints[0].y */ + POINT ahead[6]; + double dx, dy, length; + double backup, sinTheta, cosTheta; + double vertX, vertY, temp; + double fracHeight; + + fracHeight = 2.0 / arrowshape[2]; + backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; + + ahead[0].x = ahead[5].x = polypoints[0].x; + ahead[0].y = ahead[5].y = polypoints[0].y; + dx = ahead[0].x - polypoints[1].x; + dy = ahead[0].y - polypoints[1].y; + if ( (length = hypot(dx, dy)) == 0 ) + sinTheta = cosTheta = 0.0; + else + { + sinTheta = dy / length; + cosTheta = dx / length; + } + vertX = ahead[0].x - arrowshape[0]*cosTheta; + vertY = ahead[0].y - arrowshape[0]*sinTheta; + temp = arrowshape[2]*sinTheta; + ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); + ahead[4].x = (long)(ahead[1].x - 2 * temp); + temp = arrowshape[2]*cosTheta; + ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); + ahead[4].y = (long)(ahead[1].y + 2 * temp); + ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); + ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); + + Polygon(hDC, ahead, 6); + } + + + if (width || dolinecolor || dodash ) + GdiFreePen(interp, hDC, hPen); + if ( doarrow ) + GdiFreeBrush(interp, hDC, hBrush); + + Tcl_Free((void *)polypoints); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Oval command +*/ +static int GdiOval (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi oval hdc x1 y1 x2 y2 -fill color -outline color " + "-stipple bitmap -width linewid"; + int x1, y1, x2, y2; + HDC hDC; + HPEN hPen; + int width=0; + COLORREF linecolor = 0, fillcolor = 0; + int dolinecolor = 0, dofillcolor = 0; + HBRUSH hBrush; + LOGBRUSH lbrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now... */ + if (argc >= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + x1 = atol(argv[1]); + y1 = atol(argv[2]); + x2 = atol(argv[3]); + y2 = atol(argv[4]); + if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } + if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } + argc -= 5; + argv += 5; + + while ( argc > 0 ) + { + /* Now handle any other arguments that occur */ + if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( argv[1] ) + if ( GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( argv[1] ) + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-stipple") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-width") == 0 ) + { + if (argv[1]) + width = atoi(argv[1]); + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + argv+=2; + argc-=2; + } + } + + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject( hDC, GetStockObject(HOLLOW_BRUSH) ); + + if (width || dolinecolor) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ + Ellipse (hDC, x1, y1, x2+1, y2+1); + if (width || dolinecolor) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject (hDC, oldobj ); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Polygon command +*/ +static int GdiPolygon (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi polygon hdc x1 y1 ... xn yn " + "-fill color -outline color -smooth [true|false|bezier] " + "-splinesteps number -stipple bitmap -width linewid"; + + char *strend; + POINT *polypoints; + int npoly; + int dosmooth = 0; + int nStep = 12; + int x, y; + HDC hDC; + HPEN hPen; + int width = 0; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + LOGBRUSH lbrush; + HBRUSH hBrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now... */ + if (argc >= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) + { + Tcl_SetResult(interp, "Out of memory in GdiLine", TCL_STATIC); + return TCL_ERROR; + } + polypoints[0].x = atol(argv[1]); + polypoints[0].y = atol(argv[2]); + polypoints[1].x = atol(argv[3]); + polypoints[1].y = atol(argv[4]); + argc -= 5; + argv += 5; + npoly = 2; + + while ( argc >= 2 ) + { + /* Check for a number */ + x = strtoul(argv[0], &strend, 0); + if ( strend > argv[0] ) + { + /* One number... */ + y = strtoul (argv[1], &strend, 0); + if ( strend > argv[1] ) + { + /* TWO numbers! */ + polypoints[npoly].x = x; + polypoints[npoly].y = y; + npoly++; + argc-=2; + argv+=2; + } + else + { + /* Only one number... Assume a usage error */ + Tcl_Free((void *)polypoints); + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + } + else + { + if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( argv[1] && GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 0; + } + else if ( strcmp(argv[0], "-smooth") == 0 ) { + if ( argv[1] ) { + switch ( argv[1][0] ) { + case 't': case 'T': + case '1': + case 'b': case 'B': /* bezier */ + dosmooth = 1; + break; + default: + dosmooth = 0; + break; + } + } + } + else if ( strcmp(argv[0], "-splinesteps") == 0 ) + { + if ( argv[1] ) + nStep = atoi(argv[1]); + } + else if (strcmp(argv[0], "-stipple") == 0 ) + { + } + else if (strcmp(argv[0], "-width") == 0 ) + { + if (argv[1]) + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + argc -= 2; + argv += 2; + /* Check for arguments + * Most of the arguments affect the "Pen" and "Brush" + */ + } + } + + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); + + if (width || dolinecolor) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + + if ( dosmooth) + { + int nbpoints; + POINT *bpoints = 0; + nbpoints = Bezierize(polypoints,npoly,nStep,&bpoints); + if ( nbpoints > 0 ) + Polygon(hDC, bpoints, nbpoints); + else + Polygon(hDC, polypoints, npoly); + if ( bpoints != 0 ) + Tcl_Free((void *)bpoints); + } + else + Polygon(hDC, polypoints, npoly); + + if (width || dolinecolor) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject (hDC, oldobj); + + Tcl_Free((void *)polypoints); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* Rectangle command +*/ +static int GdiRectangle(ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi rectangle hdc x1 y1 x2 y2 " + "-fill color -outline color " + "-stipple bitmap -width linewid"; + + int x1, y1, x2, y2; + HDC hDC; + HPEN hPen; + int width = 0; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + LOGBRUSH lbrush; + HBRUSH hBrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now... */ + if (argc >= 5) + { + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + x1 = atol(argv[1]); + y1 = atol(argv[2]); + x2 = atol(argv[3]); + y2 = atol(argv[4]); + if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } + if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } + argc -= 5; + argv += 5; + + /* Now handle any other arguments that occur */ + while (argc > 1) + { + if ( strcmp(argv[0], "-fill") == 0 ) + { + if (argv[1]) + if (GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + } + else if ( strcmp(argv[0], "-outline") == 0) + { + if (argv[1]) + if (GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + } + else if ( strcmp(argv[0], "-stipple") == 0) + { + } + else if ( strcmp(argv[0], "-width") == 0) + { + if (argv[1] ) + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + + argc -= 2; + argv += 2; + } + + /* Note: If any fill is specified, the function must create a brush and + * put the coordinates in a RECTANGLE structure, and call FillRect. + * FillRect requires a BRUSH / color. + * If not, the function Rectangle must be called + */ + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); + + if ( width || dolinecolor ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ + Rectangle (hDC, x1, y1, x2+1, y2+1); + if ( width || dolinecolor ) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject(hDC, oldobj); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* characters command +* Need some way to get accurate data on character widths. +* This is completely inadequate for typesetting, but should work +* for simple text manipulation. +*/ +static int GdiCharWidths (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi characters hdc [-font fontname] [-array ary]"; + /* Returns widths of characters from font in an associative array + * Font is currently selected font for HDC if not specified + * Array name is GdiCharWidths if not specified + * Widths should be in the same measures as all other values (1/1000 inch). + */ + HDC hDC; + LOGFONT lf; + HFONT hfont, oldfont; + int made_font = 0; + const char *aryvarname = "GdiCharWidths"; + /* For now, assume 256 characters in the font... */ + int widths[256]; + int retval; + + if ( argc < 1 ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + argc--; + argv++; + + while ( argc > 0 ) + { + if ( strcmp(argv[0], "-font") == 0 ) + { + argc--; + argv++; + if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) + if ( (hfont = CreateFontIndirect(&lf)) != NULL ) + { + made_font = 1; + oldfont = SelectObject(hDC, hfont); + } + /* Else leave the font alone! */ + } + else if ( strcmp(argv[0], "-array") == 0 ) + { + argv++; + argc--; + if ( argc > 0 ) + { + aryvarname=argv[0]; + } + } + argv++; + argc--; + } + + /* Now, get the widths using the correct function for this windows version */ +#ifdef WIN32 + /* Try the correct function. If it fails (as has been reported on some + * versions of Windows 95), try the "old" function + */ + if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) + { + retval = GetCharWidth (hDC, 0, 255, widths ); + } +#else + retval = GetCharWidth (hDC, 0, 255, widths); +#endif + /* Retval should be 1 (TRUE) if the function succeeded. If the function fails, + * get the "extended" error code and return. Be sure to deallocate the font if + * necessary. + */ + if (retval == FALSE) + { + DWORD val = GetLastError(); + char intstr[12+1]; + sprintf (intstr, "%ld", val ); + Tcl_AppendResult (interp, "gdi character failed with code ", intstr, 0); + if ( made_font ) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + return TCL_ERROR; + } + + { + int i; + char numbuf[11+1]; + char ind[2]; + ind[1] = '\0'; + + for (i = 0; i < 255; i++ ) + { + /* May need to convert the widths here(?) */ + sprintf(numbuf, "%d", widths[i]); + ind[0] = i; + Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); + } + } + /* Now, remove the font if we created it only for this function */ + if ( made_font ) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + + /* The return value should be the array name(?) */ + Tcl_SetResult(interp, (char *)aryvarname, TCL_VOLATILE); + return TCL_OK; +} + +/* +* Text command +* Q: Add -clip/-noclip? Add -single? +* Q: To match canvas semantics, this should respect newlines, +* and treat no width supplied (width of 0) to output as +* a single line EXCEPT that it respects newlines. +*/ +static int GdiText (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi text hdc x y -anchor [center|n|e|s|w] " + "-fill color -font fontname " + "-justify [left|right|center] " + "-stipple bitmap -text string -width linelen " + "-single -backfill" + "-encoding [input encoding] -unicode"; + + HDC hDC; + int x, y; + const char *string = 0; + RECT sizerect; + UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas */ + Tk_Anchor anchor = 0; + LOGFONT lf; + HFONT hfont, oldfont; + int made_font = 0; + int retval; + int dotextcolor=0; + int dobgmode=0; + int dounicodeoutput=0; /* If non-zero, output will be drawn in Unicode */ + int bgmode; + COLORREF textcolor = 0; + int usewidth=0; + int usesingle = 0; + const char *encoding_name = 0; + +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + TCHAR *ostring; + Tcl_DString tds; + Tcl_Encoding encoding = NULL; + int tds_len; +#endif + + if ( argc >= 4 ) + { + /* Parse the command */ + hDC = get_dc(interp, argv[0]); + /* Check hDC */ + if (hDC == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + x = atol(argv[1]); + y = atol(argv[2]); + argc -= 3; + argv += 3; + + sizerect.left = sizerect.right = x; + sizerect.top = sizerect.bottom = y; + + while ( argc > 0 ) + { + if ( strcmp(argv[0], "-anchor") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + Tk_GetAnchor(interp, argv[0], &anchor); + } + else if ( strcmp(argv[0], "-justify") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + { + if ( strcmp(argv[0], "left") == 0 ) + format_flags |= DT_LEFT; + else if ( strcmp(argv[0], "center") == 0 ) + format_flags |= DT_CENTER; + else if ( strcmp(argv[0], "right") == 0 ) + format_flags |= DT_RIGHT; + } + } + else if ( strcmp(argv[0], "-text") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + string = argv[0]; + } + else if ( strcmp(argv[0], "-font") == 0 ) + { + argc--; + argv++; + if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) + if ( (hfont = CreateFontIndirect(&lf)) != NULL ) + { + made_font = 1; + oldfont = SelectObject(hDC, hfont); + } + /* Else leave the font alone! */ + } + else if ( strcmp(argv[0], "-stipple") == 0 ) + { + argc--; + argv++; + /* Not implemented yet */ + } + else if ( strcmp(argv[0], "-fill") == 0 ) + { + argc--; + argv++; + /* Get text color */ + if ( GdiGetColor(argv[0], &textcolor) ) + dotextcolor = 1; + } + else if ( strcmp(argv[0], "-width") == 0 ) + { + argc--; + argv++; + if ( argc > 0 ) + sizerect.right += atol(argv[0]); + /* If a width is specified, break at words. */ + format_flags |= DT_WORDBREAK; + usewidth = 1; + } + else if ( strcmp(argv[0], "-single") == 0 ) + { + usesingle = 1; + } + else if ( strcmp(argv[0], "-backfill") == 0 ) + dobgmode = 1; + else if ( strcmp(argv[0], "-unicode") == 0 ) + { + dounicodeoutput = 1; + /* Set the encoding name to utf-8, but can be overridden */ + if ( encoding_name == 0 ) + encoding_name = "utf-8"; + } + else if ( strcmp(argv[0], "-encoding") == 0 ) { + argc--; + argv++; + if ( argc > 0 ) { + encoding_name = argv[0]; + } + } + + argc--; + argv++; + } + +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + /* Handle the encoding, if present */ + if ( encoding_name != 0 ) + { + Tcl_Encoding tmp_encoding; + tmp_encoding = Tcl_GetEncoding(interp,encoding_name); + if (tmp_encoding != NULL) + encoding = tmp_encoding; + } +#endif + + if (string == 0 ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + /* Set the format flags for -single: Overrides -width */ + if ( usesingle == 1 ) + { + format_flags |= DT_SINGLELINE; + format_flags |= DT_NOCLIP; + format_flags &= ~DT_WORDBREAK; + } + + /* Calculate the rectangle */ +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + Tcl_DStringInit(&tds); + Tcl_UtfToExternalDString(encoding, string, -1, &tds); + ostring = Tcl_DStringValue(&tds); + tds_len = Tcl_DStringLength(&tds); + /* Just for fun, let's try translating ostring to unicode */ + if (dounicodeoutput) /* Convert UTF-8 to unicode */ + { + Tcl_UniChar *ustring; + Tcl_DString tds2; + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToWCharDString(ostring, tds_len, &tds2); + DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); + Tcl_DStringFree(&tds2); + } + else /* Use UTF-8/local code page output */ + { + DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); + } +#else + DrawText (hDC, string, -1, &sizerect, format_flags | DT_CALCRECT); +#endif + + /* Adjust the rectangle according to the anchor */ + x = y = 0; + switch ( anchor ) + { + case TK_ANCHOR_N: + x = ( sizerect.right - sizerect.left ) / 2; + break; + case TK_ANCHOR_S: + x = ( sizerect.right - sizerect.left ) / 2; + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_E: + x = ( sizerect.right - sizerect.left ); + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + case TK_ANCHOR_W: + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + case TK_ANCHOR_NE: + x = ( sizerect.right - sizerect.left ); + break; + case TK_ANCHOR_NW: + break; + case TK_ANCHOR_SE: + x = ( sizerect.right - sizerect.left ); + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_SW: + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_CENTER: + x = ( sizerect.right - sizerect.left ) / 2; + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + } + sizerect.right -= x; + sizerect.left -= x; + sizerect.top -= y; + sizerect.bottom -= y; + + /* Get the color right */ + if ( dotextcolor ) + textcolor = SetTextColor(hDC, textcolor); + + if ( dobgmode ) + bgmode = SetBkMode(hDC, OPAQUE); + else + bgmode = SetBkMode(hDC, TRANSPARENT); + + + /* Print the text */ +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + if (dounicodeoutput) /* Convert UTF-8 to unicode */ + { + Tcl_UniChar *ustring; + Tcl_DString tds2; + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToWCharDString(ostring, tds_len, &tds2); + retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); + Tcl_DStringFree(&tds2); + } + else + { + retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); + } + Tcl_DStringFree(&tds); +#else + retval = DrawText (hDC, string, -1, &sizerect, format_flags); +#endif + + /* Get the color set back */ + if ( dotextcolor ) + textcolor = SetTextColor(hDC, textcolor); + + SetBkMode(hDC, bgmode); + + if (made_font) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + + /* In this case, the return value is the height of the text */ + sprintf(msgbuf, "%d", retval); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + + return TCL_OK; + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* GdiGetHdcInfo +* Return salient characteristics of the CTM. +* The return value is 0 if any failure occurs--in which case +* none of the other values are meaningful. +* Otherwise the return value is the current mapping mode +* (this may be VERY windows-specific). +*/ +static int GdiGetHdcInfo( HDC hdc, + LPPOINT worigin, LPSIZE wextent, + LPPOINT vorigin, LPSIZE vextent) +{ + int mapmode; + int retval; + + memset (worigin, 0, sizeof(POINT)); + memset (vorigin, 0, sizeof(POINT)); + memset (wextent, 0, sizeof(SIZE)); + memset (vextent, 0, sizeof(SIZE)); + + if ( (mapmode = GetMapMode(hdc)) == 0 ) + { + /* Failed! */ + retval=0; + } + else + retval = mapmode; + + if ( GetWindowExtEx(hdc, wextent) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetViewportExtEx (hdc, vextent) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetWindowOrgEx(hdc, worigin) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetViewportOrgEx(hdc, vorigin) == FALSE ) + { + /* Failed! */ + retval = 0; + } + + return retval; +} + +/* +* Converts Windows mapping mode names to values in the .h +*/ +static int GdiNameToMode(const char *name) +{ + static struct gdimodes { + int mode; + const char *name; + } modes[] = { + { MM_ANISOTROPIC, "MM_ANISOTROPIC" }, + { MM_HIENGLISH, "MM_HIENGLISH" }, + { MM_HIMETRIC, "MM_HIMETRIC" }, + { MM_ISOTROPIC, "MM_ISOTROPIC" }, + { MM_LOENGLISH, "MM_LOENGLISH" }, + { MM_LOMETRIC, "MM_LOMETRIC" }, + { MM_TEXT, "MM_TEXT" }, + { MM_TWIPS, "MM_TWIPS" } + }; + + int i; + for (i=0; i < sizeof(modes) / sizeof(struct gdimodes); i++) + { + if ( strcmp(modes[i].name, name) == 0 ) + return modes[i].mode; + } + return atoi(name); +} + +/* +* Mode to Name converts the mode number to a printable form +*/ +static const char *GdiModeToName(int mode) +{ + static struct gdi_modes { + int mode; + const char *name; + } modes[] = { + { MM_ANISOTROPIC, "Anisotropic" }, + { MM_HIENGLISH, "1/1000 inch" }, + { MM_HIMETRIC, "1/100 mm" }, + { MM_ISOTROPIC, "Isotropic" }, + { MM_LOENGLISH, "1/100 inch" }, + { MM_LOMETRIC, "1/10 mm" }, + { MM_TEXT, "1 to 1" }, + { MM_TWIPS, "1/1440 inch" } + }; + + int i; + for (i=0; i < sizeof(modes) / sizeof(struct gdi_modes); i++) + { + if ( modes[i].mode == mode ) + return modes[i].name; + } + return "Unknown"; +} + +/* +* GdiMap - +* Set mapping mode between logical and physical device space +* Syntax for this is intended to be more-or-less independent of +* Windows/Mac/X--that is, equally difficult to use with each. +* Alternative: +* Possibly this could be a feature of the HDC extension itself? +*/ +static int GdiMap (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + static const char usage_message[] = "gdi map hdc " + "[-logical x[y]] [-physical x[y]] " + "[-offset {x y} ] [-default] [-mode mode]" + ; + HDC hdc; + int mapmode; /* Mapping mode */ + SIZE wextent; /* Device extent */ + SIZE vextent; /* Viewport extent */ + POINT worigin; /* Device origin */ + POINT vorigin; /* Viewport origin */ + int argno; + + /* Keep track of what parts of the function need to be executed */ + int need_usage = 0; + int use_logical = 0; + int use_physical = 0; + int use_offset = 0; + int use_default = 0; + int use_mode = 0; + + /* Required parameter: HDC for printer */ + if ( argc >= 1 ) + { + hdc = get_dc(interp, argv[0]); + /* Check hDC */ + if (hdc == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", 0); + return TCL_ERROR; + } + + if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) + { + /* Failed! */ + Tcl_SetResult(interp, "Cannot get current HDC info", TCL_STATIC); + return TCL_ERROR; + } + + /* Parse remaining arguments */ + for (argno = 1; argno < argc; argno++) + { + if ( strcmp(argv[argno], "-default") == 0 ) + { + vextent.cx = vextent.cy = wextent.cx = wextent.cy = 1; + vorigin.x = vorigin.y = worigin.x = worigin.y = 0; + mapmode = MM_TEXT; + use_default = 1; + } + else if ( strcmp (argv[argno], "-mode" ) == 0 ) + { + if ( argno + 1 >= argc ) + need_usage = 1; + else + { + mapmode = GdiNameToMode(argv[argno+1]); + use_mode = 1; + argno++; + } + } + else if ( strcmp (argv[argno], "-offset") == 0 ) + { + if (argno + 1 >= argc) + need_usage = 1; + else + { + /* It would be nice if this parsed units as well... */ + if ( sscanf(argv[argno+1], "%ld%ld", &vorigin.x, &vorigin.y) == 2 ) + use_offset = 1; + else + need_usage = 1; + argno ++; + } + } + else if ( strcmp (argv[argno], "-logical") == 0 ) + { + if ( argno+1 >= argc) + need_usage = 1; + else + { + int count; + argno++; + /* In "real-life", this should parse units as well. */ + if ( (count = sscanf(argv[argno], "%ld%ld", &wextent.cx, &wextent.cy)) != 2 ) + { + if ( count == 1 ) + { + mapmode = MM_ISOTROPIC; + use_logical = 1; + wextent.cy = wextent.cx; /* Make them the same */ + } + else + need_usage = 1; + } + else + { + mapmode = MM_ANISOTROPIC; + use_logical = 2; + } + } + } + else if ( strcmp (argv[argno], "-physical") == 0 ) + { + if ( argno+1 >= argc) + need_usage = 1; + else + { + int count; + + argno++; + /* In "real-life", this should parse units as well. */ + if ( (count = sscanf(argv[argno], "%ld%ld", &vextent.cx, &vextent.cy)) != 2 ) + { + if ( count == 1 ) + { + mapmode = MM_ISOTROPIC; + use_physical = 1; + vextent.cy = vextent.cx; /* Make them the same */ + } + else + need_usage = 1; + } + else + { + mapmode = MM_ANISOTROPIC; + use_physical = 2; + } + } + } + } + + /* Check for any impossible combinations */ + if ( use_logical != use_physical ) + need_usage = 1; + if ( use_default && (use_logical || use_offset || use_mode ) ) + need_usage = 1; + if ( use_mode && use_logical && + (mapmode != MM_ISOTROPIC && mapmode != MM_ANISOTROPIC) + ) + need_usage = 1; + + if ( need_usage == 0 ) + { + /* Call Windows CTM functions */ + if ( use_logical || use_default || use_mode ) /* Don't call for offset only */ + { + SetMapMode(hdc, mapmode); + } + + if ( use_offset || use_default ) + { + POINT oldorg; + SetViewportOrgEx (hdc, vorigin.x, vorigin.y, &oldorg); + SetWindowOrgEx (hdc, worigin.x, worigin.y, &oldorg); + } + + if ( use_logical ) /* Same as use_physical */ + { + SIZE oldsiz; + SetWindowExtEx (hdc, wextent.cx, wextent.cy, &oldsiz); + SetViewportExtEx (hdc, vextent.cx, vextent.cy, &oldsiz); + } + + /* Since we may not have set up every parameter, get them again for + * the report: + */ + mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent); + + /* Output current CTM info */ + /* Note: This should really be in terms that can be used in a gdi map command! */ + sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " + "Origin: \"(%ld, %ld)\" " + "MappingMode: \"%s\"", + vextent.cx, vextent.cy, wextent.cx, wextent.cy, + vorigin.x, vorigin.y, + GdiModeToName(mapmode)); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_OK; + } + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* +* GdiCopyBits +*/ +static int GdiCopyBits (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + /* Goal: get the Tk_Window from the top-level + convert it to an HWND + get the HDC + Do a bitblt to the given hdc + Use an optional parameter to point to an arbitrary window instead of the main + Use optional parameters to map to the width and height required for the dest. + */ + static const char usage_message[] = "gdi copybits hdc [-window w|-screen] [-client] " + "[-source \"a b c d\"] " + "[-destination \"a b c d\"] [-scale number] [-calc]"; + + Tk_Window mainWin; + Tk_Window workwin; + Window w; + HDC src; + HDC dst; + HWND wnd = 0; + + HANDLE hDib; /* handle for device-independent bitmap */ + LPBITMAPINFOHEADER lpDIBHdr; + LPSTR lpBits; + enum PrintType wintype = PTWindow; + + int hgt, wid; + char *strend; + long errcode; + + /* Variables to remember what we saw in the arguments */ + int do_window=0; + int do_screen=0; + int do_scale=0; + int do_print=1; + + /* Variables to remember the values in the arguments */ + const char *window_spec; + double scale=1.0; + int src_x=0, src_y=0, src_w=0, src_h=0; + int dst_x=0, dst_y=0, dst_w=0, dst_h=0; + int is_toplevel = 0; + + /* + * The following steps are peculiar to the top level window. + * There is likely a clever way to do the mapping of a + * widget pathname to the proper window, to support the idea of + * using a parameter for this purpose. + */ + if ( (workwin = mainWin = Tk_MainWindow(interp)) == 0 ) + { + Tcl_SetResult(interp, "Can't find main Tk window", TCL_STATIC); + return TCL_ERROR; + } + + /* + * Parse the arguments. + */ + /* HDC is required */ + if ( argc < 1 ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + dst = get_dc(interp, argv[0]); + + /* Check hDC */ + if (dst == (HDC)0 ) + { + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for BitBlt destination", 0); + return TCL_ERROR; + } + + /* + * Next, check to see if 'dst' can support BitBlt. + * If not, raise an error + */ + if ( ( GetDeviceCaps (dst, RASTERCAPS) & RC_BITBLT ) == 0 ) + { + sprintf(msgbuf, "Can't do bitmap operations on device context (0x%lx)", dst); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + + /* Loop through the remaining arguments */ + { + int k; + for (k=1; k= 100.0 ) + { + sprintf(msgbuf, "Unreasonable scale specification %s", argv[k]); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + do_scale = 1; + } + } + else if ( strcmp(argv[k], "-noprint") == 0 || strncmp(argv[k], "-calc", 5) == 0 ) + { + /* This option suggested by Pascal Bouvier to get sizes without printing */ + do_print = 0; + } + } + } + + /* + * Check to ensure no incompatible arguments were used + */ + if ( do_window && do_screen ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + /* + * Get the MS Window we want to copy. + */ + /* Given the HDC, we can get the "Window" */ + if (wnd == 0 ) + { + if ( Tk_IsTopLevel(workwin) ) + is_toplevel = 1; + + if ( (w = Tk_WindowId(workwin)) == 0 ) + { + Tcl_SetResult(interp, "Can't get id for Tk window", TCL_STATIC); + return TCL_ERROR; + } + + /* Given the "Window" we can get a Microsoft Windows HWND */ + + if ( (wnd = Tk_GetHWND(w)) == 0 ) + { + Tcl_SetResult(interp, "Can't get Windows handle for Tk window", TCL_STATIC); + return TCL_ERROR; + } + + /* If it's a toplevel, give it special treatment: Get the top-level window instead. + * If the user only wanted the client, the -client flag will take care of it. + * This uses "windows" tricks rather than Tk since the obvious method of + * getting the wrapper window didn't seem to work. + */ + if ( is_toplevel ) + { + HWND tmpWnd = wnd; + while ( (tmpWnd = GetParent( tmpWnd ) ) != 0 ) + wnd = tmpWnd; + } + } + + /* Given the HWND, we can get the window's device context */ + if ( (src = GetWindowDC(wnd)) == 0 ) + { + Tcl_SetResult(interp, "Can't get device context for Tk window", TCL_STATIC); + return TCL_ERROR; + } + + if ( do_screen ) + { + LONG w, h; + GetDisplaySize(&w, &h); + wid = w; + hgt = h; + } + else if ( is_toplevel ) + { + RECT tl; + GetWindowRect(wnd, &tl); + wid = tl.right - tl.left; + hgt = tl.bottom - tl.top; + } + else + { + if ( (hgt = Tk_Height(workwin)) <= 0 ) + { + Tcl_SetResult(interp, "Can't get height of Tk window", TCL_STATIC); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + if ( (wid = Tk_Width(workwin)) <= 0 ) + { + Tcl_SetResult(interp, "Can't get width of Tk window", TCL_STATIC); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + } + + /* + * Ensure all the widths and heights are set up right + * A: No dimensions are negative + * B: No dimensions exceed the maximums + * C: The dimensions don't lead to a 0 width or height image. + */ + if ( src_x < 0 ) + src_x = 0; + if ( src_y < 0 ) + src_y = 0; + if ( dst_x < 0 ) + dst_x = 0; + if ( dst_y < 0 ) + dst_y = 0; + + if ( src_w > wid || src_w <= 0 ) + src_w = wid; + + if ( src_h > hgt || src_h <= 0 ) + src_h = hgt; + + if ( do_scale && dst_w == 0 ) + { + /* Calculate destination width and height based on scale */ + dst_w = (int)(scale * src_w); + dst_h = (int)(scale * src_h); + } + + if ( dst_h == -1 ) + dst_h = (int) (((long)src_h * dst_w) / (src_w + 1)) + 1; + + if ( dst_h == 0 || dst_w == 0 ) + { + dst_h = src_h; + dst_w = src_w; + } + + if ( do_print ) + { + /* + * Based on notes from Heiko Schock and Arndt Roger Schneider, + * create this as a DIBitmap, to allow output to a greater range of + * devices. This approach will also allow selection of + * a) Whole screen + * b) Whole window + * c) Client window only + * for the "grab" + */ + hDib = CopyToDIB( wnd, wintype ); + + /* GdiFlush(); */ + + if (!hDib) { + Tcl_SetResult(interp, "Can't create DIB", TCL_STATIC); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + lpDIBHdr = (LPBITMAPINFOHEADER)GlobalLock(hDib); + if (!lpDIBHdr) { + Tcl_SetResult(interp, "Can't get DIB header", TCL_STATIC); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + lpBits = (LPSTR)lpDIBHdr + lpDIBHdr->biSize + DIBNumColors(lpDIBHdr) * sizeof(RGBQUAD); + + /* stretch the DIBbitmap directly in the target device */ + + if (StretchDIBits(dst, + dst_x, dst_y, dst_w, dst_h, + src_x, src_y, src_w, src_h, + lpBits, (LPBITMAPINFO)lpDIBHdr, DIB_RGB_COLORS, + SRCCOPY) == GDI_ERROR) + { + errcode = GetLastError(); + GlobalUnlock(hDib); + GlobalFree(hDib); + ReleaseDC(wnd,src); + sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + + /* free allocated memory */ + GlobalUnlock(hDib); + GlobalFree(hDib); + } + + ReleaseDC(wnd,src); + + /* The return value should relate to the size in the destination space. + * At least the height should be returned (for page layout purposes) + */ + sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + + return TCL_OK; +} + +/* +* Computes the number of colors required for a DIB palette +*/ +static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) +{ + WORD wBitCount; // DIB bit count + DWORD dwClrUsed; + + // If this is a Windows-style DIB, the number of colors in the + // color table can be less than the number of bits per pixel + // allows for (i.e. lpbi->biClrUsed can be set to some value). + // If this is the case, return the appropriate value. + + + dwClrUsed = (lpDIB)->biClrUsed; + if (dwClrUsed) + return (WORD)dwClrUsed; + + // Calculate the number of colors in the color table based on + // the number of bits per pixel for the DIB. + + wBitCount = (lpDIB)->biBitCount; + + // return number of colors based on bits per pixel + + switch (wBitCount) + { + case 1: + return 2; + + case 4: + return 16; + + case 8: + return 256; + + default: + return 0; + } +} + +/* +* Helper functions +*/ +static int GdiWordToWeight(const char *str); +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs); +/* +* ParseFontWords converts various keywords to modifyers of a +* font specification. +* For all words, later occurances override earlier occurances. +* Overstrike and underline cannot be "undone" by other words +*/ +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs) +{ + int i; + int retval = 0; /* Number of words that could not be parsed */ + for (i=0; ilfWeight = wt; + else if ( strcmp(str[i], "roman") == 0 ) + lf->lfItalic = FALSE; + else if ( strcmp(str[i], "italic") == 0 ) + lf->lfItalic = TRUE; + else if ( strcmp(str[i], "underline") == 0 ) + lf->lfUnderline = TRUE; + else if ( strcmp(str[i], "overstrike") == 0 ) + lf->lfStrikeOut = TRUE; + else + retval++; + } + } + return retval; +} + +/* +* GdiWordToWeight converts keywords to font weights. +* This is used to help set the proper font for GDI rendering. +*/ +static int GdiWordToWeight(const char *str) +{ + int retval = -1; + int i; + static struct font_weight + { + const char *name; + int weight; + } font_weights[] = + { + { "thin", FW_THIN }, + { "extralight", FW_EXTRALIGHT }, + { "ultralight", FW_EXTRALIGHT }, + { "light", FW_LIGHT }, + { "normal", FW_NORMAL }, + { "regular", FW_NORMAL }, + { "medium", FW_MEDIUM }, + { "semibold", FW_SEMIBOLD }, + { "demibold", FW_SEMIBOLD }, + { "bold", FW_BOLD }, + { "extrabold", FW_EXTRABOLD }, + { "ultrabold", FW_EXTRABOLD }, + { "heavy", FW_HEAVY }, + { "black", FW_HEAVY }, + }; + + if ( str == 0 ) + return -1; + + for (i=0; ilfWeight = FW_NORMAL; + lf->lfCharSet = DEFAULT_CHARSET; + lf->lfOutPrecision = OUT_DEFAULT_PRECIS; + lf->lfClipPrecision = CLIP_DEFAULT_PRECIS; + lf->lfQuality = DEFAULT_QUALITY; + lf->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; + + /* The cast to (char *) is silly, based on prototype of Tcl_SplitList */ + if ( Tcl_SplitList(interp, (char *)str, &count, &list) != TCL_OK ) + return 0; + + /* Now we have the font structure broken into name, size, weight */ + if ( count >= 1 ) + strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); + else + return 0; + + if ( count >= 2 ) + { + int siz; + char *strend; + siz = strtol(list[1], &strend, 0); + + /* Assumptions: + * 1) Like canvas, if a positive number is specified, it's in points + * 2) Like canvas, if a negative number is specified, it's in pixels + */ + if ( strend > list[1] ) /* If it looks like a number, it is a number... */ + { + if ( siz > 0 ) /* Size is in points */ + { + SIZE wextent, vextent; + POINT worigin, vorigin; + double factor; + + switch ( GdiGetHdcInfo(hDC, &worigin, &wextent, &vorigin, &vextent) ) + { + case MM_ISOTROPIC: + if ( vextent.cy < -1 || vextent.cy > 1 ) + { + factor = (double)wextent.cy / vextent.cy; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else if ( vextent.cx < -1 || vextent.cx > 1 ) + { + factor = (double)wextent.cx / vextent.cx; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else + lf->lfHeight = -siz; /* This is bad news... */ + break; + case MM_ANISOTROPIC: + if ( vextent.cy != 0 ) + { + factor = (double)wextent.cy / vextent.cy; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else + lf->lfHeight = -siz; /* This is bad news... */ + break; + case MM_TEXT: + default: + /* If mapping mode is MM_TEXT, use the documented formula */ + lf->lfHeight = -MulDiv(siz, GetDeviceCaps(hDC, LOGPIXELSY), 72); + break; + case MM_HIENGLISH: + lf->lfHeight = -MulDiv(siz, 1000, 72); + break; + case MM_LOENGLISH: + lf->lfHeight = -MulDiv(siz, 100, 72); + break; + case MM_HIMETRIC: + lf->lfHeight = -MulDiv(siz, (int)(1000*2.54), 72); + break; + case MM_LOMETRIC: + lf->lfHeight = -MulDiv(siz, (int)(100*2.54), 72); + break; + case MM_TWIPS: + lf->lfHeight = -MulDiv(siz, 1440, 72); + break; + } + } + else if ( siz == 0 ) /* Use default size of 12 points */ + lf->lfHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72); + else /* Use pixel size */ + { + lf->lfHeight = siz; /* Leave this negative */ + } + } + else + GdiParseFontWords(interp, lf, list+1, count-1); + } + + if ( count >= 3 ) + GdiParseFontWords(interp, lf, list+2, count-2); + + Tcl_Free((char *)list); + return 1; +} + +/* +* This command creates a logical pen based on input +* parameters and selects it into the HDC +*/ +/* The LOGPEN structure takes the following dash options: + * PS_SOLID: a solid pen + * PS_DASH: a dashed pen + * PS_DOT: a dotted pen + * PS_DASHDOT: a pen with a dash followed by a dot + * PS_DASHDOTDOT: a pen with a dash followed by 2 dots + * + * It seems that converting to ExtCreatePen may be more advantageous, as it matches + * the Tk canvas pens much better--but not for Win95, which does not support PS_USERSTYLE + * An explicit test (or storage in a static after first failure) may suffice for working + * around this. The ExtCreatePen is not supported at all under Win32s. +*/ +static int GdiMakePen(Tcl_Interp *interp, int width, + int dashstyle, const char *dashstyledata, + int capstyle, /* Ignored for now */ + int joinstyle, /* Ignored for now */ + int stipplestyle, const char *stippledata, /* Ignored for now */ + unsigned long color, + HDC hDC, HGDIOBJ *oldPen) +{ + HPEN hPen; + LOGBRUSH lBrush; + DWORD pStyle = PS_SOLID; /* -dash should override*/ + DWORD endStyle = PS_ENDCAP_ROUND; /* -capstyle should override */ + DWORD joinStyle = PS_JOIN_ROUND; /* -joinstyle should override */ + DWORD styleCount = 0; + DWORD *styleArray = 0; + + /* To limit the propagation of allocated memory, the dashes will have a maximum here. + * If one wishes to remove the static allocation, please be sure to update GdiFreePen + * and ensure that the array is NOT freed if the LOGPEN option is used. + */ + static DWORD pStyleData[24]; + if ( dashstyle != 0 && dashstyledata != 0 ) + { + const char *cp; + int i; + char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); + if (dup) + strcpy(dup, dashstyledata); + /* DEBUG */ + Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", dashstyledata, "|\n", 0); + + /* Parse the dash spec */ + if ( isdigit(dashstyledata[0]) ) { + cp = strtok(dup, " \t,;"); + for ( i = 0; cp && i < sizeof(pStyleData) / sizeof (DWORD); i++ ) { + pStyleData[styleCount++] = atoi(cp); + cp = strtok(NULL, " \t,;"); + } + } else { + for (i=0; dashstyledata[i] != '\0' && i< sizeof(pStyleData) / sizeof(DWORD); i++ ) { + switch ( dashstyledata[i] ) { + case ' ': + pStyleData[styleCount++] = 8; + break; + case ',': + pStyleData[styleCount++] = 4; + break; + case '_': + pStyleData[styleCount++] = 6; + break; + case '-': + pStyleData[styleCount++] = 4; + break; + case '.': + pStyleData[styleCount++] = 2; + break; + default: + break; + } + } + } + if ( styleCount > 0 ) + styleArray = pStyleData; + else + dashstyle = 0; + if (dup) + Tcl_Free(dup); + } + + if ( dashstyle != 0 ) + pStyle = PS_USERSTYLE; + + /* -stipple could affect this... */ + lBrush.lbStyle = BS_SOLID; + lBrush.lbColor = color; + lBrush.lbHatch = 0; + + /* We only use geometric pens, even for 1-pixel drawing */ + hPen = ExtCreatePen ( PS_GEOMETRIC|pStyle|endStyle|joinStyle, + width, + &lBrush, + styleCount, + styleArray); + + if ( hPen == 0 ) { /* Failed for some reason...Fall back on CreatePenIndirect */ + LOGPEN lf; + lf.lopnWidth.x = width; + lf.lopnWidth.y = 0; /* Unused in LOGPEN */ + if ( dashstyle == 0 ) + lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future */ + else + lf.lopnStyle = PS_DASH; /* REALLLLY simple for now */ + lf.lopnColor = color; /* Assume we're getting a COLORREF */ + /* Now we have a logical pen. Create the "real" pen and put it in the hDC */ + hPen = CreatePenIndirect(&lf); + } + + *oldPen = SelectObject(hDC, hPen); + return 1; +} + +/* +* FreePen wraps the protocol to delete a created pen +*/ +static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen) +{ + HGDIOBJ gonePen; + gonePen = SelectObject (hDC, oldPen); + DeleteObject (gonePen); + return 1; +} + +/* +* MakeBrush creates a logical brush based on input parameters, +* creates it, and selects it into the hdc. +*/ +static int GdiMakeBrush (Tcl_Interp *interp, unsigned int style, unsigned long color, + long hatch, LOGBRUSH *lb, HDC hDC, HGDIOBJ *oldBrush) +{ + HBRUSH hBrush; + lb->lbStyle = BS_SOLID; /* Support other styles later */ + lb->lbColor = color; /* Assume this is a COLORREF */ + lb->lbHatch = hatch; /* Ignored for now, given BS_SOLID in the Style */ + /* Now we have the logical brush. Create the "real" brush and put it in the hDC */ + hBrush = CreateBrushIndirect(lb); + *oldBrush = SelectObject(hDC, hBrush); + return 1; +} + +/* +* FreeBrush wraps the protocol to delete a created brush +*/ +static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBrush) +{ + HGDIOBJ goneBrush; + goneBrush = SelectObject (hDC, oldBrush); + DeleteObject(goneBrush); + return 1; +} + +/* +* Copied functions from elsewhere in Tcl. +* Functions have removed reliance on X and Tk libraries, +* as well as removing the need for TkWindows. +* GdiGetColor is a copy of a TkpGetColor from tkWinColor.c +* GdiParseColor is a copy of XParseColor from xcolors.c +*/ +typedef struct { + const char *name; + int index; +} SystemColorEntry; + + +static const SystemColorEntry sysColors[] = { + {"3dDarkShadow", COLOR_3DDKSHADOW}, + {"3dLight", COLOR_3DLIGHT}, + {"ActiveBorder", COLOR_ACTIVEBORDER}, + {"ActiveCaption", COLOR_ACTIVECAPTION}, + {"AppWorkspace", COLOR_APPWORKSPACE}, + {"Background", COLOR_BACKGROUND}, + {"ButtonFace", COLOR_BTNFACE}, + {"ButtonHighlight", COLOR_BTNHIGHLIGHT}, + {"ButtonShadow", COLOR_BTNSHADOW}, + {"ButtonText", COLOR_BTNTEXT}, + {"CaptionText", COLOR_CAPTIONTEXT}, + {"DisabledText", COLOR_GRAYTEXT}, + {"GrayText", COLOR_GRAYTEXT}, + {"Highlight", COLOR_HIGHLIGHT}, + {"HighlightText", COLOR_HIGHLIGHTTEXT}, + {"InactiveBorder", COLOR_INACTIVEBORDER}, + {"InactiveCaption", COLOR_INACTIVECAPTION}, + {"InactiveCaptionText", COLOR_INACTIVECAPTIONTEXT}, + {"InfoBackground", COLOR_INFOBK}, + {"InfoText", COLOR_INFOTEXT}, + {"Menu", COLOR_MENU}, + {"MenuText", COLOR_MENUTEXT}, + {"Scrollbar", COLOR_SCROLLBAR}, + {"Window", COLOR_WINDOW}, + {"WindowFrame", COLOR_WINDOWFRAME}, + {"WindowText", COLOR_WINDOWTEXT} +}; + +static int numsyscolors = 0; + +typedef struct { + const char *name; + unsigned char red; + unsigned char green; + unsigned char blue; +} XColorEntry; + +static const XColorEntry xColors[] = { + {"alice blue", 240, 248, 255}, + {"AliceBlue", 240, 248, 255}, + {"antique white", 250, 235, 215}, + {"AntiqueWhite", 250, 235, 215}, + {"AntiqueWhite1", 255, 239, 219}, + {"AntiqueWhite2", 238, 223, 204}, + {"AntiqueWhite3", 205, 192, 176}, + {"AntiqueWhite4", 139, 131, 120}, + {"aquamarine", 127, 255, 212}, + {"aquamarine1", 127, 255, 212}, + {"aquamarine2", 118, 238, 198}, + {"aquamarine3", 102, 205, 170}, + {"aquamarine4", 69, 139, 116}, + {"azure", 240, 255, 255}, + {"azure1", 240, 255, 255}, + {"azure2", 224, 238, 238}, + {"azure3", 193, 205, 205}, + {"azure4", 131, 139, 139}, + {"beige", 245, 245, 220}, + {"bisque", 255, 228, 196}, + {"bisque1", 255, 228, 196}, + {"bisque2", 238, 213, 183}, + {"bisque3", 205, 183, 158}, + {"bisque4", 139, 125, 107}, + {"black", 0, 0, 0}, + {"blanched almond", 255, 235, 205}, + {"BlanchedAlmond", 255, 235, 205}, + {"blue", 0, 0, 255}, + {"blue violet", 138, 43, 226}, + {"blue1", 0, 0, 255}, + {"blue2", 0, 0, 238}, + {"blue3", 0, 0, 205}, + {"blue4", 0, 0, 139}, + {"BlueViolet", 138, 43, 226}, + {"brown", 165, 42, 42}, + {"brown1", 255, 64, 64}, + {"brown2", 238, 59, 59}, + {"brown3", 205, 51, 51}, + {"brown4", 139, 35, 35}, + {"burlywood", 222, 184, 135}, + {"burlywood1", 255, 211, 155}, + {"burlywood2", 238, 197, 145}, + {"burlywood3", 205, 170, 125}, + {"burlywood4", 139, 115, 85}, + {"cadet blue", 95, 158, 160}, + {"CadetBlue", 95, 158, 160}, + {"CadetBlue1", 152, 245, 255}, + {"CadetBlue2", 142, 229, 238}, + {"CadetBlue3", 122, 197, 205}, + {"CadetBlue4", 83, 134, 139}, + {"chartreuse", 127, 255, 0}, + {"chartreuse1", 127, 255, 0}, + {"chartreuse2", 118, 238, 0}, + {"chartreuse3", 102, 205, 0}, + {"chartreuse4", 69, 139, 0}, + {"chocolate", 210, 105, 30}, + {"chocolate1", 255, 127, 36}, + {"chocolate2", 238, 118, 33}, + {"chocolate3", 205, 102, 29}, + {"chocolate4", 139, 69, 19}, + {"coral", 255, 127, 80}, + {"coral1", 255, 114, 86}, + {"coral2", 238, 106, 80}, + {"coral3", 205, 91, 69}, + {"coral4", 139, 62, 47}, + {"cornflower blue", 100, 149, 237}, + {"CornflowerBlue", 100, 149, 237}, + {"cornsilk", 255, 248, 220}, + {"cornsilk1", 255, 248, 220}, + {"cornsilk2", 238, 232, 205}, + {"cornsilk3", 205, 200, 177}, + {"cornsilk4", 139, 136, 120}, + {"cyan", 0, 255, 255}, + {"cyan1", 0, 255, 255}, + {"cyan2", 0, 238, 238}, + {"cyan3", 0, 205, 205}, + {"cyan4", 0, 139, 139}, + {"dark goldenrod", 184, 134, 11}, + {"dark green", 0, 100, 0}, + {"dark khaki", 189, 183, 107}, + {"dark olive green", 85, 107, 47}, + {"dark orange", 255, 140, 0}, + {"dark orchid", 153, 50, 204}, + {"dark salmon", 233, 150, 122}, + {"dark sea green", 143, 188, 143}, + {"dark slate blue", 72, 61, 139}, + {"dark slate gray", 47, 79, 79}, + {"dark slate grey", 47, 79, 79}, + {"dark turquoise", 0, 206, 209}, + {"dark violet", 148, 0, 211}, + {"DarkGoldenrod", 184, 134, 11}, + {"DarkGoldenrod1", 255, 185, 15}, + {"DarkGoldenrod2", 238, 173, 14}, + {"DarkGoldenrod3", 205, 149, 12}, + {"DarkGoldenrod4", 139, 101, 8}, + {"DarkGreen", 0, 100, 0}, + {"DarkKhaki", 189, 183, 107}, + {"DarkOliveGreen", 85, 107, 47}, + {"DarkOliveGreen1", 202, 255, 112}, + {"DarkOliveGreen2", 188, 238, 104}, + {"DarkOliveGreen3", 162, 205, 90}, + {"DarkOliveGreen4", 110, 139, 61}, + {"DarkOrange", 255, 140, 0}, + {"DarkOrange1", 255, 127, 0}, + {"DarkOrange2", 238, 118, 0}, + {"DarkOrange3", 205, 102, 0}, + {"DarkOrange4", 139, 69, 0}, + {"DarkOrchid", 153, 50, 204}, + {"DarkOrchid1", 191, 62, 255}, + {"DarkOrchid2", 178, 58, 238}, + {"DarkOrchid3", 154, 50, 205}, + {"DarkOrchid4", 104, 34, 139}, + {"DarkSalmon", 233, 150, 122}, + {"DarkSeaGreen", 143, 188, 143}, + {"DarkSeaGreen1", 193, 255, 193}, + {"DarkSeaGreen2", 180, 238, 180}, + {"DarkSeaGreen3", 155, 205, 155}, + {"DarkSeaGreen4", 105, 139, 105}, + {"DarkSlateBlue", 72, 61, 139}, + {"DarkSlateGray", 47, 79, 79}, + {"DarkSlateGray1", 151, 255, 255}, + {"DarkSlateGray2", 141, 238, 238}, + {"DarkSlateGray3", 121, 205, 205}, + {"DarkSlateGray4", 82, 139, 139}, + {"DarkSlateGrey", 47, 79, 79}, + {"DarkTurquoise", 0, 206, 209}, + {"DarkViolet", 148, 0, 211}, + {"deep pink", 255, 20, 147}, + {"deep sky blue", 0, 191, 255}, + {"DeepPink", 255, 20, 147}, + {"DeepPink1", 255, 20, 147}, + {"DeepPink2", 238, 18, 137}, + {"DeepPink3", 205, 16, 118}, + {"DeepPink4", 139, 10, 80}, + {"DeepSkyBlue", 0, 191, 255}, + {"DeepSkyBlue1", 0, 191, 255}, + {"DeepSkyBlue2", 0, 178, 238}, + {"DeepSkyBlue3", 0, 154, 205}, + {"DeepSkyBlue4", 0, 104, 139}, + {"dim gray", 105, 105, 105}, + {"dim grey", 105, 105, 105}, + {"DimGray", 105, 105, 105}, + {"DimGrey", 105, 105, 105}, + {"dodger blue", 30, 144, 255}, + {"DodgerBlue", 30, 144, 255}, + {"DodgerBlue1", 30, 144, 255}, + {"DodgerBlue2", 28, 134, 238}, + {"DodgerBlue3", 24, 116, 205}, + {"DodgerBlue4", 16, 78, 139}, + {"firebrick", 178, 34, 34}, + {"firebrick1", 255, 48, 48}, + {"firebrick2", 238, 44, 44}, + {"firebrick3", 205, 38, 38}, + {"firebrick4", 139, 26, 26}, + {"floral white", 255, 250, 240}, + {"FloralWhite", 255, 250, 240}, + {"forest green", 34, 139, 34}, + {"ForestGreen", 34, 139, 34}, + {"gainsboro", 220, 220, 220}, + {"ghost white", 248, 248, 255}, + {"GhostWhite", 248, 248, 255}, + {"gold", 255, 215, 0}, + {"gold1", 255, 215, 0}, + {"gold2", 238, 201, 0}, + {"gold3", 205, 173, 0}, + {"gold4", 139, 117, 0}, + {"goldenrod", 218, 165, 32}, + {"goldenrod1", 255, 193, 37}, + {"goldenrod2", 238, 180, 34}, + {"goldenrod3", 205, 155, 29}, + {"goldenrod4", 139, 105, 20}, + {"gray", 190, 190, 190}, + {"gray0", 0, 0, 0}, + {"gray1", 3, 3, 3}, + {"gray10", 26, 26, 26}, + {"gray100", 255, 255, 255}, + {"gray11", 28, 28, 28}, + {"gray12", 31, 31, 31}, + {"gray13", 33, 33, 33}, + {"gray14", 36, 36, 36}, + {"gray15", 38, 38, 38}, + {"gray16", 41, 41, 41}, + {"gray17", 43, 43, 43}, + {"gray18", 46, 46, 46}, + {"gray19", 48, 48, 48}, + {"gray2", 5, 5, 5}, + {"gray20", 51, 51, 51}, + {"gray21", 54, 54, 54}, + {"gray22", 56, 56, 56}, + {"gray23", 59, 59, 59}, + {"gray24", 61, 61, 61}, + {"gray25", 64, 64, 64}, + {"gray26", 66, 66, 66}, + {"gray27", 69, 69, 69}, + {"gray28", 71, 71, 71}, + {"gray29", 74, 74, 74}, + {"gray3", 8, 8, 8}, + {"gray30", 77, 77, 77}, + {"gray31", 79, 79, 79}, + {"gray32", 82, 82, 82}, + {"gray33", 84, 84, 84}, + {"gray34", 87, 87, 87}, + {"gray35", 89, 89, 89}, + {"gray36", 92, 92, 92}, + {"gray37", 94, 94, 94}, + {"gray38", 97, 97, 97}, + {"gray39", 99, 99, 99}, + {"gray4", 10, 10, 10}, + {"gray40", 102, 102, 102}, + {"gray41", 105, 105, 105}, + {"gray42", 107, 107, 107}, + {"gray43", 110, 110, 110}, + {"gray44", 112, 112, 112}, + {"gray45", 115, 115, 115}, + {"gray46", 117, 117, 117}, + {"gray47", 120, 120, 120}, + {"gray48", 122, 122, 122}, + {"gray49", 125, 125, 125}, + {"gray5", 13, 13, 13}, + {"gray50", 127, 127, 127}, + {"gray51", 130, 130, 130}, + {"gray52", 133, 133, 133}, + {"gray53", 135, 135, 135}, + {"gray54", 138, 138, 138}, + {"gray55", 140, 140, 140}, + {"gray56", 143, 143, 143}, + {"gray57", 145, 145, 145}, + {"gray58", 148, 148, 148}, + {"gray59", 150, 150, 150}, + {"gray6", 15, 15, 15}, + {"gray60", 153, 153, 153}, + {"gray61", 156, 156, 156}, + {"gray62", 158, 158, 158}, + {"gray63", 161, 161, 161}, + {"gray64", 163, 163, 163}, + {"gray65", 166, 166, 166}, + {"gray66", 168, 168, 168}, + {"gray67", 171, 171, 171}, + {"gray68", 173, 173, 173}, + {"gray69", 176, 176, 176}, + {"gray7", 18, 18, 18}, + {"gray70", 179, 179, 179}, + {"gray71", 181, 181, 181}, + {"gray72", 184, 184, 184}, + {"gray73", 186, 186, 186}, + {"gray74", 189, 189, 189}, + {"gray75", 191, 191, 191}, + {"gray76", 194, 194, 194}, + {"gray77", 196, 196, 196}, + {"gray78", 199, 199, 199}, + {"gray79", 201, 201, 201}, + {"gray8", 20, 20, 20}, + {"gray80", 204, 204, 204}, + {"gray81", 207, 207, 207}, + {"gray82", 209, 209, 209}, + {"gray83", 212, 212, 212}, + {"gray84", 214, 214, 214}, + {"gray85", 217, 217, 217}, + {"gray86", 219, 219, 219}, + {"gray87", 222, 222, 222}, + {"gray88", 224, 224, 224}, + {"gray89", 227, 227, 227}, + {"gray9", 23, 23, 23}, + {"gray90", 229, 229, 229}, + {"gray91", 232, 232, 232}, + {"gray92", 235, 235, 235}, + {"gray93", 237, 237, 237}, + {"gray94", 240, 240, 240}, + {"gray95", 242, 242, 242}, + {"gray96", 245, 245, 245}, + {"gray97", 247, 247, 247}, + {"gray98", 250, 250, 250}, + {"gray99", 252, 252, 252}, + {"green", 0, 255, 0}, + {"green yellow", 173, 255, 47}, + {"green1", 0, 255, 0}, + {"green2", 0, 238, 0}, + {"green3", 0, 205, 0}, + {"green4", 0, 139, 0}, + {"GreenYellow", 173, 255, 47}, + {"grey", 190, 190, 190}, + {"grey0", 0, 0, 0}, + {"grey1", 3, 3, 3}, + {"grey10", 26, 26, 26}, + {"grey100", 255, 255, 255}, + {"grey11", 28, 28, 28}, + {"grey12", 31, 31, 31}, + {"grey13", 33, 33, 33}, + {"grey14", 36, 36, 36}, + {"grey15", 38, 38, 38}, + {"grey16", 41, 41, 41}, + {"grey17", 43, 43, 43}, + {"grey18", 46, 46, 46}, + {"grey19", 48, 48, 48}, + {"grey2", 5, 5, 5}, + {"grey20", 51, 51, 51}, + {"grey21", 54, 54, 54}, + {"grey22", 56, 56, 56}, + {"grey23", 59, 59, 59}, + {"grey24", 61, 61, 61}, + {"grey25", 64, 64, 64}, + {"grey26", 66, 66, 66}, + {"grey27", 69, 69, 69}, + {"grey28", 71, 71, 71}, + {"grey29", 74, 74, 74}, + {"grey3", 8, 8, 8}, + {"grey30", 77, 77, 77}, + {"grey31", 79, 79, 79}, + {"grey32", 82, 82, 82}, + {"grey33", 84, 84, 84}, + {"grey34", 87, 87, 87}, + {"grey35", 89, 89, 89}, + {"grey36", 92, 92, 92}, + {"grey37", 94, 94, 94}, + {"grey38", 97, 97, 97}, + {"grey39", 99, 99, 99}, + {"grey4", 10, 10, 10}, + {"grey40", 102, 102, 102}, + {"grey41", 105, 105, 105}, + {"grey42", 107, 107, 107}, + {"grey43", 110, 110, 110}, + {"grey44", 112, 112, 112}, + {"grey45", 115, 115, 115}, + {"grey46", 117, 117, 117}, + {"grey47", 120, 120, 120}, + {"grey48", 122, 122, 122}, + {"grey49", 125, 125, 125}, + {"grey5", 13, 13, 13}, + {"grey50", 127, 127, 127}, + {"grey51", 130, 130, 130}, + {"grey52", 133, 133, 133}, + {"grey53", 135, 135, 135}, + {"grey54", 138, 138, 138}, + {"grey55", 140, 140, 140}, + {"grey56", 143, 143, 143}, + {"grey57", 145, 145, 145}, + {"grey58", 148, 148, 148}, + {"grey59", 150, 150, 150}, + {"grey6", 15, 15, 15}, + {"grey60", 153, 153, 153}, + {"grey61", 156, 156, 156}, + {"grey62", 158, 158, 158}, + {"grey63", 161, 161, 161}, + {"grey64", 163, 163, 163}, + {"grey65", 166, 166, 166}, + {"grey66", 168, 168, 168}, + {"grey67", 171, 171, 171}, + {"grey68", 173, 173, 173}, + {"grey69", 176, 176, 176}, + {"grey7", 18, 18, 18}, + {"grey70", 179, 179, 179}, + {"grey71", 181, 181, 181}, + {"grey72", 184, 184, 184}, + {"grey73", 186, 186, 186}, + {"grey74", 189, 189, 189}, + {"grey75", 191, 191, 191}, + {"grey76", 194, 194, 194}, + {"grey77", 196, 196, 196}, + {"grey78", 199, 199, 199}, + {"grey79", 201, 201, 201}, + {"grey8", 20, 20, 20}, + {"grey80", 204, 204, 204}, + {"grey81", 207, 207, 207}, + {"grey82", 209, 209, 209}, + {"grey83", 212, 212, 212}, + {"grey84", 214, 214, 214}, + {"grey85", 217, 217, 217}, + {"grey86", 219, 219, 219}, + {"grey87", 222, 222, 222}, + {"grey88", 224, 224, 224}, + {"grey89", 227, 227, 227}, + {"grey9", 23, 23, 23}, + {"grey90", 229, 229, 229}, + {"grey91", 232, 232, 232}, + {"grey92", 235, 235, 235}, + {"grey93", 237, 237, 237}, + {"grey94", 240, 240, 240}, + {"grey95", 242, 242, 242}, + {"grey96", 245, 245, 245}, + {"grey97", 247, 247, 247}, + {"grey98", 250, 250, 250}, + {"grey99", 252, 252, 252}, + {"honeydew", 240, 255, 240}, + {"honeydew1", 240, 255, 240}, + {"honeydew2", 224, 238, 224}, + {"honeydew3", 193, 205, 193}, + {"honeydew4", 131, 139, 131}, + {"hot pink", 255, 105, 180}, + {"HotPink", 255, 105, 180}, + {"HotPink1", 255, 110, 180}, + {"HotPink2", 238, 106, 167}, + {"HotPink3", 205, 96, 144}, + {"HotPink4", 139, 58, 98}, + {"indian red", 205, 92, 92}, + {"IndianRed", 205, 92, 92}, + {"IndianRed1", 255, 106, 106}, + {"IndianRed2", 238, 99, 99}, + {"IndianRed3", 205, 85, 85}, + {"IndianRed4", 139, 58, 58}, + {"ivory", 255, 255, 240}, + {"ivory1", 255, 255, 240}, + {"ivory2", 238, 238, 224}, + {"ivory3", 205, 205, 193}, + {"ivory4", 139, 139, 131}, + {"khaki", 240, 230, 140}, + {"khaki1", 255, 246, 143}, + {"khaki2", 238, 230, 133}, + {"khaki3", 205, 198, 115}, + {"khaki4", 139, 134, 78}, + {"lavender", 230, 230, 250}, + {"lavender blush", 255, 240, 245}, + {"LavenderBlush", 255, 240, 245}, + {"LavenderBlush1", 255, 240, 245}, + {"LavenderBlush2", 238, 224, 229}, + {"LavenderBlush3", 205, 193, 197}, + {"LavenderBlush4", 139, 131, 134}, + {"lawn green", 124, 252, 0}, + {"LawnGreen", 124, 252, 0}, + {"lemon chiffon", 255, 250, 205}, + {"LemonChiffon", 255, 250, 205}, + {"LemonChiffon1", 255, 250, 205}, + {"LemonChiffon2", 238, 233, 191}, + {"LemonChiffon3", 205, 201, 165}, + {"LemonChiffon4", 139, 137, 112}, + {"light blue", 173, 216, 230}, + {"light coral", 240, 128, 128}, + {"light cyan", 224, 255, 255}, + {"light goldenrod", 238, 221, 130}, + {"light goldenrod yellow", 250, 250, 210}, + {"light gray", 211, 211, 211}, + {"light grey", 211, 211, 211}, + {"light pink", 255, 182, 193}, + {"light salmon", 255, 160, 122}, + {"light sea green", 32, 178, 170}, + {"light sky blue", 135, 206, 250}, + {"light slate blue", 132, 112, 255}, + {"light slate gray", 119, 136, 153}, + {"light slate grey", 119, 136, 153}, + {"light steel blue", 176, 196, 222}, + {"light yellow", 255, 255, 224}, + {"LightBlue", 173, 216, 230}, + {"LightBlue1", 191, 239, 255}, + {"LightBlue2", 178, 223, 238}, + {"LightBlue3", 154, 192, 205}, + {"LightBlue4", 104, 131, 139}, + {"LightCoral", 240, 128, 128}, + {"LightCyan", 224, 255, 255}, + {"LightCyan1", 224, 255, 255}, + {"LightCyan2", 209, 238, 238}, + {"LightCyan3", 180, 205, 205}, + {"LightCyan4", 122, 139, 139}, + {"LightGoldenrod", 238, 221, 130}, + {"LightGoldenrod1", 255, 236, 139}, + {"LightGoldenrod2", 238, 220, 130}, + {"LightGoldenrod3", 205, 190, 112}, + {"LightGoldenrod4", 139, 129, 76}, + {"LightGoldenrodYellow", 250, 250, 210}, + {"LightGray", 211, 211, 211}, + {"LightGrey", 211, 211, 211}, + {"LightPink", 255, 182, 193}, + {"LightPink1", 255, 174, 185}, + {"LightPink2", 238, 162, 173}, + {"LightPink3", 205, 140, 149}, + {"LightPink4", 139, 95, 101}, + {"LightSalmon", 255, 160, 122}, + {"LightSalmon1", 255, 160, 122}, + {"LightSalmon2", 238, 149, 114}, + {"LightSalmon3", 205, 129, 98}, + {"LightSalmon4", 139, 87, 66}, + {"LightSeaGreen", 32, 178, 170}, + {"LightSkyBlue", 135, 206, 250}, + {"LightSkyBlue1", 176, 226, 255}, + {"LightSkyBlue2", 164, 211, 238}, + {"LightSkyBlue3", 141, 182, 205}, + {"LightSkyBlue4", 96, 123, 139}, + {"LightSlateBlue", 132, 112, 255}, + {"LightSlateGray", 119, 136, 153}, + {"LightSlateGrey", 119, 136, 153}, + {"LightSteelBlue", 176, 196, 222}, + {"LightSteelBlue1", 202, 225, 255}, + {"LightSteelBlue2", 188, 210, 238}, + {"LightSteelBlue3", 162, 181, 205}, + {"LightSteelBlue4", 110, 123, 139}, + {"LightYellow", 255, 255, 224}, + {"LightYellow1", 255, 255, 224}, + {"LightYellow2", 238, 238, 209}, + {"LightYellow3", 205, 205, 180}, + {"LightYellow4", 139, 139, 122}, + {"lime green", 50, 205, 50}, + {"LimeGreen", 50, 205, 50}, + {"linen", 250, 240, 230}, + {"magenta", 255, 0, 255}, + {"magenta1", 255, 0, 255}, + {"magenta2", 238, 0, 238}, + {"magenta3", 205, 0, 205}, + {"magenta4", 139, 0, 139}, + {"maroon", 176, 48, 96}, + {"maroon1", 255, 52, 179}, + {"maroon2", 238, 48, 167}, + {"maroon3", 205, 41, 144}, + {"maroon4", 139, 28, 98}, + {"medium aquamarine", 102, 205, 170}, + {"medium blue", 0, 0, 205}, + {"medium orchid", 186, 85, 211}, + {"medium purple", 147, 112, 219}, + {"medium sea green", 60, 179, 113}, + {"medium slate blue", 123, 104, 238}, + {"medium spring green", 0, 250, 154}, + {"medium turquoise", 72, 209, 204}, + {"medium violet red", 199, 21, 133}, + {"MediumAquamarine", 102, 205, 170}, + {"MediumBlue", 0, 0, 205}, + {"MediumOrchid", 186, 85, 211}, + {"MediumOrchid1", 224, 102, 255}, + {"MediumOrchid2", 209, 95, 238}, + {"MediumOrchid3", 180, 82, 205}, + {"MediumOrchid4", 122, 55, 139}, + {"MediumPurple", 147, 112, 219}, + {"MediumPurple1", 171, 130, 255}, + {"MediumPurple2", 159, 121, 238}, + {"MediumPurple3", 137, 104, 205}, + {"MediumPurple4", 93, 71, 139}, + {"MediumSeaGreen", 60, 179, 113}, + {"MediumSlateBlue", 123, 104, 238}, + {"MediumSpringGreen", 0, 250, 154}, + {"MediumTurquoise", 72, 209, 204}, + {"MediumVioletRed", 199, 21, 133}, + {"midnight blue", 25, 25, 112}, + {"MidnightBlue", 25, 25, 112}, + {"mint cream", 245, 255, 250}, + {"MintCream", 245, 255, 250}, + {"misty rose", 255, 228, 225}, + {"MistyRose", 255, 228, 225}, + {"MistyRose1", 255, 228, 225}, + {"MistyRose2", 238, 213, 210}, + {"MistyRose3", 205, 183, 181}, + {"MistyRose4", 139, 125, 123}, + {"moccasin", 255, 228, 181}, + {"navajo white", 255, 222, 173}, + {"NavajoWhite", 255, 222, 173}, + {"NavajoWhite1", 255, 222, 173}, + {"NavajoWhite2", 238, 207, 161}, + {"NavajoWhite3", 205, 179, 139}, + {"NavajoWhite4", 139, 121, 94}, + {"navy", 0, 0, 128}, + {"navy blue", 0, 0, 128}, + {"NavyBlue", 0, 0, 128}, + {"old lace", 253, 245, 230}, + {"OldLace", 253, 245, 230}, + {"olive drab", 107, 142, 35}, + {"OliveDrab", 107, 142, 35}, + {"OliveDrab1", 192, 255, 62}, + {"OliveDrab2", 179, 238, 58}, + {"OliveDrab3", 154, 205, 50}, + {"OliveDrab4", 105, 139, 34}, + {"orange", 255, 165, 0}, + {"orange red", 255, 69, 0}, + {"orange1", 255, 165, 0}, + {"orange2", 238, 154, 0}, + {"orange3", 205, 133, 0}, + {"orange4", 139, 90, 0}, + {"OrangeRed", 255, 69, 0}, + {"OrangeRed1", 255, 69, 0}, + {"OrangeRed2", 238, 64, 0}, + {"OrangeRed3", 205, 55, 0}, + {"OrangeRed4", 139, 37, 0}, + {"orchid", 218, 112, 214}, + {"orchid1", 255, 131, 250}, + {"orchid2", 238, 122, 233}, + {"orchid3", 205, 105, 201}, + {"orchid4", 139, 71, 137}, + {"pale goldenrod", 238, 232, 170}, + {"pale green", 152, 251, 152}, + {"pale turquoise", 175, 238, 238}, + {"pale violet red", 219, 112, 147}, + {"PaleGoldenrod", 238, 232, 170}, + {"PaleGreen", 152, 251, 152}, + {"PaleGreen1", 154, 255, 154}, + {"PaleGreen2", 144, 238, 144}, + {"PaleGreen3", 124, 205, 124}, + {"PaleGreen4", 84, 139, 84}, + {"PaleTurquoise", 175, 238, 238}, + {"PaleTurquoise1", 187, 255, 255}, + {"PaleTurquoise2", 174, 238, 238}, + {"PaleTurquoise3", 150, 205, 205}, + {"PaleTurquoise4", 102, 139, 139}, + {"PaleVioletRed", 219, 112, 147}, + {"PaleVioletRed1", 255, 130, 171}, + {"PaleVioletRed2", 238, 121, 159}, + {"PaleVioletRed3", 205, 104, 137}, + {"PaleVioletRed4", 139, 71, 93}, + {"papaya whip", 255, 239, 213}, + {"PapayaWhip", 255, 239, 213}, + {"peach puff", 255, 218, 185}, + {"PeachPuff", 255, 218, 185}, + {"PeachPuff1", 255, 218, 185}, + {"PeachPuff2", 238, 203, 173}, + {"PeachPuff3", 205, 175, 149}, + {"PeachPuff4", 139, 119, 101}, + {"peru", 205, 133, 63}, + {"pink", 255, 192, 203}, + {"pink1", 255, 181, 197}, + {"pink2", 238, 169, 184}, + {"pink3", 205, 145, 158}, + {"pink4", 139, 99, 108}, + {"plum", 221, 160, 221}, + {"plum1", 255, 187, 255}, + {"plum2", 238, 174, 238}, + {"plum3", 205, 150, 205}, + {"plum4", 139, 102, 139}, + {"powder blue", 176, 224, 230}, + {"PowderBlue", 176, 224, 230}, + {"purple", 160, 32, 240}, + {"purple1", 155, 48, 255}, + {"purple2", 145, 44, 238}, + {"purple3", 125, 38, 205}, + {"purple4", 85, 26, 139}, + {"red", 255, 0, 0}, + {"red1", 255, 0, 0}, + {"red2", 238, 0, 0}, + {"red3", 205, 0, 0}, + {"red4", 139, 0, 0}, + {"rosy brown", 188, 143, 143}, + {"RosyBrown", 188, 143, 143}, + {"RosyBrown1", 255, 193, 193}, + {"RosyBrown2", 238, 180, 180}, + {"RosyBrown3", 205, 155, 155}, + {"RosyBrown4", 139, 105, 105}, + {"royal blue", 65, 105, 225}, + {"RoyalBlue", 65, 105, 225}, + {"RoyalBlue1", 72, 118, 255}, + {"RoyalBlue2", 67, 110, 238}, + {"RoyalBlue3", 58, 95, 205}, + {"RoyalBlue4", 39, 64, 139}, + {"saddle brown", 139, 69, 19}, + {"SaddleBrown", 139, 69, 19}, + {"salmon", 250, 128, 114}, + {"salmon1", 255, 140, 105}, + {"salmon2", 238, 130, 98}, + {"salmon3", 205, 112, 84}, + {"salmon4", 139, 76, 57}, + {"sandy brown", 244, 164, 96}, + {"SandyBrown", 244, 164, 96}, + {"sea green", 46, 139, 87}, + {"SeaGreen", 46, 139, 87}, + {"SeaGreen1", 84, 255, 159}, + {"SeaGreen2", 78, 238, 148}, + {"SeaGreen3", 67, 205, 128}, + {"SeaGreen4", 46, 139, 87}, + {"seashell", 255, 245, 238}, + {"seashell1", 255, 245, 238}, + {"seashell2", 238, 229, 222}, + {"seashell3", 205, 197, 191}, + {"seashell4", 139, 134, 130}, + {"sienna", 160, 82, 45}, + {"sienna1", 255, 130, 71}, + {"sienna2", 238, 121, 66}, + {"sienna3", 205, 104, 57}, + {"sienna4", 139, 71, 38}, + {"sky blue", 135, 206, 235}, + {"SkyBlue", 135, 206, 235}, + {"SkyBlue1", 135, 206, 255}, + {"SkyBlue2", 126, 192, 238}, + {"SkyBlue3", 108, 166, 205}, + {"SkyBlue4", 74, 112, 139}, + {"slate blue", 106, 90, 205}, + {"slate gray", 112, 128, 144}, + {"slate grey", 112, 128, 144}, + {"SlateBlue", 106, 90, 205}, + {"SlateBlue1", 131, 111, 255}, + {"SlateBlue2", 122, 103, 238}, + {"SlateBlue3", 105, 89, 205}, + {"SlateBlue4", 71, 60, 139}, + {"SlateGray", 112, 128, 144}, + {"SlateGray1", 198, 226, 255}, + {"SlateGray2", 185, 211, 238}, + {"SlateGray3", 159, 182, 205}, + {"SlateGray4", 108, 123, 139}, + {"SlateGrey", 112, 128, 144}, + {"snow", 255, 250, 250}, + {"snow1", 255, 250, 250}, + {"snow2", 238, 233, 233}, + {"snow3", 205, 201, 201}, + {"snow4", 139, 137, 137}, + {"spring green", 0, 255, 127}, + {"SpringGreen", 0, 255, 127}, + {"SpringGreen1", 0, 255, 127}, + {"SpringGreen2", 0, 238, 118}, + {"SpringGreen3", 0, 205, 102}, + {"SpringGreen4", 0, 139, 69}, + {"steel blue", 70, 130, 180}, + {"SteelBlue", 70, 130, 180}, + {"SteelBlue1", 99, 184, 255}, + {"SteelBlue2", 92, 172, 238}, + {"SteelBlue3", 79, 148, 205}, + {"SteelBlue4", 54, 100, 139}, + {"tan", 210, 180, 140}, + {"tan1", 255, 165, 79}, + {"tan2", 238, 154, 73}, + {"tan3", 205, 133, 63}, + {"tan4", 139, 90, 43}, + {"thistle", 216, 191, 216}, + {"thistle1", 255, 225, 255}, + {"thistle2", 238, 210, 238}, + {"thistle3", 205, 181, 205}, + {"thistle4", 139, 123, 139}, + {"tomato", 255, 99, 71}, + {"tomato1", 255, 99, 71}, + {"tomato2", 238, 92, 66}, + {"tomato3", 205, 79, 57}, + {"tomato4", 139, 54, 38}, + {"turquoise", 64, 224, 208}, + {"turquoise1", 0, 245, 255}, + {"turquoise2", 0, 229, 238}, + {"turquoise3", 0, 197, 205}, + {"turquoise4", 0, 134, 139}, + {"violet", 238, 130, 238}, + {"violet red", 208, 32, 144}, + {"VioletRed", 208, 32, 144}, + {"VioletRed1", 255, 62, 150}, + {"VioletRed2", 238, 58, 140}, + {"VioletRed3", 205, 50, 120}, + {"VioletRed4", 139, 34, 82}, + {"wheat", 245, 222, 179}, + {"wheat1", 255, 231, 186}, + {"wheat2", 238, 216, 174}, + {"wheat3", 205, 186, 150}, + {"wheat4", 139, 126, 102}, + {"white", 255, 255, 255}, + {"white smoke", 245, 245, 245}, + {"WhiteSmoke", 245, 245, 245}, + {"yellow", 255, 255, 0}, + {"yellow green", 154, 205, 50}, + {"yellow1", 255, 255, 0}, + {"yellow2", 238, 238, 0}, + {"yellow3", 205, 205, 0}, + {"yellow4", 139, 139, 0}, + {"YellowGreen", 154, 205, 50}, +}; + +static int numxcolors=0; + +/* +* Convert color name to color specification +*/ +static int GdiGetColor(const char *name, unsigned long *color) +{ + if ( numsyscolors == 0 ) + numsyscolors = sizeof ( sysColors ) / sizeof (SystemColorEntry); + if ( _strnicmp(name, "system", 6) == 0 ) + { + int i, l, u, r; + l = 0; + u = numsyscolors; + while ( l <= u ) + { + i = (l + u) / 2; + if ( (r = _strcmpi(name+6, sysColors[i].name)) == 0 ) + break; + if ( r < 0 ) + u = i - 1; + else + l = i + 1; + } + if ( l > u ) + return 0; + *color = GetSysColor(sysColors[i].index); + return 1; + } + else + return GdiParseColor(name, color); +} + +/* +* Convert color specification string (which could be an RGB string) +* to a color RGB triple +*/ +static int GdiParseColor (const char *name, unsigned long *color) +{ + if ( name[0] == '#' ) + { + char fmt[16]; + int i; + unsigned red, green, blue; + + if ( (i = strlen(name+1))%3 != 0 || i > 12 || i < 3) + return 0; + i /= 3; + sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i); + if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { + return 0; + } + /* Now this is windows specific -- each component is at most 8 bits */ + switch ( i ) + { + case 1: + red <<= 4; + green <<= 4; + blue <<= 4; + break; + case 2: + break; + case 3: + red >>= 4; + green >>= 4; + blue >>= 4; + break; + case 4: + red >>= 8; + green >>= 8; + blue >>= 8; + break; + } + *color = RGB(red, green, blue); + return 1; + } + else + { + int i, u, r, l; + if ( numxcolors == 0 ) + numxcolors = sizeof(xColors) / sizeof(XColorEntry); + l = 0; + u = numxcolors; + + while ( l <= u) + { + i = (l + u) / 2; + if ( (r = _strcmpi(name, xColors[i].name)) == 0 ) + break; + if ( r < 0 ) + u = i-1; + else + l = i+1; + } + if ( l > u ) + return 0; + *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); + return 1; + } +} + +/* +* Beginning of functions for screen-to-dib translations +* Several of these functions are based on those in the WINCAP32 +* program provided as a sample by Microsoft on the VC++ 5.0 +* disk. The copyright on these functions is retained, even for +* those with significant changes. +* I do not understand the meaning of this copyright in this +* context, since the example is present to provide insight into +* the rather baroque mechanism used to manipulate DIBs. +*/ + +static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) +{ + HANDLE hDIB; + HBITMAP hBitmap; + HPALETTE hPalette; + + /* check for a valid window handle */ + + if (!hWnd) + return NULL; + + switch (type) + { + case PTWindow: /* copy entire window */ + { + RECT rectWnd; + + /* get the window rectangle */ + + GetWindowRect(hWnd, &rectWnd); + + /* get the DIB of the window by calling + * CopyScreenToDIB and passing it the window rect + */ + + hDIB = CopyScreenToDIB(&rectWnd); + break; + } + + case PTClient: /* copy client area */ + { + RECT rectClient; + POINT pt1, pt2; + + /* get the client area dimensions */ + + GetClientRect(hWnd, &rectClient); + + /* convert client coords to screen coords */ + + pt1.x = rectClient.left; + pt1.y = rectClient.top; + pt2.x = rectClient.right; + pt2.y = rectClient.bottom; + ClientToScreen(hWnd, &pt1); + ClientToScreen(hWnd, &pt2); + rectClient.left = pt1.x; + rectClient.top = pt1.y; + rectClient.right = pt2.x; + rectClient.bottom = pt2.y; + + /* get the DIB of the client area by calling + * CopyScreenToDIB and passing it the client rect + */ + + hDIB = CopyScreenToDIB(&rectClient); + break; + } + + case PTScreen: /* Entire screen */ + { + RECT Rect; + + /* get the device-dependent bitmap in lpRect by calling + * CopyScreenToBitmap and passing it the rectangle to grab + */ + Rect.top = Rect.left = 0; + GetDisplaySize(&Rect.right, &Rect.bottom); + + hBitmap = CopyScreenToBitmap(&Rect); + + /* check for a valid bitmap handle */ + + if (!hBitmap) + return NULL; + + /* get the current palette */ + + hPalette = GetSystemPalette(); + + /* convert the bitmap to a DIB */ + + hDIB = BitmapToDIB(hBitmap, hPalette); + + /* clean up */ + + DeleteObject(hPalette); + DeleteObject(hBitmap); + + /* return handle to the packed-DIB */ + } + break; + default: /* invalid print area */ + return NULL; + } + + /* return the handle to the DIB */ + return hDIB; +} + +/* +* GetDisplaySize does just that. +* There may be an easier way, but I just haven't found it. +*/ +static void GetDisplaySize (LONG *width, LONG *height) +{ + HDC hDC; + + hDC = CreateDC("DISPLAY", 0, 0, 0); + *width = GetDeviceCaps (hDC, HORZRES); + *height = GetDeviceCaps (hDC, VERTRES); + DeleteDC(hDC); +} + + +static HBITMAP CopyScreenToBitmap(LPRECT lpRect) +{ + HDC hScrDC, hMemDC; /* screen DC and memory DC */ + HBITMAP hBitmap, hOldBitmap; /* handles to deice-dependent bitmaps */ + int nX, nY, nX2, nY2; /* coordinates of rectangle to grab */ + int nWidth, nHeight; /* DIB width and height */ + int xScrn, yScrn; /* screen resolution */ + + /* check for an empty rectangle */ + + if (IsRectEmpty(lpRect)) + return NULL; + + /* create a DC for the screen and create + * a memory DC compatible to screen DC + */ + + hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL); + hMemDC = CreateCompatibleDC(hScrDC); + + /* get points of rectangle to grab */ + + nX = lpRect->left; + nY = lpRect->top; + nX2 = lpRect->right; + nY2 = lpRect->bottom; + + /* get screen resolution */ + + xScrn = GetDeviceCaps(hScrDC, HORZRES); + yScrn = GetDeviceCaps(hScrDC, VERTRES); + + /* make sure bitmap rectangle is visible */ + + if (nX < 0) + nX = 0; + if (nY < 0) + nY = 0; + if (nX2 > xScrn) + nX2 = xScrn; + if (nY2 > yScrn) + nY2 = yScrn; + + nWidth = nX2 - nX; + nHeight = nY2 - nY; + + /* create a bitmap compatible with the screen DC */ + hBitmap = CreateCompatibleBitmap(hScrDC, nWidth, nHeight); + + /* select new bitmap into memory DC */ + hOldBitmap = SelectObject(hMemDC, hBitmap); + + /* bitblt screen DC to memory DC */ + BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY); + + /* select old bitmap back into memory DC and get handle to + * bitmap of the screen + */ + + hBitmap = SelectObject(hMemDC, hOldBitmap); + + /* clean up */ + + DeleteDC(hScrDC); + DeleteDC(hMemDC); + + /* return handle to the bitmap */ + + return hBitmap; +} + + +static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) +{ + BITMAP bm; + BITMAPINFOHEADER bi; + LPBITMAPINFOHEADER lpbi; + DWORD dwLen; + HANDLE hDIB; + HANDLE h; + HDC hDC; + WORD biBits; + + /* check if bitmap handle is valid */ + + if (!hBitmap) + return NULL; + + /* fill in BITMAP structure, return NULL if it didn't work */ + + if (!GetObject(hBitmap, sizeof(bm), (LPSTR)&bm)) + return NULL; + + /* if no palette is specified, use default palette */ + + if (hPal == NULL) + hPal = GetStockObject(DEFAULT_PALETTE); + + /* calculate bits per pixel */ + + biBits = bm.bmPlanes * bm.bmBitsPixel; + + /* make sure bits per pixel is valid */ + + if (biBits <= 1) + biBits = 1; + else if (biBits <= 4) + biBits = 4; + else if (biBits <= 8) + biBits = 8; + else /* if greater than 8-bit, force to 24-bit */ + biBits = 24; + + /* initialize BITMAPINFOHEADER */ + + bi.biSize = sizeof(BITMAPINFOHEADER); + bi.biWidth = bm.bmWidth; + bi.biHeight = bm.bmHeight; + bi.biPlanes = 1; + bi.biBitCount = biBits; + bi.biCompression = BI_RGB; + bi.biSizeImage = 0; + bi.biXPelsPerMeter = 0; + bi.biYPelsPerMeter = 0; + bi.biClrUsed = 0; + bi.biClrImportant = 0; + + /* calculate size of memory block required to store BITMAPINFO */ + + dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD); + + /* get a DC */ + + hDC = GetDC(NULL); + + /* select and realize our palette */ + + hPal = SelectPalette(hDC, hPal, FALSE); + RealizePalette(hDC); + + /* alloc memory block to store our bitmap */ + + hDIB = GlobalAlloc(GHND, dwLen); + + /* if we couldn't get memory block */ + + if (!hDIB) + { + /* clean up and return NULL */ + + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } + + /* lock memory and get pointer to it */ + + lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDIB); + + /* use our bitmap info. to fill BITMAPINFOHEADER */ + + *lpbi = bi; + + /* call GetDIBits with a NULL lpBits param, so it will calculate the + * biSizeImage field for us + */ + + GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, NULL, (LPBITMAPINFO)lpbi, + DIB_RGB_COLORS); + + /* get the info. returned by GetDIBits and unlock memory block */ + + bi = *lpbi; + GlobalUnlock(hDIB); + + /* if the driver did not fill in the biSizeImage field, make one up */ + if (bi.biSizeImage == 0) + bi.biSizeImage = (((((DWORD)bm.bmWidth * biBits) + 31) / 32) * 4) * bm.bmHeight; + + /* realloc the buffer big enough to hold all the bits */ + + dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD) + bi.biSizeImage; + + if ((h = GlobalReAlloc(hDIB, dwLen, 0)) != 0) + hDIB = h; + else + { + /* clean up and return NULL */ + + GlobalFree(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } + + /* lock memory block and get pointer to it */ + + lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDIB); + + /* call GetDIBits with a NON-NULL lpBits param, and actualy get the + * bits this time + */ + + if (GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, (LPSTR)lpbi + + (WORD)lpbi->biSize + DIBNumColors(lpbi) * sizeof(RGBQUAD), (LPBITMAPINFO)lpbi, + DIB_RGB_COLORS) == 0) + { + /* clean up and return NULL */ + + GlobalUnlock(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } + + bi = *lpbi; + + /* clean up */ + GlobalUnlock(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + + /* return handle to the DIB */ + return hDIB; +} + + +static HANDLE CopyScreenToDIB(LPRECT lpRect) +{ + HBITMAP hBitmap; + HPALETTE hPalette; + HANDLE hDIB; + + /* get the device-dependent bitmap in lpRect by calling + * CopyScreenToBitmap and passing it the rectangle to grab + */ + + hBitmap = CopyScreenToBitmap(lpRect); + + /* check for a valid bitmap handle */ + + if (!hBitmap) + return NULL; + + /* get the current palette */ + + hPalette = GetSystemPalette(); + + /* convert the bitmap to a DIB */ + + hDIB = BitmapToDIB(hBitmap, hPalette); + + /* clean up */ + + DeleteObject(hPalette); + DeleteObject(hBitmap); + + /* return handle to the packed-DIB */ + return hDIB; +} + + +static HPALETTE GetSystemPalette(void) +{ + HDC hDC; // handle to a DC + static HPALETTE hPal = NULL; // handle to a palette + HANDLE hLogPal; // handle to a logical palette + LPLOGPALETTE lpLogPal; // pointer to a logical palette + int nColors; // number of colors + + // Find out how many palette entries we want. + + hDC = GetDC(NULL); + + if (!hDC) + return NULL; + + nColors = PalEntriesOnDevice(hDC); // Number of palette entries + + // Allocate room for the palette and lock it. + + hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + nColors * + sizeof(PALETTEENTRY)); + + // if we didn't get a logical palette, return NULL + + if (!hLogPal) + return NULL; + + // get a pointer to the logical palette + + lpLogPal = (LPLOGPALETTE)GlobalLock(hLogPal); + + // set some important fields + + lpLogPal->palVersion = 0x300; + lpLogPal->palNumEntries = nColors; + + // Copy the current system palette into our logical palette + + GetSystemPaletteEntries(hDC, 0, nColors, + (LPPALETTEENTRY)(lpLogPal->palPalEntry)); + + // Go ahead and create the palette. Once it's created, + // we no longer need the LOGPALETTE, so free it. + + hPal = CreatePalette(lpLogPal); + + // clean up + + GlobalUnlock(hLogPal); + GlobalFree(hLogPal); + ReleaseDC(NULL, hDC); + + return hPal; +} + + +static int PalEntriesOnDevice(HDC hDC) +{ + return (1 << (GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES))); +} + + +/* +* This is the version information/command +* The static data should also be used by pkg_provide, etc. +*/ +/* Version information */ +static char version_string[] = "0.9.9.15"; + +/* Version command */ +static int Version(ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +{ + Tcl_SetResult(interp, version_string, TCL_STATIC); + return TCL_OK; +} + +/* +* Initialization procedures +* These are the only public procedures in the file. +* These are OS independent +*/ +/* Initialization Procedures */ +int Gdi_Init(Tcl_Interp *interp) +{ + +#if TCL_MAJOR_VERSION <= 7 + Tcl_CreateCommand(interp, "gdi", gdi, + (ClientData)0, 0); +#else + #if defined(USE_TCL_STUBS) + Tcl_InitStubs(interp, TCL_VERSION, 0 ); + #endif + #if defined(USE_TK_STUBS) + Tk_InitStubs (interp, TCL_VERSION, 0 ); + #endif + /* Wanted to use namespaces, but "unknown" isn't smart enough yet */ + /* Since this package is so full of numbers, this would be a great place + * to introduce a TclCmdObj + */ + Tcl_CreateCommand(interp, "gdi", gdi, + (ClientData)0, (Tcl_CmdDeleteProc *)0); +#endif + + /* Make this package work whether hdc is loaded or not */ + if ( Tcl_PkgRequire(interp, "hdc", "0.2", 0) ) + { + init_hdc_functions(interp); + if ( hdc_create == 0 ) + hdc_loaded = 0; + else + hdc_loaded = 1; + } + else + hdc_loaded = 0; + + Tcl_PkgProvide (interp, "gdi", version_string); + + return TCL_OK; +} + +/* The gdi function is considered safe. */ +int Gdi_SafeInit(Tcl_Interp *interp) +{ + return Gdi_Init(interp); +} + +#if 0 +/* Exported symbols */ +BOOL APIENTRY DllEntryPoint (HINSTANCE hInstance, DWORD reason, LPVOID lpCmdLine) +{ + switch (reason) + { + case DLL_PROCESS_ATTACH: + break; + case DLL_THREAD_ATTACH: + break; + case DLL_PROCESS_DETACH: + /* Since GDI doesn't create DCs, just uses them, no cleanup is required */ + break; + case DLL_THREAD_DETACH: + break; + } + /* Don't do anything, so just return true */ + return TRUE; +} +#endif + +static void init_hdc_functions(Tcl_Interp *interp) +{ + void *fn[7]; + int result; + const char *cp; + Tcl_Eval(interp, "hdc FunctionVector"); + cp = Tcl_GetStringResult(interp); + /* Does cp need to be freed when I'm done? */ + result = sscanf(cp, "%lx%lx%lx%lx%lx%lx%lx", &fn[0], &fn[1], &fn[2], &fn[3], + &fn[4], &fn[5], &fn[6]); + if ( result == 7) + { + hdc_create = fn[0]; + hdc_delete = fn[1]; + hdc_get = fn[2]; + hdc_typeof = fn[3]; + hdc_prefixof = fn[4]; + hdc_list = fn[5]; + hdc_valid = fn[6]; + } +} + +static HDC get_dc(Tcl_Interp *interp, const char *name) +{ + /* ANY type of DC should be ok here */ + if ( hdc_loaded == 0 || hdc_valid == 0 || hdc_valid(interp, name, -1) == 0 ) + { + char *strend; + HGDIOBJ tmp; + + /* Perhaps it is a numeric DC */ + tmp = (HGDIOBJ)INT2PTR(strtoul(name, &strend, 0)); + if ( strend != 0 && strend > name ) + { + DWORD objtype = GetObjectType(tmp); + switch (objtype) + { + /* Any of the DC types are OK. */ + case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: + break; + /* Anything else is invalid */ + case 0: /* Function failed */ + default: + tmp = 0; + Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", + "need a drawing context, got non-context address: ", name, "\n", 0); + break; + } + return (HDC)tmp; + } + else + { + Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", + "need a drawing context, got: ", name, "\n", 0); + return 0; + } + } + + { + HDC hdc = (HDC)hdc_get(interp, name); + DWORD objtype = GetObjectType((HGDIOBJ)hdc); + switch (objtype) + { + /* Any of the DC types are OK. */ + case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: + break; + /* Anything else is invalid */ + case 0: /* Function failed */ + default: + hdc = 0; + Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", + "need a drawing context, got: ", name, "\n", 0); + break; + } + return hdc; + } +} + + + +/* +* Something new: Include 'irox@cygnus.com' text widget printer +*/ +#ifdef TEXTWIDGET_CMD +#include "tkWinPrintText.c" +#endif + +/* +* The following functions are copied from tkTrig.c, since they +* are not available in the stubs library. +*/ + +/* + *-------------------------------------------------------------- + * + * TkGdiBezierScreenPoints -- + * + * Given four control points, create a larger set of XPoints + * for a Bezier spline based on the points. + * + * Results: + * The array at *xPointPtr gets filled in with numSteps XPoints + * corresponding to the Bezier spline defined by the four + * control points. Note: no output point is generated for the + * first input point, but an output point *is* generated for + * the last input point. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +TkGdiBezierScreenPoints(canvas, control, numSteps, xPointPtr) + Tk_Canvas canvas; /* Canvas in which curve is to be + * drawn. */ + double control[]; /* Array of coordinates for four + * control points: x0, y0, x1, y1, + * ... x3 y3. */ + int numSteps; /* Number of curve points to + * generate. */ + register XPoint *xPointPtr; /* Where to put new points. */ +{ + int i; + double u, u2, u3, t, t2, t3; + + for (i = 1; i <= numSteps; i++, xPointPtr++) { + t = ((double) i)/((double) numSteps); + t2 = t*t; + t3 = t2*t; + u = 1.0 - t; + u2 = u*u; + u3 = u2*u; + Tk_CanvasDrawableCoords(canvas, + (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + + control[6]*t3), + (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + + control[7]*t3), + &xPointPtr->x, &xPointPtr->y); + } +} + +/* + *-------------------------------------------------------------- + * + * TkGdiBezierPoints -- + * + * Given four control points, create a larger set of points + * for a Bezier spline based on the points. + * + * Results: + * The array at *coordPtr gets filled in with 2*numSteps + * coordinates, which correspond to the Bezier spline defined + * by the four control points. Note: no output point is + * generated for the first input point, but an output point + * *is* generated for the last input point. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +TkGdiBezierPoints(control, numSteps, coordPtr) + double control[]; /* Array of coordinates for four + * control points: x0, y0, x1, y1, + * ... x3 y3. */ + int numSteps; /* Number of curve points to + * generate. */ + register double *coordPtr; /* Where to put new points. */ +{ + int i; + double u, u2, u3, t, t2, t3; + + for (i = 1; i <= numSteps; i++, coordPtr += 2) { + t = ((double) i)/((double) numSteps); + t2 = t*t; + t3 = t2*t; + u = 1.0 - t; + u2 = u*u; + u3 = u2*u; + coordPtr[0] = control[0]*u3 + + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; + coordPtr[1] = control[1]*u3 + + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; + } +} + +/* + *-------------------------------------------------------------- + * + * TkGdiMakeBezierCurve -- + * + * Given a set of points, create a new set of points that fit + * parabolic splines to the line segments connecting the original + * points. Produces output points in either of two forms. + * + * Note: in spite of this procedure's name, it does *not* generate + * Bezier curves. Since only three control points are used for + * each curve segment, not four, the curves are actually just + * parabolic. + * + * Results: + * Either or both of the xPoints or dblPoints arrays are filled + * in. The return value is the number of points placed in the + * arrays. Note: if the first and last points are the same, then + * a closed curve is generated. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ +static int +TkGdiMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints) + Tk_Canvas canvas; /* Canvas in which curve is to be + * drawn. */ + double *pointPtr; /* Array of input coordinates: x0, + * y0, x1, y1, etc.. */ + int numPoints; /* Number of points at pointPtr. */ + int numSteps; /* Number of steps to use for each + * spline segments (determines + * smoothness of curve). */ + XPoint xPoints[]; /* Array of XPoints to fill in (e.g. + * for display. NULL means don't + * fill in any XPoints. */ + double dblPoints[]; /* Array of points to fill in as + * doubles, in the form x0, y0, + * x1, y1, .... NULL means don't + * fill in anything in this form. + * Caller must make sure that this + * array has enough space. */ +{ + int closed, outputPoints, i; + int numCoords = numPoints*2; + double control[8]; + + /* + * If the curve is a closed one then generate a special spline + * that spans the last points and the first ones. Otherwise + * just put the first point into the output. + */ + + if (!pointPtr) { + /* Of pointPtr == NULL, this function returns an upper limit. + * of the array size to store the coordinates. This can be + * used to allocate storage, before the actual coordinates + * are calculated. */ + return 1 + numPoints * numSteps; + } + + outputPoints = 0; + if ((pointPtr[0] == pointPtr[numCoords-2]) + && (pointPtr[1] == pointPtr[numCoords-1])) { + closed = 1; + control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0]; + control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1]; + control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0]; + control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1]; + control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2]; + control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3]; + control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; + control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; + if (xPoints != NULL) { + Tk_CanvasDrawableCoords(canvas, control[0], control[1], + &xPoints->x, &xPoints->y); + TkGdiBezierScreenPoints(canvas, control, numSteps, xPoints+1); + xPoints += numSteps+1; + } + if (dblPoints != NULL) { + dblPoints[0] = control[0]; + dblPoints[1] = control[1]; + TkGdiBezierPoints(control, numSteps, dblPoints+2); + dblPoints += 2*(numSteps+1); + } + outputPoints += numSteps+1; + } else { + closed = 0; + if (xPoints != NULL) { + Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1], + &xPoints->x, &xPoints->y); + xPoints += 1; + } + if (dblPoints != NULL) { + dblPoints[0] = pointPtr[0]; + dblPoints[1] = pointPtr[1]; + dblPoints += 2; + } + outputPoints += 1; + } + + for (i = 2; i < numPoints; i++, pointPtr += 2) { + /* + * Set up the first two control points. This is done + * differently for the first spline of an open curve + * than for other cases. + */ + + if ((i == 2) && !closed) { + control[0] = pointPtr[0]; + control[1] = pointPtr[1]; + control[2] = 0.333*pointPtr[0] + 0.667*pointPtr[2]; + control[3] = 0.333*pointPtr[1] + 0.667*pointPtr[3]; + } else { + control[0] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; + control[1] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; + control[2] = 0.167*pointPtr[0] + 0.833*pointPtr[2]; + control[3] = 0.167*pointPtr[1] + 0.833*pointPtr[3]; + } + + /* + * Set up the last two control points. This is done + * differently for the last spline of an open curve + * than for other cases. + */ + + if ((i == (numPoints-1)) && !closed) { + control[4] = .667*pointPtr[2] + .333*pointPtr[4]; + control[5] = .667*pointPtr[3] + .333*pointPtr[5]; + control[6] = pointPtr[4]; + control[7] = pointPtr[5]; + } else { + control[4] = .833*pointPtr[2] + .167*pointPtr[4]; + control[5] = .833*pointPtr[3] + .167*pointPtr[5]; + control[6] = 0.5*pointPtr[2] + 0.5*pointPtr[4]; + control[7] = 0.5*pointPtr[3] + 0.5*pointPtr[5]; + } + + /* + * If the first two points coincide, or if the last + * two points coincide, then generate a single + * straight-line segment by outputting the last control + * point. + */ + + if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3])) + || ((pointPtr[2] == pointPtr[4]) + && (pointPtr[3] == pointPtr[5]))) { + if (xPoints != NULL) { + Tk_CanvasDrawableCoords(canvas, control[6], control[7], + &xPoints[0].x, &xPoints[0].y); + xPoints++; + } + if (dblPoints != NULL) { + dblPoints[0] = control[6]; + dblPoints[1] = control[7]; + dblPoints += 2; + } + outputPoints += 1; + continue; + } + + /* + * Generate a Bezier spline using the control points. + */ + + + if (xPoints != NULL) { + TkGdiBezierScreenPoints(canvas, control, numSteps, xPoints); + xPoints += numSteps; + } + if (dblPoints != NULL) { + TkGdiBezierPoints(control, numSteps, dblPoints); + dblPoints += 2*numSteps; + } + outputPoints += numSteps; + } + return outputPoints; +} + diff --git a/win/tkWinInit.c b/win/tkWinInit.c index e1e485f..437f733 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -43,7 +43,7 @@ TkpInit( */ WinIcoInit(interp); - PrintInit(interp); + Winprint_Init(interp); TkWinXInit(Tk_GetHINSTANCE()); return TCL_OK; } diff --git a/win/tkWinInt.h b/win/tkWinInt.h index 1398214..6dc365f 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.h @@ -225,7 +225,7 @@ MODULE_SCOPE int WinIcoInit (Tcl_Interp* interp); * The following is implemented in tkWinPrint.c */ -MODULE_SCOPE int PrintInit(Tcl_Interp* interp); +MODULE_SCOPE int Winprint_Init(Tcl_Interp* interp); /* * Common routines used in Windows implementation diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 41cc88a..b416192 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -4,7 +4,7 @@ * This module implements Win32 printer access. * * Copyright © 1998-2019 Harald Oehlmann, Elmicron GmbH - * Copyright © 2018 Microsoft Corporation. + * Copyright © 2018 Microsoft Corporation. * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of @@ -12,7 +12,9 @@ */ -#pragma warning(disable : 4201 4214 4514) +#if defined(_MSC_VER) +#pragma warning(disable: 4201 4214 4514) +#endif #define STRICT #define UNICODE #define _UNICODE @@ -31,13 +33,13 @@ #include #include #include -#include +#include /* Helper defines. */ -/* -* Values of the Res variable. -* / +/* +* Values of the Res variable. +*/ /* Success, result value not set */ #define RET_OK_NO_RESULT_SET 2 @@ -63,13 +65,13 @@ #define F_RETURN_LIST (2) -/* +/* * File Global Constants. */ - + /* Version information. */ -static char version_string[] = "3.0"; -static char usage_string[] = +static const char version_string[] = "3.0"; +static const char usage_string[] = "Windows printing (c) Elmicron GmbH, Harald Oehlmann, 2019-01-23\n" "Preparation:\n" " winprint getattr option: possible options:\n" @@ -106,7 +108,7 @@ static char usage_string[] = "Configure and select drawing tools\n" " winprint setmapmode mapmode\n" " Define the coordinate system. 'Text' is in device units origin " - "top-up.\n" + "top-up.\n" " winprint pen width ?r g b?: r,g,b is 16 bit color value (internal / 256)\n" " No rgb values uses black color.\n" " winprint brushcolor r g b: filling for rectangle\n" @@ -138,19 +140,19 @@ static BOOL fPDLGInitialised = FALSE; static PRINTDLG pdlg; static PAGESETUPDLG pgdlg; static HPEN hPen = NULL; -static HFONT hFont[10] = +static HFONT hFont[10] = {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL}; /* Index of the actually selected font, -1:None */ static int SelectedFont = -1; -/* - * Interpreter pointer to return automatic errors from the EnumerateFontsEx - * callback and the ListFontsEx function. +/* + * Interpreter pointer to return automatic errors from the EnumerateFontsEx + * callback and the ListFontsEx function. */ static Tcl_Interp *fg_interp; /* Subcommand "getattr" option list and indexes. */ -static char *fg_getattr_sub_cmds[] = { +static const char *fg_getattr_sub_cmds[] = { "printers", "defaultprinter", "copies", "firstpage", "lastpage", "mapmode", "avecharheight", "avecharwidth", "horzres", "vertres", "dpi", "physicaloffsetx", "physicaloffsety", @@ -158,24 +160,24 @@ static char *fg_getattr_sub_cmds[] = { "papertypes", "mapmodes", "fontweights", "fontcharsets", "fontpitchvalues", "fontfamilies", "fonts", "fontnames", "fontunicoderanges", NULL}; -static enum fg_getattr_i_command { +typedef enum { iPrinters, iDefaultPrinter, iCopies, iFirstPage, iLastPage, - iMapMode, iAveCharHeight, iAveCharWidth, iHorzRes, iVertRes, + iMapMode, iAveCharHeight, iAveCharWidth, iHorzRes, iVertRes, iDPI, iPhysicalOffsetX, iPhysicalOffsetY, iPrinter, iOrientation, iPaperSize, iPaperTypes, iMapModes, iFontWeights, iFontCharsets, iFontPitchValues, iFontFamilies, iFonts, - iFontNames, iFontUnicodeRanges}; + iFontNames, iFontUnicodeRanges} fg_getattr_i_command; /* Subcommand "pagesetup" orientation option list and indexes. */ -static char *fg_orient_sub_cmds[] = {"portrait", "landscape", "", NULL}; +static const char *fg_orient_sub_cmds[] = {"portrait", "landscape", "", NULL}; static short fg_orient_i_command[] = { DMORIENT_PORTRAIT, DMORIENT_LANDSCAPE, -1}; /* Subcommand "pagesetup" pagesize. */ -static char *fg_papersize_sub_cmds[] = { +static const char *fg_papersize_sub_cmds[] = { "Letter", "LetterSmall", "Tabloid", "Ledger", "Legal", "Statement", "Executive", "A3", "A4", "A4Small", "A5", "B4", "B5", "Folio", "Quarto", "10X14", "11X17", "Note", "Env_9", "Env_10", "Env_11", "Env_12", "Env_14", @@ -187,7 +189,7 @@ static char *fg_papersize_sub_cmds[] = { "Legal_Extra", "Tabloid_Extra", "A4_Extra", "Letter_Transverse", "A4_Transverse", "Letter_Extra_Transverse", "A_Plus", "B_Plus", "Letter_Plus", "A4_Plus", "A5_Transverse", "B5_Transverse", "A3_Extra", - "A5_Extra", "B5_Extra", "A2", "A3_Transverse", "A3_Extra_Transverse", + "A5_Extra", "B5_Extra", "A2", "A3_Transverse", "A3_Extra_Transverse", "Dbl_Japanese_Postcard", "A6", "JEnv_Kaku2", "JEnv_Kaku3", "JEnv_Chou3", "JEnv_Chou4", "Letter_Rotated", "A3_Rotated", "A4_Rotated", "A5_Rotated", "B4_JIS_Rotated", "B5_JIS_Rotated", "Japanese_Postcard_Rotated", @@ -325,7 +327,7 @@ static short fg_papersize_i_command[] = { }; /* Map modes */ -static char *fg_map_modes_sub_cmds[] = { +static const char *fg_map_modes_sub_cmds[] = { "Text", "LoMetric", "HiMetric", @@ -347,11 +349,11 @@ static int fg_map_modes_i_command[] = { MM_ANISOTROPIC }; -/* +/* * Font weights. */ /* Map modes */ -static char *fg_font_weight_sub_cmds[] = { +static const char *fg_font_weight_sub_cmds[] = { "Dontcare", "Thin", "Extralight", @@ -377,7 +379,7 @@ static int fg_font_weight_i_command[] = { FW_HEAVY }; -static char *fg_font_charset_sub_cmds[] = { +static const char *fg_font_charset_sub_cmds[] = { "Default", "ANSI", "Symbol", @@ -422,7 +424,7 @@ static int fg_font_charset_i_command[] = { BALTIC_CHARSET }; -static char *fg_font_pitch_sub_cmds[] = { +static const char *fg_font_pitch_sub_cmds[] = { "Default", "Fixed", "Variable", @@ -437,7 +439,7 @@ static int fg_font_pitch_i_command[] = { ,MONO_FONT }; -static char *fg_font_family_sub_cmds[] = { +static const char *fg_font_family_sub_cmds[] = { "Dontcare", "Roman", "Swiss", @@ -457,8 +459,8 @@ static int fg_font_family_i_command[] = { }; /* Declaration for functions used later in this file.*/ -static int WinPrintCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); +static int WinPrintCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static TCHAR * ReturnLockedDeviceName( HGLOBAL hDevNames ); static char GetDeviceName( Tcl_Interp *interp, @@ -492,7 +494,7 @@ static char PrintGetAttr(Tcl_Interp *interp, int Index); static char PrintSetAttr(Tcl_Interp *interp, int Index, Tcl_Obj *oParam); static char DefaultPrinterGet( Tcl_Interp *interp ); static char ListPrinters(Tcl_Interp *interp); -static char ListChoices(Tcl_Interp *interp, char *ppChoiceList[]); +static char ListChoices(Tcl_Interp *interp, const char *ppChoiceList[]); static char PrintSetMapMode( int MapMode); static char LoadDefaultPrinter( ); static char DefaultPrinterGet( Tcl_Interp *interp ); @@ -501,7 +503,7 @@ static char PrintBrushColor(COLORREF Color); static char PrintBkColor(COLORREF Color); static char PrintRuler(int X0, int Y0, int LenX, int LenY); static char PrintRectangle(int X0, int Y0, int X1, int Y1); -static char PrintFontCreate(int FontNumber, +static char PrintFontCreate(int FontNumber, TCHAR *Name, double PointSize, int Weight, int Italic, int Charset, int Pitch, int Family); static char PrintFontSelect(int FontNumber); @@ -516,12 +518,13 @@ static int CALLBACK EnumFontFamExProc( DWORD FontType, /* type of font */ LPARAM lParam /* application-defined data */ ); -static char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *CONST oImageName, +static char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *const oImageName, int PosX, int PosY, int Width, int Height); /*DLL entry point */ +#if 0 BOOL __declspec(dllexport) WINAPI DllEntryPoint( HINSTANCE hInstance, DWORD seginfo, @@ -530,6 +533,7 @@ BOOL __declspec(dllexport) WINAPI DllEntryPoint( /* Don't do anything, so just return true */ return TRUE; } +#endif /*Initialisation Procedu Res */ @@ -560,9 +564,9 @@ int __declspec(dllexport) Winprint_Init (Tcl_Interp *Interp) * * ------------------------------------------------------------------------- */ - + int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]) + Tcl_Obj *const objv[]) { /* Option list and indexes */ const char *subCmds[] = { @@ -578,7 +582,7 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, enum iCommand { iHelp, iSelectPrinter, iPrinterSetup, iPageSetup, iOpenjobdialog, - iOpenPrinter, iClose, iClosedoc, iOpenpage, + iOpenPrinter, iClose, iClosedoc, iOpenpage, iClosepage, iVersion, iGetattr, iSetAttr, iOpendoc, iPen, iBrushColor, iBkColor, iFontselect, iGetTextSize, iRuler, iRectangle, iFontCreate, @@ -586,10 +590,10 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, iPhoto }; - /* - * State variables. + /* + * State variables. */ - + /* Choice of option. */ int Index; /* Result flag. */ @@ -602,12 +606,12 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, char ParCur; Tcl_DString sPar1; int PositionSPar; - /* - * Check if option argument is given and decode it. + /* + * Check if option argument is given and decode it. */ if (objc > 1) { - if (RET_ERROR == + if (RET_ERROR == Tcl_GetIndexFromObj(interp, objv[1], subCmds, "subcmd", 0, &Index)) return RET_ERROR; } else { @@ -686,10 +690,10 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, /* Default result. */ Res = RET_OK; - /* - * One string parameter. - * if this option is not given, a 0 pointer - * is present. + /* + * One string parameter. + * if this option is not given, a 0 pointer + * is present. */ Tcl_DStringInit(& sPar1); switch (Index) { @@ -722,7 +726,7 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, Tcl_WinUtfToTChar( pStr, lStr, &sPar1); } } - /* + /* * Decode parameters and invoke. */ switch (Index) { @@ -749,7 +753,7 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, if ( objc > 2 ) { int OptionIndex; - if (RET_ERROR == + if (RET_ERROR == Tcl_GetIndexFromObj( interp, objv[2], close_subCmds, "option", 0, &OptionIndex)) @@ -792,7 +796,7 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, /* One Index parameter. */ { int IndexAttr; - if (RET_ERROR == + if (RET_ERROR == Tcl_GetIndexFromObj( interp, objv[2], fg_getattr_sub_cmds, "getattr", 0, &IndexAttr)) @@ -819,15 +823,15 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, short PaperSize; unsigned short MaxPage; double Double; - /* - * Argument 2: Printer is already in sPar or NULL. + /* + * Argument 2: Printer is already in sPar or NULL. */ /* Orientation */ if ( objc > 3 ) { int ParInt; - if (RET_ERROR == + if (RET_ERROR == Tcl_GetIndexFromObj( interp, objv[3], fg_orient_sub_cmds, "orient", 0, &ParInt)) @@ -843,7 +847,7 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, if ( objc > 4 ) { int ParInt; - if (RET_ERROR == + if (RET_ERROR == Tcl_GetIndexFromObj( interp, objv[4], fg_papersize_sub_cmds, "papersize", 0, &ParInt)) @@ -918,7 +922,7 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, if ( objc > 5 ) { int ParInt; - if (RET_ERROR == + if (RET_ERROR == Tcl_GetIntFromObj( interp, objv[5], &ParInt)) { Res = RET_ERROR; @@ -956,14 +960,14 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, const char ** pTable; const char * pMsg; const int *pValue; - + /* Set default values. */ iPar[3] = FW_DONTCARE; /* Weight */ iPar[4] = 0; /* Default Italic: off */ iPar[5] = DEFAULT_CHARSET; /* Character set */ iPar[6] = FW_DONTCARE; /* Pitch */ iPar[7] = FF_DONTCARE; /* Family */ - + for ( ParCur = 0 ; ParCur < objc-2 && Res != RET_ERROR ; ParCur++) { switch (ParCur) @@ -1013,7 +1017,7 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, pMsg = "font family"; break; } - if (RET_ERROR == + if (RET_ERROR == Tcl_GetIndexFromObj( interp, objv[ParCur+2], pTable, pMsg, 0, & IndexOut ) ) @@ -1170,14 +1174,14 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, break; } /* - * Free any intermediated strings. + * Free any intermediated strings. */ - + /* String parameter. */ Tcl_DStringFree(& sPar1); - - /* - * Format return value. + + /* + * Format return value. */ switch (Res) { @@ -1214,9 +1218,9 @@ int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc, * * ReturnLockedDeviceName -- * - * Extract the locked device name from the hDevNames structure and returns + * Extract the locked device name from the hDevNames structure and returns * its pointer. hDevNames must be unlocked on success (which captures - * the return value). + * the return value). * Results: * Returns the device name. @@ -1244,8 +1248,8 @@ static TCHAR * ReturnLockedDeviceName( HGLOBAL hDevNames ) * * GetDeviceName -- * - * Extract the device name from the hDevNames structure and put it in the - * interpreter result. + * Extract the device name from the hDevNames structure and put it in the + * interpreter result. * * Results: * Returns the device name. @@ -1266,7 +1270,7 @@ static char GetDeviceName( pPrinter = ReturnLockedDeviceName( hDevNames ); if ( pPrinter == NULL ) return RET_ERROR_PRINTER_IO; - + Tcl_DStringInit( &Printer ); Tcl_WinTCharToUtf( pPrinter, -1, &Printer); Ret = RET_OK; @@ -1274,7 +1278,7 @@ static char GetDeviceName( { Tcl_Obj *PrinterObj; Tcl_Obj *lResult; - + PrinterObj = Tcl_NewStringObj( Tcl_DStringValue( &Printer ), Tcl_DStringLength( &Printer ) ); @@ -1304,7 +1308,7 @@ static char GetDeviceName( * * PrintSelectPrinter -- * - * Return the selected printer using the printer selection box. + * Return the selected printer using the printer selection box. * * Results: * Returns the selected printer. @@ -1336,8 +1340,8 @@ static char PrintSelectPrinter( Tcl_Interp *interp ) * * GetOrientation -- * - * Search the DevMode structure for an orientation value and return - * it as a Tcl object. If not found, NULL is returned. + * Search the DevMode structure for an orientation value and return + * it as a Tcl object. If not found, NULL is returned. * * Results: * Returns the selected orientation. @@ -1347,7 +1351,7 @@ static char PrintSelectPrinter( Tcl_Interp *interp ) static Tcl_Obj * GetOrientation( DEVMODE * pDevMode ) { - char * pText; + const char * pText; int IndexCur; if ( pDevMode == NULL) @@ -1373,8 +1377,8 @@ static Tcl_Obj * GetOrientation( DEVMODE * pDevMode ) * * GetPaperSize-- * - * Search the DevMode structure for a paper size value and return - * it as a Tcl object. If not found, NULL is returned. + * Search the DevMode structure for a paper size value and return + * it as a Tcl object. If not found, NULL is returned. * * Results: * Returns the paper size. @@ -1384,7 +1388,7 @@ static Tcl_Obj * GetOrientation( DEVMODE * pDevMode ) static Tcl_Obj * GetPaperSize( DEVMODE * pDevMode ) { - char * pText; + const char * pText; int IndexCur; if ( pDevMode == NULL) @@ -1410,7 +1414,7 @@ static Tcl_Obj * GetPaperSize( DEVMODE * pDevMode ) * * AppendOrientPaperSize-- * - * Append orientation and paper size to the configuration. + * Append orientation and paper size to the configuration. * * Results: * Returns the paper size. @@ -1454,8 +1458,8 @@ static char AppendOrientPaperSize( Tcl_Interp *interp, DEVMODE * pDevMode ) * * PrintPrinterSetup-- * - * Show the page setup dialogue box and for paper size and orientation - * and return the users selection as Tcl variables. + * Show the page setup dialogue box and for paper size and orientation + * and return the users selection as Tcl variables. * * Results: * Returns the paper size and orientation. @@ -1497,8 +1501,8 @@ static char PrintPrinterSetup( Tcl_Interp *interp, TCHAR *pPrinter, * * PrintPageSetup-- * - * Show the page setup dialogue box and return the users selection -* as Tcl variables. + * Show the page setup dialogue box and return the users selection +* as Tcl variables. * * Results: * Returns the complete page setup. @@ -1540,7 +1544,7 @@ static char PrintPageSetup( Tcl_Interp *interp, TCHAR *pPrinter, sPageSetupDlg.rtMargin.top = ( Top != -1) ? Top : 2500; sPageSetupDlg.rtMargin.right = ( Right != -1) ? Right : 2500; sPageSetupDlg.rtMargin.bottom = ( Bottom != -1) ? Bottom : 2500; - + /* Show page setup dialog box. */ if ( FALSE == PageSetupDlg( & sPageSetupDlg ) ) { @@ -1564,7 +1568,7 @@ static char PrintPageSetup( Tcl_Interp *interp, TCHAR *pPrinter, { if ( pdlg.hDevNames != NULL ) GlobalFree( pdlg.hDevNames ); - + pdlg.hDevNames = sPageSetupDlg.hDevNames; } @@ -1629,17 +1633,16 @@ static char PrintPageSetup( Tcl_Interp *interp, TCHAR *pPrinter, * * CreateDevMode-- * - * Create a DevMode structure for the given settings. The devmode - * structure is put in a moveable memory object. The handle is placed - * in pdlg.hDevMode. + * Create a DevMode structure for the given settings. The devmode + * structure is put in a moveable memory object. The handle is placed + * in pdlg.hDevMode. * * Results: * Creates a DevMode structure for the printer. * * ------------------------------------------------------------------------- */ - -static char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize, +char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize, char fShowPropertySheet ) { HANDLE hPrinter; @@ -1648,7 +1651,7 @@ static char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize, DWORD fMode; char fDevNamesLocked; char Res; - + Res = RET_OK; /* If no printer given use last or default printer. */ if ( pPrinter == NULL || pPrinter[0] == '\0' ) @@ -1742,6 +1745,7 @@ static char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize, if ( Size < 0 ) { Res = RET_ERROR_PRINTER_IO; + } } if ( fDevNamesLocked ) GlobalUnlock( pdlg.hDevNames ); @@ -1766,7 +1770,7 @@ static char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize, * * PrintOpenPrinter-- * - * Open the given printer. + * Open the given printer. * * Results: * Opens the selected printer. @@ -1774,14 +1778,13 @@ static char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize, * ------------------------------------------------------------------------- */ - -static char PrintOpenPrinter( +char PrintOpenPrinter( TCHAR * pPrinter, short Orientation, short PaperSize) { DEVMODE* lpInitData; char Res; char fDevNamesLocked; - + PrintReset( 1 ); Res = CreateDevMode( pPrinter, Orientation, PaperSize, 0 ); @@ -1793,9 +1796,9 @@ static char PrintOpenPrinter( return RET_ERROR_MEMORY; } - /* - * If no printer given, it was loaded by CreateDevMode in - * pdlg.hDeviceNames. + /* + * If no printer given, it was loaded by CreateDevMode in + * pdlg.hDeviceNames. */ if ( pPrinter == NULL || pPrinter[0] == '\0' ) { @@ -1829,7 +1832,7 @@ static char PrintOpenPrinter( * * PrintOpenJobDialog-- * - * Open the print job dialog. + * Open the print job dialog. * * Results: * Opens the job dialog. @@ -1837,13 +1840,13 @@ static char PrintOpenPrinter( * ------------------------------------------------------------------------- */ -static char PrintOpenJobDialog( +char PrintOpenJobDialog( TCHAR * pPrinter, short Orientation, short PaperSize, unsigned short MaxPage ) -{ +{ char Res; PrintReset( 1 ); @@ -1881,8 +1884,8 @@ static char PrintOpenJobDialog( * * PrintReset-- * - * Free any resource which might be opened by a print command. - * Initialise the print dialog structure. + * Free any resource which might be opened by a print command. + * Initialise the print dialog structure. * * Results: * Free print resources and re-start the print dialog structure. @@ -1890,7 +1893,7 @@ static char PrintOpenJobDialog( * ------------------------------------------------------------------------- */ -static char PrintReset( char fPreserveDeviceData ) +char PrintReset( char fPreserveDeviceData ) { int i; if (hPen != NULL) @@ -1912,7 +1915,7 @@ static char PrintReset( char fPreserveDeviceData ) hFont[i] = NULL; } } - /* + /* * Free members of the pdlg structure. */ if ( fPDLGInitialised ) @@ -1940,7 +1943,7 @@ static char PrintReset( char fPreserveDeviceData ) } } } else { - /* + /* * Initialise pdlg structure. */ memset( &pdlg, 0, sizeof( PRINTDLG ) ); @@ -1963,7 +1966,7 @@ static char PrintReset( char fPreserveDeviceData ) * ------------------------------------------------------------------------- */ -static char PrintOpenDoc(Tcl_Obj *resultPtr, TCHAR *DocName) +char PrintOpenDoc(Tcl_Obj *resultPtr, TCHAR *DocName) { int JobID; DOCINFO di; @@ -1997,7 +2000,7 @@ static char PrintOpenDoc(Tcl_Obj *resultPtr, TCHAR *DocName) */ -static char PrintCloseDoc() +char PrintCloseDoc() { if ( EndDoc(pdlg.hDC) > 0) return RET_OK; @@ -2017,10 +2020,10 @@ static char PrintCloseDoc() * ------------------------------------------------------------------------- */ -static char PrintOpenPage() +char PrintOpenPage() { -/* +/* * Here we have to (re)set the mapping mode and select all objects * because StartPage starts with default values. */ @@ -2058,7 +2061,7 @@ static char PrintOpenPage() * ------------------------------------------------------------------------- */ -static char PrintClosePage() +char PrintClosePage() { if ( EndPage(pdlg.hDC) > 0) return RET_OK; @@ -2078,15 +2081,15 @@ static char PrintClosePage() * ------------------------------------------------------------------------- */ -static char PrintGetAttr(Tcl_Interp *interp, int Index) +char PrintGetAttr(Tcl_Interp *interp, int Index) { char Res; DEVMODE * pDevMode; - - /* + + /* * State variables. */ - + /* Check for open printer when hDC is required. */ switch ( Index ) { @@ -2104,7 +2107,7 @@ static char PrintGetAttr(Tcl_Interp *interp, int Index) if (pdlg.hDC == NULL) return RET_ERROR_PRINTER_NOT_OPEN; } - + /* Check for Allocated DeviceMode structure. */ switch ( Index ) { @@ -2129,11 +2132,11 @@ static char PrintGetAttr(Tcl_Interp *interp, int Index) Tcl_SetIntObj(Tcl_GetObjResult(interp), pdlg.nCopies); return RET_OK; case iFirstPage: - Tcl_SetIntObj(Tcl_GetObjResult(interp), + Tcl_SetIntObj(Tcl_GetObjResult(interp), 0 != (pdlg.Flags & PD_PAGENUMS) ? pdlg.nFromPage : pdlg.nMinPage); return RET_OK; case iLastPage: - Tcl_SetIntObj(Tcl_GetObjResult(interp), + Tcl_SetIntObj(Tcl_GetObjResult(interp), 0 != (pdlg.Flags & PD_PAGENUMS) ? pdlg.nToPage : pdlg.nMaxPage); return RET_OK; case iMapMode: @@ -2202,7 +2205,7 @@ static char PrintGetAttr(Tcl_Interp *interp, int Index) GetDeviceCaps(pdlg.hDC, PHYSICALOFFSETY)); return RET_OK; case iPrinter: - if ( fPDLGInitialised + if ( fPDLGInitialised && pdlg.hDevNames != NULL) { return GetDeviceName( interp, pdlg.hDevNames, FALSE ); @@ -2263,7 +2266,7 @@ static char PrintGetAttr(Tcl_Interp *interp, int Index) /* Unlock pDevMode. */ if ( NULL != pDevMode ) GlobalUnlock( pdlg.hDevMode ); - + return Res; } @@ -2280,14 +2283,14 @@ static char PrintGetAttr(Tcl_Interp *interp, int Index) * ------------------------------------------------------------------------- */ -static char PrintSetAttr(Tcl_Interp *interp, int Index, Tcl_Obj *oParam) +char PrintSetAttr(Tcl_Interp *interp, int Index, Tcl_Obj *oParam) { switch ( Index ) { case iMapMode: { int IndexMapMode; - if (RET_ERROR == + if (RET_ERROR == Tcl_GetIndexFromObj( interp, oParam, fg_map_modes_sub_cmds, "setmapmode", 1, &IndexMapMode)) @@ -2314,7 +2317,7 @@ static char PrintSetAttr(Tcl_Interp *interp, int Index, Tcl_Obj *oParam) * ------------------------------------------------------------------------- */ -static char LoadDefaultPrinter( ) +char LoadDefaultPrinter( ) { PrintReset( 1 ); pdlg.Flags = PD_RETURNDEFAULT ; @@ -2339,7 +2342,7 @@ static char LoadDefaultPrinter( ) */ -static char DefaultPrinterGet( Tcl_Interp *interp ) +char DefaultPrinterGet( Tcl_Interp *interp ) { char Res; Res = LoadDefaultPrinter(); @@ -2353,7 +2356,7 @@ static char DefaultPrinterGet( Tcl_Interp *interp ) * * ListPrinters-- * - * Lists all available printers on the system. + * Lists all available printers on the system. * * Results: * Returns the printer list. @@ -2362,7 +2365,7 @@ static char DefaultPrinterGet( Tcl_Interp *interp ) */ -static char ListPrinters(Tcl_Interp *interp) +char ListPrinters(Tcl_Interp *interp) { DWORD dwSize = 0; DWORD dwPrinters = 0; @@ -2371,12 +2374,12 @@ static char ListPrinters(Tcl_Interp *interp) /* Initialise result value. */ Res = RET_OK; - + /* Find required buffer size. */ - if (! EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_CONNECTIONS, + if (! EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_CONNECTIONS, NULL, 5, NULL, 0, &dwSize, &dwPrinters)) { - /* + /* * Check for ERROR_INSUFFICIENT_BUFFER. * If something else, then quit. */ @@ -2387,7 +2390,7 @@ static char ListPrinters(Tcl_Interp *interp) } /* Fall through */ } - + /* Allocate the buffer memory */ pInfo = (PRINTER_INFO_5 *) GlobalAlloc(GMEM_FIXED, dwSize); if (pInfo == NULL) @@ -2395,8 +2398,8 @@ static char ListPrinters(Tcl_Interp *interp) /* Out of memory */ return RET_ERROR_MEMORY; } - - /* + + /* * Fill the buffer. Again, * this depends on the O/S. */ @@ -2432,9 +2435,9 @@ static char ListPrinters(Tcl_Interp *interp) /* Error - unlikely though as first call to EnumPrinters succeeded! */ return RET_ERROR_PRINTER_IO; } - + GlobalFree( pInfo ); - + return Res; } @@ -2452,14 +2455,14 @@ static char ListPrinters(Tcl_Interp *interp) */ -static char ListChoices(Tcl_Interp *interp, char *ppChoiceList[]) +char ListChoices(Tcl_Interp *interp, const char *ppChoiceList[]) { int Index; Tcl_Obj *lResult; - + /* Initialise return list. */ lResult = Tcl_GetObjResult( interp ); - + /* Loop adding the printers to the list */ for ( Index = 0; ppChoiceList[Index] != NULL; Index++) { @@ -2487,23 +2490,23 @@ static char ListChoices(Tcl_Interp *interp, char *ppChoiceList[]) * ------------------------------------------------------------------------- */ -static char ListFonts(Tcl_Interp *interp, HDC hDC, int fFontNameOnly) +char ListFonts(Tcl_Interp *interp, HDC hDC, int fFontNameOnly) { -/* This function is used by getattr fonts and getattr fontnamestyle. - * getattr fonts: lParam is passed as 0 to EnumFontFamExProc. - * getattr fontnames: lParam is passed with an initialized last fontname +/* This function is used by getattr fonts and getattr fontnamestyle. + * getattr fonts: lParam is passed as 0 to EnumFontFamExProc. + * getattr fontnames: lParam is passed with an initialized last fontname * to EnumFontFamExProc. - * This value is used to check for duplicate listed font names. */ + * This value is used to check for duplicate listed font names. */ LOGFONT LogFont; TCHAR *pCompareFont; - + /* Initialise LogFont */ LogFont.lfCharSet = DEFAULT_CHARSET; LogFont.lfPitchAndFamily = 0; LogFont.lfFaceName[0] = '\0'; - + /*> Save interpreter ptr in global variable to use it for automatic */ /*> error feedback. */ fg_interp = interp; @@ -2513,7 +2516,7 @@ static char ListFonts(Tcl_Interp *interp, HDC hDC, int fFontNameOnly) } else { pCompareFont = 0; } - + /* Initialise return list */ if ( EnumFontFamiliesEx( hDC, @@ -2540,7 +2543,7 @@ static char ListFonts(Tcl_Interp *interp, HDC hDC, int fFontNameOnly) * ------------------------------------------------------------------------- */ -static int CALLBACK EnumFontFamExProc( +int CALLBACK EnumFontFamExProc( ENUMLOGFONTEX *lpelfe, /* logical-font data */ NEWTEXTMETRICEX *lpntme, /* physical-font data */ DWORD FontType, /* type of font */ @@ -2549,21 +2552,21 @@ static int CALLBACK EnumFontFamExProc( { /* - * This function is used by getattr fonts and getattr fontnamestyle. + * This function is used by getattr fonts and getattr fontnamestyle. * - * getattr fonts: the font attributes name, style, charset and normal/fixed are + * getattr fonts: the font attributes name, style, charset and normal/fixed are * added. In this case, the parameter lParam is 0. * - * getattr fontnamestyle: it is checked if the current font has different name - * or style as the last font. If yes, name and style is added. - * If not, nothing is added. In this case, the parameter lParam contains a pointer - * to a ENUMLOGFONTEX variable. On a change, the current content is copied into + * getattr fontnamestyle: it is checked if the current font has different name + * or style as the last font. If yes, name and style is added. + * If not, nothing is added. In this case, the parameter lParam contains a pointer + * to a ENUMLOGFONTEX variable. On a change, the current content is copied into * that variable for the next comparison round. */ Tcl_Obj *AppendObj; Tcl_Obj *pResultObj; Tcl_DString dStr; - + if (lParam != 0) { TCHAR *pCompareFont = (TCHAR *)lParam; if ( 0 == _tcscmp(pCompareFont, lpelfe->elfFullName) ) { @@ -2572,9 +2575,9 @@ static int CALLBACK EnumFontFamExProc( _tcscpy( pCompareFont, lpelfe->elfFullName ); } } - + pResultObj = Tcl_GetObjResult(fg_interp); - + /*> Add font name */ Tcl_DStringInit(& dStr); Tcl_WinTCharToUtf(lpelfe->elfFullName,-1, &dStr); @@ -2582,19 +2585,19 @@ static int CALLBACK EnumFontFamExProc( Tcl_DStringFree(& dStr); if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj)) return FALSE; - + /*> For getattr fontnames, end here */ if (lParam != 0) { return TRUE; } - + /* * Transform style to weight. * - * Style may have other words like condensed etc, so map all unknown weights - * to "Normal". + * Style may have other words like condensed etc, so map all unknown weights + * to "Normal". */ - + if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Thin")) || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Light")) || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Medium")) @@ -2621,7 +2624,7 @@ static int CALLBACK EnumFontFamExProc( } if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj)) return FALSE; - + /* Add script. */ Tcl_DStringInit(& dStr); Tcl_WinTCharToUtf(lpelfe->elfScript,-1, &dStr); @@ -2629,7 +2632,7 @@ static int CALLBACK EnumFontFamExProc( Tcl_DStringFree(& dStr); if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj)) return FALSE; - + /* Pitch. */ switch ( (lpelfe->elfLogFont.lfPitchAndFamily) & 0xf ) { @@ -2642,7 +2645,7 @@ static int CALLBACK EnumFontFamExProc( } if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj)) return FALSE; - + /* Continue enumeration. */ return TRUE; } @@ -2660,13 +2663,13 @@ static int CALLBACK EnumFontFamExProc( * ------------------------------------------------------------------------- */ -static char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC) +char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC) { size_t StructSize; LPGLYPHSET pGlyphSet; int PosCur; Tcl_Obj *oList; - + /* Get structure size. */ StructSize = GetFontUnicodeRanges(hDC,NULL); if (StructSize == 0) { @@ -2674,15 +2677,15 @@ static char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC) } /* Alloc return memory on the stack */ pGlyphSet = _alloca(StructSize); - + /* Get glyph set structure */ if (0 == GetFontUnicodeRanges(hDC,pGlyphSet)) { return RET_ERROR_PRINTER_IO; } - + /* Prepare result list. */ oList = Tcl_NewListObj(0,NULL); - + for (PosCur = 0 ; PosCur < (int)(pGlyphSet->cRanges) ; PosCur++) { /* Starting glyph */ if (RET_OK != Tcl_ListObjAppendElement(interp, oList, @@ -2695,7 +2698,7 @@ static char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC) return RET_ERROR; } } - + Tcl_SetObjResult(interp,oList); return RET_OK; } @@ -2706,22 +2709,22 @@ static char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC) * * GetFirstTextNoChar -- * - * Get data on glyph structure. + * Get data on glyph structure. * * Results: - * Returns glyph structure. + * Returns glyph structure. * * ------------------------------------------------------------------------- */ -static char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText) +char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText) { size_t StructSize; LPGLYPHSET pGlyphSet; int PosCur; int IndexCur; Tcl_Obj *oList; - + /* Get structure size. */ StructSize = GetFontUnicodeRanges(pdlg.hDC,NULL); if (StructSize == 0) { @@ -2729,15 +2732,15 @@ static char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText) } /* Alloc return memory on the stack. */ pGlyphSet = _alloca(StructSize); - + /* Get glyph set structure. */ if (0 == GetFontUnicodeRanges(pdlg.hDC,pGlyphSet)) { return RET_ERROR_PRINTER_IO; } - + /* Prepare result list. */ oList = Tcl_NewListObj(0,NULL); - + /*> Loop over characters. */ for (IndexCur = 0;;IndexCur++) { int fFound = 0; @@ -2761,7 +2764,7 @@ static char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText) return RET_OK; } } - + Tcl_SetObjResult(interp,Tcl_NewIntObj(-1)); return RET_OK; } @@ -2774,12 +2777,12 @@ static char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText) * Set the map mode for the printer. * * Results: - * Returns the map mode. + * Returns the map mode. * * ------------------------------------------------------------------------- */ -static char PrintSetMapMode( int MapMode ) +char PrintSetMapMode( int MapMode ) { /* Check for open printer when hDC is required. */ if (pdlg.hDC == NULL) @@ -2804,7 +2807,7 @@ static char PrintSetMapMode( int MapMode ) * ------------------------------------------------------------------------- */ -static char PrintPen(int Width, COLORREF Color) +char PrintPen(int Width, COLORREF Color) { if (hPen != NULL) DeleteObject(hPen); @@ -2814,9 +2817,9 @@ static char PrintPen(int Width, COLORREF Color) } else { /* Solid pen. */ LOGBRUSH lb; - lb.lbStyle = BS_SOLID; - lb.lbColor = Color; - lb.lbHatch = 0; + lb.lbStyle = BS_SOLID; + lb.lbColor = Color; + lb.lbHatch = 0; hPen = ExtCreatePen(PS_GEOMETRIC|PS_SOLID|PS_ENDCAP_SQUARE|PS_JOIN_MITER , Width, &lb, 0, NULL); } @@ -2838,7 +2841,7 @@ static char PrintPen(int Width, COLORREF Color) * ------------------------------------------------------------------------- */ -static char PrintBrushColor(COLORREF Color) +char PrintBrushColor(COLORREF Color) { if (CLR_INVALID == SetDCBrushColor(pdlg.hDC, Color) ) return RET_ERROR_PRINTER_IO; @@ -2858,7 +2861,7 @@ static char PrintBrushColor(COLORREF Color) * ------------------------------------------------------------------------- */ -static char PrintBkColor(COLORREF Color) +char PrintBkColor(COLORREF Color) { if (CLR_INVALID == SetBkColor(pdlg.hDC, Color) ) return RET_ERROR_PRINTER_IO; @@ -2877,8 +2880,8 @@ static char PrintBkColor(COLORREF Color) * * ------------------------------------------------------------------------- */ - -static char PrintRuler(int X0, int Y0, int LenX, int LenY) + +char PrintRuler(int X0, int Y0, int LenX, int LenY) { POINT pt[2]; pt[0].x = X0; @@ -2903,7 +2906,7 @@ static char PrintRuler(int X0, int Y0, int LenX, int LenY) * ------------------------------------------------------------------------- */ -static char PrintRectangle(int X0, int Y0, int X1, int Y1) +char PrintRectangle(int X0, int Y0, int X1, int Y1) { if (FALSE == Rectangle(pdlg.hDC, X0,Y0,X1,Y1)) return RET_ERROR_PRINTER_IO; @@ -2923,30 +2926,30 @@ static char PrintRectangle(int X0, int Y0, int X1, int Y1) * ------------------------------------------------------------------------- */ -static char PrintFontCreate(int FontNumber, +char PrintFontCreate(int FontNumber, TCHAR *Name, double dPointSize, int Weight, int Italic, int Charset, int Pitch, int Family) { /* - * Charset: - * ANSI 0 - * DEFAULT_ 1 - * GREEK_ 161 (0xA1) - * Italic - * 0 No - * 1 Yes - * Pitch - * 0 Default - * 1 Fixed - * 2 Variable - * Family - * 0 FF_DONTCARE - * 1 FF_ROMAN Variable stroke width, serifed. Times Roman, Century Schoolbook, etc. - * 2 FF_SWISS Variable stroke width, sans-serifed. Helvetica, Swiss, etc. - * 3 FF_MODERN Constant stroke width, serifed or sans-serifed. Pica, Elite, Courier, etc. - * 4 FF_SCRIPT Cursive, etc. - * 5 FF_DECORATIVE Old English, etc. + * Charset: + * ANSI 0 + * DEFAULT_ 1 + * GREEK_ 161 (0xA1) + * Italic + * 0 No + * 1 Yes + * Pitch + * 0 Default + * 1 Fixed + * 2 Variable + * Family + * 0 FF_DONTCARE + * 1 FF_ROMAN Variable stroke width, serifed. Times Roman, Century Schoolbook, etc. + * 2 FF_SWISS Variable stroke width, sans-serifed. Helvetica, Swiss, etc. + * 3 FF_MODERN Constant stroke width, serifed or sans-serifed. Pica, Elite, Courier, etc. + * 4 FF_SCRIPT Cursive, etc. + * 5 FF_DECORATIVE Old English, etc. */ POINT pt; /* To convert to logical scale. */ @@ -2962,7 +2965,7 @@ static char PrintFontCreate(int FontNumber, } DeleteObject (hFont[FontNumber]); } - + /* Convert decipoints to the logical device points. */ pt.x = 0; pt.y = (int) (dPointSize * GetDeviceCaps(pdlg.hDC, LOGPIXELSY) / 72.0); @@ -3001,7 +3004,7 @@ static char PrintFontCreate(int FontNumber, * * ------------------------------------------------------------------------- */ -static char PrintFontSelect(int FontNumber) +char PrintFontSelect(int FontNumber) { if (FontNumber < 0 || FontNumber > 9 || hFont[FontNumber] == NULL) return RET_ERROR_PARAMETER; @@ -3026,7 +3029,7 @@ static char PrintFontSelect(int FontNumber) * ------------------------------------------------------------------------- */ -static char PrintText(int X0, int Y0, TCHAR *pText, COLORREF Color ) +char PrintText(int X0, int Y0, TCHAR *pText, COLORREF Color ) { if (CLR_INVALID == SetTextColor(pdlg.hDC, Color ) ) return RET_ERROR_PRINTER_IO; @@ -3056,7 +3059,7 @@ static char PrintText(int X0, int Y0, TCHAR *pText, COLORREF Color ) * ------------------------------------------------------------------------- */ -static char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText ) +char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText ) { SIZE Size; @@ -3071,10 +3074,10 @@ static char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText ) { return RET_ERROR_PRINTER_IO; } - - /* - * We have got the size values. - * Initialise return list. + + /* + * We have got the size values. + * Initialise return list. */ lResult = Tcl_GetObjResult( interp ); @@ -3104,10 +3107,10 @@ static char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText ) /* @param DestPosY Destination Y position */ /* @param DestWidth Width of destination image, or 0 to use original size */ /* @param DestHeight Height of destination image or 0 to use original size */ -static char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *CONST oImageName, +char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *const oImageName, int DestPosX, int DestPosY, int DestWidth, int DestHeight) { - #if 0 +#if 0 Tk_PhotoImageBlock sImageBlock; Tk_PhotoHandle hPhoto; HBITMAP hDIB; @@ -3137,7 +3140,7 @@ static char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *CONST oImageName, bmInfo.bmiHeader.biPlanes = 1; bmInfo.bmiHeader.biBitCount = 32; bmInfo.bmiHeader.biCompression = BI_RGB; - + /* the first parameter is the dc, which may be 0. */ /* no difference to specify it */ hDIB = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS, @@ -3182,6 +3185,7 @@ static char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *CONST oImageName, return RET_ERROR_PRINTER_DRIVER; } DeleteObject(hDIB); - #endif +#endif return RET_OK; } + -- cgit v0.12 From 6163e7ad2b7623710bf1984e74b685d1c3f7436b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Mar 2021 16:36:00 +0000 Subject: Define ::tk::startOfCluster/::tk::endOfCluster directly for MacOS --- library/tk.tcl | 11 +++-------- macosx/tkMacOSXFont.c | 4 ++-- 2 files changed, 5 insertions(+), 10 deletions(-) diff --git a/library/tk.tcl b/library/tk.tcl index a6b499a..399cb02 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -701,14 +701,7 @@ if {[tk windowingsystem] eq "aqua"} { } } -if {[tk windowingsystem] eq "aqua"} { - namespace eval :: { - namespace export endOfCluster startOfCluster - } - namespace eval ::tk:: { - namespace import ::endOfCluster ::startOfCluster - } -} else { +if {[info commands ::tk::endOfCluster] eq ""} { proc ::tk::endOfCluster {str start} { if {$start >= [string length $str]} { return -1; @@ -722,6 +715,8 @@ if {[tk windowingsystem] eq "aqua"} { } return $start } +} +if {[info commands ::tk::startOfCluster] eq ""} { proc ::tk::startOfCluster {str start} { if {$start eq "end"} { set start [expr {[string length $str]-1}] diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index 4a4b97c..302dacc 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -616,8 +616,8 @@ TkpFontPkgInit( [cs release]; } [pool drain]; - Tcl_CreateObjCommand(interp, "startOfCluster", startOfClusterObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "endOfCluster", endOfClusterObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::startOfCluster", startOfClusterObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::endOfCluster", endOfClusterObjCmd, NULL, NULL); } /* -- cgit v0.12 From 63d1232edf70469c276639f36542ee60c3a04387 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 20 Mar 2021 17:36:33 +0000 Subject: Finish incomplete function renaming. Remove unused function --- library/entry.tcl | 8 -------- library/spinbox.tcl | 2 +- library/text.tcl | 12 ++++++------ 3 files changed, 7 insertions(+), 15 deletions(-) diff --git a/library/entry.tcl b/library/entry.tcl index 8d0fb3e..30888b7 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -636,14 +636,6 @@ proc ::tk::EntryPreviousChar {w start} { return $pos } -proc ::tk::EntryInsertChar {w start} { - set pos [::tk::endOfCluster [$w get] [$w index $start]] - if {$pos < 0} { - return end - } - return $pos -} - # ::tk::EntryScanMark -- # diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 6d740bc..95863b4 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -175,7 +175,7 @@ bind Spinbox { if {[%W selection present]} { %W delete sel.first sel.last } else { - %W delete [::tk::startOfGlyphCluster [%W get] [%W index insert]] [::tk::endOfGlyphCluster [%W get] [%W index insert]] + %W delete [::tk::startOfCluster [%W get] [%W index insert]] [::tk::endOfGlyphCluster [%W get] [%W index insert]] } } bind Spinbox { diff --git a/library/text.tcl b/library/text.tcl index 0a42285..638c9f0 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -99,10 +99,10 @@ bind Text { # nothing } # stop an accidental movement triggering bind Text { # nothing } bind Text <> { - tk::TextSetCursor %W [tk::TextPrevPos %W insert ::tk::startOfGlyphCluster] + tk::TextSetCursor %W [tk::TextPrevPos %W insert ::tk::startOfCluster] } bind Text <> { - tk::TextSetCursor %W [tk::TextNextPos %W insert ::tk::endOfGlyphCluster] + tk::TextSetCursor %W [tk::TextNextPos %W insert ::tk::endOfCluster] } bind Text <> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] @@ -111,10 +111,10 @@ bind Text <> { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } bind Text <> { - tk::TextKeySelect %W [tk::TextPrevPos %W insert ::tk::startOfGlyphCluster] + tk::TextKeySelect %W [tk::TextPrevPos %W insert ::tk::startOfCluster] } bind Text <> { - tk::TextKeySelect %W [tk::TextNextPos %W insert ::tk::endOfGlyphCluster] + tk::TextKeySelect %W [tk::TextNextPos %W insert ::tk::endOfCluster] } bind Text <> { tk::TextKeySelect %W [tk::TextUpDownLine %W -1] @@ -222,7 +222,7 @@ bind Text { %W delete sel.first sel.last } else { if {[%W compare end != insert+1c]} { - %W delete [tk::TextPrevPos %W insert+1c ::tk::startOfGlyphCluster] [tk::TextNextPos %W insert ::tk::endOfGlyphCluster] + %W delete [tk::TextPrevPos %W insert+1c ::tk::startOfCluster] [tk::TextNextPos %W insert ::tk::endOfCluster] } %W see insert } @@ -232,7 +232,7 @@ bind Text { %W delete sel.first sel.last } else { if {[%W compare insert != 1.0]} { - %W delete [tk::TextPrevPos %W insert ::tk::startOfGlyphCluster] [tk::TextNextPos %W insert-1c ::tk::endOfGlyphCluster] + %W delete [tk::TextPrevPos %W insert ::tk::startOfCluster] [tk::TextNextPos %W insert-1c ::tk::endOfCluster] } %W see insert } -- cgit v0.12 From 77ac610c9e7e9cf0c59633191c986c13be415f44 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 21 Mar 2021 16:16:58 +0000 Subject: Fix startOfClusterObjCmd/endOfClusterObjCmd so they can handle index "end" too. Needed in text widget. --- library/entry.tcl | 19 ++++++++++--------- library/spinbox.tcl | 15 ++++++++------- library/text.tcl | 30 ++++++++++++++++-------------- library/tk.tcl | 15 +++++++++++++++ library/ttk/entry.tcl | 17 +++++++++-------- macosx/tkMacOSXFont.c | 28 ++++++++++++++++++---------- 6 files changed, 76 insertions(+), 48 deletions(-) diff --git a/library/entry.tcl b/library/entry.tcl index 30888b7..dc29418 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -165,7 +165,8 @@ bind Entry { if {[%W selection present]} { %W delete sel.first sel.last } else { - %W delete [::tk::startOfCluster [%W get] [%W index insert]] [::tk::endOfCluster [%W get] [%W index insert]] + %W delete [tk::startOfCluster [%W get] [%W index insert]] \ + [tk::endOfCluster [%W get] [%W index insert]] } } bind Entry { @@ -505,8 +506,8 @@ proc ::tk::EntryBackspace w { } else { set x [expr {[$w index insert] - 1}] if {$x >= 0} { - $w delete [::tk::startOfCluster [$w get] $x] \ - [::tk::endOfCluster [$w get] $x] + $w delete [tk::startOfCluster [$w get] $x] \ + [tk::endOfCluster [$w get] $x] } if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -584,9 +585,9 @@ proc ::tk::EntryTranspose w { if {[tk windowingsystem] eq "win32"} { proc ::tk::EntryNextWord {w start} { - set pos [tcl_endOfWord [$w get] [$w index $start]] + set pos [tk::endOfWord [$w get] [$w index $start]] if {$pos >= 0} { - set pos [tcl_startOfNextWord [$w get] $pos] + set pos [tk::startOfNextWord [$w get] $pos] } if {$pos < 0} { return end @@ -595,7 +596,7 @@ if {[tk windowingsystem] eq "win32"} { } } else { proc ::tk::EntryNextWord {w start} { - set pos [tcl_endOfWord [$w get] [$w index $start]] + set pos [tk::endOfWord [$w get] [$w index $start]] if {$pos < 0} { return end } @@ -613,7 +614,7 @@ if {[tk windowingsystem] eq "win32"} { # start - Position at which to start search. proc ::tk::EntryPreviousWord {w start} { - set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] + set pos [tk::startOfPreviousWord [$w get] [$w index $start]] if {$pos < 0} { return 0 } @@ -621,7 +622,7 @@ proc ::tk::EntryPreviousWord {w start} { } proc ::tk::EntryNextChar {w start} { - set pos [::tk::endOfCluster [$w get] [$w index $start]] + set pos [tk::endOfCluster [$w get] [$w index $start]] if {$pos < 0} { return end } @@ -629,7 +630,7 @@ proc ::tk::EntryNextChar {w start} { } proc ::tk::EntryPreviousChar {w start} { - set pos [::tk::startOfCluster [$w get] [expr {[$w index $start]-1}]] + set pos [tk::startOfCluster [$w get] [expr {[$w index $start]-1}]] if {$pos < 0} { return 0 } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 95863b4..8729d0e 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -129,18 +129,18 @@ bind Spinbox <> { } bind Spinbox <> { - tk::EntrySetCursor %W [tk::EntryPreviousChar %W insert] + ::tk::EntrySetCursor %W [tk::EntryPreviousChar %W insert] } bind Spinbox <> { - tk::EntrySetCursor %W [tk::EntryNextChar %W insert] + ::tk::EntrySetCursor %W [tk::EntryNextChar %W insert] } bind Spinbox <> { - tk::EntryKeySelect %W [tk::EntryPreviousChar %W insert] - tk::EntrySeeInsert %W + ::tk::EntryKeySelect %W [tk::EntryPreviousChar %W insert] + ::tk::EntrySeeInsert %W } bind Spinbox <> { - tk::EntryKeySelect %W [tk::EntryNextChar %W insert] - tk::EntrySeeInsert %W + ::tk::EntryKeySelect %W [tk::EntryNextChar %W insert] + ::tk::EntrySeeInsert %W } bind Spinbox <> { ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] @@ -175,7 +175,8 @@ bind Spinbox { if {[%W selection present]} { %W delete sel.first sel.last } else { - %W delete [::tk::startOfCluster [%W get] [%W index insert]] [::tk::endOfGlyphCluster [%W get] [%W index insert]] + %W delete [tk::startOfCluster [%W get] [%W index insert]] \ + [tk::endOfGlyphCluster [%W get] [%W index insert]] } } bind Spinbox { diff --git a/library/text.tcl b/library/text.tcl index 638c9f0..5824690 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -99,10 +99,10 @@ bind Text { # nothing } # stop an accidental movement triggering bind Text { # nothing } bind Text <> { - tk::TextSetCursor %W [tk::TextPrevPos %W insert ::tk::startOfCluster] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tk::startOfCluster] } bind Text <> { - tk::TextSetCursor %W [tk::TextNextPos %W insert ::tk::endOfCluster] + tk::TextSetCursor %W [tk::TextNextPos %W insert tk::endOfCluster] } bind Text <> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] @@ -111,10 +111,10 @@ bind Text <> { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } bind Text <> { - tk::TextKeySelect %W [tk::TextPrevPos %W insert ::tk::startOfCluster] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tk::startOfCluster] } bind Text <> { - tk::TextKeySelect %W [tk::TextNextPos %W insert ::tk::endOfCluster] + tk::TextKeySelect %W [tk::TextNextPos %W insert tk::endOfCluster] } bind Text <> { tk::TextKeySelect %W [tk::TextUpDownLine %W -1] @@ -123,7 +123,7 @@ bind Text <> { tk::TextKeySelect %W [tk::TextUpDownLine %W 1] } bind Text <> { - tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } bind Text <> { tk::TextSetCursor %W [tk::TextNextWord %W insert] @@ -135,7 +135,7 @@ bind Text <> { tk::TextSetCursor %W [tk::TextNextPara %W insert] } bind Text <> { - tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } bind Text <> { tk::TextKeySelect %W [tk::TextNextWord %W insert] @@ -222,7 +222,8 @@ bind Text { %W delete sel.first sel.last } else { if {[%W compare end != insert+1c]} { - %W delete [tk::TextPrevPos %W insert+1c ::tk::startOfCluster] [tk::TextNextPos %W insert ::tk::endOfCluster] + %W delete [tk::TextPrevPos %W insert+1c tk::startOfCluster] \ + [tk::TextNextPos %W insert tk::endOfCluster] } %W see insert } @@ -232,7 +233,8 @@ bind Text { %W delete sel.first sel.last } else { if {[%W compare insert != 1.0]} { - %W delete [tk::TextPrevPos %W insert ::tk::startOfCluster] [tk::TextNextPos %W insert-1c ::tk::endOfCluster] + %W delete [tk::TextPrevPos %W insert tk::startOfCluster] \ + [tk::TextNextPos %W insert-1c tk::endOfCluster] } %W see insert } @@ -355,7 +357,7 @@ bind Text <> { bind Text { if {!$tk_strictMotif} { - tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } } bind Text { @@ -380,12 +382,12 @@ bind Text { } bind Text { if {!$tk_strictMotif} { - %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tk::startOfPreviousWord] insert } } bind Text { if {!$tk_strictMotif} { - %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tk::startOfPreviousWord] insert } } @@ -1067,12 +1069,12 @@ proc ::tk_textPaste w { if {[tk windowingsystem] eq "win32"} { proc ::tk::TextNextWord {w start} { - TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \ - tcl_startOfNextWord + TextNextPos $w [TextNextPos $w $start tk::endOfWord] \ + tk::startOfNextWord } } else { proc ::tk::TextNextWord {w start} { - TextNextPos $w $start tcl_endOfWord + TextNextPos $w $start tk::endOfWord } } diff --git a/library/tk.tcl b/library/tk.tcl index 399cb02..dd16793 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -701,6 +701,21 @@ if {[tk windowingsystem] eq "aqua"} { } } +if {[info commands ::tk::endOfWord] eq ""} { + proc ::tk::endOfWord {str start} { + return [tcl_endOfWord $str $start] + } +} +if {[info commands ::tk::startOfNextWord] eq ""} { + proc ::tk::startOfNextWord {str start} { + return [tcl_startOfNextWord $str $start] + } +} +if {[info commands ::tk::startOfPreviousWord] eq ""} { + proc ::tk::startOfPreviousWord {str start} { + return [tcl_startOfPreviousWord $str $start] + } +} if {[info commands ::tk::endOfCluster] eq ""} { proc ::tk::endOfCluster {str start} { if {$start >= [string length $str]} { diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 1e19120..8ffde7f 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -244,9 +244,9 @@ set ::ttk::entry::State(startNext) \ proc ttk::entry::NextWord {w start} { variable State - set pos [tcl_endOfWord [$w get] [$w index $start]] + set pos [tk::endOfWord [$w get] [$w index $start]] if {$pos >= 0 && $State(startNext)} { - set pos [tcl_startOfNextWord [$w get] $pos] + set pos [tk::startOfNextWord [$w get] $pos] } if {$pos < 0} { return end @@ -257,7 +257,7 @@ proc ttk::entry::NextWord {w start} { ## PrevWord -- Find the previous word position. # proc ttk::entry::PrevWord {w start} { - set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] + set pos [tk::startOfPreviousWord [$w get] [$w index $start]] if {$pos < 0} { return 0 } @@ -268,17 +268,17 @@ proc ttk::entry::PrevWord {w start} { # proc ttk::entry::NextChar {w start} { variable State - set pos [::tk::endOfCluster [$w get] [$w index $start]] + set pos [tk::endOfCluster [$w get] [$w index $start]] if {$pos < 0} { return end } return $pos } -## PrevChar -- Find the previous word position. +## PrevChar -- Find the previous char position. # proc ttk::entry::PrevChar {w start} { - set pos [::tk::startOfCluster [$w get] [expr {[$w index $start]-1}]] + set pos [tk::startOfCluster [$w get] [expr {[$w index $start]-1}]] if {$pos < 0} { return 0 } @@ -621,7 +621,7 @@ proc ttk::entry::Backspace {w} { set x [expr {[$w index insert] - 1}] if {$x < 0} { return } - $w delete [::tk::startOfCluster [$w get] $x] [::tk::endOfCluster [$w get] $x] + $w delete [tk::startOfCluster [$w get] $x] [tk::endOfCluster [$w get] $x] if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -636,7 +636,8 @@ proc ttk::entry::Backspace {w} { # proc ttk::entry::Delete {w} { if {![PendingDelete $w]} { - $w delete [::tk::startOfCluster [$w get] [$w index insert]] [::tk::endOfCluster [$w get] [$w index insert]] + $w delete [tk::startOfCluster [$w get] [$w index insert]] \ + [tk::endOfCluster [$w get] [$w index insert]] } } diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index 302dacc..a4af627 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -462,8 +462,8 @@ startOfClusterObjCmd( TKNSString *S; const char *stringArg; int numBytes; - Tcl_WideInt indexArg; - Tcl_WideInt result; + TkSizeT indexArg; + TkSizeT result; if ((objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; @@ -472,16 +472,20 @@ startOfClusterObjCmd( if (stringArg == NULL) { return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[2], &indexArg) != TCL_OK) { + S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; + if (TkGetIntForIndex(objv[2], [S length] - 1, 0, &indexArg) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be integer or end", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INDEX", NULL); return TCL_ERROR; } - S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; if ((unsigned long long) indexArg >= [S length]) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj([S length])); return TCL_OK; } result = indexArg >= 0 ? [S startOfCluster:indexArg] : -1; - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); + Tcl_SetObjResult(interp, TkNewIndexObj(result)); return TCL_OK; } @@ -495,8 +499,8 @@ endOfClusterObjCmd( TKNSString *S; char *stringArg; int numBytes; - Tcl_WideInt indexArg; - Tcl_WideInt result; + TkSizeT indexArg; + TkSizeT result; if ((objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); @@ -506,17 +510,21 @@ endOfClusterObjCmd( if (stringArg == NULL) { return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[2], &indexArg) != TCL_OK) { + S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; + if (TkGetIntForIndex(objv[2], [S length] - 1, 0, &indexArg) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be integer or end", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INDEX", NULL); return TCL_ERROR; } if (indexArg < 0) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); return TCL_OK; } - S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; result = (unsigned long long) indexArg < [S length] ? [S endOfCluster:indexArg] : [S length]; - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); + Tcl_SetObjResult(interp, TkNewIndexObj(result)); return TCL_OK; } -- cgit v0.12 From f5f4b880e9073674fc88a8983da21ce17cf13c87 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 21 Mar 2021 16:56:56 +0000 Subject: more tweak in MacOS implementation --- macosx/tkMacOSXFont.c | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index a4af627..daaf3cd 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -480,11 +480,13 @@ startOfClusterObjCmd( Tcl_SetErrorCode(interp, "TK", "VALUE", "INDEX", NULL); return TCL_ERROR; } - if ((unsigned long long) indexArg >= [S length]) { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj([S length])); + if (indexArg == TCL_INDEX_NONE) { + Tcl_SetObjResult(interp, TkNewIndexObj(TCL_INDEX_NONE)); + } else if ((size_t)indexArg >= [S length]) { + Tcl_SetObjResult(interp, TkNewIndexObj([S length])); return TCL_OK; } - result = indexArg >= 0 ? [S startOfCluster:indexArg] : -1; + result = [S startOfCluster:indexArg]; Tcl_SetObjResult(interp, TkNewIndexObj(result)); return TCL_OK; } @@ -518,12 +520,12 @@ endOfClusterObjCmd( Tcl_SetErrorCode(interp, "TK", "VALUE", "INDEX", NULL); return TCL_ERROR; } - if (indexArg < 0) { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); - return TCL_OK; + if (indexArg == TCL_INDEX_NONE) { + result = 0; + } else { + result = (size_t)indexArg < [S length] ? + [S endOfCluster:indexArg] : [S length]; } - result = (unsigned long long) indexArg < [S length] ? - [S endOfCluster:indexArg] : [S length]; Tcl_SetObjResult(interp, TkNewIndexObj(result)); return TCL_OK; } -- cgit v0.12 From d6d676512fab10d31a6fc83012b29505d11a3a89 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 24 Mar 2021 11:33:57 +0000 Subject: more progress --- generic/tkIcu.c | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++++---- generic/tkInt.h | 2 +- library/tk.tcl | 9 ------ unix/Makefile.in | 8 ++--- win/Makefile.in | 3 +- win/makefile.vc | 3 +- win/tkWinInit.c | 1 + 7 files changed, 93 insertions(+), 22 deletions(-) diff --git a/generic/tkIcu.c b/generic/tkIcu.c index 23ccbaa..8fdd8df 100644 --- a/generic/tkIcu.c +++ b/generic/tkIcu.c @@ -11,6 +11,13 @@ */ #include "tkInt.h" +#ifdef HAVE_STDLIB_H +#include +#endif + +#ifdef HAVE_STDINT_H +#include +#endif /* * Runtime linking of libicu. @@ -41,6 +48,9 @@ static struct { 0, NULL, NULL, NULL, NULL, NULL }; +#define FLAG_WORD 1 +#define FLAG_FOLLOWING 4 + #define icu_open icu_fns.open #define icu_close icu_fns.close #define icu_preceding icu_fns.preceding @@ -48,19 +58,77 @@ static struct { TCL_DECLARE_MUTEX(icu_mutex); -int +static int +startEndOfCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_DString ds; + TkSizeT len; + const char *str; + UErrorCodex errorCode; + void *it; + TkSizeT idx; + int flags = PTR2INT(clientData); + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1 , objv, "str start"); + return TCL_ERROR; + } + Tcl_DStringInit(&ds); + str = Tcl_GetStringFromObj(objv[1], &len); + Tcl_UtfToChar16DString(str, len, &ds); + if (TkGetIntForIndex(objv[2], Tcl_DStringLength(&ds)/2-1, 1, &idx) != TCL_OK) { + Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "ICU", "INDEX", NULL); + return TCL_ERROR; + } + + it = icu_open((UBreakIteratorTypex)(PTR2INT(clientData)&3), "C", + (const uint16_t *)Tcl_DStringValue(&ds), -1, &errorCode); + if (flags & FLAG_FOLLOWING) { + idx = icu_following(it, idx); + } else { + idx = icu_preceding(it, idx); + } + Tcl_SetObjResult(interp, TkNewIndexObj(idx)); + icu_close(it); + Tcl_DStringFree(&ds); + return TCL_OK; +} + +void Icu_Init( Tcl_Interp *interp) { Tcl_MutexLock(&icu_mutex); + if (icu_fns.nopen == 0) { int i = 0; Tcl_Obj *nameobj; static const char *iculibs[] = { - "libicuuc68.so", +#if defined(_WIN32) + "cygicuuc68.dll", + "icuuc68.dll", +#elif defined(__CYGWIN__) + "cygicuuc68.dll", +#elif defined(MAC_OSX_TCL) + "libicuuc68.dylib", +#else + "libicuuc.so.68", +#endif NULL }; +#if defined(_WIN32) && !defined(STATIC_BUILD) + if (!tclStubsPtr->tcl_CreateFileHandler) { + /* Not running on Cygwin, so don't try to load the cygwin icu dll */ + i++; + } +#endif while (iculibs[i] != NULL) { Tcl_ResetResult(interp); nameobj = Tcl_NewStringObj(iculibs[i], -1); @@ -76,7 +144,7 @@ Icu_Init( if (icu_fns.lib != NULL) { #define ICU_SYM(name) \ icu_fns.name = (fn_icu_ ## name) \ - Tcl_FindSymbol(NULL, icu_fns.lib, "ubrk_" #name "_86") + Tcl_FindSymbol(NULL, icu_fns.lib, "ubrk_" #name "_68") ICU_SYM(open); ICU_SYM(close); ICU_SYM(preceding); @@ -87,9 +155,18 @@ Icu_Init( icu_fns.nopen++; Tcl_MutexUnlock(&icu_mutex); - //Tcl_CreateObjCommand(interp, "::tk::endOfCluster", endOfClusterCmd, - // interp, NULL); - return TCL_OK; + if (icu_fns.lib != NULL) { + Tcl_CreateObjCommand(interp, "::tk::startOfCluster", startEndOfCmd, + INT2PTR(0), NULL); + Tcl_CreateObjCommand(interp, "::tk::startOfNextWord", startEndOfCmd, + INT2PTR(FLAG_WORD|FLAG_FOLLOWING), NULL); + Tcl_CreateObjCommand(interp, "::tk::startOfPreviousWord", startEndOfCmd, + INT2PTR(FLAG_WORD), NULL); + Tcl_CreateObjCommand(interp, "::tk::endOfCluster", startEndOfCmd, + INT2PTR(FLAG_FOLLOWING), NULL); + Tcl_CreateObjCommand(interp, "::tk::endOfWord", startEndOfCmd, + INT2PTR(FLAG_WORD|FLAG_FOLLOWING), NULL); + } } /* diff --git a/generic/tkInt.h b/generic/tkInt.h index 1b608df..fb43ef5 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1431,7 +1431,7 @@ MODULE_SCOPE void TkUnixSetXftClipRegion(Region clipRegion); # define tcl_CreateFileHandler reserved9 #endif -MODULE_SCOPE int Icu_Init(Tcl_Interp* interp); +MODULE_SCOPE void Icu_Init(Tcl_Interp* interp); /* * Unsupported commands. diff --git a/library/tk.tcl b/library/tk.tcl index dd16793..6828465 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -725,9 +725,6 @@ if {[info commands ::tk::endOfCluster] eq ""} { set start [expr {$start+1}] } set start [expr {$start+1}] - if {[string index $str $start] eq {^}} { - set start [expr {$start+1}];# For demo purposes only - } return $start } } @@ -739,12 +736,6 @@ if {[info commands ::tk::startOfCluster] eq ""} { if {$start < 0} { return -1; } - if {[string index $str $start] eq {^}} { - set start [expr {$start-1}];# For demo purposes only - } - if {[string length [string index $str [expr {$start-1}]]] > 1} { - return [expr {$start-1}] - } return $start } } diff --git a/unix/Makefile.in b/unix/Makefile.in index 6626a66..3314c20 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -333,7 +333,7 @@ CC_SWITCHES_NO_STUBS = -I${UNIX_DIR} -I${GENERIC_DIR} -I${BMAP_DIR} \ ${@TK_WINDOWINGSYSTEM@_INCLUDES} ${CFLAGS} ${CFLAGS_WARNING} \ ${SHLIB_CFLAGS} -I${TCL_GENERIC_DIR} -I${TCL_PLATFORM_DIR} ${AC_FLAGS} \ ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} \ -${NO_DEPRECATED_FLAGS} @EXTRA_CC_SWITCHES@ +${NO_DEPRECATED_FLAGS} -DTCL_UTF_MAX=3 @EXTRA_CC_SWITCHES@ CC_SWITCHES = $(CC_SWITCHES_NO_STUBS) @TCL_STUB_FLAGS@ @@ -1200,6 +1200,9 @@ tkRectOval.o: $(GENERIC_DIR)/tkRectOval.c tkTrig.o: $(GENERIC_DIR)/tkTrig.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTrig.c +tkIcu.o: $(GENERIC_DIR)/tkIcu.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkIcu.c + tkImage.o: $(GENERIC_DIR)/tkImage.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImage.c @@ -1296,9 +1299,6 @@ tkUnixEmbed.o: $(UNIX_DIR)/tkUnixEmbed.c tkUnixEvent.o: $(UNIX_DIR)/tkUnixEvent.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEvent.c -tkIcu.o: $(GENERIC_DIR)/tkIcu.c - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkIcu.c - tkUnixFocus.o: $(UNIX_DIR)/tkUnixFocus.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFocus.c diff --git a/win/Makefile.in b/win/Makefile.in index 76b2958..9d16cdb 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -260,7 +260,7 @@ CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ -I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ -I"${XLIB_DIR_NATIVE}" -I"${BITMAP_DIR_NATIVE}" \ -I"${TCL_GENERIC_NATIVE}" -I"${TCL_PLATFORM_NATIVE}" \ -${AC_FLAGS} $(NO_DEPRECATED_FLAGS) -DUSE_TCL_STUBS +${AC_FLAGS} $(NO_DEPRECATED_FLAGS) -DTCL_UTF_MAX=3 -DUSE_TCL_STUBS CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ @@ -356,6 +356,7 @@ TK_OBJS = \ tkGet.$(OBJEXT) \ tkGrab.$(OBJEXT) \ tkGrid.$(OBJEXT) \ + tkIcu.$(OBJEXT) \ tkImage.$(OBJEXT) \ tkImgBmap.$(OBJEXT) \ tkImgListFormat.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index 912f781..73a9830 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -228,6 +228,7 @@ TKOBJS = \ $(TMP_DIR)\tkGet.obj \ $(TMP_DIR)\tkGrab.obj \ $(TMP_DIR)\tkGrid.obj \ + $(TMP_DIR)\tkIcu.obj \ $(TMP_DIR)\tkImage.obj \ $(TMP_DIR)\tkImgBmap.obj \ $(TMP_DIR)\tkImgListFormat.obj \ @@ -335,7 +336,7 @@ PRJ_INCLUDES = -I"$(BITMAPDIR)" -I"$(XLIBDIR)" CONFIG_DEFS =/DHAVE_SYS_TYPES_H=1 /DHAVE_SYS_STAT_H=1 \ /DHAVE_STRING_H=1 /DHAVE_MEMORY_H=1 \ - /DHAVE_STRINGS_H=1 \ + /DHAVE_STRINGS_H=1 /DTCL_UTF_MAX=3 \ !if $(HAVE_UXTHEME_H) /DHAVE_UXTHEME_H=1 \ !endif diff --git a/win/tkWinInit.c b/win/tkWinInit.c index 1f630e4..1140ff2 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -44,6 +44,7 @@ TkpInit( WinIcoInit(interp); TkWinXInit(Tk_GetHINSTANCE()); + Icu_Init(interp); return TCL_OK; } -- cgit v0.12 From a820220b3d4be7f09e9eb56fa090642f316bf3fb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 24 Mar 2021 16:08:15 +0000 Subject: ::tk::startOfCluster/::tk::endOfCluster are now giving the correct result on ICU 68 (or ICU 64 on XQuarz) --- generic/tkCanvText.c | 14 +++--- generic/tkEntry.c | 16 +++---- generic/tkFont.c | 20 ++++----- generic/tkIcu.c | 47 ++++++++++++++------ generic/tkImgListFormat.c | 2 +- generic/tkInt.h | 2 + generic/tkText.c | 18 ++++---- generic/tkUtil.c | 110 ++++++++++++++++++++++++++++++++++++++++++++++ generic/ttk/ttkEntry.c | 26 +++++------ macosx/tkMacOSXFont.c | 12 ++--- unix/tkUnixMenu.c | 4 +- win/tkWinMenu.c | 4 +- 12 files changed, 204 insertions(+), 71 deletions(-) diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 3f4a3a9..b305ff3 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -507,7 +507,7 @@ ConfigureText( */ textPtr->numBytes = strlen(textPtr->text); - textPtr->numChars = Tcl_NumUtfChars(textPtr->text, textPtr->numBytes); + textPtr->numChars = TkNumUtfChars(textPtr->text, textPtr->numBytes); if (textInfoPtr->selItemPtr == itemPtr) { if (textInfoPtr->selectFirst + 1 >= textPtr->numChars + 1) { @@ -1030,7 +1030,7 @@ TextInsert( if (index + 1 > textPtr->numChars + 1) { index = textPtr->numChars; } - byteIndex = Tcl_UtfAtIndex(text, index) - text; + byteIndex = TkUtfAtIndex(text, index) - text; byteCount = strlen(string); if (byteCount == 0) { return; @@ -1043,7 +1043,7 @@ TextInsert( ckfree(text); textPtr->text = newStr; - charsAdded = Tcl_NumUtfChars(string, byteCount); + charsAdded = TkNumUtfChars(string, byteCount); textPtr->numChars += charsAdded; textPtr->numBytes += byteCount; @@ -1113,8 +1113,8 @@ TextDeleteChars( } charsRemoved = last + 1 - first; - byteIndex = Tcl_UtfAtIndex(text, first) - text; - byteCount = Tcl_UtfAtIndex(text + byteIndex, charsRemoved) + byteIndex = TkUtfAtIndex(text, first) - text; + byteCount = TkUtfAtIndex(text + byteIndex, charsRemoved) - (text + byteIndex); newStr = (char *)ckalloc(textPtr->numBytes + 1 - byteCount); @@ -1536,8 +1536,8 @@ GetSelText( return 0; } text = textPtr->text; - selStart = Tcl_UtfAtIndex(text, textInfoPtr->selectFirst); - selEnd = Tcl_UtfAtIndex(selStart, + selStart = TkUtfAtIndex(text, textInfoPtr->selectFirst); + selEnd = TkUtfAtIndex(selStart, textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst); if (selEnd <= selStart + offset) { return 0; diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 0e7f87c..15b41d2 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -2167,7 +2167,7 @@ InsertChars( char *newStr; string = entryPtr->string; - byteIndex = Tcl_UtfAtIndex(string, index) - string; + byteIndex = TkUtfAtIndex(string, index) - string; byteCount = strlen(value); if (byteCount == 0) { return TCL_OK; @@ -2194,13 +2194,13 @@ InsertChars( * The following construction is used because inserting improperly formed * UTF-8 sequences between other improperly formed UTF-8 sequences could * result in actually forming valid UTF-8 sequences; the number of - * characters added may not be Tcl_NumUtfChars(string, -1), because of + * characters added may not be TkNumUtfChars(string, -1), because of * context. The actual number of characters added is how many characters * are in the string now minus the number that used to be there. */ oldChars = entryPtr->numChars; - entryPtr->numChars = Tcl_NumUtfChars(newStr, TCL_INDEX_NONE); + entryPtr->numChars = TkNumUtfChars(newStr, TCL_INDEX_NONE); charsAdded = entryPtr->numChars - oldChars; entryPtr->numBytes += byteCount; @@ -2271,8 +2271,8 @@ DeleteChars( } string = entryPtr->string; - byteIndex = Tcl_UtfAtIndex(string, index) - string; - byteCount = Tcl_UtfAtIndex(string + byteIndex, count) - (string+byteIndex); + byteIndex = TkUtfAtIndex(string, index) - string; + byteCount = TkUtfAtIndex(string + byteIndex, count) - (string+byteIndex); newByteCount = entryPtr->numBytes + 1 - byteCount; newStr = (char *)ckalloc(newByteCount); @@ -2500,7 +2500,7 @@ EntrySetValue( entryPtr->string = tmp; } entryPtr->numBytes = valueLen; - entryPtr->numChars = Tcl_NumUtfChars(value, valueLen); + entryPtr->numChars = TkNumUtfChars(value, valueLen); if (entryPtr->displayString == oldSource) { entryPtr->displayString = entryPtr->string; @@ -2930,8 +2930,8 @@ EntryFetchSelection( return -1; } string = entryPtr->displayString; - selStart = Tcl_UtfAtIndex(string, entryPtr->selectFirst); - selEnd = Tcl_UtfAtIndex(selStart, + selStart = TkUtfAtIndex(string, entryPtr->selectFirst); + selEnd = TkUtfAtIndex(selStart, entryPtr->selectLast - entryPtr->selectFirst); if (selEnd <= selStart + offset) { return 0; diff --git a/generic/tkFont.c b/generic/tkFont.c index 6664cbb..c717ff8 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -1993,7 +1993,7 @@ Tk_ComputeTextLayout( height = fmPtr->ascent + fmPtr->descent; if (numChars < 0) { - numChars = Tcl_NumUtfChars(string, -1); + numChars = TkNumUtfChars(string, -1); } if (wrapLength == 0) { wrapLength = -1; @@ -2016,7 +2016,7 @@ Tk_ComputeTextLayout( curX = 0; - endp = Tcl_UtfAtIndex(string, numChars); + endp = TkUtfAtIndex(string, numChars); special = string; flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES; @@ -2133,7 +2133,7 @@ Tk_ComputeTextLayout( bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk, -1, 0, &chunkPtr->totalWidth); chunkPtr->numBytes += bytesThisChunk; - chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk); + chunkPtr->numChars += TkNumUtfChars(end, bytesThisChunk); chunkPtr->totalWidth += curX; } } @@ -2324,14 +2324,14 @@ Tk_DrawTextLayout( firstChar = 0; firstByte = chunkPtr->start; } else { - firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar); + firstByte = TkUtfAtIndex(chunkPtr->start, firstChar); Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start, firstByte - chunkPtr->start, -1, 0, &drawX); } if (lastChar < numDisplayChars) { numDisplayChars = lastChar; } - lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars); + lastByte = TkUtfAtIndex(chunkPtr->start, numDisplayChars); #ifdef TK_DRAW_IN_CONTEXT TkpDrawCharsInContext(display, drawable, gc, layoutPtr->tkfont, chunkPtr->start, chunkPtr->numBytes, @@ -2394,14 +2394,14 @@ TkDrawAngledTextLayout( firstChar = 0; firstByte = chunkPtr->start; } else { - firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar); + firstByte = TkUtfAtIndex(chunkPtr->start, firstChar); Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start, firstByte - chunkPtr->start, -1, 0, &drawX); } if (lastChar < numDisplayChars) { numDisplayChars = lastChar; } - lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars); + lastByte = TkUtfAtIndex(chunkPtr->start, numDisplayChars); #ifdef TK_DRAW_IN_CONTEXT dx = cosA * (chunkPtr->x) + sinA * (chunkPtr->y); dy = -sinA * (chunkPtr->x) + cosA * (chunkPtr->y); @@ -2654,7 +2654,7 @@ Tk_PointToChar( } n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start, chunkPtr->numBytes, x - chunkPtr->x, 0, &dummy); - return numChars + Tcl_NumUtfChars(chunkPtr->start, n); + return numChars + TkNumUtfChars(chunkPtr->start, n); } numChars += chunkPtr->numChars; lastPtr = chunkPtr; @@ -2758,7 +2758,7 @@ Tk_CharBbox( goto check; } } else if (index < chunkPtr->numChars) { - end = Tcl_UtfAtIndex(chunkPtr->start, index); + end = TkUtfAtIndex(chunkPtr->start, index); if (xPtr != NULL) { Tk_MeasureChars(tkfont, chunkPtr->start, end - chunkPtr->start, -1, 0, &x); @@ -3831,7 +3831,7 @@ NewChunk( *layoutPtrPtr = layoutPtr; *maxPtr = maxChunks; } - numChars = Tcl_NumUtfChars(start, numBytes); + numChars = TkNumUtfChars(start, numBytes); chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks]; chunkPtr->start = start; chunkPtr->numBytes = numBytes; diff --git a/generic/tkIcu.c b/generic/tkIcu.c index 8fdd8df..fc112c5 100644 --- a/generic/tkIcu.c +++ b/generic/tkIcu.c @@ -36,6 +36,7 @@ typedef void *(*fn_icu_open)(UBreakIteratorTypex, const char *, typedef void (*fn_icu_close)(void *); typedef int32_t (*fn_icu_preceding)(void *, int32_t); typedef int32_t (*fn_icu_following)(void *, int32_t); +typedef void (*fn_icu_setText)(void *, const void *, int32_t, UErrorCodex *); static struct { int nopen; @@ -44,8 +45,9 @@ static struct { fn_icu_close close; fn_icu_preceding preceding; fn_icu_following following; + fn_icu_setText setText; } icu_fns = { - 0, NULL, NULL, NULL, NULL, NULL + 0, NULL, NULL, NULL, NULL, NULL, NULL }; #define FLAG_WORD 1 @@ -55,6 +57,7 @@ static struct { #define icu_close icu_fns.close #define icu_preceding icu_fns.preceding #define icu_following icu_fns.following +#define icu_setText icu_fns.setText TCL_DECLARE_MUTEX(icu_mutex); @@ -68,7 +71,7 @@ startEndOfCmd( Tcl_DString ds; TkSizeT len; const char *str; - UErrorCodex errorCode; + UErrorCodex errorCode = U_ZERO_ERRORZ; void *it; TkSizeT idx; int flags = PTR2INT(clientData); @@ -79,20 +82,30 @@ startEndOfCmd( } Tcl_DStringInit(&ds); str = Tcl_GetStringFromObj(objv[1], &len); - Tcl_UtfToChar16DString(str, len, &ds); - if (TkGetIntForIndex(objv[2], Tcl_DStringLength(&ds)/2-1, 1, &idx) != TCL_OK) { + Tcl_UtfToUniCharDString(str, len, &ds); + if (TkGetIntForIndex(objv[2], Tcl_DStringLength(&ds)/2-1, 0, &idx) != TCL_OK) { Tcl_DStringFree(&ds); Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TK", "ICU", "INDEX", NULL); return TCL_ERROR; } - it = icu_open((UBreakIteratorTypex)(PTR2INT(clientData)&3), "C", - (const uint16_t *)Tcl_DStringValue(&ds), -1, &errorCode); + it = icu_open((UBreakIteratorTypex)(PTR2INT(clientData)&3), NULL, + NULL, -1, &errorCode); + if (it != NULL) { + errorCode = U_ZERO_ERRORZ; + icu_setText(it, (const uint16_t *)Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)/2, &errorCode); + } + if (it == NULL || errorCode != U_ZERO_ERRORZ) { + Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("cannot open ICU iterator, errocode: %d", (int)errorCode)); + Tcl_SetErrorCode(interp, "TK", "ICU", "CANNOTOPEN", NULL); + return TCL_ERROR; + } if (flags & FLAG_FOLLOWING) { idx = icu_following(it, idx); } else { - idx = icu_preceding(it, idx); + idx = icu_preceding(it, idx + 1); } Tcl_SetObjResult(interp, TkNewIndexObj(idx)); icu_close(it); @@ -100,6 +113,13 @@ startEndOfCmd( return TCL_OK; } +#ifdef MAC_OSX_TCL +/* Hack, since homebrew doesn't have ICU 68 yet */ +#define ICU_VERSION "64" +#else +#define ICU_VERSION "68" +#endif + void Icu_Init( Tcl_Interp *interp) @@ -111,14 +131,14 @@ Icu_Init( Tcl_Obj *nameobj; static const char *iculibs[] = { #if defined(_WIN32) - "cygicuuc68.dll", - "icuuc68.dll", + "cygicuuc" ICU_VERSION ".dll", + "icuuc" ICU_VERSION ".dll", #elif defined(__CYGWIN__) - "cygicuuc68.dll", + "cygicuuc" ICU_VERSION ".dll", #elif defined(MAC_OSX_TCL) - "libicuuc68.dylib", + "libicuuc." ICU_VERSION ".dylib", #else - "libicuuc.so.68", + "libicuuc.so." ICU_VERSION "", #endif NULL }; @@ -144,11 +164,12 @@ Icu_Init( if (icu_fns.lib != NULL) { #define ICU_SYM(name) \ icu_fns.name = (fn_icu_ ## name) \ - Tcl_FindSymbol(NULL, icu_fns.lib, "ubrk_" #name "_68") + Tcl_FindSymbol(NULL, icu_fns.lib, "ubrk_" #name "_" ICU_VERSION) ICU_SYM(open); ICU_SYM(close); ICU_SYM(preceding); ICU_SYM(following); + ICU_SYM(setText); #undef ICU_SYM } } diff --git a/generic/tkImgListFormat.c b/generic/tkImgListFormat.c index 98a56cf..1fa813b 100644 --- a/generic/tkImgListFormat.c +++ b/generic/tkImgListFormat.c @@ -413,7 +413,7 @@ StringMatchDef( if (Tcl_ListObjIndex(interp, rowListPtr[0], 0, &pixelData) != TCL_OK) { return 0; } - if (Tcl_GetCharLength(pixelData) > TK_PHOTO_MAX_COLOR_CHARS) { + if (TkNumUtfChars(Tcl_GetString(pixelData), -1) > TK_PHOTO_MAX_COLOR_CHARS) { return 0; } if (ParseColor(interp, pixelData, Tk_Display(Tk_MainWindow(interp)), diff --git a/generic/tkInt.h b/generic/tkInt.h index fb43ef5..13b182e 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1426,6 +1426,8 @@ MODULE_SCOPE void TkUnixSetXftClipRegion(Region clipRegion); MODULE_SCOPE size_t TkUtfToUniChar(const char *, int *); MODULE_SCOPE size_t TkUniCharToUtf(int, char *); #endif +MODULE_SCOPE const char *TkUtfAtIndex(const char *,size_t); +MODULE_SCOPE size_t TkNumUtfChars(const char *, size_t); #if defined(_WIN32) && !defined(STATIC_BUILD) && TCL_MAJOR_VERSION < 9 # define tcl_CreateFileHandler reserved9 diff --git a/generic/tkText.c b/generic/tkText.c index 09a110d..daf2e03 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -1466,7 +1466,7 @@ TextWidgetObjCmd( insertLength = 0; for (j = 4; j < objc; j += 2) { - insertLength += Tcl_GetCharLength(objv[j]); + insertLength += TkNumUtfChars(Tcl_GetString(objv[j]), -1); } /* @@ -4101,12 +4101,12 @@ TextSearchIndexInLine( if (searchSpecPtr->exact) { index += leftToScan; } else { - index += Tcl_NumUtfChars(segPtr->body.chars, leftToScan); + index += TkNumUtfChars(segPtr->body.chars, leftToScan); } } else if (searchSpecPtr->exact) { index += segPtr->size; } else { - index += Tcl_NumUtfChars(segPtr->body.chars, -1); + index += TkNumUtfChars(segPtr->body.chars, -1); } } leftToScan -= segPtr->size; @@ -4231,7 +4231,7 @@ TextSearchAddNextLine( Tcl_GetString(theLine); *lenPtr = theLine->length; } else { - *lenPtr = Tcl_GetCharLength(theLine); + *lenPtr = TkNumUtfChars(Tcl_GetString(theLine), -1); } } return linePtr; @@ -4301,7 +4301,7 @@ TextSearchFoundMatch( if (searchSpecPtr->exact) { const char *startOfLine = Tcl_GetString(theLine); - numChars = Tcl_NumUtfChars(startOfLine + matchOffset, matchLength); + numChars = TkNumUtfChars(startOfLine + matchOffset, matchLength); } else { numChars = matchLength; } @@ -4360,13 +4360,13 @@ TextSearchFoundMatch( if (searchSpecPtr->exact) { matchOffset += segPtr->size; } else { - matchOffset += Tcl_NumUtfChars(segPtr->body.chars, -1); + matchOffset += TkNumUtfChars(segPtr->body.chars, -1); } } else { if (searchSpecPtr->exact) { leftToScan -= (int)segPtr->size; } else { - leftToScan -= Tcl_NumUtfChars(segPtr->body.chars, -1); + leftToScan -= TkNumUtfChars(segPtr->body.chars, -1); } } curIndex.byteIndex += segPtr->size; @@ -4451,13 +4451,13 @@ TextSearchFoundMatch( continue; } else if (!searchSpecPtr->searchElide && TkTextIsElided(textPtr, &curIndex, NULL)) { - numChars += Tcl_NumUtfChars(segPtr->body.chars, -1); + numChars += TkNumUtfChars(segPtr->body.chars, -1); continue; } if (searchSpecPtr->exact) { leftToScan -= segPtr->size; } else { - leftToScan -= Tcl_NumUtfChars(segPtr->body.chars, -1); + leftToScan -= TkNumUtfChars(segPtr->body.chars, -1); } } diff --git a/generic/tkUtil.c b/generic/tkUtil.c index da2ce95..8595144 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -1270,6 +1270,116 @@ size_t TkUniCharToUtf(int ch, char *buf) return Tcl_UniCharToUtf(ch, buf); } #endif + +/* + *--------------------------------------------------------------------------- + * + * TkUtfAtIndex -- + * + * Returns a pointer to the specified character (not byte) position in + * the UTF-8 string. Characters > U+FFFF count as + * 2 positions, but then the pointer should never be placed between + * the two positions. + * + * Results: + * As above. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +const char * +TkUtfAtIndex( + const char *src, /* The UTF-8 string. */ + size_t index) /* The position of the desired character. */ +{ + Tcl_UniChar ch = 0; + size_t len = 0; + + while (index-- > 0) { + len = Tcl_UtfToUniChar(src, &ch); + src += len; + } + if ((ch >= 0xD800) && (len < 3)) { + /* Index points at character following high Surrogate */ + src += Tcl_UtfToUniChar(src, &ch); + } + return src; +} + +/* + *--------------------------------------------------------------------------- + * + * TkNumUtfChars -- + * + * Returns the number of characters (not bytes) in the UTF-8 string, not + * including the terminating NULL byte. This is equivalent to Plan 9 + * utflen() and utfnlen(), except that Characters > U+FFFF count as + * 2 positions. + * + * Results: + * As above. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +size_t +TkNumUtfChars( + const char *src, /* The UTF-8 string to measure. */ + size_t length) /* The length of the string in bytes, or -1 + * for strlen(string). */ +{ + Tcl_UniChar ch = 0; + size_t i = 0; + + if (length == (size_t)-1) { + /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */ + while (*src != '\0') { + src += Tcl_UtfToUniChar(src, &ch); + i++; + } + } else { + /* Will return value between 0 and length. No overflow checks. */ + + /* Pointer to the end of string. Never read endPtr[0] */ + const char *endPtr = src + length; + /* Pointer to last byte where optimization still can be used */ + const char *optPtr = endPtr - 4; + + /* + * Optimize away the call in this loop. Justified because... + * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr) + * By initialization above (endPtr - optPtr) = TCL_UTF_MAX + * So (endPtr - src) >= TCL_UTF_MAX, and passing that to + * Tcl_UtfCharComplete we know will cause return of 1. + */ + while (src <= optPtr + /* && Tcl_UtfCharComplete(src, endPtr - src) */ ) { + src += Tcl_UtfToUniChar(src, &ch); + i++; + } + /* Loop over the remaining string where call must happen */ + while (src < endPtr) { + if (Tcl_UtfCharComplete(src, endPtr - src)) { + src += Tcl_UtfToUniChar(src, &ch); + } else { + /* + * src points to incomplete UTF-8 sequence + * Treat first byte as character and count it + */ + src++; + } + i++; + } + } + return i; +} + /* * Local Variables: * mode: c diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index cc6c6af..614203e 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -365,8 +365,8 @@ EntryFetchSelection( } string = entryPtr->entry.displayString; - selStart = Tcl_UtfAtIndex(string, entryPtr->entry.selectFirst); - selEnd = Tcl_UtfAtIndex(selStart, + selStart = TkUtfAtIndex(string, entryPtr->entry.selectFirst); + selEnd = TkUtfAtIndex(selStart, entryPtr->entry.selectLast - entryPtr->entry.selectFirst); if (selEnd <= selStart + offset) { return 0; @@ -484,11 +484,11 @@ ExpandPercents( break; case 'S': /* string to be inserted/deleted, if any */ if (reason == VALIDATE_INSERT) { - string = Tcl_UtfAtIndex(newValue, index); - stringLength = Tcl_UtfAtIndex(string, count) - string; + string = TkUtfAtIndex(newValue, index); + stringLength = TkUtfAtIndex(string, count) - string; } else if (reason == VALIDATE_DELETE) { - string = Tcl_UtfAtIndex(entryPtr->entry.string, index); - stringLength = Tcl_UtfAtIndex(string, count) - string; + string = TkUtfAtIndex(entryPtr->entry.string, index); + stringLength = TkUtfAtIndex(string, count) - string; } else { string = ""; stringLength = 0; @@ -734,7 +734,7 @@ static void EntryStoreValue(Entry *entryPtr, const char *value) { size_t numBytes = strlen(value); - TkSizeT numChars = Tcl_NumUtfChars(value, numBytes); + TkSizeT numChars = TkNumUtfChars(value, numBytes); if (entryPtr->core.flags & VALIDATING) entryPtr->core.flags |= VALIDATION_SET_VALUE; @@ -839,9 +839,9 @@ InsertChars( const char *value) /* New characters to add */ { char *string = entryPtr->entry.string; - size_t byteIndex = Tcl_UtfAtIndex(string, index) - string; + size_t byteIndex = TkUtfAtIndex(string, index) - string; size_t byteCount = strlen(value); - int charsAdded = Tcl_NumUtfChars(value, byteCount); + int charsAdded = TkNumUtfChars(value, byteCount); size_t newByteCount = entryPtr->entry.numBytes + byteCount + 1; char *newBytes; int code; @@ -893,8 +893,8 @@ DeleteChars( return TCL_OK; } - byteIndex = Tcl_UtfAtIndex(string, index) - string; - byteCount = Tcl_UtfAtIndex(string+byteIndex, count) - (string+byteIndex); + byteIndex = TkUtfAtIndex(string, index) - string; + byteCount = TkUtfAtIndex(string+byteIndex, count) - (string+byteIndex); newByteCount = entryPtr->entry.numBytes + 1 - byteCount; newBytes = (char *)ckalloc(newByteCount); @@ -1305,10 +1305,10 @@ static void EntryDisplay(void *clientData, Drawable d) if ((*(entryPtr->entry.displayString) == '\0') && (entryPtr->entry.placeholderObj != NULL)) { /* No text displayed, but -placeholder is given */ - if (Tcl_GetCharLength(es.placeholderForegroundObj) > 0) { + if (TkNumUtfChars(Tcl_GetString(es.placeholderForegroundObj), -1) > 0) { foregroundObj = es.placeholderForegroundObj; } else { - foregroundObj = es.foregroundObj; + foregroundObj = es.foregroundObj; } /* Use placeholder text width */ leftIndex = 0; diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index daaf3cd..7cfd023 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -112,7 +112,7 @@ static int CreateNamedSystemFont(Tcl_Interp *interp, self = [self init]; if (self) { Tcl_DStringInit(&_ds); - Tcl_UtfToChar16DString((const char *)bytes, len, &_ds); + Tcl_UtfToUniCharDString((const char *)bytes, len, &_ds); _string = [[NSString alloc] initWithCharactersNoCopy:(unichar *)Tcl_DStringValue(&_ds) length:Tcl_DStringLength(&_ds)>>1 @@ -1041,8 +1041,8 @@ TkpMeasureCharsInContext( attributes:fontPtr->nsAttributes]; typesetter = CTTypesetterCreateWithAttributedString( (CFAttributedStringRef)attributedString); - start = Tcl_NumUtfChars(source, rangeStart); - len = Tcl_NumUtfChars(source + rangeStart, rangeLength); + start = TkNumUtfChars(source, rangeStart); + len = TkNumUtfChars(source + rangeStart, rangeLength); if (start > 0) { range.length = start; line = CTTypesetterCreateLine(typesetter, range); @@ -1143,7 +1143,7 @@ TkpMeasureCharsInContext( [attributedString release]; [string release]; length = ceil(width - offset); - fit = (Tcl_UtfAtIndex(source, index) - source) - rangeStart; + fit = (TkUtfAtIndex(source, index) - source) - rangeStart; done: #ifdef TK_MAC_DEBUG_FONTS TkMacOSXDbgMsg("measure: source=\"%s\" range=\"%.*s\" maxLength=%d " @@ -1339,8 +1339,8 @@ TkpDrawAngledCharsInContext( -textX, -textY); } CGContextConcatCTM(context, t); - start = Tcl_NumUtfChars(source, rangeStart); - length = Tcl_NumUtfChars(source, rangeStart + rangeLength) - start; + start = TkNumUtfChars(source, rangeStart); + length = TkNumUtfChars(source, rangeStart + rangeLength) - start; line = CTTypesetterCreateLine(typesetter, CFRangeMake(start, length)); if (start > 0) { diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c index 08df309..4ae25d5 100644 --- a/unix/tkUnixMenu.c +++ b/unix/tkUnixMenu.c @@ -854,13 +854,13 @@ DrawMenuUnderline( if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) { int len; - len = Tcl_GetCharLength(mePtr->labelPtr); + len = TkNumUtfChars(Tcl_GetString(mePtr->labelPtr), -1); if (mePtr->underline < len) { int activeBorderWidth, leftEdge, ch; const char *label, *start, *end; label = Tcl_GetString(mePtr->labelPtr); - start = Tcl_UtfAtIndex(label, mePtr->underline); + start = TkUtfAtIndex(label, mePtr->underline); end = start + TkUtfToUniChar(start, &ch); Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index 24e64f1..6c338c0 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -2134,13 +2134,13 @@ DrawMenuUnderline( if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) { int len; - len = Tcl_GetCharLength(mePtr->labelPtr); + len = TkNumUtfChars(Tcl_GetString(mePtr->labelPtr), -1); if (mePtr->underline < len) { const char *label, *start, *end; int ch; label = Tcl_GetString(mePtr->labelPtr); - start = Tcl_UtfAtIndex(label, mePtr->underline); + start = TkUtfAtIndex(label, mePtr->underline); end = start + TkUtfToUniChar(start, &ch); Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, label, x + mePtr->indicatorSpace, -- cgit v0.12 From 05e8c3929d4192bdfe4511b62cc4deb5f6ea8321 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 24 Mar 2021 16:54:25 +0000 Subject: Handle Characters > U+FFFF better --- generic/tkTextIndex.c | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index ade889b..c56f44c 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -2134,7 +2134,12 @@ TkTextIndexBackChars( if (p == start) { break; } - charCount--; + if ((sizeof(Tcl_UniChar) == 2) && (unsigned)(UCHAR(*p) - 0xF0) <= 5) { + charCount--; /* Characters > U+FFFF count as 2 here */ + } + if (charCount != 0) { + charCount--; + } } } else { if (type & COUNT_INDICES) { @@ -2372,18 +2377,18 @@ StartEnd( } firstChar = 0; } - if (offset == 0) { - if (modifier == TKINDEX_DISPLAY) { - TkTextIndexBackChars(textPtr, indexPtr, 1, indexPtr, - COUNT_DISPLAY_INDICES); - } else { - TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr, - COUNT_INDICES); - } - } else { - indexPtr->byteIndex -= chSize; - } - offset -= chSize; + if (offset == 0) { + if (modifier == TKINDEX_DISPLAY) { + TkTextIndexBackChars(textPtr, indexPtr, 1, indexPtr, + COUNT_DISPLAY_INDICES); + } else { + TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr, + COUNT_INDICES); + } + } else { + indexPtr->byteIndex -= chSize; + } + offset -= chSize; if ((int)offset < 0) { if (indexPtr->byteIndex == 0) { goto done; -- cgit v0.12 From 708494fd5b00424cd7b489728cb2099def6da6c5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 25 Mar 2021 10:05:06 +0000 Subject: More WIP --- generic/tkIcu.c | 76 ++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 62 insertions(+), 14 deletions(-) diff --git a/generic/tkIcu.c b/generic/tkIcu.c index fc112c5..69f3c00 100644 --- a/generic/tkIcu.c +++ b/generic/tkIcu.c @@ -36,27 +36,34 @@ typedef void *(*fn_icu_open)(UBreakIteratorTypex, const char *, typedef void (*fn_icu_close)(void *); typedef int32_t (*fn_icu_preceding)(void *, int32_t); typedef int32_t (*fn_icu_following)(void *, int32_t); +typedef int32_t (*fn_icu_previous)(void *); +typedef int32_t (*fn_icu_next)(void *); typedef void (*fn_icu_setText)(void *, const void *, int32_t, UErrorCodex *); static struct { - int nopen; + size_t nopen; Tcl_LoadHandle lib; fn_icu_open open; fn_icu_close close; fn_icu_preceding preceding; fn_icu_following following; + fn_icu_previous previous; + fn_icu_next next; fn_icu_setText setText; } icu_fns = { - 0, NULL, NULL, NULL, NULL, NULL, NULL + 0, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL }; #define FLAG_WORD 1 #define FLAG_FOLLOWING 4 +#define FLAG_SPACE 8 #define icu_open icu_fns.open #define icu_close icu_fns.close #define icu_preceding icu_fns.preceding #define icu_following icu_fns.following +#define icu_previous icu_fns.previous +#define icu_next icu_fns.next #define icu_setText icu_fns.setText TCL_DECLARE_MUTEX(icu_mutex); @@ -83,18 +90,19 @@ startEndOfCmd( Tcl_DStringInit(&ds); str = Tcl_GetStringFromObj(objv[1], &len); Tcl_UtfToUniCharDString(str, len, &ds); - if (TkGetIntForIndex(objv[2], Tcl_DStringLength(&ds)/2-1, 0, &idx) != TCL_OK) { + len = Tcl_DStringLength(&ds)/2; + if (TkGetIntForIndex(objv[2], len-1, 0, &idx) != TCL_OK) { Tcl_DStringFree(&ds); Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TK", "ICU", "INDEX", NULL); return TCL_ERROR; } - it = icu_open((UBreakIteratorTypex)(PTR2INT(clientData)&3), NULL, + it = icu_open((UBreakIteratorTypex)(flags&3), NULL, NULL, -1, &errorCode); if (it != NULL) { errorCode = U_ZERO_ERRORZ; - icu_setText(it, (const uint16_t *)Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)/2, &errorCode); + icu_setText(it, (const uint16_t *)Tcl_DStringValue(&ds), len, &errorCode); } if (it == NULL || errorCode != U_ZERO_ERRORZ) { Tcl_DStringFree(&ds); @@ -107,6 +115,14 @@ startEndOfCmd( } else { idx = icu_preceding(it, idx + 1); } + if ((flags & FLAG_WORD) && (idx != (TkSizeT)-1) && !(flags & FLAG_SPACE) == + ((idx >= len) || Tcl_UniCharIsSpace(((const uint16_t *)Tcl_DStringValue(&ds))[idx]))) { + if (flags & FLAG_FOLLOWING) { + idx = icu_next(it); + } else { + idx = icu_previous(it); + } + } Tcl_SetObjResult(interp, TkNewIndexObj(idx)); icu_close(it); Tcl_DStringFree(&ds); @@ -120,6 +136,36 @@ startEndOfCmd( #define ICU_VERSION "68" #endif +/* + *---------------------------------------------------------------------- + * + * SysNotifyDeleteCmd -- + * + * Delete notification and clean up. + * + * Results: + * Window destroyed. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +icuCleanup( + TCL_UNUSED(void *)) +{ + Tcl_MutexLock(&icu_mutex); + if (icu_fns.nopen-- <= 1) { + if (icu_fns.lib != NULL) { + Tcl_FSUnloadFile(NULL, icu_fns.lib); + } + memset(&icu_fns, 0, sizeof(icu_fns)); + } + Tcl_MutexUnlock(&icu_mutex); +} + void Icu_Init( Tcl_Interp *interp) @@ -131,7 +177,7 @@ Icu_Init( Tcl_Obj *nameobj; static const char *iculibs[] = { #if defined(_WIN32) - "cygicuuc" ICU_VERSION ".dll", + //"cygicuuc" ICU_VERSION ".dll", "icuuc" ICU_VERSION ".dll", #elif defined(__CYGWIN__) "cygicuuc" ICU_VERSION ".dll", @@ -146,7 +192,7 @@ Icu_Init( #if defined(_WIN32) && !defined(STATIC_BUILD) if (!tclStubsPtr->tcl_CreateFileHandler) { /* Not running on Cygwin, so don't try to load the cygwin icu dll */ - i++; + //i++; } #endif while (iculibs[i] != NULL) { @@ -164,29 +210,31 @@ Icu_Init( if (icu_fns.lib != NULL) { #define ICU_SYM(name) \ icu_fns.name = (fn_icu_ ## name) \ - Tcl_FindSymbol(NULL, icu_fns.lib, "ubrk_" #name "_" ICU_VERSION) + Tcl_FindSymbol(NULL, icu_fns.lib, "ubrk_" #name "_" ICU_VERSION); ICU_SYM(open); ICU_SYM(close); ICU_SYM(preceding); ICU_SYM(following); + ICU_SYM(previous); + ICU_SYM(next); ICU_SYM(setText); #undef ICU_SYM } } - icu_fns.nopen++; Tcl_MutexUnlock(&icu_mutex); if (icu_fns.lib != NULL) { Tcl_CreateObjCommand(interp, "::tk::startOfCluster", startEndOfCmd, - INT2PTR(0), NULL); + INT2PTR(0), icuCleanup); Tcl_CreateObjCommand(interp, "::tk::startOfNextWord", startEndOfCmd, - INT2PTR(FLAG_WORD|FLAG_FOLLOWING), NULL); + INT2PTR(FLAG_WORD|FLAG_FOLLOWING), icuCleanup); Tcl_CreateObjCommand(interp, "::tk::startOfPreviousWord", startEndOfCmd, - INT2PTR(FLAG_WORD), NULL); + INT2PTR(FLAG_WORD), icuCleanup); Tcl_CreateObjCommand(interp, "::tk::endOfCluster", startEndOfCmd, - INT2PTR(FLAG_FOLLOWING), NULL); + INT2PTR(FLAG_FOLLOWING), icuCleanup); Tcl_CreateObjCommand(interp, "::tk::endOfWord", startEndOfCmd, - INT2PTR(FLAG_WORD|FLAG_FOLLOWING), NULL); + INT2PTR(FLAG_WORD|FLAG_FOLLOWING|FLAG_SPACE), icuCleanup); + icu_fns.nopen += 5; } } -- cgit v0.12 From 718c9801f9fe7d3bb58dad0acad9d026a4add33d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 25 Mar 2021 22:06:54 +0000 Subject: Add "cluster" testcases, and make them pass in all environments --- .github/workflows/linux-build.yml | 2 +- .github/workflows/linux-with-tcl8-build.yml | 2 +- .github/workflows/linux-with-tcl9-build.yml | 2 +- generic/tkIcu.c | 38 ++++++-- library/tk.tcl | 13 ++- macosx/tkMacOSXFont.c | 5 +- tests/cluster.test | 129 ++++++++++++++++++++++++++++ 7 files changed, 174 insertions(+), 17 deletions(-) create mode 100644 tests/cluster.test diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index b5198e0..3bdb827 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -118,7 +118,7 @@ jobs: path: tk - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | - sudo apt-get install tcl8.6-dev libxss-dev xvfb + sudo apt-get install tcl8.6-dev libxss-dev xvfb libicu-dev mkdir "$HOME/install dir" touch tk/doc/man.macros tk/generic/tkStubInit.c echo "CFGOPT=$CFGOPT --with-tcl=/usr/lib/tcl8.6 --disable-zipfs" >> $GITHUB_ENV diff --git a/.github/workflows/linux-with-tcl8-build.yml b/.github/workflows/linux-with-tcl8-build.yml index 4e56b64..eb61eee 100644 --- a/.github/workflows/linux-with-tcl8-build.yml +++ b/.github/workflows/linux-with-tcl8-build.yml @@ -137,7 +137,7 @@ jobs: path: tcl - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | - sudo apt-get install libxss-dev xvfb + sudo apt-get install libxss-dev xvfb libicu-dev mkdir "$HOME/install dir" touch tk/doc/man.macros tk/generic/tkStubInit.c echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV diff --git a/.github/workflows/linux-with-tcl9-build.yml b/.github/workflows/linux-with-tcl9-build.yml index 5335708..37ff390 100644 --- a/.github/workflows/linux-with-tcl9-build.yml +++ b/.github/workflows/linux-with-tcl9-build.yml @@ -137,7 +137,7 @@ jobs: path: tcl - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | - sudo apt-get install libxss-dev xvfb + sudo apt-get install libxss-dev xvfb libicu-dev mkdir "$HOME/install dir" touch tk/doc/man.macros tk/generic/tkStubInit.c echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV diff --git a/generic/tkIcu.c b/generic/tkIcu.c index 69f3c00..7c8e066 100644 --- a/generic/tkIcu.c +++ b/generic/tkIcu.c @@ -82,6 +82,7 @@ startEndOfCmd( void *it; TkSizeT idx; int flags = PTR2INT(clientData); + const uint16_t *ustr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1 , objv, "str start"); @@ -102,7 +103,8 @@ startEndOfCmd( NULL, -1, &errorCode); if (it != NULL) { errorCode = U_ZERO_ERRORZ; - icu_setText(it, (const uint16_t *)Tcl_DStringValue(&ds), len, &errorCode); + ustr = (const uint16_t *)Tcl_DStringValue(&ds); + icu_setText(it, ustr, len, &errorCode); } if (it == NULL || errorCode != U_ZERO_ERRORZ) { Tcl_DStringFree(&ds); @@ -111,16 +113,34 @@ startEndOfCmd( return TCL_ERROR; } if (flags & FLAG_FOLLOWING) { + if ((idx == TCL_INDEX_NONE) && (flags & FLAG_WORD)) { + idx = 0; + } idx = icu_following(it, idx); - } else { - idx = icu_preceding(it, idx + 1); + if ((flags & FLAG_WORD) && idx >= len) { + idx = -1; + } + } else if (idx > 0) { + if (!(flags & FLAG_WORD)) { + idx += 1 + (((ustr[idx]&0xFFC0) == 0xD800) && ((ustr[idx+1]&0xFFC0) == 0xDC00)); + } + idx = icu_preceding(it, idx); + if (idx == 0 && (flags & FLAG_WORD)) { + flags &= ~FLAG_WORD; /* If 0 is reached here, don't do a further search */ + } } - if ((flags & FLAG_WORD) && (idx != (TkSizeT)-1) && !(flags & FLAG_SPACE) == - ((idx >= len) || Tcl_UniCharIsSpace(((const uint16_t *)Tcl_DStringValue(&ds))[idx]))) { - if (flags & FLAG_FOLLOWING) { - idx = icu_next(it); - } else { - idx = icu_previous(it); + if ((flags & FLAG_WORD) && (idx != TCL_INDEX_NONE)) { + if (!(flags & FLAG_SPACE) == ((idx >= len) || Tcl_UniCharIsSpace(ustr[idx]))) { + if (flags & FLAG_FOLLOWING) { + idx = icu_next(it); + if (idx >= len) { + idx = -1; + } + } else { + idx = icu_previous(it); + } + } else if (idx == 0 && !(flags & FLAG_FOLLOWING)) { + idx = -1; } } Tcl_SetObjResult(interp, TkNewIndexObj(idx)); diff --git a/library/tk.tcl b/library/tk.tcl index 6828465..6571b0d 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -718,8 +718,10 @@ if {[info commands ::tk::startOfPreviousWord] eq ""} { } if {[info commands ::tk::endOfCluster] eq ""} { proc ::tk::endOfCluster {str start} { - if {$start >= [string length $str]} { - return -1; + if {$start eq "end"} { + return [string length $str] + } elseif {$start >= [string length $str]} { + return -1 } if {[string length [string index $str $start]] > 1} { set start [expr {$start+1}] @@ -732,9 +734,14 @@ if {[info commands ::tk::startOfCluster] eq ""} { proc ::tk::startOfCluster {str start} { if {$start eq "end"} { set start [expr {[string length $str]-1}] + } elseif {$start >= [string length $str]} { + return [string length $str] + } + if {[string length [string index $str $start]] < 1} { + set start [expr {$start-1}] } if {$start < 0} { - return -1; + return -1 } return $start } diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index 7cfd023..e775091 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -482,8 +482,9 @@ startOfClusterObjCmd( } if (indexArg == TCL_INDEX_NONE) { Tcl_SetObjResult(interp, TkNewIndexObj(TCL_INDEX_NONE)); + return TCL_OK; } else if ((size_t)indexArg >= [S length]) { - Tcl_SetObjResult(interp, TkNewIndexObj([S length])); + Tcl_SetObjResult(interp, TkNewIndexObj((TkSizeT)[S length])); return TCL_OK; } result = [S startOfCluster:indexArg]; @@ -524,7 +525,7 @@ endOfClusterObjCmd( result = 0; } else { result = (size_t)indexArg < [S length] ? - [S endOfCluster:indexArg] : [S length]; + [S endOfCluster:indexArg] : -1; } Tcl_SetObjResult(interp, TkNewIndexObj(result)); return TCL_OK; diff --git a/tests/cluster.test b/tests/cluster.test new file mode 100644 index 0000000..14e8677 --- /dev/null +++ b/tests/cluster.test @@ -0,0 +1,129 @@ +# This file is a Tcl script to test the [::tk::startOf|endOf]* functions in +# tk.tcl and tkIcu.c. It is organized in the standard fashion for Tcl tests. +# +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1995 Sun Microsystems, Inc. +# Copyright © 1998-1999 Scriptics Corporation. +# All rights reserved. + +package require tcltest 2.2 +eval tcltest::configure $argv +tcltest::loadTestedCommands +namespace import -force tcltest::test + +test cluster-1.0 {::tk::startOfCluster} -body { + ::tk::startOfCluster 🤡 -1 +} -result -1 +test cluster-1.1 {::tk::startOfCluster} -body { + ::tk::startOfCluster 🤡 0 +} -result 0 +test cluster-1.2 {::tk::startOfCluster} -body { + ::tk::startOfCluster 🤡 1 +} -result 0 +test cluster-1.3 {::tk::startOfCluster} -body { + ::tk::startOfCluster 🤡 2 +} -result 2 +test cluster-1.3 {::tk::startOfCluster} -body { + ::tk::startOfCluster 🤡 3 +} -result 2 +test cluster-1.3 {::tk::startOfCluster} -body { + ::tk::startOfCluster 🤡 end +} -result 0 + +test cluster-2.0 {::tk::endOfCluster} -body { + ::tk::endOfCluster 🤡 -1 +} -result 0 +test cluster-2.1 {::tk::endOfCluster} -body { + ::tk::endOfCluster 🤡 0 +} -result 2 +test cluster-2.2 {::tk::endOfCluster} -body { + ::tk::endOfCluster 🤡 1 +} -result 2 +test cluster-2.3 {::tk::endOfCluster} -body { + ::tk::endOfCluster 🤡 2 +} -result -1 +test cluster-2.4 {::tk::endOfCluster} -body { + ::tk::endOfCluster 🤡 3 +} -result -1 +test cluster-2.5 {::tk::endOfCluster} -body { + ::tk::endOfCluster 🤡 end +} -result 2 + +test cluster-3.0 {::tk::endOfWord} -body { + ::tk::endOfWord "ab cd" -1 +} -result 2 +test cluster-3.1 {::tk::endOfWord} -body { + ::tk::endOfWord "ab cd" 0 +} -result 2 +test cluster-3.2 {::tk::endOfWord} -body { + ::tk::endOfWord "ab cd" 1 +} -result 2 +test cluster-3.3 {::tk::endOfWord} -body { + ::tk::endOfWord "ab cd" 2 +} -result -1 +test cluster-3.4 {::tk::endOfWord} -body { + ::tk::endOfWord "ab cd" 3 +} -result -1 +test cluster-3.5 {::tk::endOfWord} -body { + ::tk::endOfWord "ab cd" 4 +} -result -1 +test cluster-3.6 {::tk::endOfWord} -body { + ::tk::endOfWord "ab cd" 5 +} -result -1 +test cluster-3.7 {::tk::endOfWord} -body { + ::tk::endOfWord "ab cd" end +} -result -1 + +test cluster-4.0 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord "ab cd" -1 +} -result -1 +test cluster-4.1 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord "ab cd" 0 +} -result -1 +test cluster-4.2 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord "ab cd" 1 +} -result 0 +test cluster-4.3 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord "ab cd" 2 +} -result 0 +test cluster-4.4 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord "ab cd" 3 +} -result 0 +test cluster-4.5 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord "ab cd" 4 +} -result 3 +test cluster-4.6 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord "ab cd" 5 +} -result 3 +test cluster-4.7 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord "ab cd" end +} -result 3 + +test cluster-5.0 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord "ab cd" -1 +} -result 3 +test cluster-5.1 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord "ab cd" 0 +} -result 3 +test cluster-5.2 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord "ab cd" 1 +} -result 3 +test cluster-5.3 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord "ab cd" 2 +} -result 3 +test cluster-5.4 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord "ab cd" 3 +} -result -1 +test cluster-5.5 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord "ab cd" 4 +} -result -1 +test cluster-5.6 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord "ab cd" 5 +} -result -1 +test cluster-5.7 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord "ab cd" end +} -result -1 + + +cleanupTests +return -- cgit v0.12 From d7b2522f64fd46754b3d322db0eab3794a55672c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 25 Mar 2021 23:29:23 +0000 Subject: Add optional argument ?locale?. Only used for the ICU implementation --- generic/tkIcu.c | 15 +++++++++++---- library/tk.tcl | 10 +++++----- macosx/tkMacOSXFont.c | 12 ++++++------ tests/cluster.test | 15 +++++++++++++++ 4 files changed, 37 insertions(+), 15 deletions(-) diff --git a/generic/tkIcu.c b/generic/tkIcu.c index 7c8e066..4e37193 100644 --- a/generic/tkIcu.c +++ b/generic/tkIcu.c @@ -83,11 +83,18 @@ startEndOfCmd( TkSizeT idx; int flags = PTR2INT(clientData); const uint16_t *ustr; + const char *locale = NULL; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1 , objv, "str start"); + if ((unsigned)(objc - 3) > 1) { + Tcl_WrongNumArgs(interp, 1 , objv, "str start ?locale?"); return TCL_ERROR; } + if (objc > 3) { + locale = Tcl_GetString(objv[3]); + if (!*locale) { + locale = NULL; + } + } Tcl_DStringInit(&ds); str = Tcl_GetStringFromObj(objv[1], &len); Tcl_UtfToUniCharDString(str, len, &ds); @@ -99,7 +106,7 @@ startEndOfCmd( return TCL_ERROR; } - it = icu_open((UBreakIteratorTypex)(flags&3), NULL, + it = icu_open((UBreakIteratorTypex)(flags&3), locale, NULL, -1, &errorCode); if (it != NULL) { errorCode = U_ZERO_ERRORZ; @@ -108,7 +115,7 @@ startEndOfCmd( } if (it == NULL || errorCode != U_ZERO_ERRORZ) { Tcl_DStringFree(&ds); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("cannot open ICU iterator, errocode: %d", (int)errorCode)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("cannot open ICU iterator, errorcode: %d", (int)errorCode)); Tcl_SetErrorCode(interp, "TK", "ICU", "CANNOTOPEN", NULL); return TCL_ERROR; } diff --git a/library/tk.tcl b/library/tk.tcl index 6571b0d..da388bd 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -702,22 +702,22 @@ if {[tk windowingsystem] eq "aqua"} { } if {[info commands ::tk::endOfWord] eq ""} { - proc ::tk::endOfWord {str start} { + proc ::tk::endOfWord {str start {locale {}}} { return [tcl_endOfWord $str $start] } } if {[info commands ::tk::startOfNextWord] eq ""} { - proc ::tk::startOfNextWord {str start} { + proc ::tk::startOfNextWord {str start {locale {}}} { return [tcl_startOfNextWord $str $start] } } if {[info commands ::tk::startOfPreviousWord] eq ""} { - proc ::tk::startOfPreviousWord {str start} { + proc ::tk::startOfPreviousWord {str start {locale {}}} { return [tcl_startOfPreviousWord $str $start] } } if {[info commands ::tk::endOfCluster] eq ""} { - proc ::tk::endOfCluster {str start} { + proc ::tk::endOfCluster {str start {locale {}}} { if {$start eq "end"} { return [string length $str] } elseif {$start >= [string length $str]} { @@ -731,7 +731,7 @@ if {[info commands ::tk::endOfCluster] eq ""} { } } if {[info commands ::tk::startOfCluster] eq ""} { - proc ::tk::startOfCluster {str start} { + proc ::tk::startOfCluster {str start {locale {}}} { if {$start eq "end"} { set start [expr {[string length $str]-1}] } elseif {$start >= [string length $str]} { diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index e775091..79eae2c 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -464,9 +464,9 @@ startOfClusterObjCmd( int numBytes; TkSizeT indexArg; TkSizeT result; - if ((objc != 3)) { - Tcl_WrongNumArgs(interp, 1, objv, "string index"); - return TCL_ERROR; + if ((unsigned)(objc - 3) > 1) { + Tcl_WrongNumArgs(interp, 1 , objv, "str start ?locale?"); + return TCL_ERROR; } stringArg = Tcl_GetStringFromObj(objv[1], &numBytes); if (stringArg == NULL) { @@ -505,9 +505,9 @@ endOfClusterObjCmd( TkSizeT indexArg; TkSizeT result; - if ((objc != 3)) { - Tcl_WrongNumArgs(interp, 1, objv, "string index"); - return TCL_ERROR; + if ((unsigned)(objc - 3) > 1) { + Tcl_WrongNumArgs(interp, 1 , objv, "str start ?locale?"); + return TCL_ERROR; } stringArg = Tcl_GetStringFromObj(objv[1], &numBytes); if (stringArg == NULL) { diff --git a/tests/cluster.test b/tests/cluster.test index 14e8677..b4403bf 100644 --- a/tests/cluster.test +++ b/tests/cluster.test @@ -124,6 +124,21 @@ test cluster-5.7 {::tk::startOfNextWord} -body { ::tk::startOfNextWord "ab cd" end } -result -1 +test cluster-6.0 {::tk::startOfCluster} -body { + ::tk::startOfCluster a b c d +} -returnCodes 1 -result {wrong # args: should be "::tk::startOfCluster str start ?locale?"} +test cluster-6.1 {::tk::endOfCluster} -body { + ::tk::endOfCluster a b c d +} -returnCodes 1 -result {wrong # args: should be "::tk::endOfCluster str start ?locale?"} +test cluster-6.0 {::tk::startOfPreviousWord} -body { + ::tk::startOfPreviousWord a b c d +} -returnCodes 1 -result {wrong # args: should be "::tk::startOfPreviousWord str start ?locale?"} +test cluster-6.0 {::tk::startOfNextWord} -body { + ::tk::startOfNextWord a b c d +} -returnCodes 1 -result {wrong # args: should be "::tk::startOfNextWord str start ?locale?"} +test cluster-6.1 {::tk::endOfWord} -body { + ::tk::endOfWord a b c d +} -returnCodes 1 -result {wrong # args: should be "::tk::endOfWord str start ?locale?"} cleanupTests return -- cgit v0.12 From daddc48750eecd5bf30eedbcc89366679e24416e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 25 Mar 2021 23:30:52 +0000 Subject: renumber testcases --- tests/cluster.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/cluster.test b/tests/cluster.test index b4403bf..820d9ab 100644 --- a/tests/cluster.test +++ b/tests/cluster.test @@ -130,13 +130,13 @@ test cluster-6.0 {::tk::startOfCluster} -body { test cluster-6.1 {::tk::endOfCluster} -body { ::tk::endOfCluster a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::endOfCluster str start ?locale?"} -test cluster-6.0 {::tk::startOfPreviousWord} -body { +test cluster-6.2 {::tk::startOfPreviousWord} -body { ::tk::startOfPreviousWord a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::startOfPreviousWord str start ?locale?"} -test cluster-6.0 {::tk::startOfNextWord} -body { +test cluster-6.3 {::tk::startOfNextWord} -body { ::tk::startOfNextWord a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::startOfNextWord str start ?locale?"} -test cluster-6.1 {::tk::endOfWord} -body { +test cluster-6.4 {::tk::endOfWord} -body { ::tk::endOfWord a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::endOfWord str start ?locale?"} -- cgit v0.12 From db75e9e3bd947c73ca6d4f5dc4db61758d08a093 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 26 Mar 2021 07:51:08 +0000 Subject: Support any ICU version between 50 and 69 --- generic/tkIcu.c | 62 +++++++++++++++++++++++++++++++++------------------------ 1 file changed, 36 insertions(+), 26 deletions(-) diff --git a/generic/tkIcu.c b/generic/tkIcu.c index 4e37193..6f81c09 100644 --- a/generic/tkIcu.c +++ b/generic/tkIcu.c @@ -156,13 +156,6 @@ startEndOfCmd( return TCL_OK; } -#ifdef MAC_OSX_TCL -/* Hack, since homebrew doesn't have ICU 68 yet */ -#define ICU_VERSION "64" -#else -#define ICU_VERSION "68" -#endif - /* *---------------------------------------------------------------------- * @@ -198,46 +191,63 @@ Icu_Init( Tcl_Interp *interp) { Tcl_MutexLock(&icu_mutex); + char symbol[24]; + char icuversion[3] = "70"; /* Highest ICU version + 1 */ if (icu_fns.nopen == 0) { int i = 0; Tcl_Obj *nameobj; static const char *iculibs[] = { #if defined(_WIN32) - //"cygicuuc" ICU_VERSION ".dll", - "icuuc" ICU_VERSION ".dll", + "icuuc??.dll", /* When running under Windows */ + NULL, + "cygicuuc??.dll", /* When running under Cygwin */ #elif defined(__CYGWIN__) - "cygicuuc" ICU_VERSION ".dll", + "cygicuuc??.dll", #elif defined(MAC_OSX_TCL) - "libicuuc." ICU_VERSION ".dylib", + "libicuuc.??.dylib", #else - "libicuuc.so." ICU_VERSION "", + "libicuuc.so.??", #endif NULL }; + /* Going back down to ICU version 50 */ + while ((icu_fns.lib == NULL) && (icuversion[0] >= '5')) { + if (icuversion[1]-- < '0') { + icuversion[0]--; icuversion[1] = '9'; + } #if defined(_WIN32) && !defined(STATIC_BUILD) - if (!tclStubsPtr->tcl_CreateFileHandler) { - /* Not running on Cygwin, so don't try to load the cygwin icu dll */ - //i++; - } + if (tclStubsPtr->tcl_CreateFileHandler) { + /* Running on Cygwin, so try to load the cygwin icu dll */ + i = 2; + } else #endif - while (iculibs[i] != NULL) { - Tcl_ResetResult(interp); - nameobj = Tcl_NewStringObj(iculibs[i], -1); - Tcl_IncrRefCount(nameobj); - if (Tcl_LoadFile(interp, nameobj, NULL, 0, NULL, &icu_fns.lib) - == TCL_OK) { + i = 0; + while (iculibs[i] != NULL) { + Tcl_ResetResult(interp); + nameobj = Tcl_NewStringObj(iculibs[i], -1); + char *nameStr = Tcl_GetString(nameobj); + char *p = strchr(nameStr, '?'); + if (p != NULL) { + memcpy(p, icuversion, 2); + } + Tcl_IncrRefCount(nameobj); + if (Tcl_LoadFile(interp, nameobj, NULL, 0, NULL, &icu_fns.lib) + == TCL_OK) { + Tcl_DecrRefCount(nameobj); + break; + } Tcl_DecrRefCount(nameobj); - break; + ++i; } - Tcl_DecrRefCount(nameobj); - ++i; } if (icu_fns.lib != NULL) { #define ICU_SYM(name) \ + strcpy(symbol, "ubrk_" #name "_" ); \ + strcat(symbol, icuversion); \ icu_fns.name = (fn_icu_ ## name) \ - Tcl_FindSymbol(NULL, icu_fns.lib, "ubrk_" #name "_" ICU_VERSION); + Tcl_FindSymbol(NULL, icu_fns.lib, symbol); ICU_SYM(open); ICU_SYM(close); ICU_SYM(preceding); -- cgit v0.12 From bed613263187a27d1528de5236b9c437d68a9681 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 26 Mar 2021 10:25:42 +0000 Subject: renumber testcases and add constraints --- tests/cluster.test | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/tests/cluster.test b/tests/cluster.test index 820d9ab..f3f3ea1 100644 --- a/tests/cluster.test +++ b/tests/cluster.test @@ -11,32 +11,35 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test +testConstraint needsTcl87orICU [expr {[package vsatisfies [package provide Tcl] 8.7] || [catch {info body ::tk::startOfCluster}]}] + + test cluster-1.0 {::tk::startOfCluster} -body { ::tk::startOfCluster 🤡 -1 } -result -1 test cluster-1.1 {::tk::startOfCluster} -body { ::tk::startOfCluster 🤡 0 } -result 0 -test cluster-1.2 {::tk::startOfCluster} -body { +test cluster-1.2 {::tk::startOfCluster} -constraints needsTcl87orICU -body { ::tk::startOfCluster 🤡 1 } -result 0 -test cluster-1.3 {::tk::startOfCluster} -body { +test cluster-1.3 {::tk::startOfCluster} -constraints needsTcl87orICU -body { ::tk::startOfCluster 🤡 2 } -result 2 -test cluster-1.3 {::tk::startOfCluster} -body { +test cluster-1.4 {::tk::startOfCluster} -constraints needsTcl87orICU -body { ::tk::startOfCluster 🤡 3 } -result 2 -test cluster-1.3 {::tk::startOfCluster} -body { +test cluster-1.5 {::tk::startOfCluster} -body { ::tk::startOfCluster 🤡 end } -result 0 test cluster-2.0 {::tk::endOfCluster} -body { ::tk::endOfCluster 🤡 -1 } -result 0 -test cluster-2.1 {::tk::endOfCluster} -body { +test cluster-2.1 {::tk::endOfCluster} -constraints needsTcl87orICU -body { ::tk::endOfCluster 🤡 0 } -result 2 -test cluster-2.2 {::tk::endOfCluster} -body { +test cluster-2.2 {::tk::endOfCluster} -constraints needsTcl87orICU -body { ::tk::endOfCluster 🤡 1 } -result 2 test cluster-2.3 {::tk::endOfCluster} -body { @@ -45,7 +48,7 @@ test cluster-2.3 {::tk::endOfCluster} -body { test cluster-2.4 {::tk::endOfCluster} -body { ::tk::endOfCluster 🤡 3 } -result -1 -test cluster-2.5 {::tk::endOfCluster} -body { +test cluster-2.5 {::tk::endOfCluster} -constraints needsTcl87orICU -body { ::tk::endOfCluster 🤡 end } -result 2 -- cgit v0.12 From 2937446e0ba89de3f5f4cd81d6758999b3722193 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 26 Mar 2021 14:03:33 +0000 Subject: macOS code cleanup --- macosx/tkMacOSXFont.c | 49 +++++++++++++++++++------------------------------ 1 file changed, 19 insertions(+), 30 deletions(-) diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index 79eae2c..087faa5 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -149,17 +149,6 @@ static int CreateNamedSystemFont(Tcl_Interp *interp, return [_string characterAtIndex:index]; } -- (NSUInteger)startOfCluster:(NSUInteger)index -{ - NSRange range = [_string rangeOfComposedCharacterSequenceAtIndex:index]; - return range.location; -} -- (NSUInteger)endOfCluster:(NSUInteger)index -{ - NSRange range = [_string rangeOfComposedCharacterSequenceAtIndex:index]; - return range.location + range.length; -} - - (Tcl_DString)DString { if ( _ds.string == NULL) { @@ -462,8 +451,7 @@ startOfClusterObjCmd( TKNSString *S; const char *stringArg; int numBytes; - TkSizeT indexArg; - TkSizeT result; + TkSizeT index; if ((unsigned)(objc - 3) > 1) { Tcl_WrongNumArgs(interp, 1 , objv, "str start ?locale?"); return TCL_ERROR; @@ -473,22 +461,22 @@ startOfClusterObjCmd( return TCL_ERROR; } S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; - if (TkGetIntForIndex(objv[2], [S length] - 1, 0, &indexArg) != TCL_OK) { + if (TkGetIntForIndex(objv[2], [S length] - 1, 0, &index) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad index \"%s\": must be integer or end", Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "INDEX", NULL); return TCL_ERROR; } - if (indexArg == TCL_INDEX_NONE) { - Tcl_SetObjResult(interp, TkNewIndexObj(TCL_INDEX_NONE)); - return TCL_OK; - } else if ((size_t)indexArg >= [S length]) { - Tcl_SetObjResult(interp, TkNewIndexObj((TkSizeT)[S length])); - return TCL_OK; + if (index == TCL_INDEX_NONE) { + /* index = TCL_INDEX_NONE; */ + } else if ((size_t)index >= [S length]) { + index = (TkSizeT)[S length]; + } else { + NSRange range = [S rangeOfComposedCharacterSequenceAtIndex:index]; + index = range.location; } - result = [S startOfCluster:indexArg]; - Tcl_SetObjResult(interp, TkNewIndexObj(result)); + Tcl_SetObjResult(interp, TkNewIndexObj(index)); return TCL_OK; } @@ -502,8 +490,7 @@ endOfClusterObjCmd( TKNSString *S; char *stringArg; int numBytes; - TkSizeT indexArg; - TkSizeT result; + TkSizeT index; if ((unsigned)(objc - 3) > 1) { Tcl_WrongNumArgs(interp, 1 , objv, "str start ?locale?"); @@ -514,20 +501,22 @@ endOfClusterObjCmd( return TCL_ERROR; } S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes]; - if (TkGetIntForIndex(objv[2], [S length] - 1, 0, &indexArg) != TCL_OK) { + if (TkGetIntForIndex(objv[2], [S length] - 1, 0, &index) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad index \"%s\": must be integer or end", Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "INDEX", NULL); return TCL_ERROR; } - if (indexArg == TCL_INDEX_NONE) { - result = 0; + if (index == TCL_INDEX_NONE) { + index = 0; + } else if ((size_t)index >= [S length]) { + index = TCL_INDEX_NONE; } else { - result = (size_t)indexArg < [S length] ? - [S endOfCluster:indexArg] : -1; + NSRange range = [S rangeOfComposedCharacterSequenceAtIndex:index]; + index = range.location + range.length; } - Tcl_SetObjResult(interp, TkNewIndexObj(result)); + Tcl_SetObjResult(interp, TkNewIndexObj(index)); return TCL_OK; } -- cgit v0.12 From d77357e0d98eea3f1a1dd6821fde469cd22f8ef3 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 26 Mar 2021 21:07:38 +0000 Subject: Adding print script commands, not ready to deploy or test; adding cleaned up printer and GDI code for Windodws --- library/print.tcl | 976 +++++++++++++++++++++++++++++ win/tkWinGDI.c | 1773 ++++++++++++++++++++++++++++------------------------- win/tkWinPrint.c | 69 ++- 3 files changed, 1960 insertions(+), 858 deletions(-) create mode 100644 library/print.tcl diff --git a/library/print.tcl b/library/print.tcl new file mode 100644 index 0000000..42a84fd --- /dev/null +++ b/library/print.tcl @@ -0,0 +1,976 @@ +################################################################ +## page_args +## Description: +## This is a helper proc used to parse common arguments for +## text processing in the other commands. +## Args: +## Name of an array in which to store the various pieces +## needed for text processing +################################################################ +proc page_args { array } { + upvar #0 $array ary + + # First we check whether we have a valid hDC + # (perhaps we can later make this also an optional argument, defaulting to + # the default printer) + set attr [ printer attr ] + foreach attrpair $attr { + set key [lindex $attrpair 0] + set val [lindex $attrpair 1] + switch -exact $key { + "hDC" { set ary(hDC) $val } + "copies" { if { $val >= 0 } { set ary(copies) $val } } + "page dimensions" { + set wid [lindex $val 0] + set hgt [lindex $val 1] + if { $wid > 0 } { set ary(pw) $wid } + if { $hgt > 0 } { set ary(pl) $hgt } + } + "page margins" { + if { [scan [lindex $val 0] %d tmp] > 0 } { + set ary(lm) [ lindex $val 0 ] + set ary(tm) [ lindex $val 1 ] + set ary(rm) [ lindex $val 2 ] + set ary(bm) [ lindex $val 3 ] + } + } + "resolution" { + if { [scan [lindex $val 0] %d tmp] > 0 } { + set ary(resx) [ lindex $val 0 ] + set ary(resy) [ lindex $val 1 ] + } else { + set ary(resx) 200 ;# Set some defaults for this... + set ary(resy) 200 + } + } + } + } + + if { ( [ info exist ary(hDC) ] == 0 ) || ($ary(hDC) == 0x0) } { + error "Can't get printer attributes" + } + + # Now, set "reasonable" defaults if some values were unavailable + if { [ info exist ary(resx) ] == 0 } { set ary(resx) 200 } + if { [ info exist ary(resy) ] == 0 } { set ary(resy) 200 } + if { [ info exist ary(tm) ] == 0 } { set ary(tm) 1000 } + if { [ info exist ary(bm) ] == 0 } { set ary(bm) 1000 } + if { [ info exist ary(lm) ] == 0 } { set ary(lm) 1000 } + if { [ info exist ary(rm) ] == 0 } { set ary(rm) 1000 } + if { [ info exist ary(pw) ] == 0 } { set ary(pw) 8500 } + if { [ info exist ary(pl) ] == 0 } { set ary(pl) 11000 } + if { [ info exist ary(copies) ] == 0 } { set ary(copies) 1 } + + debug_puts "Dimensions: $ary(pw) x $ary(pl) ; Margins (tblr): $ary(tm) $ary(bm) $ary(lm) $ary(rm)" +} + +################################################################ +## print_page_data +## Description: +## This is the simplest way to print a small amount of text +## on a page. The text is formatted in a box the size of the +## selected page and margins. +## Args: +## data Text data for printing +## fontargs Optional arguments to supply to the text command +################################################################ +proc print_page_data { data {fontargs {}} } { + + global printargs + page_args printargs + if { ! [info exist printargs(hDC)] } { + printer open + page_args printargs + } + + set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] + set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] + set pw [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] + printer job start + printer page start + eval gdi text $printargs(hDC) $lm $tm \ + -anchor nw -text [list $data] \ + -width $pw \ + $fontargs + printer page end + printer job end +} + +################################################################ +## print_page_file +## Description: +## This is the simplest way to print a small file +## on a page. The text is formatted in a box the size of the +## selected page and margins. +## Args: +## data Text data for printing +## fontargs Optional arguments to supply to the text command +################################################################ +proc print_page_file { filename {fontargs {}} } { + set fn [open $filename r] + + set data [ read $fn ] + + close $fn + + print_page_data $data $fontargs +} + +################################################################ +## print_data +## Description: +## This function prints multiple-page files, using a line-oriented +## function, taking advantage of knowing the character widths. +## Many fancier things could be done with it: +## e.g. page titles, page numbering, user-provided boundary to override +## page margins, HTML-tag interpretation, etc. +## Args: +## data Text data for printing +## breaklines If non-zero, keep newlines in the string as +## newlines in the output. +## font Font for printing +################################################################ +proc print_data { data {breaklines 1 } {font {}} } { + global printargs + + page_args printargs + if { ! [info exist printargs(hDC)] } { + printer open + page_args printargs + } + if { $printargs(hDC) == "?" || $printargs(hDC) == 0 } { + printer open + page_args printargs + } + + if { [string length $font] == 0 } { + eval gdi characters $printargs(hDC) -array printcharwid + } else { + eval gdi characters $printargs(hDC) -font $font -array printcharwid + } + + set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] + set pagehgt [ expr ( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) ] + set totallen [ string length $data ] + debug_puts "page width: $pagewid; page height: $pagehgt; Total length: $totallen" + set curlen 0 + set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] + + printer job start + printer page start + while { $curlen < $totallen } { + set linestring [ string range $data $curlen end ] + if { $breaklines } { + set endind [ string first "\n" $linestring ] + if { $endind != -1 } { + set linestring [ string range $linestring 0 $endind ] + # handle blank lines.... + if { $linestring == "" } { + set linestring " " + } + } + } + + set result [print_page_nextline $linestring \ + printcharwid printargs $curhgt $font] + incr curlen [lindex $result 0] + incr curhgt [lindex $result 1] + if { [expr $curhgt + [lindex $result 1] ] > $pagehgt } { + printer page end + printer page start + set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] + } + } + printer page end + printer job end +} + +################################################################ +## print_file +## Description: +## This function prints multiple-page files +## It will either break lines or just let them run over the +## margins (and thus truncate). +## The font argument is JUST the font name, not any additional +## arguments. +## Args: +## filename File to open for printing +## breaklines 1 to break lines as done on input, 0 to ignore newlines +## font Optional arguments to supply to the text command +################################################################ +proc print_file { filename {breaklines 1 } { font {}} } { + set fn [open $filename r] + + set data [ read $fn ] + + close $fn + + print_data $data $breaklines $font +} + +################################################################ +## print_page_nextline +## +## Args: +## string Data to print +## parray Array of values for printer characteristics +## carray Array of values for character widths +## y Y value to begin printing at +## font if non-empty specifies a font to draw the line in +## Return: +## Returns the pair "chars y" +## where chars is the number of characters printed on the line +## and y is the height of the line printed +################################################################ +proc print_page_nextline { string carray parray y font } { + upvar #0 $carray charwidths + upvar #0 $parray printargs + + set endindex 0 + set totwidth 0 + set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] + set maxstring [ string length $string ] + set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] + + for { set i 0 } { ( $i < $maxstring ) && ( $totwidth < $maxwidth ) } { incr i } { + set ch [ string index $string $i ] + if [ info exist charwidths($ch) ] { + incr totwidth $charwidths([string index $string $i]) + } else { + incr totwidth $charwidths(n) + } + # set width($i) $totwidth + } + + set endindex $i + set startindex $endindex + + if { $i < $maxstring } { + # In this case, the whole data string is not used up, and we wish to break on a + # word. Since we have all the partial widths calculated, this should be easy. + set endindex [ expr [string wordstart $string $endindex] - 1 ] + set startindex [ expr $endindex + 1 ] + + # If the line is just too long (no word breaks), print as much as you can.... + if { $endindex <= 1 } { + set endindex $i + set startindex $i + } + } + + if { [string length $font] > 0 } { + set result [ gdi text $printargs(hDC) $lm $y \ + -anchor nw -justify left \ + -text [ string trim [ string range $string 0 $endindex ] "\r\n" ] \ + -font $font ] + } else { + set result [ gdi text $printargs(hDC) $lm $y \ + -anchor nw -justify left \ + -text [string trim [ string range $string 0 $endindex ] "\r\n" ] ] + } + + debug_puts "Maxwidth: $maxwidth; Max String: $maxstring ; Ending at $endindex" + debug_puts "Printed line at ($lm, $y). Now starting at $startindex" + return "$startindex $result" +} + + +################################################################ +## prntcanv.tcl +## +## Usage: +## printer::print_widget p +## If the parameter p is anything but default, uses the +## print dialog. If it is default, it uses the default printer. +## +## Prints a canvas "reasonably" well (as GDI matures...) +## John Blattner contributed the original +## version of this code. +## Modifications made by Michael Schwartz (mschwart@nyx.net) +## +## Handles some additional printer types that do not put numbers in the +## resolution field +## Darcy Kahle contributed the origianl +## version of this code. +## Modifications made by Michael Schwartz (mschwart@nyx.net) +## Several suggestions and code contributions were made by Mick O'Donnell (micko@wagsoft.com) +## +## This version (0.1) scales the canvas to "fit" the page. +## It is very limited now, by may meet simple user needs. +## LIMITATIONS: +## This is limited by GDI (e.g., no arrows on the lines, stipples), +## and is also limited in current canvas items supported. +## For instance, bitmaps and images are not yet supported. +## +## Idea mill for future enhancements: +## c) Add an optional page title and footer +## d) Add tk font support to the gdi command if tk is loaded. +## e) Make scaling an option +## f) Make rendering the canvas something done as PART of a +## print. +################################################################ + +namespace eval printer { + + # First some utilities to ensure we can debug this sucker. + + variable debug + variable option + variable vtgPrint + + proc init_print_canvas { } { + variable debug + variable option + variable vtgPrint + + set debug 0 + set option(use_copybits) 1 + set vtgPrint(printer.bg) white + } + + proc is_win {} { + return [ info exist tk_patchLevel ] + } + + proc debug_puts {str} { + variable debug + if $debug { + if [ is_win ] { + if [! winfo exist .debug ] { + set tl [ toplevel .debug ] + frame $tl.buttons + pack $tl.buttons -side bottom -fill x + button $tl.buttons.ok -text OK -command "destroy .debug" + pack $tl.buttons.ok + text $tl.text -yscroll "$tl.yscroll set" + scrollbar $tl.yscroll -orient vertical -command "$tl.text yview" + pack $tl.yscroll -side right -fill y -expand false + pack $tl.text -side left -fill both -expand true + } + $tl.text insert end $str + } else { + puts "Debug: $str" + after 100 + } + } + } + + ################################################################ + ## page_args + ## Description: + ## This is a helper proc used to parse common arguments for + ## text processing in the other commands. + ## "Reasonable" defaults are provided if not present + ## Args: + ## Name of an array in which to store the various pieces + ## needed for text processing + ################################################################ + proc page_args { array } { + # use upvar one level to get into the context of the immediate caller. + upvar 1 $array ary + + # First we check whether we have a valid hDC + # (perhaps we can later make this also an optional argument, defaulting to + # the default printer) + set attr [ printer attr ] + foreach attrpair $attr { + set key [lindex $attrpair 0] + set val [lindex $attrpair 1] + set ary($key) $val + switch -exact $key { + "page dimensions" { + set wid [lindex $val 0] + set hgt [lindex $val 1] + if { $wid > 0 } { set ary(pw) $wid } + if { $hgt > 0 } { set ary(pl) $hgt } + } + "page margins" { + if { [scan [lindex $val 0] %d tmp] > 0 } { + set ary(lm) [ lindex $val 0 ] + set ary(tm) [ lindex $val 1 ] + set ary(rm) [ lindex $val 2 ] + set ary(bm) [ lindex $val 3 ] + } + } + "resolution" { + if { [scan [lindex $val 0] %d tmp] > 0 } { + set ary(resx) [ lindex $val 0 ] + set ary(resy) [ lindex $val 1 ] + } else { + set ary(resolution) [lindex $val 0] + ;# set ary(resx) 200 ;# Set some defaults for this... + ;# set ary(resy) 200 + } + } + } + } + + if { ( [ info exist ary(hDC) ] == 0 ) || ($ary(hDC) == 0x0) } { + error "Can't get printer attributes" + } + + # Now, set "reasonable" defaults if some values were unavailable + # Resolution is the hardest. Uses "resolution" first, if it was numeric. + # Uses "pixels per inch" second, if it is set. + # Use the words medium and best for resolution third--these are guesses + # Uses 200 as a last resort. + if { [ info exist ary(resx) ] == 0 } { + set ppi "pixels per inch" + if { [ info exist ary($ppt) ] == 0 } { + if { [ scan $ary($ppt) "%d%d" tmp1 tmp2 ] > 0 } { + set ary(resx) $tmp1 + if { $tmp2 > 0 } { + set ary(resy) $tmp2 + } + } else { + if [ string match -nocase $ary($ppt) "medium" ] { + set ary(resx) 300 + set ary(resy) 300 + } elseif [ string match -nocase $ary($ppt) "best" ] { + set ary(resx) 600 + set ary(resy) 600 + } else { + set ary(resx) 200 + set ary(resy) 200 + } + } + } else { + set ary(resx) 200 + } + } + if { [ info exist ary(resy) ] == 0 } { set ary(resy) $ary(resx) } + if { [ info exist ary(tm) ] == 0 } { set ary(tm) 1000 } + if { [ info exist ary(bm) ] == 0 } { set ary(bm) 1000 } + if { [ info exist ary(lm) ] == 0 } { set ary(lm) 1000 } + if { [ info exist ary(rm) ] == 0 } { set ary(rm) 1000 } + if { [ info exist ary(pw) ] == 0 } { set ary(pw) 8500 } + if { [ info exist ary(pl) ] == 0 } { set ary(pl) 11000 } + if { [ info exist ary(copies) ] == 0 } { set ary(copies) 1 } + } + + ################################################################ + # These procedures read in the canvas widget, and write all of # + # its contents out to the Windows printer. # + ################################################################ + + ################################################################ + ## print_widget + ## Description: + ## Main procedure for printing a widget. Currently supports + ## canvas widgets. Handles opening and closing of printer. + ## Assumes that printer and gdi packages are loaded. + ## Args: + ## wid The widget to be printed. + ## printer Flag whether to use the default printer. + ## name App name to pass to printer. + ################################################################ + + proc print_widget { wid {printer default} {name "tcl canvas"} } { + + # start printing process ------ + if {[string match "default" $printer]} { + set hdc [printer open] + } else { + set hdc [printer dialog select] + if { [lindex $hdc 1] == 0 } { + # User has canceled printing + return + } + set hdc [ lindex $hdc 0 ] + } + + variable p + set p(0) 0 ; unset p(0) + page_args p + + if {![info exist p(hDC)]} { + set hdc [printer open] + page_args p + } + if {[string match "?" $hdc] || [string match 0x0 $hdc]} { + catch {printer close} + error "Problem opening printer: printer context cannot be established" + } + + printer job start -name "$name" + printer page start + + # Here is where any scaling/gdi mapping should take place + # For now, scale so the dimensions of the window are sized to the + # width of the page. Scale evenly. + + # For normal windows, this may be fine--but for a canvas, one wants the + # canvas dimensions, and not the WINDOW dimensions. + if { [winfo class $wid] == "Canvas" } { + set sc [ lindex [ $wid configure -scrollregion ] 4 ] + # if there is no scrollregion, use width and height. + if { "$sc" == "" } { + set window_x [ lindex [ $wid configure -width ] 4 ] + set window_y [ lindex [ $wid configure -height ] 4 ] + } else { + set window_x [ lindex $sc 2 ] + set window_y [ lindex $sc 3 ] + } + } else { + set window_x [ winfo width $wid ] + set window_y [ winfo height $wid ] + } + + set pd "page dimensions" + set pm "page margins" + set ppi "pixels per inch" + + set printer_x [ expr ( [lindex $p($pd) 0] - \ + [lindex $p($pm) 0 ] - \ + [lindex $p($pm) 2 ] \ + ) * \ + [lindex $p($ppi) 0] / 1000.0 ] + set printer_y [ expr ( [lindex $p($pd) 1] - \ + [lindex $p($pm) 1 ] - \ + [lindex $p($pm) 3 ] \ + ) * \ + [lindex $p($ppi) 1] / 1000.0 ] + set factor_x [ expr $window_x / $printer_x ] + set factor_y [ expr $window_y / $printer_y ] + + debug_puts "printer: ($printer_x, $printer_y)" + debug_puts "window : ($window_x, $window_y)" + debug_puts "factor : $factor_x $factor_y" + + if { $factor_x < $factor_y } { + set lo $window_y + set ph $printer_y + } else { + set lo $window_x + set ph $printer_x + } + + # The offset still needs to be set based on page margins + debug_puts [ list \ + gdi map $hdc -logical $lo -physical $ph -offset $p(resolution) \ + ] + + gdi map $hdc -logical $lo -physical $ph -offset $p(resolution) + + # handling of canvas widgets + # additional procs can be added for other widget types + switch [winfo class $wid] { + Canvas { + # if {[catch { + print_canvas [lindex $hdc 0] $wid + # } msg]} { + # debug_puts "print_widget: $msg" + # error "Windows Printing Problem: $msg" + # } + } + default { + debug_puts "Can't print items of type [winfo class $wid]. No handler registered" + } + } + + # end printing process ------ + printer page end + printer job end + printer close + } + + + ################################################################ + ## print_canvas + ## Description: + ## Main procedure for writing canvas widget items to printer. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ################################################################ + + proc print_canvas {hdc cw} { + variable vtgPrint + + # get information about page being printed to + # print_canvas.CalcSizing $cw + set vtgPrint(canvas.bg) [string tolower [$cw cget -background]] + + # re-write each widget from cw to printer + foreach id [$cw find all] { + set type [$cw type $id] + if { [ info commands print_canvas.$type ] == "print_canvas.$type" } { + print_canvas.[$cw type $id] $hdc $cw $id + } else { + debug_puts "Omitting canvas item of type $type since there is no handler registered for it" + } + } + } + + + ################################################################ + ## These procedures support the various canvas item types, # + ## reading the information about the item on the real canvas # + ## and then writing a similar item to the printer. # + ################################################################ + + ################################################################ + ## print_canvas.line + ## Description: + ## Prints a line item. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ## id The id of the canvas item. + ################################################################ + + proc print_canvas.line {hdc cw id} { + variable vtgPrint + + set color [print_canvas.TransColor [$cw itemcget $id -fill]] + if {[string match $vtgPrint(printer.bg) $color]} {return} + + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set arrow [$cw itemcget $id -arrow] + set arwshp [$cw itemcget $id -arrowshape] + set dash [$cw itemcget $id -dash] + set smooth [$cw itemcget $id -smooth ] + set splinesteps [ $cw itemcget $id -splinesteps ] + + set cmmd "gdi line $hdc $coords -fill $color -arrow $arrow -arrowshape [list $arwshp]" + + if { $wdth > 1 } { + set cmmd "$cmmd -width $wdth" + } + + if { $dash != "" } { + set cmmd "$cmmd -dash [list $dash]" + } + + if { $smooth != "" } { + set cmmd "$cmmd -smooth $smooth" + } + + if { $splinesteps != "" } { + set cmmd "$cmmd -splinesteps $splinesteps" + } + + debug_puts "$cmmd" + set result [eval $cmmd] + if { $result != "" } { + debug_puts $result + } + } + + + ################################################################ + ## print_canvas.arc + ## Description: + ## Prints a arc item. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ## id The id of the canvas item. + ################################################################ + + proc print_canvas.arc {hdc cw id} { + variable vtgPrint + + set color [print_canvas.TransColor [$cw itemcget $id -outline]] + if { [string match $vtgPrint(printer.bg) $color] } { + return + } + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set style [ $cw itemcget $id -style ] + set start [ $cw itemcget $id -start ] + set extent [ $cw itemcget $id -extent ] + set fill [ $cw itemcget $id -fill ] + + set cmmd "gdi arc $hdc $coords -outline $color -style $style -start $start -extent $extent" + if { $wdth > 1 } { + set cmmd "$cmmd -width $wdth" + } + if { $fill != "" } { + set cmmd "$cmmd -fill $fill" + } + + debug_puts "$cmmd" + eval $cmmd + } + + ################################################################ + ## print_canvas.polygon + ## Description: + ## Prints a polygon item. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ## id The id of the canvas item. + ################################################################ + + proc print_canvas.polygon {hdc cw id} { + variable vtgPrint + + set fcolor [print_canvas.TransColor [$cw itemcget $id -fill]] + if { ![string length $fcolor] } { + set fcolor $vtgPrint(printer.bg) + } + set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] + if { ![string length $ocolor] } { + set ocolor $vtgPrint(printer.bg) + } + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set smooth [$cw itemcget $id -smooth ] + set splinesteps [ $cw itemcget $id -splinesteps ] + + + set cmmd "gdi polygon $hdc $coords -width $wdth \ + -fill $fcolor -outline $ocolor" + if { $smooth != "" } { + set cmmd "$cmmd -smooth $smooth" + } + + if { $splinesteps != "" } { + set cmmd "$cmmd -splinesteps $splinesteps" + } + + debug_puts "$cmmd" + eval $cmmd + } + + + ################################################################ + ## print_canvas.oval + ## Description: + ## Prints an oval item. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ## id The id of the canvas item. + ################################################################ + + proc print_canvas.oval { hdc cw id } { + variable vtgPrint + + set fcolor [print_canvas.TransColor [$cw itemcget $id -fill]] + if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} + set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] + if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + + set cmmd "gdi oval $hdc $coords -width $wdth \ + -fill $fcolor -outline $ocolor" + debug_puts "$cmmd" + eval $cmmd + } + + ################################################################ + ## print_canvas.rectangle + ## Description: + ## Prints a rectangle item. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ## id The id of the canvas item. + ################################################################ + + proc print_canvas.rectangle {hdc cw id} { + variable vtgPrint + + set fcolor [print_canvas.TransColor [$cw itemcget $id -fill]] + if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} + set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] + if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + + set cmmd "gdi rectangle $hdc $coords -width $wdth \ + -fill $fcolor -outline $ocolor" + debug_puts "$cmmd" + eval $cmmd + } + + + ################################################################ + ## print_canvas.text + ## Description: + ## Prints a text item. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ## id The id of the canvas item. + ################################################################ + + proc print_canvas.text {hdc cw id} { + variable vtgPrint + variable p + + set p(0) 1 ; unset p(0) + page_args p + + set color [print_canvas.TransColor [$cw itemcget $id -fill]] + # if {[string match white [string tolower $color]]} {return} + # set color black + set txt [$cw itemcget $id -text] + if {![string length $txt]} {return} + set coords [$cw coords $id] + set anchr [$cw itemcget $id -anchor] + + set bbox [$cw bbox $id] + set wdth [expr [lindex $bbox 2] - [lindex $bbox 0]] + + set just [$cw itemcget $id -justify] + + # Get the canvas font info + set font [ $cw itemcget $id -font ] + # Find the real font info + set font [font actual $font] + # Create a compatible font, suitable for printer name extraction + set font [ eval font create $font ] + # Just get the name and family, or some of the gdi commands will fail. + # Improve this as GDI improves + set font [list [font configure $font -family] -[font configure $font -size] ] + + set cmmd "gdi text $hdc $coords -fill $color -text [list $txt] \ + -anchor $anchr -font [ list $font ] \ + -width $wdth -justify $just" + debug_puts "$cmmd" + eval $cmmd + } + + + ################################################################ + ## print_canvas.image + ## Description: + ## Prints an image item. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ## id The id of the canvas item. + ################################################################ + + proc print_canvas.image {hdc cw id} { + + variable vtgPrint + variable option + + # First, we have to get the image name + set imagename [ $cw itemcget $id -image] + # Now we get the size + set wid [ image width $imagename] + set hgt [ image height $imagename ] + # next, we get the location and anchor + set anchor [ $cw itemcget $id -anchor ] + set coords [ $cw coords $id ] + + + # Since the GDI commands don't yet support images and bitmaps, + # and since this represents a rendered bitmap, we CAN use + # copybits IF we create a new temporary toplevel to hold the beast. + # if this is too ugly, change the option! + if { [ info exist option(use_copybits) ] } { + set firstcase $option(use_copybits) + } else { + set firstcase 0 + } + + if { $firstcase > 0 } { + set tl [toplevel .tmptop[expr int( rand() * 65535 ) ] -height $hgt -width $wid -background $vtgPrint(printer.bg) ] + canvas $tl.canvas -width $wid -height $hgt + $tl.canvas create image 0 0 -image $imagename -anchor nw + pack $tl.canvas -side left -expand false -fill none + tkwait visibility $tl.canvas + update + #set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] + #set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] + set srccoords [ list "0 0 $wid $hgt" ] + set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] $wid $hgt" ] + set cmmd "gdi copybits $hdc -window $tl -client -source $srccoords -destination $dstcoords " + debug_puts "$cmmd" + eval $cmmd + destroy $tl + } else { + set cmmd "gdi image $hdc $coords -anchor $anchor -image $imagename" + debug_puts "$cmmd" + eval $cmmd + } + } + + ################################################################ + ## print_canvas.bitmap + ## Description: + ## Prints a bitmap item. + ## Args: + ## hdc The printer handle. + ## cw The canvas widget. + ## id The id of the canvas item. + ################################################################ + + proc print_canvas.bitmap {hdc cw id} { + variable option + variable vtgPrint + + # First, we have to get the bitmap name + set imagename [ $cw itemcget $id -image] + # Now we get the size + set wid [ image width $imagename] + set hgt [ image height $imagename ] + # next, we get the location and anchor + set anchor [ $cw itemcget $id -anchor ] + set coords [ $cw coords $id ] + + # Since the GDI commands don't yet support images and bitmaps, + # and since this represents a rendered bitmap, we CAN use + # copybits IF we create a new temporary toplevel to hold the beast. + # if this is too ugly, change the option! + if { [ info exist option(use_copybits) ] } { + set firstcase $option(use_copybits) + } else { + set firstcase 0 + } + if { $firstcase > 0 } { + set tl [toplevel .tmptop[expr int( rand() * 65535 ) ] -height $hgt -width $wid -background $vtgPrint(canvas.bg) ] + canvas $tl.canvas -width $wid -height $hgt + $tl.canvas create image 0 0 -image $imagename -anchor nw + pack $tl.canvas -side left -expand false -fill none + tkwait visibility $tl.canvas + update + set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] + set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] + set cmmd "gdi copybits $hdc -window $tl -client -source $srccoords -destination $dstcoords " + debug_puts "$cmmd" + eval $cmmd + destroy $tl + } else { + set cmmd "gdi bitmap $hdc $coords -anchor $anchor -bitmap $imagename" + debug_puts "$cmmd" + eval $cmmd + } + } + + ################################################################ + ## These procedures transform attribute setting from the real # + ## canvas to the appropriate setting for printing to paper. # + ################################################################ + + ################################################################ + ## print_canvas.TransColor + ## Description: + ## Does the actual transformation of colors from the + ## canvas widget to paper. + ## Args: + ## color The color value to be transformed. + ################################################################ + + proc print_canvas.TransColor {color} { + variable vtgPrint + + switch [string toupper $color] { + $vtgPrint(canvas.bg) {return $vtgPrint(printer.bg)} + } + return $color + } + + # Initialize all the variables once + init_print_canvas +} + diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 1e1a4c3..10035c7 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -12,27 +12,24 @@ */ -/* Remove Deprecation Warnings. */ +/* Remove deprecation warnings. */ #define _CRT_SECURE_NO_WARNINGS #include #include #include - - -#include /* Ensure to include WINAPI definition */ +#include /* Ensure to include WINAPI definition. */ #include -/* #include */ + #include "tkWinInt.h" -/* Main dispatcher for commands */ -static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -/* Main dispatcher for subcommands */ -static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +/* Main dispatcher for commands. */ +static int TkWinGDI (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +/* Main dispatcher for subcommands. */ +static int TkWinGDISubcmd (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -/* Real functions */ -static int GdiConfig (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +/* Real functions. */ static int GdiArc (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); static int GdiBitmap (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); static int GdiCharWidths (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); @@ -48,36 +45,16 @@ static int Version (ClientData unused, Tcl_Interp *interp, int argc, const c static int GdiMap (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); static int GdiCopyBits (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -/* Local copies of similar routines elsewhere in Tcl/Tk */ +/* Local copies of similar routines elsewhere in Tcl/Tk. */ static int GdiParseColor (const char *name, unsigned long *color); static int GdiGetColor (const char *name, unsigned long *color); static int TkGdiMakeBezierCurve(Tk_Canvas, double *, int, int, XPoint[], double[]); -/* Routines imported from irox */ -#ifdef TEXTWIDGET_CMD -static int PrintTextCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -#endif -/* -* Hash table support -* -* Provided by the hdc extension -*/ -static int hdc_loaded = 0; -static void init_hdc_functions(Tcl_Interp *interp); -static const char * (*hdc_create) (Tcl_Interp *interp, void *ptr, int type); -static int (*hdc_valid) (Tcl_Interp *interp, const char *hdcname, int type); -static int (*hdc_delete) (Tcl_Interp *interp, const char *hdcname); -static void * (*hdc_get) (Tcl_Interp *interp, const char *hdcname); -static int (*hdc_typeof) (Tcl_Interp *interp, const char *hdcname); -static const char * (*hdc_prefixof) (Tcl_Interp *interp, int type, const char *newprefix); -static int (*hdc_list) (Tcl_Interp *interp, int type, const char *out[], int *poutlen); - -static HDC get_dc(Tcl_Interp *interp, const char *name); /* -* Helper functions -*/ + * Helper functions. + */ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC hDC); static int GdiMakePen(Tcl_Interp *interp, int width, int dashstyle, const char *dashstyledata, @@ -94,7 +71,7 @@ static int GdiGetHdcInfo( HDC hdc, LPPOINT worigin, LPSIZE wextent, LPPOINT vorigin, LPSIZE vextent); -/* Helper functions for printing the window client area */ +/* Helper functions for printing the window client area. */ enum PrintType { PTWindow=0, PTClient=1, PTScreen=2 }; static HANDLE CopyToDIB ( HWND wnd, enum PrintType type ); static HBITMAP CopyScreenToBitmap(LPRECT lpRect); @@ -104,24 +81,36 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB); static int PalEntriesOnDevice(HDC hDC); static HPALETTE GetSystemPalette(void); static void GetDisplaySize (LONG *width, LONG *height); +static int GdiWordToWeight(const char *str); +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs); -static const char gdi_usage_message[] = "gdi [arc|characters|copybits|line|map|oval|" +static const char gdi_usage_message[] = "::tk::print::_gdi [arc|characters|copybits|line|map|oval|" "photo|polygon|rectangle|text|version]\n" "\thdc parameters can be generated by the printer extension"; static char msgbuf[1024]; + /* -* This is the top-level routine for the GDI command -* It strips off the first word of the command (gdi) and -* sends the result to the switch -*/ -static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) + *---------------------------------------------------------------------- + * + * TkWinGDI -- + * + * Top-level routine for the ::tk::print::_gdi command. + * + * Results: + * It strips off the first word of the command (::tk::print::_gdi) and + * sends the result to a subcommand parser. + * + *---------------------------------------------------------------------- + */ + +static int TkWinGDI (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) { - if ( argc > 1 && strcmp(*argv, "gdi") == 0 ) + if ( argc > 1 && strcmp(*argv, "::tk::print::_gdi") == 0 ) { argc--; argv++; - return Gdi(unused, interp, argc, argv); + return TkWinGDISubcmd(unused, interp, argc, argv); } Tcl_AppendResult(interp, gdi_usage_message, NULL); @@ -129,10 +118,10 @@ static int gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **a } /* -* To make the "subcommands" follow a standard convention, -* add them to this array. The first element is the subcommand -* name, and the second a standard Tcl command handler. -*/ + * To make the "subcommands" follow a standard convention, + * add them to this array. The first element is the subcommand + * name, and the second a standard Tcl command handler. + */ struct gdi_command { const char *command_string; @@ -142,7 +131,6 @@ struct gdi_command { "arc", GdiArc }, { "bitmap", GdiBitmap }, { "characters", GdiCharWidths }, - { "configure", GdiConfig }, { "image", GdiImage }, { "line", GdiLine }, { "map", GdiMap }, @@ -159,10 +147,21 @@ struct gdi_command }; + /* -* This is the GDI subcommand dispatcher -*/ -static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) + *---------------------------------------------------------------------- + * + * TkWinGDISubcmd -- + * + * This is the GDI subcommand dispatcher. + * + * Results: + * Parses and executes subcommands to ::tk::print::_gdi. + * + *---------------------------------------------------------------------- + */ + +static int TkWinGDISubcmd (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) { size_t i; @@ -174,97 +173,31 @@ static int Gdi (ClientData unused, Tcl_Interp *interp, int argc, const char return TCL_ERROR; } -/* -* GdiConfig -* Configure (or get) global options about the HDC -* -background Specify a background color -* -bg alias for -background -* [-width and -height are not modified in this function] -* Other "canvas" options are not relevant to a static display -*/ -static int GdiConfig( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) -{ - static const char usage_message[] = "gdi configure hdc " - "[-background bgcolor]"; - - COLORREF c; - char clrhex[2+2+2+2+1]; - int status = TCL_OK; - HDC hDC; - - if ( argc >= 1 ) - { - hDC = get_dc(interp, argv[0]); - /* Check hDC */ - if ( hDC == (HDC) 0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } - argc--; - argv++; - } - else - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - - /* Now check for other arguments */ - while ( argc >= 1 ) - { - if ( strcmp(argv[0], "-bg") == 0 || strcmp(argv[0], "-background") == 0 ) - { - unsigned long color; - argc--; - argv++; - if ( argc >= 1 ) - { - if ( GdiParseColor(argv[0], &color) > 0 ) /* OK */ - SetBkColor(hDC, color); - else - { - Tcl_AppendResult(interp, - "{ {gdi configure: color parsing error for background ", - argv[0], - "} }", - NULL); - status = TCL_ERROR; - } - } - } - argc--; - argv++; - } - - if ( (c = GetBkColor(hDC)) == CLR_INVALID ) - { - Tcl_AppendResult(interp, "{ -background INVALID }", NULL); - status = TCL_ERROR; - } - else - { - sprintf(clrhex, "#%02x%02x%02x", GetRValue(c), GetGValue(c), GetBValue(c)); - Tcl_AppendResult(interp, "{ -background ", clrhex, " }", NULL); - } - - return status; -} /* -* Arc command -* Create a standard "DrawFunc" to make this more workable.... -*/ + * Create a standard "DrawFunc" to make this more workable.... + */ #ifdef _MSC_VER -typedef BOOL (WINAPI *DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie */ +typedef BOOL (WINAPI *DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie. */ #else -typedef BOOL WINAPI (*DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie */ +typedef BOOL WINAPI (*DrawFunc) (HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie. */ #endif + +/* + *---------------------------------------------------------------------- + * + * GdiArc -- + * + * Map canvas arcs to GDI context. + * + * Results: + * Renders arcs. + * + *---------------------------------------------------------------------- + */ + + static int GdiArc( TCL_UNUSED(void *), Tcl_Interp *interp, @@ -286,7 +219,7 @@ static int GdiArc( int dodash = 0; const char *dashdata = 0; - static const char usage_message[] = "gdi arc hdc x1 y1 x2 y2 " + static const char usage_message[] = "::tk::print::_gdi arc hdc x1 y1 x2 y2 " "-extent degrees " "-fill color -outline color " "-outlinestipple bitmap " @@ -296,11 +229,11 @@ static int GdiArc( drawfunc = Pie; - /* Verrrrrry simple for now... */ + /* Verrrrrry simple for now.... */ if (argc >= 5) { hDC = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (hDC == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); @@ -329,7 +262,7 @@ static int GdiArc( else if ( strcmp(argv[1], "chord") == 0 ) drawfunc = Chord; } - /* Handle all args, even if we don't use them yet */ + /* Handle all args, even if we don't use them yet. */ else if ( strcmp(argv[0], "-fill") == 0 ) { if ( GdiGetColor(argv[1], &fillcolor) ) @@ -364,19 +297,19 @@ static int GdiArc( yr0 = yr1 = ( y1 + y2 ) / 2; - /* - * The angle used by the arc must be "warped" by the eccentricity of the ellipse. - * Thanks to Nigel Dodd for bringing a nice example. - */ + /* + * The angle used by the arc must be "warped" by the eccentricity of the ellipse. + * Thanks to Nigel Dodd for bringing a nice example. + */ xr0 += (int)(100.0 * (x2 - x1) * cos( (start * 2.0 * 3.14159265) / 360.0 ) ); yr0 -= (int)(100.0 * (y2 - y1) * sin( (start * 2.0 * 3.14159265) / 360.0 ) ); xr1 += (int)(100.0 * (x2 - x1) * cos( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); yr1 -= (int)(100.0 * (y2 - y1) * sin( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); /* Under Win95, SetArcDirection isn't implemented--so we have to - assume that arcs are drawn counterclockwise (e.g., positive extent) - So if it's negative, switch the coordinates! - */ + * assume that arcs are drawn counterclockwise (e.g., positive extent) + * So if it's negative, switch the coordinates! + */ if ( extent < 0 ) { int xr2 = xr0; @@ -410,89 +343,117 @@ static int GdiArc( return TCL_OK; } - Tcl_AppendResult(interp, usage_message, NULL); + Tcl_AppendResult(interp, ::tk::print::_gdi, NULL); return TCL_ERROR; } /* -* Bitmap command -* Unimplemented for now. -* Should use the same techniques as CanvasPsBitmap (tkCanvPs.c) -*/ + *---------------------------------------------------------------------- + * + * GdiBitmap -- + * + * Unimplemented for now. Should use the same techniques as CanvasPsBitmap (tkCanvPs.c). + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + static int GdiBitmap( TCL_UNUSED(void *), Tcl_Interp *interp, TCL_UNUSED(int), TCL_UNUSED(const char **)) { - static const char usage_message[] = "gdi bitmap hdc x y " + static const char usage_message[] = "::tk::print::_gdi bitmap hdc x y " "-anchor [center|n|e|s|w] -background color " "-bitmap bitmap -foreground color\n" "Not implemented yet. Sorry!"; - /* Skip this for now.... */ - /* Should be based on common code with the copybits command */ + /* + * Skip this for now. Should be based on common + * code with the copybits command. + */ Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } + /* -* Image command -* Unimplemented for now. -* Should switch on image type and call either GdiPhoto or GdiImage -* (or other registered function(?)) -* This code is similar to that in the tkx.y.z/win/tkWinImage.c code? -*/ + *---------------------------------------------------------------------- + * + * GdiImage -- + * + * Unimplemented for now. Unimplemented for now. Should switch on image type and call + * either GdiPhoto or GdiBitmap. This code is similar to that in tkWinImage.c. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + static int GdiImage( TCL_UNUSED(void *), Tcl_Interp *interp, TCL_UNUSED(int), TCL_UNUSED(const char **)) { - static const char usage_message[] = "gdi image hdc x y -anchor [center|n|e|s|w] -image name\n" + static const char usage_message[] = "::tk::print::_gdi image hdc x y -anchor [center|n|e|s|w] -image name\n" "Not implemented yet. Sorry!"; - /* Skip this for now.... */ - /* Should be based on common code with the copybits command */ + /* Skip this for now..... */ + /* Should be based on common code with the copybits command. */ Tcl_AppendResult(interp, usage_message, NULL); - /* Normally, usage results in TCL_ERROR--but wait til' it's implemented */ + /* Normally, usage results in TCL_ERROR--but wait til' it's implemented. */ return TCL_OK; } /* -* Gdi Photo -* Contributed by Lukas Rosenthaler -* Note: The canvas doesn't directly support photos (only as images), -* so this is the first gdi command without an equivalent canvas command. -* This code may be modified to support photo images on the canvas. -*/ + *---------------------------------------------------------------------- + * + * GdiPhoto -- + * + * Contributed by Lukas Rosenthaler + * Note: The canvas doesn't directly support photos (only as images), + * so this is the first ::tk::print::_gdi command without an equivalent canvas command. +* This code may be modified to support photo images on the canvas. + * + * Results: + * Renders a photo. + * + *---------------------------------------------------------------------- + */ + static int GdiPhoto( TCL_UNUSED(void *), Tcl_Interp *interp, int argc, const char **argv) { - static const char usage_message[] = "gdi photo hdc [-destination x y [w [h]]] -photo name\n"; + static const char usage_message[] = "::tk::print::_gdi photo hdc [-destination x y [w [h]]] -photo name\n"; HDC dst; int dst_x = 0, dst_y = 0, dst_w = 0, dst_h = 0; int nx, ny, sll; - const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char * */ + const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char *. */ Tk_PhotoHandle photo_handle; Tk_PhotoImageBlock img_block; BITMAPINFO bitmapinfo; /* Since we don't need the bmiColors table, - there is no need for dynamic allocation */ - int oldmode; /* For saving the old stretch mode */ - POINT pt; /* For saving the brush org */ + there is no need for dynamic allocation. */ + int oldmode; /* For saving the old stretch mode. */ + POINT pt; /* For saving the brush org. */ char *pbuf = NULL; int i, j, k; int retval = TCL_OK; /* - * Parse the arguments. - */ - /* HDC is required */ + * Parse the arguments. + */ + + /* HDC is required. */ if ( argc < 1 ) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; @@ -500,24 +461,24 @@ static int GdiPhoto( dst = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (dst == (HDC) 0) { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for gdi photo\n", NULL); + Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI photo\n", NULL); Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } /* * Next, check to see if 'dst' can support BitBlt. - * If not, raise an error + * If not, raise an error. */ if ( (GetDeviceCaps (dst, RASTERCAPS) & RC_STRETCHDIB) == 0 ) { - sprintf(msgbuf, "gdi photo not supported on device context (0x%s)", argv[0]); + sprintf(msgbuf, "::tk::print::_gdi photo not supported on device context (0x%s)", argv[0]); Tcl_AppendResult(interp, msgbuf, NULL); return TCL_ERROR; } - /* Parse the command line arguments */ + /* Parse the command line arguments. */ for (j = 1; j < argc; j++) { if (strcmp (argv[j], "-destination") == 0) @@ -528,7 +489,7 @@ static int GdiPhoto( if ( j < argc ) count = sscanf(argv[++j], "%lf%lf%lf%lf", &x, &y, &w, &h); - if ( count < 2 ) /* Destination must provide at least 2 arguments */ + if ( count < 2 ) /* Destination must provide at least 2 arguments. */ { Tcl_AppendResult(interp, "-destination requires a list of at least 2 numbers\n", usage_message, NULL); @@ -554,16 +515,16 @@ static int GdiPhoto( photoname = argv[++j]; } - if ( photoname == 0 ) /* No photo provided */ + if ( photoname == 0 ) /* No photo provided. */ { - Tcl_AppendResult(interp, "No photo name provided to gdi photo\n", usage_message, NULL); + Tcl_AppendResult(interp, "No photo name provided to ::tk::print::_gdi photo\n", usage_message, NULL); return TCL_ERROR; } photo_handle = Tk_FindPhoto (interp, photoname); if ( photo_handle == 0 ) { - Tcl_AppendResult(interp, "gdi photo: Photo name ", photoname, " can't be located\n", + Tcl_AppendResult(interp, "::tk::print::_gdi photo: Photo name ", photoname, " can't be located\n", usage_message, NULL); return TCL_ERROR; } @@ -572,18 +533,18 @@ static int GdiPhoto( nx = img_block.width; ny = img_block.height; - sll = ((3*nx + 3) / 4)*4; /* must be multiple of 4 */ + sll = ((3*nx + 3) / 4)*4; /* Must be multiple of 4. */ pbuf = (char *) Tcl_Alloc (sll*ny*sizeof (char)); - if ( pbuf == 0 ) /* Memory allocation failure */ + if ( pbuf == 0 ) /* Memory allocation failure. */ { - Tcl_AppendResult(interp, "gdi photo failed--out of memory", NULL); + Tcl_AppendResult(interp, "::tk::print::_gdi photo failed--out of memory", NULL); return TCL_ERROR; } - /* After this, all returns must go through retval */ + /* After this, all returns must go through retval. */ - /* BITMAP expects BGR; photo provides RGB */ + /* BITMAP expects BGR; photo provides RGB. */ for (k = 0; k < ny; k++) { for (i = 0; i < nx; i++) @@ -605,14 +566,14 @@ static int GdiPhoto( bitmapinfo.bmiHeader.biPlanes = 1; bitmapinfo.bmiHeader.biBitCount = 24; bitmapinfo.bmiHeader.biCompression = BI_RGB; - bitmapinfo.bmiHeader.biSizeImage = 0; /* sll*ny; */ + bitmapinfo.bmiHeader.biSizeImage = 0; /* sll*ny;. */ bitmapinfo.bmiHeader.biXPelsPerMeter = 0; bitmapinfo.bmiHeader.biYPelsPerMeter = 0; bitmapinfo.bmiHeader.biClrUsed = 0; bitmapinfo.bmiHeader.biClrImportant = 0; oldmode = SetStretchBltMode (dst, HALFTONE); - /* According to the Win32 Programmer's Manual, we have to set the brush org, now */ + /* According to the Win32 Programmer's Manual, we have to set the brush org, now. */ SetBrushOrgEx(dst, 0, 0, &pt); if (dst_w <= 0) @@ -630,12 +591,12 @@ static int GdiPhoto( int errcode; errcode = GetLastError(); - sprintf(msgbuf, "gdi photo internal failure: StretchDIBits error code %d", errcode); + sprintf(msgbuf, "::tk::print::_gdi photo internal failure: StretchDIBits error code %d", errcode); Tcl_AppendResult(interp, msgbuf, NULL); retval = TCL_ERROR; } - /* Clean up the hDC */ + /* Clean up the hDC. */ if (oldmode != 0 ) { SetStretchBltMode(dst, oldmode); @@ -653,12 +614,23 @@ static int GdiPhoto( return retval; } + /* -* Interface to Tk's line smoother, used for lines and pollies -* Provided by Jasper Taylor -*/ + *---------------------------------------------------------------------- + * + * Bezierize -- + * + * Interface to Tk's line smoother, used for lines and pollies. + * Provided by Jasper Taylor . + * + * Results: + * Smooths lines. + * + *---------------------------------------------------------------------- + */ + int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { - /* First, translate my points into a list of doubles */ + /* First, translate my points into a list of doubles. */ double *inPointList, *outPointList; int n; int nbpoints = 0; @@ -667,7 +639,7 @@ int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { inPointList=(double *)Tcl_Alloc(2*sizeof(double)*npoly); if ( inPointList == 0 ) { - return nbpoints; /* 0 */ + return nbpoints; /* 0. */ } for (n=0;n= 5) { hDC = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (hDC == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); @@ -771,15 +753,15 @@ static int GdiLine( while ( argc >= 2 ) { - /* Check for a number */ + /* Check for a number. */ x = strtoul(argv[0], &strend, 0); if ( strend > argv[0] ) { - /* One number... */ + /* One number.... */ y = strtoul (argv[1], &strend, 0); if ( strend > argv[1] ) { - /* TWO numbers! */ + /* TWO numbers!. */ polypoints[npoly].x = x; polypoints[npoly].y = y; npoly++; @@ -788,7 +770,7 @@ static int GdiLine( } else { - /* Only one number... Assume a usage error */ + /* Only one number... Assume a usage error. */ Tcl_Free((void *)polypoints); Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; @@ -811,7 +793,7 @@ static int GdiLine( } else if ( strcmp(*argv, "-arrowshape") == 0 ) { - /* List of 3 numbers--set arrowshape array */ + /* List of 3 numbers--set arrowshape array. */ int a1, a2, a3; if ( sscanf(argv[1], "%d%d%d", &a1, &a2, &a3) == 3 ) @@ -822,9 +804,9 @@ static int GdiLine( arrowshape[1] = a2; arrowshape[2] = a3; } - /* Else the numbers are bad */ + /* Else the numbers are bad. */ } - /* Else the argument was bad */ + /* Else the argument was bad. */ argv+=2; argc-=2; @@ -848,12 +830,12 @@ static int GdiLine( } else if ( strcmp(*argv, "-smooth") == 0 ) { - /* Argument is true/false or 1/0 or bezier */ + /* Argument is true/false or 1/0 or bezier. */ if ( argv[1] ) { switch ( argv[1][0] ) { case 't': case 'T': case '1': - case 'b': case 'B': /* bezier */ + case 'b': case 'B': /* bezier. */ dosmooth = 1; break; default: @@ -895,14 +877,14 @@ static int GdiLine( argv+=2; argc-=2; } - else /* It's an unknown argument! */ + else /* It's an unknown argument!. */ { argc--; argv++; } /* Check for arguments - * Most of the arguments affect the "Pen" - */ + * Most of the arguments affect the "Pen" + */ } } @@ -914,7 +896,7 @@ static int GdiLine( if ( doarrow != 0 ) GdiMakeBrush(interp, 0, linecolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - if (dosmooth) /* Use PolyBezier */ + if (dosmooth) /* Use PolyBezier. */ { int nbpoints; POINT *bpoints = 0; @@ -922,7 +904,7 @@ static int GdiLine( if (nbpoints > 0 ) Polyline(hDC, bpoints, nbpoints); else - Polyline(hDC, polypoints, npoly); /* out of memory? just draw a regular line */ + Polyline(hDC, polypoints, npoly); /* Out of memory? Just draw a regular line. */ if ( bpoints != 0 ) Tcl_Free((void *)bpoints); } @@ -938,10 +920,10 @@ static int GdiLine( linecolor, hDC, (HGDIOBJ *)&hPen); } - /* Now the arrowheads, if any */ + /* Now the arrowheads, if any. */ if ( doarrow & 1 ) { - /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y */ + /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y. */ POINT ahead[6]; double dx, dy, length; double backup, sinTheta, cosTheta; @@ -981,7 +963,7 @@ static int GdiLine( if ( doarrow & 2 ) { - /* Arrowhead at end = polypoints[0].x, polypoints[0].y */ + /* Arrowhead at end = polypoints[0].x, polypoints[0].y. */ POINT ahead[6]; double dx, dy, length; double backup, sinTheta, cosTheta; @@ -1034,15 +1016,25 @@ static int GdiLine( } /* -* Oval command -*/ + *---------------------------------------------------------------------- + * + * GdiOval -- + * + * Maps ovals to GDI context. + * + * Results: + * Renders ovals. + * + *---------------------------------------------------------------------- + */ + static int GdiOval( TCL_UNUSED(void *), Tcl_Interp *interp, int argc, const char **argv) { - static const char usage_message[] = "gdi oval hdc x1 y1 x2 y2 -fill color -outline color " + static const char usage_message[] = "::tk::print::_gdi oval hdc x1 y1 x2 y2 -fill color -outline color " "-stipple bitmap -width linewid"; int x1, y1, x2, y2; HDC hDC; @@ -1057,11 +1049,11 @@ static int GdiOval( int dodash = 0; const char *dashdata = 0; - /* Verrrrrry simple for now... */ + /* Verrrrrry simple for now.... */ if (argc >= 5) { hDC = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (hDC == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); @@ -1079,7 +1071,7 @@ static int GdiOval( while ( argc > 0 ) { - /* Now handle any other arguments that occur */ + /* Now handle any other arguments that occur. */ if ( strcmp(argv[0], "-fill") == 0 ) { if ( argv[1] ) @@ -1130,10 +1122,10 @@ static int GdiOval( 0, 0, 0, 0, linecolor, hDC, (HGDIOBJ *)&hPen); /* - * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and - * earlier documentation, canvas rectangle does not. Thus, add 1 to - * right and lower bounds to get appropriate behavior. - */ + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ Ellipse (hDC, x1, y1, x2+1, y2+1); if (width || dolinecolor) GdiFreePen(interp, hDC, hPen); @@ -1150,15 +1142,25 @@ static int GdiOval( } /* -* Polygon command -*/ + *---------------------------------------------------------------------- + * + * GdiPolygon -- + * + * Maps polygons to GDI context. + * + * Results: + * Renders polygons. + * + *---------------------------------------------------------------------- + */ + static int GdiPolygon( TCL_UNUSED(void *), Tcl_Interp *interp, int argc, const char **argv) { - static const char usage_message[] = "gdi polygon hdc x1 y1 ... xn yn " + static const char usage_message[] = "::tk::print::_gdi polygon hdc x1 y1 ... xn yn " "-fill color -outline color -smooth [true|false|bezier] " "-splinesteps number -stipple bitmap -width linewid"; @@ -1180,11 +1182,11 @@ static int GdiPolygon( int dodash = 0; const char *dashdata = 0; - /* Verrrrrry simple for now... */ + /* Verrrrrry simple for now.... */ if (argc >= 5) { hDC = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (hDC == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); @@ -1210,11 +1212,11 @@ static int GdiPolygon( x = strtoul(argv[0], &strend, 0); if ( strend > argv[0] ) { - /* One number... */ + /* One number.... */ y = strtoul (argv[1], &strend, 0); if ( strend > argv[1] ) { - /* TWO numbers! */ + /* TWO numbers!. */ polypoints[npoly].x = x; polypoints[npoly].y = y; npoly++; @@ -1223,7 +1225,7 @@ static int GdiPolygon( } else { - /* Only one number... Assume a usage error */ + /* Only one number... Assume a usage error. */ Tcl_Free((void *)polypoints); Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; @@ -1246,7 +1248,7 @@ static int GdiPolygon( switch ( argv[1][0] ) { case 't': case 'T': case '1': - case 'b': case 'B': /* bezier */ + case 'b': case 'B': /* bezier. */ dosmooth = 1; break; default: @@ -1277,9 +1279,10 @@ static int GdiPolygon( } argc -= 2; argv += 2; - /* Check for arguments - * Most of the arguments affect the "Pen" and "Brush" - */ + /* + * Check for arguments. + * Most of the arguments affect the "Pen" and "Brush". + */ } } @@ -1326,15 +1329,25 @@ static int GdiPolygon( } /* -* Rectangle command -*/ + *---------------------------------------------------------------------- + * + * GdiRectangle -- + * + * Maps rectangles to GDI context. + * + * Results: + * Renders rectangles. + * + *---------------------------------------------------------------------- + */ + static int GdiRectangle( TCL_UNUSED(void *), Tcl_Interp *interp, int argc, const char **argv) { - static const char usage_message[] = "gdi rectangle hdc x1 y1 x2 y2 " + static const char usage_message[] = "::tk::print::_gdi rectangle hdc x1 y1 x2 y2 " "-fill color -outline color " "-stipple bitmap -width linewid"; @@ -1351,11 +1364,11 @@ static int GdiRectangle( int dodash = 0; const char *dashdata = 0; - /* Verrrrrry simple for now... */ + /* Verrrrrry simple for now.... */ if (argc >= 5) { hDC = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (hDC == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); @@ -1371,7 +1384,7 @@ static int GdiRectangle( argc -= 5; argv += 5; - /* Now handle any other arguments that occur */ + /* Now handle any other arguments that occur. */ while (argc > 1) { if ( strcmp(argv[0], "-fill") == 0 ) @@ -1406,11 +1419,12 @@ static int GdiRectangle( argv += 2; } - /* Note: If any fill is specified, the function must create a brush and - * put the coordinates in a RECTANGLE structure, and call FillRect. - * FillRect requires a BRUSH / color. - * If not, the function Rectangle must be called - */ + /* + * Note: If any fill is specified, the function must create a brush and + * put the coordinates in a RECTANGLE structure, and call FillRect. + * FillRect requires a BRUSH / color. + * If not, the function Rectangle must be called. + */ if (dofillcolor) GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); else @@ -1421,11 +1435,11 @@ static int GdiRectangle( dodash, dashdata, 0, 0, 0, 0, linecolor, hDC, (HGDIOBJ *)&hPen); - /* - * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and - * earlier documentation, canvas rectangle does not. Thus, add 1 to - * right and lower bounds to get appropriate behavior. - */ + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ Rectangle (hDC, x1, y1, x2+1, y2+1); if ( width || dolinecolor ) GdiFreePen(interp, hDC, hPen); @@ -1442,29 +1456,39 @@ static int GdiRectangle( } /* -* characters command -* Need some way to get accurate data on character widths. -* This is completely inadequate for typesetting, but should work -* for simple text manipulation. -*/ + *---------------------------------------------------------------------- + * + * GdiCharWidths -- + * + * Computes /character widths. This is completely inadequate for typesetting, + but should work for simple text manipulation. + * + * Results: + * Returns character width. + * + *---------------------------------------------------------------------- + */ + + static int GdiCharWidths( TCL_UNUSED(void *), Tcl_Interp *interp, int argc, const char **argv) { - static const char usage_message[] = "gdi characters hdc [-font fontname] [-array ary]"; - /* Returns widths of characters from font in an associative array - * Font is currently selected font for HDC if not specified - * Array name is GdiCharWidths if not specified - * Widths should be in the same measures as all other values (1/1000 inch). + static const char usage_message[] = "::tk::print::_gdi characters hdc [-font fontname] [-array ary]"; + /* + * Returns widths of characters from font in an associative array. + * Font is currently selected font for HDC if not specified. + * Array name is GdiCharWidths if not specified. + * Widths should be in the same measures as all other values (1/1000 inch). */ HDC hDC; LOGFONT lf; HFONT hfont, oldfont; int made_font = 0; const char *aryvarname = "GdiCharWidths"; - /* For now, assume 256 characters in the font... */ + /* For now, assume 256 characters in the font.... */ int widths[256]; int retval; @@ -1475,7 +1499,7 @@ static int GdiCharWidths( } hDC = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (hDC == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); @@ -1497,7 +1521,7 @@ static int GdiCharWidths( made_font = 1; oldfont = SelectObject(hDC, hfont); } - /* Else leave the font alone! */ + /* Else leave the font alone!. */ } else if ( strcmp(argv[0], "-array") == 0 ) { @@ -1512,11 +1536,12 @@ static int GdiCharWidths( argc--; } - /* Now, get the widths using the correct function for this windows version */ + /* Now, get the widths using the correct function for this Windows version. */ #ifdef WIN32 - /* Try the correct function. If it fails (as has been reported on some - * versions of Windows 95), try the "old" function - */ + /* + * Try the correct function. If it fails (as has been reported on some + * versions of Windows 95), try the "old" function. + */ if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) { retval = GetCharWidth (hDC, 0, 255, widths ); @@ -1524,16 +1549,17 @@ static int GdiCharWidths( #else retval = GetCharWidth (hDC, 0, 255, widths); #endif - /* Retval should be 1 (TRUE) if the function succeeded. If the function fails, - * get the "extended" error code and return. Be sure to deallocate the font if - * necessary. - */ + /* + * Retval should be 1 (TRUE) if the function succeeded. If the function fails, + * get the "extended" error code and return. Be sure to deallocate the font if + * necessary. + */ if (retval == FALSE) { DWORD val = GetLastError(); char intstr[12+1]; sprintf (intstr, "%ld", val ); - Tcl_AppendResult (interp, "gdi character failed with code ", intstr, NULL); + Tcl_AppendResult (interp, "::tk::print::_gdi character failed with code ", intstr, NULL); if ( made_font ) { SelectObject(hDC, oldfont); @@ -1550,38 +1576,44 @@ static int GdiCharWidths( for (i = 0; i < 255; i++ ) { - /* May need to convert the widths here(?) */ + /* May need to convert the widths here(?). */ sprintf(numbuf, "%d", widths[i]); ind[0] = i; Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); } } - /* Now, remove the font if we created it only for this function */ + /* Now, remove the font if we created it only for this function. */ if ( made_font ) { SelectObject(hDC, oldfont); DeleteObject(hfont); } - /* The return value should be the array name(?) */ + /* The return value should be the array name(?). */ Tcl_AppendResult(interp, (char *)aryvarname, NULL); return TCL_OK; } /* -* Text command -* Q: Add -clip/-noclip? Add -single? -* Q: To match canvas semantics, this should respect newlines, -* and treat no width supplied (width of 0) to output as -* a single line EXCEPT that it respects newlines. -*/ + *---------------------------------------------------------------------- + * + * GdiText -- + * + * Maps text to GDI context. + * + * Results: + * Renders text. + * + *---------------------------------------------------------------------- + */ + int GdiText( TCL_UNUSED(void *), Tcl_Interp *interp, int argc, const char **argv) { - static const char usage_message[] = "gdi text hdc x y -anchor [center|n|e|s|w] " + static const char usage_message[] = "::tk::print::_gdi text hdc x y -anchor [center|n|e|s|w] " "-fill color -font fontname " "-justify [left|right|center] " "-stipple bitmap -text string -width linelen " @@ -1592,7 +1624,7 @@ int GdiText( int x, y; const char *string = 0; RECT sizerect; - UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas */ + UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas. */ Tk_Anchor anchor = 0; LOGFONT lf; HFONT hfont, oldfont; @@ -1600,7 +1632,7 @@ int GdiText( int retval; int dotextcolor=0; int dobgmode=0; - int dounicodeoutput=0; /* If non-zero, output will be drawn in Unicode */ + int dounicodeoutput=0; /* If non-zero, output will be drawn in Unicode. */ int bgmode; COLORREF textcolor = 0; int usesingle = 0; @@ -1615,9 +1647,9 @@ int GdiText( if ( argc >= 4 ) { - /* Parse the command */ + /* Parse the command. */ hDC = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (hDC == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); @@ -1678,13 +1710,13 @@ int GdiText( { argc--; argv++; - /* Not implemented yet */ + /* Not implemented yet. */ } else if ( strcmp(argv[0], "-fill") == 0 ) { argc--; argv++; - /* Get text color */ + /* Get text color. */ if ( GdiGetColor(argv[0], &textcolor) ) dotextcolor = 1; } @@ -1694,7 +1726,7 @@ int GdiText( argv++; if ( argc > 0 ) sizerect.right += atol(argv[0]); - /* If a width is specified, break at words. */ + /* If a width is specified, break at words.. */ format_flags |= DT_WORDBREAK; } else if ( strcmp(argv[0], "-single") == 0 ) @@ -1706,7 +1738,7 @@ int GdiText( else if ( strcmp(argv[0], "-unicode") == 0 ) { dounicodeoutput = 1; - /* Set the encoding name to utf-8, but can be overridden */ + /* Set the encoding name to utf-8, but can be overridden. */ if ( encoding_name == 0 ) encoding_name = "utf-8"; } @@ -1723,7 +1755,7 @@ int GdiText( } #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - /* Handle the encoding, if present */ + /* Handle the encoding, if present. */ if ( encoding_name != 0 ) { Tcl_Encoding tmp_encoding; @@ -1739,7 +1771,7 @@ int GdiText( return TCL_ERROR; } - /* Set the format flags for -single: Overrides -width */ + /* Set the format flags for -single: Overrides -width. */ if ( usesingle == 1 ) { format_flags |= DT_SINGLELINE; @@ -1747,31 +1779,30 @@ int GdiText( format_flags &= ~DT_WORDBREAK; } - /* Calculate the rectangle */ + /* Calculate the rectangle. */ #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) Tcl_DStringInit(&tds); Tcl_UtfToExternalDString(encoding, string, -1, &tds); ostring = Tcl_DStringValue(&tds); tds_len = Tcl_DStringLength(&tds); - /* Just for fun, let's try translating ostring to unicode */ - if (dounicodeoutput) /* Convert UTF-8 to unicode */ + /* Just for fun, let's try translating ostring to Unicode. */ + if (dounicodeoutput) /* Convert UTF-8 to unicode. */ { Tcl_UniChar *ustring; Tcl_DString tds2; Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToWCharDString(ostring, tds_len, &tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); - Tcl_DStringFree(&tds2); - } - else /* Use UTF-8/local code page output */ - { + Tcl_DStringFree(&tds2); + } else /* Use UTF-8/local code page output. */ + { DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); } #else DrawText (hDC, string, -1, &sizerect, format_flags | DT_CALCRECT); #endif - /* Adjust the rectangle according to the anchor */ + /* Adjust the rectangle according to the anchor. */ x = y = 0; switch ( anchor ) { @@ -1811,7 +1842,7 @@ int GdiText( sizerect.top -= y; sizerect.bottom -= y; - /* Get the color right */ + /* Get the color right. */ if ( dotextcolor ) textcolor = SetTextColor(hDC, textcolor); @@ -1821,14 +1852,14 @@ int GdiText( bgmode = SetBkMode(hDC, TRANSPARENT); - /* Print the text */ + /* Print the text. */ #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - if (dounicodeoutput) /* Convert UTF-8 to unicode */ + if (dounicodeoutput) /* Convert UTF-8 to unicode. */ { Tcl_UniChar *ustring; Tcl_DString tds2; Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToWCharDString(ostring, tds_len, &tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); Tcl_DStringFree(&tds2); } @@ -1841,7 +1872,7 @@ int GdiText( retval = DrawText (hDC, string, -1, &sizerect, format_flags); #endif - /* Get the color set back */ + /* Get the color set back. */ if ( dotextcolor ) textcolor = SetTextColor(hDC, textcolor); @@ -1853,7 +1884,7 @@ int GdiText( DeleteObject(hfont); } - /* In this case, the return value is the height of the text */ + /* In this case, the return value is the height of the text. */ sprintf(msgbuf, "%d", retval); Tcl_AppendResult(interp, msgbuf, NULL); @@ -1865,13 +1896,21 @@ int GdiText( } /* -* GdiGetHdcInfo -* Return salient characteristics of the CTM. -* The return value is 0 if any failure occurs--in which case -* none of the other values are meaningful. -* Otherwise the return value is the current mapping mode -* (this may be VERY windows-specific). -*/ + *---------------------------------------------------------------------- + * + * GdiGetHdcInfo -- + * + * Gets salient characteristics of the CTM. + * + * Results: + * The return value is 0 if any failure occurs--in which case + * none of the other values are meaningful. + * Otherwise the return value is the current mapping mode. + + * + *---------------------------------------------------------------------- + */ + static int GdiGetHdcInfo( HDC hdc, LPPOINT worigin, LPSIZE wextent, LPPOINT vorigin, LPSIZE vextent) @@ -1916,9 +1955,21 @@ static int GdiGetHdcInfo( HDC hdc, return retval; } + /* -* Converts Windows mapping mode names to values in the .h -*/ + *---------------------------------------------------------------------- + * + * GdiNameToMode -- + * + * Converts Windows mapping mode names. + * + * Results: + * Mapping modes are delineated. + + * + *---------------------------------------------------------------------- + */ + static int GdiNameToMode(const char *name) { static struct gdimodes { @@ -1945,8 +1996,19 @@ static int GdiNameToMode(const char *name) } /* -* Mode to Name converts the mode number to a printable form -*/ + *---------------------------------------------------------------------- + * + * GdiNameToMode -- + * + * Converts the mode number to a printable form. + * + * Results: + * Mapping numbers are delineated. + + * + *---------------------------------------------------------------------- + */ + static const char *GdiModeToName(int mode) { static struct gdi_modes { @@ -1973,32 +2035,38 @@ static const char *GdiModeToName(int mode) } /* -* GdiMap - -* Set mapping mode between logical and physical device space -* Syntax for this is intended to be more-or-less independent of -* Windows/Mac/X--that is, equally difficult to use with each. -* Alternative: -* Possibly this could be a feature of the HDC extension itself? -*/ + *---------------------------------------------------------------------- + * + * GdiMap -- + * + * Sets mapping mode between logical and physical device space. + * + * Results: + * Bridges map modes. + + * + *---------------------------------------------------------------------- + */ + static int GdiMap( TCL_UNUSED(void *), Tcl_Interp *interp, int argc, const char **argv) { - static const char usage_message[] = "gdi map hdc " + static const char usage_message[] = "::tk::print::_gdi map hdc " "[-logical x[y]] [-physical x[y]] " "[-offset {x y} ] [-default] [-mode mode]" ; HDC hdc; - int mapmode; /* Mapping mode */ - SIZE wextent; /* Device extent */ - SIZE vextent; /* Viewport extent */ - POINT worigin; /* Device origin */ - POINT vorigin; /* Viewport origin */ + int mapmode; /* Mapping mode. */ + SIZE wextent; /* Device extent. */ + SIZE vextent; /* Viewport extent. */ + POINT worigin; /* Device origin. */ + POINT vorigin; /* Viewport origin. */ int argno; - /* Keep track of what parts of the function need to be executed */ + /* Keep track of what parts of the function need to be executed. */ int need_usage = 0; int use_logical = 0; int use_physical = 0; @@ -2006,11 +2074,11 @@ static int GdiMap( int use_default = 0; int use_mode = 0; - /* Required parameter: HDC for printer */ + /* Required parameter: HDC for printer. */ if ( argc >= 1 ) { hdc = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (hdc == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); @@ -2019,12 +2087,12 @@ static int GdiMap( if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) { - /* Failed! */ + /* Failed!. */ Tcl_AppendResult(interp, "Cannot get current HDC info", NULL); return TCL_ERROR; } - /* Parse remaining arguments */ + /* Parse remaining arguments. */ for (argno = 1; argno < argc; argno++) { if ( strcmp(argv[argno], "-default") == 0 ) @@ -2051,7 +2119,7 @@ static int GdiMap( need_usage = 1; else { - /* It would be nice if this parsed units as well... */ + /* It would be nice if this parsed units as well.... */ if ( sscanf(argv[argno+1], "%ld%ld", &vorigin.x, &vorigin.y) == 2 ) use_offset = 1; else @@ -2067,14 +2135,14 @@ static int GdiMap( { int count; argno++; - /* In "real-life", this should parse units as well. */ + /* In "real-life", this should parse units as well.. */ if ( (count = sscanf(argv[argno], "%ld%ld", &wextent.cx, &wextent.cy)) != 2 ) { if ( count == 1 ) { mapmode = MM_ISOTROPIC; use_logical = 1; - wextent.cy = wextent.cx; /* Make them the same */ + wextent.cy = wextent.cx; /* Make them the same. */ } else need_usage = 1; @@ -2095,14 +2163,14 @@ static int GdiMap( int count; argno++; - /* In "real-life", this should parse units as well. */ + /* In "real-life", this should parse units as well.. */ if ( (count = sscanf(argv[argno], "%ld%ld", &vextent.cx, &vextent.cy)) != 2 ) { if ( count == 1 ) { mapmode = MM_ISOTROPIC; use_physical = 1; - vextent.cy = vextent.cx; /* Make them the same */ + vextent.cy = vextent.cx; /* Make them the same. */ } else need_usage = 1; @@ -2116,7 +2184,7 @@ static int GdiMap( } } - /* Check for any impossible combinations */ + /* Check for any impossible combinations. */ if ( use_logical != use_physical ) need_usage = 1; if ( use_default && (use_logical || use_offset || use_mode ) ) @@ -2128,8 +2196,8 @@ static int GdiMap( if ( need_usage == 0 ) { - /* Call Windows CTM functions */ - if ( use_logical || use_default || use_mode ) /* Don't call for offset only */ + /* Call Windows CTM functions. */ + if ( use_logical || use_default || use_mode ) /* Don't call for offset only. */ { SetMapMode(hdc, mapmode); } @@ -2141,20 +2209,23 @@ static int GdiMap( SetWindowOrgEx (hdc, worigin.x, worigin.y, &oldorg); } - if ( use_logical ) /* Same as use_physical */ + if ( use_logical ) /* Same as use_physical. */ { SIZE oldsiz; SetWindowExtEx (hdc, wextent.cx, wextent.cy, &oldsiz); SetViewportExtEx (hdc, vextent.cx, vextent.cy, &oldsiz); } - /* Since we may not have set up every parameter, get them again for - * the report: - */ + /* + * Since we may not have set up every parameter, get them again for + * the report. + */ mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent); - /* Output current CTM info */ - /* Note: This should really be in terms that can be used in a gdi map command! */ + /* + * Output current CTM info. + * Note: This should really be in terms that can be used in a ::tk::print::_gdi map command! + */ sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " "Origin: \"(%ld, %ld)\" " "MappingMode: \"%s\"", @@ -2171,8 +2242,19 @@ static int GdiMap( } /* -* GdiCopyBits -*/ + *---------------------------------------------------------------------- + * + * GdiCopyBits -- + * + * Copies window bits from source to destination. + * + * Results: + * Copies window bits. + + * + *---------------------------------------------------------------------- + */ + static int GdiCopyBits ( TCL_UNUSED(void *), Tcl_Interp *interp, @@ -2180,13 +2262,13 @@ static int GdiCopyBits ( const char **argv) { /* Goal: get the Tk_Window from the top-level - convert it to an HWND - get the HDC - Do a bitblt to the given hdc - Use an optional parameter to point to an arbitrary window instead of the main - Use optional parameters to map to the width and height required for the dest. + * convert it to an HWND + * get the HDC + * Do a bitblt to the given hdc + * Use an optional parameter to point to an arbitrary window instead of the main + * Use optional parameters to map to the width and height required for the dest. */ - static const char usage_message[] = "gdi copybits hdc [-window w|-screen] [-client] " + static const char usage_message[] = "::tk::print::_gdi copybits hdc [-window w|-screen] [-client] " "[-source \"a b c d\"] " "[-destination \"a b c d\"] [-scale number] [-calc]"; @@ -2197,7 +2279,7 @@ static int GdiCopyBits ( HDC dst; HWND wnd = 0; - HANDLE hDib; /* handle for device-independent bitmap */ + HANDLE hDib; /* Handle for device-independent bitmap. */ LPBITMAPINFOHEADER lpDIBHdr; LPSTR lpBits; enum PrintType wintype = PTWindow; @@ -2206,13 +2288,13 @@ static int GdiCopyBits ( char *strend; long errcode; - /* Variables to remember what we saw in the arguments */ + /* Variables to remember what we saw in the arguments. */ int do_window=0; int do_screen=0; int do_scale=0; int do_print=1; - /* Variables to remember the values in the arguments */ + /* Variables to remember the values in the arguments. */ const char *window_spec; double scale=1.0; int src_x=0, src_y=0, src_w=0, src_h=0; @@ -2220,11 +2302,11 @@ static int GdiCopyBits ( int is_toplevel = 0; /* - * The following steps are peculiar to the top level window. - * There is likely a clever way to do the mapping of a - * widget pathname to the proper window, to support the idea of - * using a parameter for this purpose. - */ + * The following steps are peculiar to the top level window. + * There is likely a clever way to do the mapping of a + * widget pathname to the proper window, to support the idea of + * using a parameter for this purpose. + */ if ( (workwin = mainWin = Tk_MainWindow(interp)) == 0 ) { Tcl_AppendResult(interp, "Can't find main Tk window", NULL); @@ -2234,7 +2316,7 @@ static int GdiCopyBits ( /* * Parse the arguments. */ - /* HDC is required */ + /* HDC is required. */ if ( argc < 1 ) { Tcl_AppendResult(interp, usage_message, NULL); @@ -2243,7 +2325,7 @@ static int GdiCopyBits ( dst = get_dc(interp, argv[0]); - /* Check hDC */ + /* Check hDC. */ if (dst == (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for BitBlt destination", NULL); @@ -2251,17 +2333,17 @@ static int GdiCopyBits ( } /* - * Next, check to see if 'dst' can support BitBlt. - * If not, raise an error - */ + * Next, check to see if 'dst' can support BitBlt. + * If not, raise an error. + */ if ( ( GetDeviceCaps (dst, RASTERCAPS) & RC_BITBLT ) == 0 ) { - sprintf(msgbuf, "Can't do bitmap operations on device context (0x%lx)", dst); + printf(msgbuf, "Can't do bitmap operations on device context\n"); Tcl_AppendResult(interp, msgbuf, NULL); return TCL_ERROR; } - /* Loop through the remaining arguments */ + /* Loop through the remaining arguments. */ { int k; for (k=1; kbiSize + DIBNumColors(lpDIBHdr) * sizeof(RGBQUAD); - /* stretch the DIBbitmap directly in the target device */ + /* stretch the DIBbitmap directly in the target device. */ if (StretchDIBits(dst, dst_x, dst_y, dst_w, dst_h, @@ -2543,16 +2626,17 @@ static int GdiCopyBits ( return TCL_ERROR; } - /* free allocated memory */ + /* free allocated memory. */ GlobalUnlock(hDib); GlobalFree(hDib); } ReleaseDC(wnd,src); - /* The return value should relate to the size in the destination space. - * At least the height should be returned (for page layout purposes) - */ + /* + * The return value should relate to the size in the destination space. + * At least the height should be returned (for page layout purposes). + */ sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); Tcl_AppendResult(interp, msgbuf, NULL); @@ -2560,29 +2644,44 @@ static int GdiCopyBits ( } /* -* Computes the number of colors required for a DIB palette -*/ + *---------------------------------------------------------------------- + * + * DIBNumColors -- + * + * Computes the number of colors required for a DIB palette. + * + * Results: + * Returns number of colors. + + * + *---------------------------------------------------------------------- + */ + static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) { - WORD wBitCount; // DIB bit count + WORD wBitCount; /* DIB bit count. */ DWORD dwClrUsed; - // If this is a Windows-style DIB, the number of colors in the - // color table can be less than the number of bits per pixel - // allows for (i.e. lpbi->biClrUsed can be set to some value). - // If this is the case, return the appropriate value. + /* + * If this is a Windows-style DIB, the number of colors in the + * color table can be less than the number of bits per pixel. + * allows for (i.e. lpbi->biClrUsed can be set to some value). + * If this is the case, return the appropriate value.. + */ dwClrUsed = (lpDIB)->biClrUsed; if (dwClrUsed) return (WORD)dwClrUsed; - // Calculate the number of colors in the color table based on - // the number of bits per pixel for the DIB. + /* + * Calculate the number of colors in the color table based on. + * The number of bits per pixel for the DIB. + */ wBitCount = (lpDIB)->biBitCount; - // return number of colors based on bits per pixel + /* Return number of colors based on bits per pixel. */ switch (wBitCount) { @@ -2603,14 +2702,29 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) /* * Helper functions */ -static int GdiWordToWeight(const char *str); -static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs); + /* * ParseFontWords converts various keywords to modifyers of a * font specification. -* For all words, later occurances override earlier occurances. +* For all words, later occurrences override earlier occurrences. * Overstrike and underline cannot be "undone" by other words */ + +/* + *---------------------------------------------------------------------- + * + * GdiParseFontWords -- + * + * Converts various keywords to modifiers of a font specification. + * For all words, later occurrences override earlier occurrences. + * Overstrike and underline cannot be "undone" by other words + * + * Results: + * Keywords converted to modifiers. + * + *---------------------------------------------------------------------- + */ + static int GdiParseFontWords( TCL_UNUSED(Tcl_Interp *), LOGFONT *lf, @@ -2618,7 +2732,7 @@ static int GdiParseFontWords( int numargs) { int i; - int retval = 0; /* Number of words that could not be parsed */ + int retval = 0; /* Number of words that could not be parsed. */ for (i=0; ilfWeight = FW_NORMAL; lf->lfCharSet = DEFAULT_CHARSET; @@ -2707,11 +2837,11 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC lf->lfQuality = DEFAULT_QUALITY; lf->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; - /* The cast to (char *) is silly, based on prototype of Tcl_SplitList */ + /* The cast to (char *) is silly, based on prototype of Tcl_SplitList. */ if ( Tcl_SplitList(interp, str, &count, &list) != TCL_OK ) return 0; - /* Now we have the font structure broken into name, size, weight */ + /* Now we have the font structure broken into name, size, weight. */ if ( count >= 1 ) strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); else @@ -2723,13 +2853,14 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC char *strend; siz = strtol(list[1], &strend, 0); - /* Assumptions: - * 1) Like canvas, if a positive number is specified, it's in points - * 2) Like canvas, if a negative number is specified, it's in pixels - */ - if ( strend > list[1] ) /* If it looks like a number, it is a number... */ + /* + * Assumptions: + * 1) Like canvas, if a positive number is specified, it's in points. + * 2) Like canvas, if a negative number is specified, it's in pixels. + */ + if ( strend > list[1] ) /* If it looks like a number, it is a number.... */ { - if ( siz > 0 ) /* Size is in points */ + if ( siz > 0 ) /* Size is in points. */ { SIZE wextent, vextent; POINT worigin, vorigin; @@ -2753,7 +2884,7 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); } else - lf->lfHeight = -siz; /* This is bad news... */ + lf->lfHeight = -siz; /* This is bad news.... */ break; case MM_ANISOTROPIC: if ( vextent.cy != 0 ) @@ -2764,11 +2895,11 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); } else - lf->lfHeight = -siz; /* This is bad news... */ + lf->lfHeight = -siz; /* This is bad news.... */ break; case MM_TEXT: default: - /* If mapping mode is MM_TEXT, use the documented formula */ + /* If mapping mode is MM_TEXT, use the documented formula. */ lf->lfHeight = -MulDiv(siz, GetDeviceCaps(hDC, LOGPIXELSY), 72); break; case MM_HIENGLISH: @@ -2788,11 +2919,11 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC break; } } - else if ( siz == 0 ) /* Use default size of 12 points */ + else if ( siz == 0 ) /* Use default size of 12 points. */ lf->lfHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72); - else /* Use pixel size */ + else /* Use pixel size. */ { - lf->lfHeight = siz; /* Leave this negative */ + lf->lfHeight = siz; /* Leave this negative. */ } } else @@ -2807,43 +2938,56 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC } /* -* This command creates a logical pen based on input -* parameters and selects it into the HDC -*/ -/* The LOGPEN structure takes the following dash options: - * PS_SOLID: a solid pen - * PS_DASH: a dashed pen - * PS_DOT: a dotted pen - * PS_DASHDOT: a pen with a dash followed by a dot - * PS_DASHDOTDOT: a pen with a dash followed by 2 dots + *---------------------------------------------------------------------- * - * It seems that converting to ExtCreatePen may be more advantageous, as it matches - * the Tk canvas pens much better--but not for Win95, which does not support PS_USERSTYLE - * An explicit test (or storage in a static after first failure) may suffice for working - * around this. The ExtCreatePen is not supported at all under Win32s. -*/ + * GdiMakePen -- + * + * Creates a logical pen based on input parameters and selects it into the hDC. + * + * Results: + * Sets rendering pen. + * + *---------------------------------------------------------------------- + */ + static int GdiMakePen( Tcl_Interp *interp, int width, int dashstyle, const char *dashstyledata, - TCL_UNUSED(int), /* Ignored for now */ - TCL_UNUSED(int), /* Ignored for now */ + TCL_UNUSED(int), /* Ignored for now. */ + TCL_UNUSED(int), /* Ignored for now. */ TCL_UNUSED(int), - TCL_UNUSED(const char *), /* Ignored for now */ + TCL_UNUSED(const char *), /* Ignored for now. */ unsigned long color, HDC hDC, HGDIOBJ *oldPen) { + +/* + * The LOGPEN structure takes the following dash options: + * PS_SOLID: a solid pen + * PS_DASH: a dashed pen + * PS_DOT: a dotted pen + * PS_DASHDOT: a pen with a dash followed by a dot + * PS_DASHDOTDOT: a pen with a dash followed by 2 dots + * + * It seems that converting to ExtCreatePen may be more advantageous, as it matches + * the Tk canvas pens much better--but not for Win95, which does not support PS_USERSTYLE + * An explicit test (or storage in a static after first failure) may suffice for working + * around this. The ExtCreatePen is not supported at all under Win32. +*/ + HPEN hPen; LOGBRUSH lBrush; DWORD pStyle = PS_SOLID; /* -dash should override*/ - DWORD endStyle = PS_ENDCAP_ROUND; /* -capstyle should override */ - DWORD joinStyle = PS_JOIN_ROUND; /* -joinstyle should override */ + DWORD endStyle = PS_ENDCAP_ROUND; /* -capstyle should override. */ + DWORD joinStyle = PS_JOIN_ROUND; /* -joinstyle should override. */ DWORD styleCount = 0; DWORD *styleArray = 0; - /* To limit the propagation of allocated memory, the dashes will have a maximum here. + /* + * To limit the propagation of allocated memory, the dashes will have a maximum here. * If one wishes to remove the static allocation, please be sure to update GdiFreePen * and ensure that the array is NOT freed if the LOGPEN option is used. */ @@ -2855,10 +2999,10 @@ static int GdiMakePen( char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); if (dup) strcpy(dup, dashstyledata); - /* DEBUG */ + /* DEBUG. */ Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", dashstyledata, "|\n", NULL); - /* Parse the dash spec */ + /* Parse the dash spec. */ if ( isdigit(dashstyledata[0]) ) { cp = strtok(dup, " \t,;"); for ( i = 0; cp && i < sizeof(pStyleData) / sizeof (DWORD); i++ ) { @@ -2899,28 +3043,28 @@ static int GdiMakePen( if ( dashstyle != 0 ) pStyle = PS_USERSTYLE; - /* -stipple could affect this... */ + /* -stipple could affect this.... */ lBrush.lbStyle = BS_SOLID; lBrush.lbColor = color; lBrush.lbHatch = 0; - /* We only use geometric pens, even for 1-pixel drawing */ + /* We only use geometric pens, even for 1-pixel drawing. */ hPen = ExtCreatePen ( PS_GEOMETRIC|pStyle|endStyle|joinStyle, width, &lBrush, styleCount, styleArray); - if ( hPen == 0 ) { /* Failed for some reason...Fall back on CreatePenIndirect */ + if ( hPen == 0 ) { /* Failed for some reason...Fall back on CreatePenIndirect. */ LOGPEN lf; lf.lopnWidth.x = width; - lf.lopnWidth.y = 0; /* Unused in LOGPEN */ + lf.lopnWidth.y = 0; /* Unused in LOGPEN. */ if ( dashstyle == 0 ) - lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future */ + lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future. */ else - lf.lopnStyle = PS_DASH; /* REALLLLY simple for now */ - lf.lopnColor = color; /* Assume we're getting a COLORREF */ - /* Now we have a logical pen. Create the "real" pen and put it in the hDC */ + lf.lopnStyle = PS_DASH; /* REALLLLY simple for now. */ + lf.lopnColor = color; /* Assume we're getting a COLORREF. */ + /* Now we have a logical pen. Create the "real" pen and put it in the hDC. */ hPen = CreatePenIndirect(&lf); } @@ -2929,8 +3073,18 @@ static int GdiMakePen( } /* -* FreePen wraps the protocol to delete a created pen -*/ + *---------------------------------------------------------------------- + * + * GdiFreePen -- + * + * Wraps the protocol to delete a created pen. + * + * Results: + * Deletes pen. + * + *---------------------------------------------------------------------- + */ + static int GdiFreePen( TCL_UNUSED(Tcl_Interp *), HDC hDC, @@ -2942,10 +3096,21 @@ static int GdiFreePen( return 1; } + /* -* MakeBrush creates a logical brush based on input parameters, -* creates it, and selects it into the hdc. -*/ + *---------------------------------------------------------------------- + * + * GdiMakeBrush-- + * + * Creates a logical brush based on input parameters, + * and selects it into the hdc. + * + * Results: + * Creates brush. + * + *---------------------------------------------------------------------- + */ + static int GdiMakeBrush( TCL_UNUSED(Tcl_Interp *), TCL_UNUSED(unsigned int), @@ -2956,18 +3121,27 @@ static int GdiMakeBrush( HGDIOBJ *oldBrush) { HBRUSH hBrush; - lb->lbStyle = BS_SOLID; /* Support other styles later */ - lb->lbColor = color; /* Assume this is a COLORREF */ - lb->lbHatch = hatch; /* Ignored for now, given BS_SOLID in the Style */ - /* Now we have the logical brush. Create the "real" brush and put it in the hDC */ + lb->lbStyle = BS_SOLID; /* Support other styles later. */ + lb->lbColor = color; /* Assume this is a COLORREF. */ + lb->lbHatch = hatch; /* Ignored for now, given BS_SOLID in the Style. */ + /* Now we have the logical brush. Create the "real" brush and put it in the hDC. */ hBrush = CreateBrushIndirect(lb); *oldBrush = SelectObject(hDC, hBrush); return 1; } /* -* FreeBrush wraps the protocol to delete a created brush -*/ + *---------------------------------------------------------------------- + * + * GdiFreeBrush -- + * + * Wraps the protocol to delete a created brush. + * + * Results: + * Deletes brush. + * + *---------------------------------------------------------------------- + */ static int GdiFreeBrush( TCL_UNUSED(Tcl_Interp *), HDC hDC, @@ -2980,11 +3154,11 @@ static int GdiFreeBrush( } /* -* Copied functions from elsewhere in Tcl. -* Functions have removed reliance on X and Tk libraries, -* as well as removing the need for TkWindows. -* GdiGetColor is a copy of a TkpGetColor from tkWinColor.c -* GdiParseColor is a copy of XParseColor from xcolors.c + * Utility functions from elsewhere in Tcl. + * Functions have removed reliance on X and Tk libraries, + * as well as removing the need for TkWindows. + * GdiGetColor is a copy of a TkpGetColor from tkWinColor.c +* GdiParseColor is a copy of XParseColor from xcolors.c */ typedef struct { const char *name; @@ -3774,8 +3948,18 @@ static const XColorEntry xColors[] = { static int numxcolors=0; /* -* Convert color name to color specification -*/ + *---------------------------------------------------------------------- + * + * GdiGetColor -- + * + * Convert color name to color specification. + * + * Results: + * Color name converted. + * + *---------------------------------------------------------------------- + */ + static int GdiGetColor(const char *name, unsigned long *color) { if ( numsyscolors == 0 ) @@ -3797,7 +3981,7 @@ static int GdiGetColor(const char *name, unsigned long *color) } if ( l > u ) return 0; - *color = GetSysColor(sysColors[i].index); + *color = GetSysColor(sysColors[i].index); return 1; } else @@ -3805,9 +3989,20 @@ static int GdiGetColor(const char *name, unsigned long *color) } /* -* Convert color specification string (which could be an RGB string) -* to a color RGB triple -*/ + *---------------------------------------------------------------------- + * + * GdiParseColor -- + * + * Convert color specification string (which could be an RGB string) + * to a color RGB triple. + * + * Results: + * Color specification converted. + * + *---------------------------------------------------------------------- + */ + + static int GdiParseColor (const char *name, unsigned long *color) { if ( name[0] == '#' ) @@ -3823,7 +4018,7 @@ static int GdiParseColor (const char *name, unsigned long *color) if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { return 0; } - /* Now this is windows specific -- each component is at most 8 bits */ + /* Now this is Windows-specific -- each component is at most 8 bits. */ switch ( i ) { case 1: @@ -3844,7 +4039,7 @@ static int GdiParseColor (const char *name, unsigned long *color) blue >>= 8; break; } - *color = RGB(red, green, blue); + *color = RGB(red, green, blue); return 1; } else @@ -3867,21 +4062,31 @@ static int GdiParseColor (const char *name, unsigned long *color) } if ( l > u ) return 0; - *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); + *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); return 1; } } /* -* Beginning of functions for screen-to-dib translations -* Several of these functions are based on those in the WINCAP32 -* program provided as a sample by Microsoft on the VC++ 5.0 -* disk. The copyright on these functions is retained, even for -* those with significant changes. -* I do not understand the meaning of this copyright in this -* context, since the example is present to provide insight into -* the rather baroque mechanism used to manipulate DIBs. -*/ + * Beginning of functions for screen-to-dib translations. + * Several of these functions are based on those in the WINCAP32 + * program provided as a sample by Microsoft on the VC++ 5.0 + * disk. The copyright on these functions is retained, even for + * those with significant changes. + */ + +/* + *---------------------------------------------------------------------- + * + * CopyToDIB -- + * + * Copy window bits to a DIB. + * + * Results: + * Color specification converted. + * + *---------------------------------------------------------------------- + */ static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) { @@ -3889,39 +4094,40 @@ static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) HBITMAP hBitmap; HPALETTE hPalette; - /* check for a valid window handle */ + /* Check for a valid window handle. */ if (!hWnd) return NULL; switch (type) { - case PTWindow: /* copy entire window */ + case PTWindow: /* Copy entire window. */ { RECT rectWnd; - /* get the window rectangle */ + /* Get the window rectangle. */ GetWindowRect(hWnd, &rectWnd); - /* get the DIB of the window by calling - * CopyScreenToDIB and passing it the window rect - */ + /* + * Get the DIB of the window by calling + * CopyScreenToDIB and passing it the window rect. + */ hDIB = CopyScreenToDIB(&rectWnd); break; } - case PTClient: /* copy client area */ + case PTClient: /* Copy client area. */ { RECT rectClient; POINT pt1, pt2; - /* get the client area dimensions */ + /* Get the client area dimensions. */ GetClientRect(hWnd, &rectClient); - /* convert client coords to screen coords */ + /* Convert client coords to screen coords. */ pt1.x = rectClient.left; pt1.y = rectClient.top; @@ -3934,59 +4140,71 @@ static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) rectClient.right = pt2.x; rectClient.bottom = pt2.y; - /* get the DIB of the client area by calling - * CopyScreenToDIB and passing it the client rect - */ + /* + * Get the DIB of the client area by calling + * CopyScreenToDIB and passing it the client rect. + */ hDIB = CopyScreenToDIB(&rectClient); break; } - case PTScreen: /* Entire screen */ + case PTScreen: /* Entire screen. */ { RECT Rect; - /* get the device-dependent bitmap in lpRect by calling - * CopyScreenToBitmap and passing it the rectangle to grab - */ + /* + * Get the device-dependent bitmap in lpRect by calling + * CopyScreenToBitmap and passing it the rectangle to grab. + */ Rect.top = Rect.left = 0; GetDisplaySize(&Rect.right, &Rect.bottom); hBitmap = CopyScreenToBitmap(&Rect); - /* check for a valid bitmap handle */ + /* Check for a valid bitmap handle. */ if (!hBitmap) return NULL; - /* get the current palette */ + /* Get the current palette. */ hPalette = GetSystemPalette(); - /* convert the bitmap to a DIB */ + /* Convert the bitmap to a DIB. */ hDIB = BitmapToDIB(hBitmap, hPalette); - /* clean up */ + /* Clean up. */ DeleteObject(hPalette); DeleteObject(hBitmap); - /* return handle to the packed-DIB */ + /* Return handle to the packed-DIB. */ } break; - default: /* invalid print area */ + default: /* Invalid print area. */ return NULL; } - /* return the handle to the DIB */ + /* Return the handle to the DIB. */ return hDIB; } /* -* GetDisplaySize does just that. -* There may be an easier way, but I just haven't found it. -*/ + *---------------------------------------------------------------------- + * + * GetDisplaySize-- + * + * GetDisplaySize does just that. There may be an easier way, but it is not apparent. + * + * Results: + * Returns display size. + * + *---------------------------------------------------------------------- + */ + + static void GetDisplaySize (LONG *width, LONG *height) { HDC hDC; @@ -3998,39 +4216,53 @@ static void GetDisplaySize (LONG *width, LONG *height) } +/* + *---------------------------------------------------------------------- + * + * CopyScreenToBitmap-- + * + * Copies screen to bitmap. + * + * Results: + * Screen is copied. + * + *---------------------------------------------------------------------- + */ + static HBITMAP CopyScreenToBitmap(LPRECT lpRect) { - HDC hScrDC, hMemDC; /* screen DC and memory DC */ - HBITMAP hBitmap, hOldBitmap; /* handles to deice-dependent bitmaps */ - int nX, nY, nX2, nY2; /* coordinates of rectangle to grab */ + HDC hScrDC, hMemDC; /* Screen DC and memory DC. */ + HBITMAP hBitmap, hOldBitmap; /* Handles to deice-dependent bitmaps. */ + int nX, nY, nX2, nY2; /* Coordinates of rectangle to grab. */ int nWidth, nHeight; /* DIB width and height */ - int xScrn, yScrn; /* screen resolution */ + int xScrn, yScrn; /* Screen resolution. */ - /* check for an empty rectangle */ + /* Check for an empty rectangle. */ if (IsRectEmpty(lpRect)) return NULL; - /* create a DC for the screen and create - * a memory DC compatible to screen DC - */ + /* + * Create a DC for the screen and create + * a memory DC compatible to screen DC. + */ hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL); hMemDC = CreateCompatibleDC(hScrDC); - /* get points of rectangle to grab */ + /* Get points of rectangle to grab. */ nX = lpRect->left; nY = lpRect->top; nX2 = lpRect->right; nY2 = lpRect->bottom; - /* get screen resolution */ + /* Get screen resolution. */ xScrn = GetDeviceCaps(hScrDC, HORZRES); yScrn = GetDeviceCaps(hScrDC, VERTRES); - /* make sure bitmap rectangle is visible */ + /* Make sure bitmap rectangle is visible. */ if (nX < 0) nX = 0; @@ -4044,32 +4276,45 @@ static HBITMAP CopyScreenToBitmap(LPRECT lpRect) nWidth = nX2 - nX; nHeight = nY2 - nY; - /* create a bitmap compatible with the screen DC */ + /* Create a bitmap compatible with the screen DC. */ hBitmap = CreateCompatibleBitmap(hScrDC, nWidth, nHeight); - /* select new bitmap into memory DC */ + /* Select new bitmap into memory DC. */ hOldBitmap = SelectObject(hMemDC, hBitmap); - /* bitblt screen DC to memory DC */ + /* Bitblt screen DC to memory DC. */ BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY); - /* select old bitmap back into memory DC and get handle to - * bitmap of the screen - */ + /* + * Select old bitmap back into memory DC and get handle to + * bitmap of the screen. + */ hBitmap = SelectObject(hMemDC, hOldBitmap); - /* clean up */ + /* Clean up. */ DeleteDC(hScrDC); DeleteDC(hMemDC); - /* return handle to the bitmap */ + /* Return handle to the bitmap. */ return hBitmap; } +/* + *---------------------------------------------------------------------- + * + * BitmapToDIB-- + * + * Converts bitmap to DIB. + * + * Results: + * Bitmap converted. + * + *---------------------------------------------------------------------- + */ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) { BITMAP bm; @@ -4081,26 +4326,26 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) HDC hDC; WORD biBits; - /* check if bitmap handle is valid */ + /* Check if bitmap handle is valid. */ if (!hBitmap) return NULL; - /* fill in BITMAP structure, return NULL if it didn't work */ + /* Fill in BITMAP structure, return NULL if it didn't work. */ if (!GetObject(hBitmap, sizeof(bm), (LPSTR)&bm)) return NULL; - /* if no palette is specified, use default palette */ + /* Ff no palette is specified, use default palette. */ if (hPal == NULL) hPal = GetStockObject(DEFAULT_PALETTE); - /* calculate bits per pixel */ + /* Calculate bits per pixel. */ biBits = bm.bmPlanes * bm.bmBitsPixel; - /* make sure bits per pixel is valid */ + /* Make sure bits per pixel is valid. */ if (biBits <= 1) biBits = 1; @@ -4108,10 +4353,10 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) biBits = 4; else if (biBits <= 8) biBits = 8; - else /* if greater than 8-bit, force to 24-bit */ + else /* If greater than 8-bit, force to 24-bit. */ biBits = 24; - /* initialize BITMAPINFOHEADER */ + /* Initialize BITMAPINFOHEADER. */ bi.biSize = sizeof(BITMAPINFOHEADER); bi.biWidth = bm.bmWidth; @@ -4125,28 +4370,28 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) bi.biClrUsed = 0; bi.biClrImportant = 0; - /* calculate size of memory block required to store BITMAPINFO */ + /* Calculate size of memory block required to store BITMAPINFO. */ dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD); - /* get a DC */ + /* Get a DC. */ hDC = GetDC(NULL); - /* select and realize our palette */ + /* Select and realize our palette. */ hPal = SelectPalette(hDC, hPal, FALSE); RealizePalette(hDC); - /* alloc memory block to store our bitmap */ + /* Alloc memory block to store our bitmap. */ hDIB = GlobalAlloc(GHND, dwLen); - /* if we couldn't get memory block */ + /* If we couldn't get memory block. */ if (!hDIB) { - /* clean up and return NULL */ + /* clean up and return NULL. */ SelectPalette(hDC, hPal, TRUE); RealizePalette(hDC); @@ -4154,31 +4399,31 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) return NULL; } - /* lock memory and get pointer to it */ + /* Lock memory and get pointer to it. */ lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDIB); - /* use our bitmap info. to fill BITMAPINFOHEADER */ + /* Use our bitmap info. to fill BITMAPINFOHEADER. */ - *lpbi = bi; + *lpbi = bi; - /* call GetDIBits with a NULL lpBits param, so it will calculate the - * biSizeImage field for us - */ + /* Call GetDIBits with a NULL lpBits param, so it will calculate the + * biSizeImage field for us + */ GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, NULL, (LPBITMAPINFO)lpbi, DIB_RGB_COLORS); - /* get the info. returned by GetDIBits and unlock memory block */ + /* get the info. returned by GetDIBits and unlock memory block. */ bi = *lpbi; GlobalUnlock(hDIB); - /* if the driver did not fill in the biSizeImage field, make one up */ + /* If the driver did not fill in the biSizeImage field, make one up. */ if (bi.biSizeImage == 0) bi.biSizeImage = (((((DWORD)bm.bmWidth * biBits) + 31) / 32) * 4) * bm.bmHeight; - /* realloc the buffer big enough to hold all the bits */ + /* Realloc the buffer big enough to hold all the bits. */ dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD) + bi.biSizeImage; @@ -4186,7 +4431,7 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) hDIB = h; else { - /* clean up and return NULL */ + /* Clean up and return NULL. */ GlobalFree(hDIB); SelectPalette(hDC, hPal, TRUE); @@ -4195,19 +4440,19 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) return NULL; } - /* lock memory block and get pointer to it */ + /* Lock memory block and get pointer to it. */ lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDIB); - /* call GetDIBits with a NON-NULL lpBits param, and actualy get the - * bits this time - */ + /* Call GetDIBits with a NON-NULL lpBits param, and actualy get the + * bits this time. + */ if (GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, (LPSTR)lpbi + (WORD)lpbi->biSize + DIBNumColors(lpbi) * sizeof(RGBQUAD), (LPBITMAPINFO)lpbi, DIB_RGB_COLORS) == 0) { - /* clean up and return NULL */ + /* Clean up and return NULL. */ GlobalUnlock(hDIB); SelectPalette(hDC, hPal, TRUE); @@ -4218,99 +4463,126 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) bi = *lpbi; - /* clean up */ + /* Clean up. */ GlobalUnlock(hDIB); SelectPalette(hDC, hPal, TRUE); RealizePalette(hDC); ReleaseDC(NULL, hDC); - /* return handle to the DIB */ + /* Return handle to the DIB. */ return hDIB; } - +/* + *---------------------------------------------------------------------- + * + * CopyScreenToDIB-- + * + * Copies screen to DIB. + * + * Results: + * Screen copied. + * + *---------------------------------------------------------------------- + */ + static HANDLE CopyScreenToDIB(LPRECT lpRect) { HBITMAP hBitmap; HPALETTE hPalette; HANDLE hDIB; - /* get the device-dependent bitmap in lpRect by calling - * CopyScreenToBitmap and passing it the rectangle to grab - */ + /* + * Get the device-dependent bitmap in lpRect by calling + * CopyScreenToBitmap and passing it the rectangle to grab. + */ hBitmap = CopyScreenToBitmap(lpRect); - /* check for a valid bitmap handle */ + /* Check for a valid bitmap handle. */ if (!hBitmap) return NULL; - /* get the current palette */ + /* Get the current palette. */ hPalette = GetSystemPalette(); - /* convert the bitmap to a DIB */ + /* convert the bitmap to a DIB. */ hDIB = BitmapToDIB(hBitmap, hPalette); - /* clean up */ + /* Clean up. */ DeleteObject(hPalette); DeleteObject(hBitmap); - /* return handle to the packed-DIB */ + /* Return handle to the packed-DIB. */ return hDIB; } - +/* + *---------------------------------------------------------------------- + * + * GetSystemPalette-- + * + * Obtains the system palette. + * + * Results: + * Returns palette. + * + *---------------------------------------------------------------------- + */ + static HPALETTE GetSystemPalette(void) { - HDC hDC; // handle to a DC - static HPALETTE hPal = NULL; // handle to a palette - HANDLE hLogPal; // handle to a logical palette - LPLOGPALETTE lpLogPal; // pointer to a logical palette - int nColors; // number of colors + HDC hDC; /* Handle to a DC. */ + static HPALETTE hPal = NULL; /* Handle to a palette. */ + HANDLE hLogPal; /* Handle to a logical palette. */ + LPLOGPALETTE lpLogPal; /* Pointer to a logical palette. */ + int nColors; /* Number of colors. */ - // Find out how many palette entries we want. + /* Find out how many palette entries we want.. */ hDC = GetDC(NULL); if (!hDC) return NULL; - nColors = PalEntriesOnDevice(hDC); // Number of palette entries + nColors = PalEntriesOnDevice(hDC); /* Number of palette entries. */ - // Allocate room for the palette and lock it. + /* Allocate room for the palette and lock it.. */ hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + nColors * sizeof(PALETTEENTRY)); - // if we didn't get a logical palette, return NULL + /* If we didn't get a logical palette, return NULL. */ if (!hLogPal) return NULL; - // get a pointer to the logical palette + /* get a pointer to the logical palette. */ lpLogPal = (LPLOGPALETTE)GlobalLock(hLogPal); - // set some important fields + /* Set some important fields. */ lpLogPal->palVersion = 0x300; lpLogPal->palNumEntries = nColors; - // Copy the current system palette into our logical palette + /* Copy the current system palette into our logical palette. */ GetSystemPaletteEntries(hDC, 0, nColors, (LPPALETTEENTRY)(lpLogPal->palPalEntry)); - // Go ahead and create the palette. Once it's created, - // we no longer need the LOGPALETTE, so free it. + /* + * Go ahead and create the palette. Once it's created, + * we no longer need the LOGPALETTE, so free it. + */ hPal = CreatePalette(lpLogPal); - // clean up + /* Clean up. */ GlobalUnlock(hLogPal); GlobalFree(hLogPal); @@ -4319,192 +4591,41 @@ static HPALETTE GetSystemPalette(void) return hPal; } - +/* + *---------------------------------------------------------------------- + * + * PalEntriesOnDevice-- + * + * Returns the palettes on the device. + * + * Results: + * Returns palettes. + * + *---------------------------------------------------------------------- + */ + static int PalEntriesOnDevice(HDC hDC) { return (1 << (GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES))); } -/* -* This is the version information/command -* The static data should also be used by pkg_provide, etc. -*/ -/* Version information */ -static const char version_string[] = "0.9.9.15"; - -/* Version command */ -static int Version( - TCL_UNUSED(void *), - Tcl_Interp *interp, - TCL_UNUSED(int), - TCL_UNUSED(const char **)) -{ - Tcl_AppendResult(interp, version_string, NULL); - return TCL_OK; -} - -/* -* Initialization procedures -* These are the only public procedures in the file. -* These are OS independent -*/ -/* Initialization Procedures */ +/* Initialization procedures. */ int Gdi_Init(Tcl_Interp *interp) { -#if TCL_MAJOR_VERSION <= 7 - Tcl_CreateCommand(interp, "gdi", gdi, - (ClientData)0, 0); -#else - #if defined(USE_TCL_STUBS) - Tcl_InitStubs(interp, "8.6-", 0 ); - #endif - #if defined(USE_TK_STUBS) - Tk_InitStubs (interp, TK_VERSION, 0 ); - #endif - /* Wanted to use namespaces, but "unknown" isn't smart enough yet */ - /* Since this package is so full of numbers, this would be a great place - * to introduce a TclCmdObj - */ - Tcl_CreateCommand(interp, "gdi", gdi, + Tcl_CreateCommand(interp, ":tk::print::_gdi", TkWinGDI, (ClientData)0, (Tcl_CmdDeleteProc *)0); -#endif - /* Make this package work whether hdc is loaded or not */ - if ( Tcl_PkgRequire(interp, "hdc", "0.2", 0) ) - { init_hdc_functions(interp); - if ( hdc_create == 0 ) - hdc_loaded = 0; - else - hdc_loaded = 1; - } - else - hdc_loaded = 0; Tcl_PkgProvide(interp, "gdi", version_string); return TCL_OK; } -/* The gdi function is considered safe. */ -int Gdi_SafeInit(Tcl_Interp *interp) -{ - return Gdi_Init(interp); -} - -#if 0 -/* Exported symbols */ -BOOL APIENTRY DllEntryPoint (HINSTANCE hInstance, DWORD reason, LPVOID lpCmdLine) -{ - switch (reason) - { - case DLL_PROCESS_ATTACH: - break; - case DLL_THREAD_ATTACH: - break; - case DLL_PROCESS_DETACH: - /* Since GDI doesn't create DCs, just uses them, no cleanup is required */ - break; - case DLL_THREAD_DETACH: - break; - } - /* Don't do anything, so just return true */ - return TRUE; -} -#endif - -static void init_hdc_functions(Tcl_Interp *interp) -{ - void *fn[7]; - int result; - const char *cp; - Tcl_Eval(interp, "hdc FunctionVector"); - cp = Tcl_GetStringResult(interp); - /* Does cp need to be freed when I'm done? */ - result = sscanf(cp, "%lx%lx%lx%lx%lx%lx%lx", &fn[0], &fn[1], &fn[2], &fn[3], - &fn[4], &fn[5], &fn[6]); - if ( result == 7) - { - hdc_create = fn[0]; - hdc_delete = fn[1]; - hdc_get = fn[2]; - hdc_typeof = fn[3]; - hdc_prefixof = fn[4]; - hdc_list = fn[5]; - hdc_valid = fn[6]; - } -} - -static HDC get_dc(Tcl_Interp *interp, const char *name) -{ - /* ANY type of DC should be ok here */ - if ( hdc_loaded == 0 || hdc_valid == 0 || hdc_valid(interp, name, -1) == 0 ) - { - char *strend; - HGDIOBJ tmp; - - /* Perhaps it is a numeric DC */ - tmp = (HGDIOBJ)INT2PTR(strtoul(name, &strend, 0)); - if ( strend != 0 && strend > name ) - { - DWORD objtype = GetObjectType(tmp); - switch (objtype) - { - /* Any of the DC types are OK. */ - case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: - break; - /* Anything else is invalid */ - case 0: /* Function failed */ - default: - tmp = 0; - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", - "need a drawing context, got non-context address: ", name, "\n", NULL); - break; - } - return (HDC)tmp; - } - else - { - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", - "need a drawing context, got: ", name, "\n", NULL); - return 0; - } - } - - { - HDC hdc = (HDC)hdc_get(interp, name); - DWORD objtype = GetObjectType((HGDIOBJ)hdc); - switch (objtype) - { - /* Any of the DC types are OK. */ - case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: - break; - /* Anything else is invalid */ - case 0: /* Function failed */ - default: - hdc = 0; - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", - "need a drawing context, got: ", name, "\n", NULL); - break; - } - return hdc; - } -} - - - -/* -* Something new: Include 'irox@cygnus.com' text widget printer -*/ -#ifdef TEXTWIDGET_CMD -#include "tkWinPrintText.c" -#endif - /* -* The following functions are copied from tkTrig.c, since they -* are not available in the stubs library. +* The following functions are adapted from tkTrig.c. */ /* @@ -4531,13 +4652,13 @@ static HDC get_dc(Tcl_Interp *interp, const char *name) static void TkGdiBezierScreenPoints(canvas, control, numSteps, xPointPtr) Tk_Canvas canvas; /* Canvas in which curve is to be - * drawn. */ + * drawn.. */ double control[]; /* Array of coordinates for four * control points: x0, y0, x1, y1, - * ... x3 y3. */ + * ... x3 y3.. */ int numSteps; /* Number of curve points to * generate. */ - register XPoint *xPointPtr; /* Where to put new points. */ + register XPoint *xPointPtr; /* Where to put new points.. */ { int i; double u, u2, u3, t, t2, t3; @@ -4583,10 +4704,10 @@ static void TkGdiBezierPoints(control, numSteps, coordPtr) double control[]; /* Array of coordinates for four * control points: x0, y0, x1, y1, - * ... x3 y3. */ + * ... x3 y3.. */ int numSteps; /* Number of curve points to * generate. */ - register double *coordPtr; /* Where to put new points. */ + register double *coordPtr; /* Where to put new points.. */ { int i; double u, u2, u3, t, t2, t3; @@ -4604,7 +4725,7 @@ TkGdiBezierPoints(control, numSteps, coordPtr) + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; } } - + /* *-------------------------------------------------------------- * @@ -4632,39 +4753,31 @@ TkGdiBezierPoints(control, numSteps, coordPtr) */ static int TkGdiMakeBezierCurve( - Tk_Canvas canvas, /* Canvas in which curve is to be - * drawn. */ - double *pointPtr, /* Array of input coordinates: x0, - * y0, x1, y1, etc.. */ - int numPoints, /* Number of points at pointPtr. */ - int numSteps, /* Number of steps to use for each - * spline segments (determines - * smoothness of curve). */ - XPoint xPoints[], /* Array of XPoints to fill in (e.g. - * for display. NULL means don't - * fill in any XPoints. */ - double dblPoints[]) /* Array of points to fill in as - * doubles, in the form x0, y0, - * x1, y1, .... NULL means don't - * fill in anything in this form. - * Caller must make sure that this - * array has enough space. */ + Tk_Canvas canvas, /* Canvas in which curve is to be drawn.*/ + double *pointPtr, /* Array of input coordinates: x0, y0, x1, y1, etc... */ + int numPoints, /* Number of points at pointPtr.. */ + int numSteps, /* Number of steps to use for each spline segments. */ + XPoint xPoints[], /* Array of XPoints to fill in. */ + double dblPoints[]) /* Array of points to fill in as doubles, in the form x0, y0, x1, y1. */ + { int closed, outputPoints, i; int numCoords = numPoints*2; double control[8]; /* - * If the curve is a closed one then generate a special spline - * that spans the last points and the first ones. Otherwise - * just put the first point into the output. - */ + * If the curve is a closed one then generate a special spline + * that spans the last points and the first ones. Otherwise + * just put the first point into the output. + */ if (!pointPtr) { - /* Of pointPtr == NULL, this function returns an upper limit. + /* + * Of pointPtr == NULL, this function returns an upper limit. * of the array size to store the coordinates. This can be * used to allocate storage, before the actual coordinates - * are calculated. */ + * are calculated. + */ return 1 + numPoints * numSteps; } @@ -4731,7 +4844,7 @@ TkGdiMakeBezierCurve( * Set up the last two control points. This is done * differently for the last spline of an open curve * than for other cases. - */ + . */ if ((i == (numPoints-1)) && !closed) { control[4] = .667*pointPtr[2] + .333*pointPtr[4]; @@ -4750,7 +4863,7 @@ TkGdiMakeBezierCurve( * two points coincide, then generate a single * straight-line segment by outputting the last control * point. - */ + . */ if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3])) || ((pointPtr[2] == pointPtr[4]) @@ -4771,7 +4884,7 @@ TkGdiMakeBezierCurve( /* * Generate a Bezier spline using the control points. - */ + */ if (xPoints != NULL) { @@ -4787,3 +4900,13 @@ TkGdiMakeBezierCurve( return outputPoints; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ + + diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 672cdfd..bb82912 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -70,11 +70,10 @@ */ /* Version information. */ -static const char version_string[] = "3.0"; static const char usage_string[] = "Windows printing (c) Elmicron GmbH, Harald Oehlmann, 2019-01-23\n" "Preparation:\n" - " winprint getattr option: possible options:\n" + " ::tk::print::_print getattr option: possible options:\n" " printers, defaultprinter, copies, firstpage, lastpage, mapmode*,\n" " avecharheight*, avecharwidth*, horzres*, vertres*, dpi*,\n" " physicaloffsetx*, physicaloffsety*, printer, orientation, papersize,\n" @@ -84,50 +83,50 @@ static const char usage_string[] = " fontnames*: returns list of unique font names\n" " fontunicoderanges: returns list of alternating start len unicode point ints\n" " *: requires open printer\n" - " winprint pagesetup ?printer? ?Orientation? ?PaperSize? " + " ::tk::print::_print pagesetup ?printer? ?Orientation? ?PaperSize? " "?left? ?top? ?right? ?bottom?\n" " returns a list of identical parameters reflecting the users choice\n" " Margin unit is millimeter. Default values also by empty string\n" - " winprint selectprinter: select a printer\n" - " winprint printersetup ?printer? ? Orientation? ?PageSize?\n" + " ::tk::print::_print selectprinter: select a printer\n" + " ::tk::print::_print printersetup ?printer? ? Orientation? ?PageSize?\n" " Sets up the printer options and returns them.\n" " Not exposed printer settings are editable.\n" "Open printer: use one of:\n" - " winprint openjobdialog ?printer? ?Orientation? ?PaperSize? ?Maxpage?\n" - " winprint openprinter ?printer? ?Orientation? ?PaperSize?\n" + " ::tk::print::_print openjobdialog ?printer? ?Orientation? ?PaperSize? ?Maxpage?\n" + " ::tk::print::_print openprinter ?printer? ?Orientation? ?PaperSize?\n" "Get information about the print job and user selections:\n" - " winprint getattr {copies firstpage lastpage avecharheight avecharwidth" + " ::tk::print::_print getattr {copies firstpage lastpage avecharheight avecharwidth" "horzres\n" " vertres dpi physicaloffsetx physicaloffsety printer orientation " "papersize}\n" " The dpi value is used to transform from paint units (pixel) to mm:\n" - " Size/[mm] = [winprint getattr horzres]/[winprint getattr dpi]*2.54\n" + " Size/[mm] = [::tk::print::_print getattr horzres]/[::tk::print::_print getattr dpi]*2.54\n" "Start document and page\n" - " winprint opendoc jobname\n" - " winprint openpage\n" + " ::tk::print::_print opendoc jobname\n" + " ::tk::print::_print openpage\n" "Configure and select drawing tools\n" - " winprint setmapmode mapmode\n" + " ::tk::print::_print setmapmode mapmode\n" " Define the coordinate system. 'Text' is in device units origin " "top-up.\n" - " winprint pen width ?r g b?: r,g,b is 16 bit color value (internal / 256)\n" + " ::tk::print::_print pen width ?r g b?: r,g,b is 16 bit color value (internal / 256)\n" " No rgb values uses black color.\n" - " winprint brushcolor r g b: filling for rectangle\n" + " ::tk::print::_print brushcolor r g b: filling for rectangle\n" " winfo bkcolor r g b: text background\n" - " winprint fontcreate Fontnumber Fontname Points/10 ?Weight? ?Italic? " + " ::tk::print::_print fontcreate Fontnumber Fontname Points/10 ?Weight? ?Italic? " "?Charset?\n" " ?Pitch? ?Family? : use getattr font* to get possible values.\n" - " winprint fontselect Fontnumber\n" + " ::tk::print::_print fontselect Fontnumber\n" "Create printed items:\n" - " winprint ruler x0 y0 width height\n" - " winprint rectangle x0 y0 x1 y1\n" - " winprint text X0 Y0 Text ?r g b?: no rgb uses black text\n" - " winprint getfirstfontnochar Text: -1 or first index with no glyph\n" - " winprint gettextsize Text\n" - " winprint photo tkimage X0 Y0 ?Width? ?Height?\n" + " ::tk::print::_print ruler x0 y0 width height\n" + " ::tk::print::_print rectangle x0 y0 x1 y1\n" + " ::tk::print::_print text X0 Y0 Text ?r g b?: no rgb uses black text\n" + " ::tk::print::_print getfirstfontnochar Text: -1 or first index with no glyph\n" + " ::tk::print::_print gettextsize Text\n" + " ::tk::print::_print photo tkimage X0 Y0 ?Width? ?Height?\n" "Close page and printjob\n" - " winprint closepage Close a page\n" - " winprint closedoc Close the document\n" - " winprint close ?option?\n" + " ::tk::print::_print closepage Close a page\n" + " ::tk::print::_print closedoc Close the document\n" + " ::tk::print::_print close ?option?\n" " Close and cleanup the printing interface.\n" " If the option -eraseprinterstate is given, also the printer settings " "not passed\n" @@ -543,9 +542,9 @@ int __declspec(dllexport) Winprint_Init (Tcl_Interp *Interp) { return RET_ERROR; } - Tcl_CreateObjCommand(Interp, "winprint", WinPrintCmd, (ClientData)NULL, + Tcl_CreateObjCommand(Interp, "::tk::print::_print", WinPrintCmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); - Tcl_PkgProvide (Interp, "winprint", version_string); + Tcl_PkgProvide (Interp, "::tk::print::_print", version_string); return RET_OK; } @@ -585,7 +584,7 @@ int WinPrintCmd( iHelp, iSelectPrinter, iPrinterSetup, iPageSetup, iOpenjobdialog, iOpenPrinter, iClose, iClosedoc, iOpenpage, - iClosepage, iVersion, iGetattr, iSetAttr, iOpendoc, + iClosepage, iGetattr, iSetAttr, iOpendoc, iPen, iBrushColor, iBkColor, iFontselect, iGetTextSize, iRuler, iRectangle, iFontCreate, iText, iTextuni, iGetFirstFontNochar, @@ -735,9 +734,6 @@ int WinPrintCmd( case iHelp: Tcl_SetStringObj(resultPtr, usage_string,-1); break; - case iVersion: - Tcl_SetStringObj(resultPtr, version_string,-1); - break; case iSelectPrinter: Res = PrintSelectPrinter( interp ); break; @@ -3100,7 +3096,6 @@ char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText ) return Res; } - /* Paint a photo image to the printer DC */ /* @param interp tcl interpreter */ /* @param oImageName tcl object with tk imsge name */ @@ -3164,7 +3159,7 @@ char PaintPhoto( bgraPixel.ptr[IndexCur+2] = sImageBlock.pixelPtr[IndexCur+0]; bgraPixel.ptr[IndexCur+3] = sImageBlock.pixelPtr[IndexCur+3]; } - /* Use original width and height if not given */ + /* Use original width and height if not given. */ if (DestWidth == 0) { DestWidth = sImageBlock.width; } if (DestHeight == 0) { DestHeight = sImageBlock.height; } /* Use StretchDIBits with full image. */ @@ -3202,3 +3197,11 @@ char PaintPhoto( return RET_OK; } +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ + -- cgit v0.12 -- cgit v0.12 From ce86b59a3171bcce43aaeb65728730cc72200ed8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 30 Mar 2021 08:32:35 +0000 Subject: Teach wrapper functions like ::tk::endOfCluster how to handle "end-1" --- library/tk.tcl | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/library/tk.tcl b/library/tk.tcl index 5edafc2..b28cf12 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -703,6 +703,9 @@ if {[tk windowingsystem] eq "aqua"} { if {[info commands ::tk::endOfWord] eq ""} { proc ::tk::endOfWord {str start {locale {}}} { + if {$start < 0} { + set start -1 + } set start [tcl_endOfWord $str $start] if {$start < 0} { set start "" @@ -712,6 +715,11 @@ if {[info commands ::tk::endOfWord] eq ""} { } if {[info commands ::tk::startOfNextWord] eq ""} { proc ::tk::startOfNextWord {str start {locale {}}} { + if {$start < 0} { + set start -1 + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] + } set start [tcl_startOfNextWord $str $start] if {$start < 0} { set start "" @@ -721,6 +729,11 @@ if {[info commands ::tk::startOfNextWord] eq ""} { } if {[info commands ::tk::startOfPreviousWord] eq ""} { proc ::tk::startOfPreviousWord {str start {locale {}}} { + if {$start < 0} { + set start -1 + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] + } set start [tcl_startOfPreviousWord $str $start] if {$start < 0} { set start "" @@ -730,8 +743,12 @@ if {[info commands ::tk::startOfPreviousWord] eq ""} { } if {[info commands ::tk::endOfCluster] eq ""} { proc ::tk::endOfCluster {str start {locale {}}} { - if {$start eq "end"} { - return [string length $str] + if {$start < 0} { + set start -1 + } elseif {$start eq "end"} { + set start [expr {[string length $str]-1}] + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] } elseif {$start >= [string length $str]} { return "" } @@ -744,8 +761,12 @@ if {[info commands ::tk::endOfCluster] eq ""} { } if {[info commands ::tk::startOfCluster] eq ""} { proc ::tk::startOfCluster {str start {locale {}}} { - if {$start eq "end"} { + if {$start < 0} { + set start -1 + } elseif {$start eq "end"} { set start [expr {[string length $str]-1}] + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] } elseif {$start >= [string length $str]} { return [string length $str] } -- cgit v0.12 From 4d69269d94dcc7bd42e420cb36faf0e703e7c9a9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 30 Mar 2021 08:41:11 +0000 Subject: slightly simpler --- library/tk.tcl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/library/tk.tcl b/library/tk.tcl index b28cf12..9a3aa38 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -753,9 +753,9 @@ if {[info commands ::tk::endOfCluster] eq ""} { return "" } if {[string length [string index $str $start]] > 1} { - set start [expr {$start+1}] + incr start } - set start [expr {$start+1}] + incr start return $start } } @@ -771,7 +771,7 @@ if {[info commands ::tk::startOfCluster] eq ""} { return [string length $str] } if {[string length [string index $str $start]] < 1} { - set start [expr {$start-1}] + incr start -1 } if {$start < 0} { return "" -- cgit v0.12 From 5dd5a8a92276ad30a38f7a23d3073656f9a426d0 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 18 Apr 2021 02:05:47 +0000 Subject: Major re-work to printing API on Windows; initial Windows script implementation of printing; still need to build and test, but want to get this milestone committed --- library/tk.tcl | 1 + win/Makefile.in | 1 + win/makefile.vc | 1 + win/tkWinGDI.c | 1 + win/tkWinHDC.c | 258 +++ win/tkWinHDC.h | 28 + win/tkWinPrint.c | 6207 ++++++++++++++++++++++++++++++------------------------ 7 files changed, 3766 insertions(+), 2731 deletions(-) create mode 100644 win/tkWinHDC.c create mode 100644 win/tkWinHDC.h diff --git a/library/tk.tcl b/library/tk.tcl index 2ced087..e5e3632 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -502,6 +502,7 @@ if {$::tk_library ne ""} { SourceLibFile listbox SourceLibFile menu SourceLibFile panedwindow + SourceLibFile print SourceLibFile scale SourceLibFile scrlbar SourceLibFile spinbox diff --git a/win/Makefile.in b/win/Makefile.in index 849e79c..d46ce74 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -309,6 +309,7 @@ TK_OBJS = \ tkWinEmbed.$(OBJEXT) \ tkWinFont.$(OBJEXT) \ tkWinGDI.$(OBJEXT) \ + tkWinHDC.$(OBJEXT) \ tkWinIco.$(OBJEXT) \ tkWinImage.$(OBJEXT) \ tkWinInit.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index 5e9cbf6..dec4505 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -179,6 +179,7 @@ TKOBJS = \ $(TMP_DIR)\tkWinEmbed.obj \ $(TMP_DIR)\tkWinFont.obj \ $(TMP_DIR)\tkWinGDI.obj \ + $(TMP_DIR)\tkWinHDC.obj \ $(TMP_DIR)\tkWinIco.obj \ $(TMP_DIR)\tkWinImage.obj \ $(TMP_DIR)\tkWinInit.obj \ diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index c0fcee7..d8422b9 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -23,6 +23,7 @@ #include #include "tkWinInt.h" +#include "tkWinHDC.h" /* Main dispatcher for commands. */ static int TkWinGDI (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); diff --git a/win/tkWinHDC.c b/win/tkWinHDC.c new file mode 100644 index 0000000..67a96f7 --- /dev/null +++ b/win/tkWinHDC.c @@ -0,0 +1,258 @@ +/* + * tkWinHDC.c -- + * + * This module implements utility functions for accessing hardware device contexts + * for graphics rendering in Windows. + * + * Copyright © 2009 Michael I. Schwartz. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + + +#include "tkWinHDC.h" + + +/* + *---------------------------------------------------------------------- + * + * hdc_create -- + * + * Creates device context. + * + * Results: + * HDC created. + * + *---------------------------------------------------------------------- + */ + +const char * hdc_create (Tcl_Interp *interp, void *ptr, int type) +{ + struct hdc_value *pval; + const char *name; + Tcl_HashEntry *entry; + int status; + + pval = (struct hdc_value *)Tcl_Alloc(sizeof(struct hdc_value)); + if (pval == 0) + { + return 0; + } + pval->addr = ptr; + pval->type = type; + + name = Hdc_build_name(type); + if ( ( entry = Tcl_CreateHashEntry(&hdcs, name, &status)) != 0 ) + Tcl_SetHashValue(entry, (ClientData)pval); + return name; +} + + +/* + *---------------------------------------------------------------------- + * + * hdc_valid -- + * + * Tests validity of HDC. + * + * Results: + * HDC tested. + * + *---------------------------------------------------------------------- + */ + +int hdc_valid (Tcl_Interp *interp, const char *hdcname, int type) +{ + struct hdc_value *val; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) + { + val = (struct hdc_value *)Tcl_GetHashValue(data); + + if ( type <= 0 || val->type == type ) + return 1; + } + return 0; +} + + +/* + *---------------------------------------------------------------------- + * + * hdc_delete -- + * + * Dletes device context. + * + * Results: + * HDC created. + * + *---------------------------------------------------------------------- + */ + +int hdc_delete (Tcl_Interp *interp, const char *hdcname) +{ + struct hdc_value *val; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) + { + val = (struct hdc_value *)Tcl_GetHashValue(data); + + Tcl_DeleteHashEntry(data); + Tcl_Free((void *)val); + return 1; + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * hdc_get -- + * + * Gets device context. + * + * Results: + * HDC returned. + * + *---------------------------------------------------------------------- + */ + +void * hdc_get (Tcl_Interp *interp, const char *hdcname) +{ + struct hdc_value *val; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) + val = (struct hdc_value *)Tcl_GetHashValue(data); + else + return 0; + + return val->addr; +} + +/* + *---------------------------------------------------------------------- + * + * hdc_typeof -- + * + * Gets HDC type. + * + * Results: + * Type returned. + * + *---------------------------------------------------------------------- + */ + + +int hdc_typeof (Tcl_Interp *interp, const char *hdcname) +{ + struct hdc_value *val; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) + val = (struct hdc_value *)Tcl_GetHashValue(data); + + return val->type; +} + +/* + *---------------------------------------------------------------------- + * + * hdc_prefixof -- + * + * Gets HDC prefix. + * + * Results: + * Prefix returned. + * + *---------------------------------------------------------------------- + */ + +const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix) +{ + const char *prefix; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcprefixes, (char *)type)) != 0 ) + prefix = (const char *)Tcl_GetHashValue(data); + + if ( newprefix ) + { + char *cp; + int siz, len; + + siz = strlen(newprefix); + len = siz > 32 ? 32 : siz; + + if ( (cp = (char *)Tcl_Alloc(len+1)) != 0 ) + { + int newptr = 0; + + strncpy (cp, newprefix, len); + cp[len] = '\0'; + if ( data == 0 ) + data = Tcl_CreateHashEntry(&hdcprefixes,(char *)type,&newptr); + Tcl_SetHashValue(data, (ClientData)cp); + prefix = cp; + } + } + + return prefix; +} + +/* + *---------------------------------------------------------------------- + * + * hdc_list -- + * + * Lists all device contexts. + * + * Results: + * List of device contexts returned. + * + *---------------------------------------------------------------------- + */ + +int hdc_list (Tcl_Interp *interp, int type, const char *out[], int *poutlen) +{ + Tcl_HashEntry *ent; + Tcl_HashSearch srch; + int i=0; + const char *cp; + int retval = 0; + struct hdc_value *val; + + for ( ent = Tcl_FirstHashEntry(&hdcs, &srch); ent !=0; ent=Tcl_NextHashEntry(&srch)) + { + if ( (cp = Tcl_GetHashKey(&hdcs, ent)) != 0 ) + { + if ( i < *poutlen ) + { + if ( (val = (struct hdc_value *)Tcl_GetHashValue(ent) ) != 0 ) + { + if ( type <= 0 || type == val->type ) + { + out[i++] = cp; + retval++; + } + } + } + } + } + *poutlen = i; + return retval; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ + + diff --git a/win/tkWinHDC.h b/win/tkWinHDC.h new file mode 100644 index 0000000..9341927 --- /dev/null +++ b/win/tkWinHDC.h @@ -0,0 +1,28 @@ +#include +#include +#include +#include + + +/* + * Static data and function prototypes. + */ + +struct hdc_value +{ + void *addr; + int type; +}; + +static unsigned long hdc_count = 0L; +static Tcl_HashTable hdcs; +static Tcl_HashTable hdcprefixes; +static char hdc_name [32+12+1]; + + +int hdc_create(ClientData data, Tcl_Interp *interp, int argc, char **argv); +int hdc_delete(ClientData data, Tcl_Interp *interp, int argc, char **argv); +int hdc_list(ClientData data, Tcl_Interp *interp, int argc, char **argv); +int hdc_prefixof(ClientData data, Tcl_Interp *interp, int argc, char **argv); +int hdc_typeof(ClientData data, Tcl_Interp *interp, int argc, char **argv); +void * hdc_get (Tcl_Interp *interp, const char *hdcname); \ No newline at end of file diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 8517b38..06693bc 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -4,6 +4,7 @@ * This module implements Win32 printer access. * * Copyright © 1998-2019 Harald Oehlmann, Elmicron GmbH + * Copyright © 2009 Michael I. Schwartz. * Copyright © 2018 Microsoft Corporation. * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. * @@ -12,3196 +13,3940 @@ */ -#if defined(_MSC_VER) -#pragma warning(disable: 4201 4214 4514) -#endif -#define STRICT -#define UNICODE -#define _UNICODE -/* Taget WIndows Server 2003 */ -#define WINVER 0x0502 -#define _WIN32_WINNT 0x0502 -/* TCL Defines */ -#define DLL_BUILD - +/* + * This section contains windows-specific includes and structures + * global to the file. + * Windows-specific functions will be found in a section at the + * end of the file. + */ +#if defined(__WIN32__) || defined (__WIN32S__) || defined (WIN32S) +/* Suppress Vista Warnings. */ +#define _CRT_SECURE_NO_WARNINGS #include -#include #include -#include + + +#include #include #include -#include -#include -#include +#include /* For floor(), used later. */ +#include "tkWinHDC.h" + +/* + * This value structure is intended for ClientData in all Print functions. + * Major philosophical change: + * Instead of relying on windows to maintain the various dialog structures, + * relevant parts of this printer_values structure will be copied in and out of + * the windows structures before the dialog calls. + * This will allow the PrintAttr function to behave properly, setting and getting + * various aspects of the printer settings without concern about other + * side effects in the program. + * + * The DEVMODE and DEVNAMES structures are static rather than + * global movable objects in order to simplify access. The + * global objects will be allocated and freed as needed, + * when the appropriate functions are called. + * + * If performance suffers drastically, or so many device drivers + * require extra device-specific information that the base information + * is insufficient, this is subject to change. + * If changed, the printer_values structure will maintain its + * own handle to the devmode and devnames, still copying them + * as needed to the dialogs. + * + * Really, this structure should be attached to all printer HDCs, + * and the hash table should track which printer_values structure + * is associated with the given hDC. + * Added the new member hdcname to track the named hDC. + */ -/* Helper defines. */ +#define PVMAGIC 0x4e495250 -/* -* Values of the Res variable. -*/ - -/* Success, result value not set */ -#define RET_OK_NO_RESULT_SET 2 -/* Succes, result value set or not necessary. */ -#define RET_OK 0 -/* Error and result set. */ -#define RET_ERROR -1 -/* Printer i/o error. */ -#define RET_ERROR_PRINTER_IO -2 -/* Out of memory error. */ -#define RET_ERROR_MEMORY -3 -/* Parameter error. */ -#define RET_ERROR_PARAMETER -4 -/* User abort. */ -#define RET_ERROR_USER -5 -/* Printer not open. */ -#define RET_ERROR_PRINTER_NOT_OPEN -6 -/* Printer driver answered with an error. */ -#define RET_ERROR_PRINTER_DRIVER -7 - -/* Flag parameter of GetDeviceName function. */ -#define F_FREE_MEM (1) -#define F_RETURN_LIST (2) +static struct printer_values +{ + unsigned long magic; /* Give some indication if this is a "real" structure. */ + HDC hDC; /* Default printer context--override via args?. */ + char hdcname[19+1]; /* Name of hdc. */ + PRINTDLG pdlg; /* Printer dialog and associated values. */ + PAGESETUPDLG pgdlg; /* Printer setup dialog and associated values. */ + DEVMODE *pdevmode; /* Allocated when the printer_values is built. */ + char extra_space[1024+1]; /* space just in case.... */ + int space_count; /* How much extra space. */ + char devnames_filename[255+1]; /* Driver filename. */ + char devnames_port[255+1]; /* Output port. */ + char devnames_printername[255+1]; /* Full printer name. */ + Tcl_HashTable attribs; /* Hold the attribute name/value pairs.. */ + int in_job; /* Set to 1 after job start and before job end. */ + int in_page; /* Set to 1 after page start and before page end. */ + DWORD errorCode; /* Under some conditions, save the Windows error code. */ +} default_printer_values; + +/* + * These declarations are related to creating, destroying, and + * managing printer_values structures. + */ +struct printer_values *current_printer_values = &default_printer_values; +static int is_valid_printer_values ( const struct printer_values *ppv ); +static struct printer_values *make_printer_values(HDC hdc); +static void delete_printer_values (struct printer_values *ppv); + +/* + * These declarations and variables are related to managing a + * list of hdcs created by this extension, and their associated + * printer value structures. + */ +static Tcl_HashTable printer_hdcs; +static void add_dc(HDC hdc, struct printer_values *pv); +static struct printer_values *delete_dc (HDC hdc); +static struct printer_values *find_dc_by_hdc(HDC hdc); -/* - * File Global Constants. - */ - -/* Version information. */ -static const char usage_string[] = - "Windows printing (c) Elmicron GmbH, Harald Oehlmann, 2019-01-23\n" - "Preparation:\n" - " ::tk::print::_print getattr option: possible options:\n" - " printers, defaultprinter, copies, firstpage, lastpage, mapmode*,\n" - " avecharheight*, avecharwidth*, horzres*, vertres*, dpi*,\n" - " physicaloffsetx*, physicaloffsety*, printer, orientation, papersize,\n" - " papertypes, mapmodes, fontweights, fontcharsets, fontpitchvalues,\n" - " fontfamilies, fontunicoderanges: lists option\n" - " fonts*: returns list of unique font name, weight, charset, variable/fixed\n" - " fontnames*: returns list of unique font names\n" - " fontunicoderanges: returns list of alternating start len unicode point ints\n" - " *: requires open printer\n" - " ::tk::print::_print pagesetup ?printer? ?Orientation? ?PaperSize? " - "?left? ?top? ?right? ?bottom?\n" - " returns a list of identical parameters reflecting the users choice\n" - " Margin unit is millimeter. Default values also by empty string\n" - " ::tk::print::_print selectprinter: select a printer\n" - " ::tk::print::_print printersetup ?printer? ? Orientation? ?PageSize?\n" - " Sets up the printer options and returns them.\n" - " Not exposed printer settings are editable.\n" - "Open printer: use one of:\n" - " ::tk::print::_print openjobdialog ?printer? ?Orientation? ?PaperSize? ?Maxpage?\n" - " ::tk::print::_print openprinter ?printer? ?Orientation? ?PaperSize?\n" - "Get information about the print job and user selections:\n" - " ::tk::print::_print getattr {copies firstpage lastpage avecharheight avecharwidth" - "horzres\n" - " vertres dpi physicaloffsetx physicaloffsety printer orientation " - "papersize}\n" - " The dpi value is used to transform from paint units (pixel) to mm:\n" - " Size/[mm] = [::tk::print::_print getattr horzres]/[::tk::print::_print getattr dpi]*2.54\n" - "Start document and page\n" - " ::tk::print::_print opendoc jobname\n" - " ::tk::print::_print openpage\n" - "Configure and select drawing tools\n" - " ::tk::print::_print setmapmode mapmode\n" - " Define the coordinate system. 'Text' is in device units origin " - "top-up.\n" - " ::tk::print::_print pen width ?r g b?: r,g,b is 16 bit color value (internal / 256)\n" - " No rgb values uses black color.\n" - " ::tk::print::_print brushcolor r g b: filling for rectangle\n" - " winfo bkcolor r g b: text background\n" - " ::tk::print::_print fontcreate Fontnumber Fontname Points/10 ?Weight? ?Italic? " - "?Charset?\n" - " ?Pitch? ?Family? : use getattr font* to get possible values.\n" - " ::tk::print::_print fontselect Fontnumber\n" - "Create printed items:\n" - " ::tk::print::_print ruler x0 y0 width height\n" - " ::tk::print::_print rectangle x0 y0 x1 y1\n" - " ::tk::print::_print text X0 Y0 Text ?r g b?: no rgb uses black text\n" - " ::tk::print::_print getfirstfontnochar Text: -1 or first index with no glyph\n" - " ::tk::print::_print gettextsize Text\n" - " ::tk::print::_print photo tkimage X0 Y0 ?Width? ?Height?\n" - "Close page and printjob\n" - " ::tk::print::_print closepage Close a page\n" - " ::tk::print::_print closedoc Close the document\n" - " ::tk::print::_print close ?option?\n" - " Close and cleanup the printing interface.\n" - " If the option -eraseprinterstate is given, also the printer settings " - "not passed\n" - " to the script level are deleted." - ""; - - -/* File Global Variables */ -static BOOL fPDLGInitialised = FALSE; -static PRINTDLG pdlg; -static HPEN hPen = NULL; -static HFONT hFont[10] = - {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL}; -/* Index of the actually selected font, -1:None */ -static int SelectedFont = -1; +static HDC GetPrinterDC (const char *printer); +static int SplitDevice(LPSTR device, LPSTR *dev, LPSTR *dvr, LPSTR *port); -/* - * Interpreter pointer to return automatic errors from the EnumerateFontsEx - * callback and the ListFontsEx function. - */ -static Tcl_Interp *fg_interp; - -/* Subcommand "getattr" option list and indexes. */ -static const char *fg_getattr_sub_cmds[] = { - "printers", "defaultprinter", "copies", "firstpage", "lastpage", - "mapmode", "avecharheight", "avecharwidth", "horzres", "vertres", - "dpi", "physicaloffsetx", "physicaloffsety", - "printer", "orientation", "papersize", - "papertypes", "mapmodes", - "fontweights", "fontcharsets", "fontpitchvalues", "fontfamilies", "fonts", - "fontnames", "fontunicoderanges", NULL}; -typedef enum { - iPrinters, iDefaultPrinter, iCopies, iFirstPage, iLastPage, - iMapMode, iAveCharHeight, iAveCharWidth, iHorzRes, iVertRes, - iDPI, iPhysicalOffsetX, iPhysicalOffsetY, - iPrinter, iOrientation, iPaperSize, - iPaperTypes, iMapModes, - iFontWeights, iFontCharsets, iFontPitchValues, iFontFamilies, iFonts, - iFontNames, iFontUnicodeRanges} fg_getattr_i_command; - -/* Subcommand "pagesetup" orientation option list and indexes. */ -static const char *fg_orient_sub_cmds[] = {"portrait", "landscape", "", NULL}; -static short fg_orient_i_command[] = { - DMORIENT_PORTRAIT, - DMORIENT_LANDSCAPE, - -1}; - -/* Subcommand "pagesetup" pagesize. */ -static const char *fg_papersize_sub_cmds[] = { - "Letter", "LetterSmall", "Tabloid", "Ledger", "Legal", "Statement", - "Executive", "A3", "A4", "A4Small", "A5", "B4", "B5", "Folio", "Quarto", - "10X14", "11X17", "Note", "Env_9", "Env_10", "Env_11", "Env_12", "Env_14", - "CSheet", "DSheet", "ESheet", "Env_Dl", "Env_C5", "Env_C3", "Env_C4", - "Env_C6", "Env_C65", "Env_B4", "Env_B5", "Env_B6", "Env_Italy", - "Env_Monarch", "Env_Personal", "Fanfold_Us", "Fanfold_Std_German", - "Fanfold_Lgl_German", "Iso_B4", "Japanese_Postcard", "9X11", "10X11", - "15X11", "Env_Invite", "Reserved_48", "Reserved_49", "Letter_Extra", - "Legal_Extra", "Tabloid_Extra", "A4_Extra", "Letter_Transverse", - "A4_Transverse", "Letter_Extra_Transverse", "A_Plus", "B_Plus", - "Letter_Plus", "A4_Plus", "A5_Transverse", "B5_Transverse", "A3_Extra", - "A5_Extra", "B5_Extra", "A2", "A3_Transverse", "A3_Extra_Transverse", - "Dbl_Japanese_Postcard", "A6", "JEnv_Kaku2", "JEnv_Kaku3", "JEnv_Chou3", - "JEnv_Chou4", "Letter_Rotated", "A3_Rotated", "A4_Rotated", "A5_Rotated", - "B4_JIS_Rotated", "B5_JIS_Rotated", "Japanese_Postcard_Rotated", - "Dbl_Japanese_Postcard_Rotated", "A6_Rotated", "JEnv_Kaku2_Rotated", - "JEnv_Kaku3_Rotated", "JEnv_Chou3_Rotated", "JEnv_Chou4_Rotated", "B6_JIS", - "B6_Jis_Rotated", "12X11", "Jenv_You4", "Jenv_You4_Rotated", "P16K", "P32K", - "P32Kbig", "PEnv_1", "PEnv_2", "PEnv_3", "PEnv_4", "PEnv_5", "PEnv_6", - "PEnv_7", "PEnv_8", "PEnv_9", "PEnv_10", "P16K_Rotated", "P32K_Rotated", - "P32Kbig_Rotated", "PEnv_1_Rotated", "PEnv_2_Rotated", "PEnv_3_Rotated", - "PEnv_4_Rotated", "PEnv_5_Rotated", "PEnv_6_Rotated", "PEnv_7_Rotated", - "PEnv_8_Rotated", "PEnv_9_Rotated", "PEnv_10_Rotated", - "User", - "", NULL }; -static short fg_papersize_i_command[] = { - DMPAPER_LETTER, - DMPAPER_LETTERSMALL, - DMPAPER_TABLOID, - DMPAPER_LEDGER, - DMPAPER_LEGAL, - DMPAPER_STATEMENT, - DMPAPER_EXECUTIVE, - DMPAPER_A3, - DMPAPER_A4, - DMPAPER_A4SMALL, - DMPAPER_A5, - DMPAPER_B4, - DMPAPER_B5, - DMPAPER_FOLIO, - DMPAPER_QUARTO, - DMPAPER_10X14, - DMPAPER_11X17, - DMPAPER_NOTE, - DMPAPER_ENV_9, - DMPAPER_ENV_10, - DMPAPER_ENV_11, - DMPAPER_ENV_12, - DMPAPER_ENV_14, - DMPAPER_CSHEET, - DMPAPER_DSHEET, - DMPAPER_ESHEET, - DMPAPER_ENV_DL, - DMPAPER_ENV_C5, - DMPAPER_ENV_C3, - DMPAPER_ENV_C4, - DMPAPER_ENV_C6, - DMPAPER_ENV_C65, - DMPAPER_ENV_B4, - DMPAPER_ENV_B5, - DMPAPER_ENV_B6, - DMPAPER_ENV_ITALY, - DMPAPER_ENV_MONARCH, - DMPAPER_ENV_PERSONAL, - DMPAPER_FANFOLD_US, - DMPAPER_FANFOLD_STD_GERMAN, - DMPAPER_FANFOLD_LGL_GERMAN, - DMPAPER_ISO_B4, - DMPAPER_JAPANESE_POSTCARD, - DMPAPER_9X11, - DMPAPER_10X11, - DMPAPER_15X11, - DMPAPER_ENV_INVITE, - DMPAPER_RESERVED_48, - DMPAPER_RESERVED_49, - DMPAPER_LETTER_EXTRA, - DMPAPER_LEGAL_EXTRA, - DMPAPER_TABLOID_EXTRA, - DMPAPER_A4_EXTRA, - DMPAPER_LETTER_TRANSVERSE, - DMPAPER_A4_TRANSVERSE, - DMPAPER_LETTER_EXTRA_TRANSVERSE, - DMPAPER_A_PLUS, - DMPAPER_B_PLUS, - DMPAPER_LETTER_PLUS, - DMPAPER_A4_PLUS, - DMPAPER_A5_TRANSVERSE, - DMPAPER_B5_TRANSVERSE, - DMPAPER_A3_EXTRA, - DMPAPER_A5_EXTRA, - DMPAPER_B5_EXTRA, - DMPAPER_A2, - DMPAPER_A3_TRANSVERSE, - DMPAPER_A3_EXTRA_TRANSVERSE, - DMPAPER_DBL_JAPANESE_POSTCARD, - DMPAPER_A6, - DMPAPER_JENV_KAKU2, - DMPAPER_JENV_KAKU3, - DMPAPER_JENV_CHOU3, - DMPAPER_JENV_CHOU4, - DMPAPER_LETTER_ROTATED, - DMPAPER_A3_ROTATED, - DMPAPER_A4_ROTATED, - DMPAPER_A5_ROTATED, - DMPAPER_B4_JIS_ROTATED, - DMPAPER_B5_JIS_ROTATED, - DMPAPER_JAPANESE_POSTCARD_ROTATED, - DMPAPER_DBL_JAPANESE_POSTCARD_ROTATED, - DMPAPER_A6_ROTATED, - DMPAPER_JENV_KAKU2_ROTATED, - DMPAPER_JENV_KAKU3_ROTATED, - DMPAPER_JENV_CHOU3_ROTATED, - DMPAPER_JENV_CHOU4_ROTATED, - DMPAPER_B6_JIS, - DMPAPER_B6_JIS_ROTATED, - DMPAPER_12X11, - DMPAPER_JENV_YOU4, - DMPAPER_JENV_YOU4_ROTATED, - DMPAPER_P16K, - DMPAPER_P32K, - DMPAPER_P32KBIG, - DMPAPER_PENV_1, - DMPAPER_PENV_2, - DMPAPER_PENV_3, - DMPAPER_PENV_4, - DMPAPER_PENV_5, - DMPAPER_PENV_6, - DMPAPER_PENV_7, - DMPAPER_PENV_8, - DMPAPER_PENV_9, - DMPAPER_PENV_10, - DMPAPER_P16K_ROTATED, - DMPAPER_P32K_ROTATED, - DMPAPER_P32KBIG_ROTATED, - DMPAPER_PENV_1_ROTATED, - DMPAPER_PENV_2_ROTATED, - DMPAPER_PENV_3_ROTATED, - DMPAPER_PENV_4_ROTATED, - DMPAPER_PENV_5_ROTATED, - DMPAPER_PENV_6_ROTATED, - DMPAPER_PENV_7_ROTATED, - DMPAPER_PENV_8_ROTATED, - DMPAPER_PENV_9_ROTATED, - DMPAPER_PENV_10_ROTATED, - DMPAPER_USER, - -1 - }; - -/* Map modes */ -static const char *fg_map_modes_sub_cmds[] = { - "Text", - "LoMetric", - "HiMetric", - "LoEnglish", - "HiEnglish", - "Twips", - "Isotropic", - "Anisotropic", - NULL -}; -static int fg_map_modes_i_command[] = { - MM_TEXT, - MM_LOMETRIC, - MM_HIMETRIC, - MM_LOENGLISH, - MM_HIENGLISH, - MM_TWIPS, - MM_ISOTROPIC, - MM_ANISOTROPIC -}; +int Winprint_Init (Tcl_Interp *Interp); -/* - * Font weights. - */ -/* Map modes */ -static const char *fg_font_weight_sub_cmds[] = { - "Dontcare", - "Thin", - "Extralight", - "Light", - "Normal", - "Medium", - "Semibold", - "Bold", - "Extrabold", - "Heavy", - NULL -}; -static int fg_font_weight_i_command[] = { - FW_DONTCARE, - FW_THIN, - FW_EXTRALIGHT, - FW_LIGHT, - FW_NORMAL, - FW_MEDIUM, - FW_SEMIBOLD, - FW_BOLD, - FW_EXTRABOLD, - FW_HEAVY -}; +/* + * Internal function prototypes + */ +static int Print (ClientData unused, Tcl_Interp *interp, int argc, const char * argv, int safe); +static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const char * argv); +static int PrintSend (ClientData unused, Tcl_Interp *interp, int argc, const char * argv); +static int PrintRawData (HANDLE printer, Tcl_Interp *interp, LPBYTE lpData, DWORD dwCount); +static int PrintRawFileData (HANDLE printer, Tcl_Interp *interp, const char *filename, int binary); +static int PrintStart (HDC hdc, Tcl_Interp *interp, const char *docname); +static int PrintFinish (HDC hdc, Tcl_Interp *interp); +static int Version(ClientData unused, Tcl_Interp *interp, int argc, const char * argv); +static long WinVersion(void); +static void ReportWindowsError(Tcl_Interp * interp, DWORD errorCode); +static int PrinterGetDefaults(struct printer_values *ppv, const char *printer_name, int set_default_devmode); +static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg); +static void RestorePrintVals (struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg); +static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm); +static void SetDevNamesAttribs (Tcl_HashTable *att, struct printer_values *dn); +static void SetPrintDlgAttribs (Tcl_HashTable *att, PRINTDLG *pdlg); +static void SetPageSetupDlgAttribs (Tcl_HashTable *att, PAGESETUPDLG *pgdlg); +static void SetHDCAttribs (Tcl_HashTable *att, HDC hDC); +static const char *set_attribute(Tcl_HashTable *att, const char *key, const char *value); +static const char *get_attribute(Tcl_HashTable *att, const char *key); +static int del_attribute(Tcl_HashTable *att, const char *key); +static int PrintPageAttr (HDC hdc, int *hsize, int *vsize, + int *hscale, int *vscale, + int *hoffset, int *voffset, + int *hppi, int *vppi); +static int is_valid_hdc (HDC hdc); +static void RestorePageMargins (const char *attrib, PAGESETUPDLG *pgdlg); + +/* New functions from Mark Roseman. */ +static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char * argv); +static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, const char * argv); +static int PrintClose(ClientData data, Tcl_Interp *interp, int argc, const char * argv); +static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char * argv); +static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * argv); +static int PrintPage(ClientData data, Tcl_Interp *interp, int argc, const char * argv); +static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char * argv); +static int PrintOption(ClientData data, Tcl_Interp *interp, int argc, const char * argv); +static int JobInfo(int state, const char *name, const char * outname); +/* End new functions. */ + +/* Functions to give printer contexts names. */ +static void init_printer_dc_contexts(Tcl_Interp *interp); +static void delete_printer_dc_contexts(Tcl_Interp *inter); +static const char *make_printer_dc_name(Tcl_Interp *interp, HDC hdc, struct printer_values *pv); +static int printer_name_valid(Tcl_Interp *interp, const char *name); +static HDC get_printer_dc(Tcl_Interp *interp, const char *string); +static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, int wildcard); + + +/* + * Internal static data structures (ClientData) + */ +static char msgbuf[255+1]; +int autoclose = 1; /* Default is old behavior--one open printer at a time. */ -static const char *fg_font_charset_sub_cmds[] = { - "Default", - "ANSI", - "Symbol", - "ShiftJIS", - "Hangeul", - "Hangul", - "GB2312", - "ChineseBig5", - "OEM", - "Johab", - "Hebrew", - "Arabic", - "Greek", - "Turkish", - "Vietnamese", - "Thai", - "Easteurope", - "Russian", - "Mac", - "Baltic", - NULL -}; -static int fg_font_charset_i_command[] = { - DEFAULT_CHARSET, - ANSI_CHARSET, - SYMBOL_CHARSET, - SHIFTJIS_CHARSET, - HANGEUL_CHARSET, - HANGUL_CHARSET, - GB2312_CHARSET, - CHINESEBIG5_CHARSET, - OEM_CHARSET, - HEBREW_CHARSET, - ARABIC_CHARSET, - GREEK_CHARSET, - TURKISH_CHARSET, - VIETNAMESE_CHARSET, - THAI_CHARSET, - EASTEUROPE_CHARSET, - RUSSIAN_CHARSET, - MAC_CHARSET, - BALTIC_CHARSET -}; +static struct { + char *tmpname; +} option_defaults = + { + 0 + }; -static const char *fg_font_pitch_sub_cmds[] = { - "Default", - "Fixed", - "Variable", - "Mono", - NULL -}; +/* + *---------------------------------------------------------------------- + * + * WinVersion -- + * + * WinVersion returns an integer representing the current version + * of Windows. + * + * Results: + * Returns Windows version. + * + *---------------------------------------------------------------------- + */ -static int fg_font_pitch_i_command[] = { - DEFAULT_PITCH, - FIXED_PITCH, - VARIABLE_PITCH - ,MONO_FONT -}; +static long WinVersion(void) +{ + static OSVERSIONINFO osinfo; + if ( osinfo.dwOSVersionInfoSize == 0 ) + { + osinfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + GetVersionEx(&osinfo); /* Should never fail--only failure is if size too small. */ + } + return osinfo.dwPlatformId; +} -static const char *fg_font_family_sub_cmds[] = { - "Dontcare", - "Roman", - "Swiss", - "Modern", - "Script", - "Decorative", - NULL -}; -static int fg_font_family_i_command[] = { - FF_DONTCARE, - FF_ROMAN, - FF_SWISS, - FF_MODERN, - FF_SCRIPT, - FF_DECORATIVE -}; +/* + *---------------------------------------------------------------------- + * + * ReportWindowsError -- + * + * This function sets the Tcl error code to the provided + Windows error message in the default language. + * + * Results: + * Sets error code. + * + *---------------------------------------------------------------------- + */ -/* Declaration for functions used later in this file.*/ -static int WinPrintCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static TCHAR * ReturnLockedDeviceName( HGLOBAL hDevNames ); -static char GetDeviceName( - Tcl_Interp *interp, - HGLOBAL hDevNames, - char Flags ); -static char PrintSelectPrinter( Tcl_Interp *interp ); -static Tcl_Obj * GetOrientation( DEVMODE * pDevMode ); -static Tcl_Obj * GetPaperSize( DEVMODE * pDevMode ); -static char AppendOrientPaperSize( Tcl_Interp *interp, DEVMODE * pDevMode ); -static char PrintPrinterSetup( Tcl_Interp *interp, TCHAR *Printer, - short Orientation, short PaperSize); -static char PrintPageSetup( Tcl_Interp *interp, TCHAR *pPrinter, - short Orientation, short PaperSize, - int Left, int Top, int Right, int Bottom ); -static char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize, - char fShowPropertySheet ); -static char PrintOpenPrinter( - TCHAR * pPrinter, short Orientation, short PaperSize); -static char PrintReset( char fPreserveDeviceData ); -static char PrintOpenJobDialog( - TCHAR * pPrinter, - short Orientation, - short PaperSize, - unsigned short MaxPage - ); -static char PrintOpenDoc(Tcl_Obj *resultPtr, TCHAR *DocName); -static char PrintCloseDoc(); -static char PrintOpenPage(); -static char PrintClosePage(); -static char PrintGetAttr(Tcl_Interp *interp, int Index); -static char PrintSetAttr(Tcl_Interp *interp, int Index, Tcl_Obj *oParam); -static char DefaultPrinterGet( Tcl_Interp *interp ); -static char ListPrinters(Tcl_Interp *interp); -static char ListChoices(Tcl_Interp *interp, const char *ppChoiceList[]); -static char PrintSetMapMode( int MapMode); -static char LoadDefaultPrinter( ); -static char DefaultPrinterGet( Tcl_Interp *interp ); -static char PrintPen(int Width, COLORREF Color); -static char PrintBrushColor(COLORREF Color); -static char PrintBkColor(COLORREF Color); -static char PrintRuler(int X0, int Y0, int LenX, int LenY); -static char PrintRectangle(int X0, int Y0, int X1, int Y1); -static char PrintFontCreate(int FontNumber, - TCHAR *Name, double PointSize, int Weight, int Italic, int Charset, - int Pitch, int Family); -static char PrintFontSelect(int FontNumber); -static char PrintText(int X0, int Y0, TCHAR *pText, COLORREF Color ); -static char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText); -static char ListFonts(Tcl_Interp *interp, HDC hDC, int fFontNameOnly); -static char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC); -static char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText); -static int CALLBACK EnumFontFamExProc( - ENUMLOGFONTEX *lpelfe, /* logical-font data */ - NEWTEXTMETRICEX *lpntme, /* physical-font data */ - DWORD FontType, /* type of font */ - LPARAM lParam /* application-defined data */ -); -static char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *const oImageName, - int PosX, int PosY, int Width, int Height); - - -/*DLL entry point */ - -#if 0 -BOOL __declspec(dllexport) WINAPI DllEntryPoint( - HINSTANCE hInstance, - DWORD seginfo, - LPVOID lpCmdLine) +static void ReportWindowsError(Tcl_Interp * interp, DWORD errorCode) { - /* Don't do anything, so just return true */ - return TRUE; + LPVOID lpMsgBuf; + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | + FORMAT_MESSAGE_FROM_SYSTEM | + FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, + errorCode, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language + (LPTSTR) &lpMsgBuf, + 0, + NULL + ); + Tcl_AppendResult(interp,(char *)lpMsgBuf,0); + // Free the buffer. + LocalFree( lpMsgBuf ); + } -#endif - -/*Initialisation Function,*/ -int Winprint_Init (Tcl_Interp *Interp) +/* + * The following two functions manage the hash table for + * attribute/value pairs. + * The keys are assumed managed by the Hash structure, but the + * values are 'strdup'ed, and managed by these routines. + * Other than cleanup, there seems to be no reason to delete attributes, + * so this part is ignored. + */ + +/* + *---------------------------------------------------------------------- + * + * set_attribute -- + * + * Sets the value of a printer attribute. + * + * Results: + * Sets attribute. + * + *---------------------------------------------------------------------- + */ + + +static const char *set_attribute(Tcl_HashTable *att, const char *key, const char *value) { - if (Tcl_InitStubs(Interp, "8.6-", 0) == NULL - || Tk_InitStubs(Interp, TK_VERSION, 0) == NULL) - { - return RET_ERROR; - } - Tcl_CreateObjCommand(Interp, "::tk::print::_print", WinPrintCmd, (ClientData)NULL, - (Tcl_CmdDeleteProc *)NULL); - - return RET_OK; + Tcl_HashEntry *data; + int status; + char *val = 0; + + data = Tcl_CreateHashEntry(att, key, &status); + if ( status == 0) /* Already existing item!. */ + if ( (val = (char *)Tcl_GetHashValue(data)) != 0 ) + Tcl_Free(val); + + /* In any case, now set the new value. */ + if ( value != 0 && (val = (char *)Tcl_Alloc(strlen(value)+1)) != 0 ) + { + strcpy (val, value); + Tcl_SetHashValue(data, val); + } + return val; } -/*Called routine */ - /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * WinPrintCmd -- + * get_attribute -- * - * Provides core interface to Win32 printing API from Tcl. + * Retrieve the value of a printer attribute. * * Results: - * Returns a standard Tcl result. + * Gets attribute. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -int WinPrintCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) + +static const char *get_attribute(Tcl_HashTable *att, const char *key) { - /* Option list and indexes */ - const char *subCmds[] = { - "help", "selectprinter", "printersetup", "pagesetup", - "openjobdialog", - "openprinter", "close", "closedoc", "openpage", - "closepage", "version", "getattr", "setattr", "opendoc", - "pen", "brushcolor", "bkcolor", - "fontselect", "gettextsize", "ruler", "rectangle", "fontcreate", - "text", "textuni", "getfirstfontnochar", - "photo", - NULL}; - enum iCommand { - iHelp, iSelectPrinter, iPrinterSetup, iPageSetup, - iOpenjobdialog, - iOpenPrinter, iClose, iClosedoc, iOpenpage, - iClosepage, iGetattr, iSetAttr, iOpendoc, - iPen, iBrushColor, iBkColor, - iFontselect, iGetTextSize, iRuler, iRectangle, iFontCreate, - iText, iTextuni, iGetFirstFontNochar, - iPhoto - }; - - /* - * State variables. - */ - - /* Choice of option. */ - int Index; - /* Result flag. */ - char Res; - /* Result of Tcl functions. */ - int TclResult; - /* Store the parameters in strings. */ - int iPar[8]; - Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); - int ParCur; - Tcl_DString sPar1; - int PositionSPar; - /* - * Check if option argument is given and decode it. - */ - if (objc > 1) - { - if (RET_ERROR == - Tcl_GetIndexFromObj(interp, objv[1], subCmds, "subcmd", 0, &Index)) - return RET_ERROR; - } else { - Tcl_WrongNumArgs(interp, 1, objv, "subcmd"); - return RET_ERROR; - } - - /* Check parameters and give usage messages. */ - switch (Index) { - case iGetattr: - case iOpendoc: - case iFontselect: - case iGetTextSize: - case iGetFirstFontNochar: - if (objc != 3) - { - Tcl_WrongNumArgs(interp, 2, objv, "argument"); - return RET_ERROR; - } - break; - case iSetAttr: - if (objc != 4) - { - Tcl_WrongNumArgs(interp, 3, objv, "argument"); - return RET_ERROR; - } - break; - case iText: - case iTextuni: - if (objc != 5 && objc != 8) { - Tcl_WrongNumArgs(interp, 2, objv, "X0 Y0 text ?red green blue?"); - return RET_ERROR; - } - break; - case iRuler: - case iRectangle: - if (objc != 6) - { - Tcl_WrongNumArgs(interp, 2, objv, "X0 Y0 Width Height"); - return RET_ERROR; - } - break; - case iFontCreate: - if (objc < 5 || objc > 10) - { - Tcl_WrongNumArgs(interp, 2, objv, - "Fontnumber Fontname Points ?Weight? ?Italic? ?Charset?" - " ?Pitch? ?Family?"); - return RET_ERROR; - } - break; - case iPhoto: - if (objc < 5 || objc > 7) - { - Tcl_WrongNumArgs(interp, 2, objv, - "imagename x0 y0 ?width? ?height?"); - return RET_ERROR; - } - break; - case iPen: - /* width and optionally red green blue together */ - if (objc != 3 && objc != 6) { - Tcl_WrongNumArgs(interp, 2, objv, "width ?red green blue?"); - return RET_ERROR; - } - break; - case iBrushColor: - case iBkColor: - if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, "red green blue"); - return RET_ERROR; - } - break; - } - - /* Default result. */ - Res = RET_OK; - - /* - * One string parameter. - * if this option is not given, a 0 pointer - * is present. - */ - Tcl_DStringInit(& sPar1); - switch (Index) { - case iPrinterSetup: - case iPageSetup: - case iOpendoc: - case iOpenPrinter: - case iOpenjobdialog: - case iGetTextSize: - case iGetFirstFontNochar: - PositionSPar = 2; - break; - case iFontCreate: - PositionSPar = 3; - break; - case iText: - case iTextuni: - PositionSPar = 4; - break; - default: - PositionSPar = -1; - } - if ( -1 != PositionSPar ) - { - if ( objc > PositionSPar ) - { - char *pStr; - int lStr; - pStr = Tcl_GetStringFromObj(objv[PositionSPar],&lStr); - Tcl_WinUtfToTChar( pStr, lStr, &sPar1); - } - } - /* - * Decode parameters and invoke. - */ - switch (Index) { - case iHelp: - Tcl_SetStringObj(resultPtr, usage_string,-1); - break; - case iSelectPrinter: - Res = PrintSelectPrinter( interp ); - break; - case iClose: - { - const char *close_subCmds[] = { - "-eraseprinterstate", - NULL - }; - enum iCloseCommand { - iErasePrinterState - }; - char fPreserveState; - /* Decode argument. */ - if ( objc > 2 ) - { - int OptionIndex; - if (RET_ERROR == - Tcl_GetIndexFromObj( - interp, objv[2], close_subCmds, "option", 0, - &OptionIndex)) - { - Res = RET_ERROR; - } else { - switch (OptionIndex) - { - case iErasePrinterState: - fPreserveState = 0; - break; - default: - fPreserveState = 1; - break; - } - } - } else { - fPreserveState = 1; - } - if ( Res == RET_OK ) - { - Res = PrintReset( fPreserveState ); - } - } - break; - case iClosedoc: - Res=PrintCloseDoc(); - break; - case iOpenpage: - Res=PrintOpenPage(); - break; - case iClosepage: - Res=PrintClosePage(); - break; - case iGetTextSize: - Res = PrintGetTextSize( interp, (TCHAR *)Tcl_DStringValue(& sPar1) ); - break; - case iGetattr: - case iSetAttr: - /* One Index parameter. */ - { - int IndexAttr; - if (RET_ERROR == - Tcl_GetIndexFromObj( - interp, objv[2], fg_getattr_sub_cmds, "getattr", 0, - &IndexAttr)) - { - return RET_ERROR; - } - if ( Index == iGetattr ) - { - Res = PrintGetAttr( interp, IndexAttr ); - } else { - Res = PrintSetAttr( interp, IndexAttr, objv[3] ); - } - } - break; - case iOpendoc: - Res = PrintOpenDoc( resultPtr, (TCHAR *)Tcl_DStringValue(& sPar1)); - break; - case iPageSetup: - case iPrinterSetup: - case iOpenPrinter: - case iOpenjobdialog: - { - short Orientation = -1; - short PaperSize; - unsigned short MaxPage; - double Double; - /* - * Argument 2: Printer is already in sPar or NULL. - */ - - /* Orientation */ - if ( objc > 3 ) - { - int ParInt; - if (RET_ERROR == - Tcl_GetIndexFromObj( - interp, objv[3], fg_orient_sub_cmds, "orient", 0, - &ParInt)) - { - Res = RET_ERROR; - } else { - Orientation = fg_orient_i_command[ParInt]; - } - } - /* Paper Size */ - if ( objc > 4 ) - { - int ParInt; - if (RET_ERROR == - Tcl_GetIndexFromObj( - interp, objv[4], fg_papersize_sub_cmds, "papersize", 0, - &ParInt)) - { - Res = RET_ERROR; - } else { - PaperSize = fg_papersize_i_command[ParInt]; - } - } else { - PaperSize = -1; - } - switch (Index) - { - case iPrinterSetup: - if ( Res == RET_OK ) - { - Res = PrintPrinterSetup( - interp, (TCHAR *)Tcl_DStringValue(& sPar1), - Orientation,PaperSize ); - } - break; - case iPageSetup: - /* Margins: Left, Top, Right, Bottom. */ - if ( objc <= 5 - || RET_OK != Tcl_GetDoubleFromObj(interp,objv[5], &Double) ) - { - iPar[0] = -1; - } else { - iPar[0] = (int) (Double * 100); - } - if ( objc <= 6 - || RET_OK != Tcl_GetDoubleFromObj(interp,objv[6], &Double) ) - { - iPar[1] = -1; - } else { - iPar[1] = (int) (Double * 100); - } - if ( objc <= 7 - || RET_OK != Tcl_GetDoubleFromObj(interp,objv[7], &Double) ) - { - iPar[2] = -1; - } else { - iPar[2] = (int) (Double * 100); - } - if ( objc <= 8 - || RET_OK != Tcl_GetDoubleFromObj(interp,objv[8], &Double) ) - { - iPar[3] = -1; - } else { - iPar[3] = (int) (Double * 100); - } - if ( Res == RET_OK ) - { - Res = PrintPageSetup( - interp, (TCHAR *)Tcl_DStringValue(& sPar1), - Orientation,PaperSize, - iPar[0], iPar[1], iPar[2], - iPar[3]); - } - break; - case iOpenPrinter: - if ( Res == RET_OK ) - { - Res = PrintOpenPrinter( - (TCHAR *) Tcl_DStringValue(& sPar1), - Orientation, PaperSize ); - } - break; - case iOpenjobdialog: - default: - /* MaxPage */ - if ( objc > 5 ) - { - int ParInt; - if (RET_ERROR == - Tcl_GetIntFromObj( interp, objv[5], &ParInt)) - { - Res = RET_ERROR; - } - MaxPage = (unsigned short) ParInt; - } else { - MaxPage = 0; - } - if ( Res == RET_OK ) - { - Res = PrintOpenJobDialog( - (TCHAR *)Tcl_DStringValue(& sPar1), - Orientation, - PaperSize, - MaxPage ); - } - break; - } - } - break; - case iFontCreate: - /* | Type | name | ParCur | objv | iParCur */ - /* +--------+---------------+-----------+-------+-------- */ - /* | int | Font number | 0 | 2 | 0 */ - /* | string | font name | 1 | 3 | % */ - /* | double | points | 2 | 4 | % */ - /* | choice | Weight | 3 | 5 | 3 */ - /* | int0/1 | Italic | 4 | 6 | 4 */ - /* | choice | Charset | 5 | 7 | 5 */ - /* | choice | Pitch | 6 | 8 | 6 */ - /* | choice | Family | 7 | 9 | 7 */ - { - double dPointSize; - int IndexOut; - const char ** pTable; - const char * pMsg; - const int *pValue; - - /* Set default values. */ - iPar[3] = FW_DONTCARE; /* Weight */ - iPar[4] = 0; /* Default Italic: off */ - iPar[5] = DEFAULT_CHARSET; /* Character set */ - iPar[6] = FW_DONTCARE; /* Pitch */ - iPar[7] = FF_DONTCARE; /* Family */ - - for ( ParCur = 0 ; ParCur < objc-2 && Res != RET_ERROR ; ParCur++) - { - switch (ParCur) - { - case 1: - /* Font name: Char parameter was already decoded */ - break; - case 2: - /* Point Size: double parameter */ - if (RET_ERROR == - Tcl_GetDoubleFromObj( - interp, - objv[ParCur+2],& dPointSize ) ) - { - Res = RET_ERROR; - } - break; - case 3: - /* Weight */ - case 5: - /* CharSet */ - case 6: - /* Pitch */ - case 7: - /* Family */ - switch (ParCur) - { - case 3: - pTable = fg_font_weight_sub_cmds; - pValue = fg_font_weight_i_command; - pMsg = "font weight"; - break; - case 5: - pTable = fg_font_charset_sub_cmds; - pValue = fg_font_charset_i_command; - pMsg = "font charset"; - break; - case 6: - pTable = fg_font_pitch_sub_cmds; - pValue = fg_font_pitch_i_command; - pMsg = "font pitch"; - break; - case 7: - default: - pTable = fg_font_family_sub_cmds; - pValue = fg_font_family_i_command; - pMsg = "font family"; - break; - } - if (RET_ERROR == - Tcl_GetIndexFromObj( - interp, objv[ParCur+2], pTable, - pMsg, 0, & IndexOut ) ) - { - Res = RET_ERROR; - } else { - iPar[ParCur] = pValue[IndexOut]; - } - break; - case 0: - /* Font Number */ - case 4: - /* Italic */ - default: - /* Int parameter */ - if (RET_ERROR == - Tcl_GetIntFromObj( - interp, - objv[ParCur+2],& (iPar[ParCur])) ) - { - Res = RET_ERROR; - } - break; - } - } - if (Res != RET_ERROR) - { - Res = PrintFontCreate( - iPar[0], (TCHAR *)Tcl_DStringValue(& sPar1), - dPointSize, iPar[3], - iPar[4], iPar[5], iPar[6], iPar[7]); - } - } - break; - case iFontselect: - /* One int parameter */ - TclResult = Tcl_GetIntFromObj(interp, objv[2], & (iPar[0])); - if (TclResult == RET_OK) { - Res = PrintFontSelect( iPar[0]); - } else { - Res = RET_ERROR; - } - break; - case iPen: - /* One int parameter and 3 optional color parameter. */ - if (RET_OK != Tcl_GetIntFromObj(interp, objv[2], & (iPar[0]))) { - Res = RET_ERROR; - } else { - COLORREF Color = 0; - if (objc > 3) { - int r,g,b; - if (RET_OK != Tcl_GetIntFromObj(interp, objv[3], &r)) { - Res = RET_ERROR; - } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[4], &g)) { - Res = RET_ERROR; - } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[5], &b)) { - Res = RET_ERROR; - } else { - Color = RGB(r/256,g/256,b/256); - } - } - Res = PrintPen( iPar[0],Color); - } - break; - case iBrushColor: - case iBkColor: - /* 3 color parameter. */ - { - COLORREF Color = 0; - int r,g,b; - if (RET_OK != Tcl_GetIntFromObj(interp, objv[2], &r)) { - Res = RET_ERROR; - } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[3], &g)) { - Res = RET_ERROR; - } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[4], &b)) { - Res = RET_ERROR; - } else { - Color = RGB(r/256,g/256,b/256); - } - if (Index == iBrushColor) - Res = PrintBrushColor(Color); - else - Res = PrintBkColor(Color); - } - break; - case iText: - case iTextuni: - /* Two int, one string and optional 3 color parameters. */ - if ( RET_OK != Tcl_GetIntFromObj(interp,objv[2],& (iPar[0])) ) { - Res = RET_ERROR; - } else if ( RET_OK != Tcl_GetIntFromObj(interp,objv[3],& (iPar[1])) ) { - Res = RET_ERROR; - } else { - COLORREF Color = 0; - if (objc > 5) { - int r,g,b; - if (RET_OK != Tcl_GetIntFromObj(interp, objv[5], &r)) { - Res = RET_ERROR; - } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[6], &g)) { - Res = RET_ERROR; - } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[7], &b)) { - Res = RET_ERROR; - } else { - Color = RGB(r/256,g/256,b/256); - } - } - Res = PrintText( iPar[0], iPar[1], - (TCHAR *)Tcl_DStringValue(& sPar1), Color ); - } - break; - case iGetFirstFontNochar: - /* One string. */ - Res = GetFirstTextNoChar( interp, (TCHAR *)Tcl_DStringValue(& sPar1)); - break; - case iRuler: - case iRectangle: - /* 4 int */ - for ( ParCur=0 ; ParCur < 4 ; ParCur++ ) - { - if ( RET_ERROR == Tcl_GetIntFromObj(interp, - objv[ParCur+2],& (iPar[ParCur])) ) - { - Res = RET_ERROR; - break; - } - } - if (Res != RET_ERROR) - { - if (Index == iRuler) - Res = PrintRuler(iPar[0], iPar[1], iPar[2], iPar[3]); - else - Res = PrintRectangle(iPar[0], iPar[1], iPar[2], iPar[3]); - } - break; - - case iPhoto: - /* tkImg + 2..4 int: X0, Y0, Width, Height */ - /* initialize optional parameters */ - iPar[2] = 0; - iPar[3] = 0; - for ( ParCur=0 ; ParCur < objc-3 ; ParCur++ ) - { - if ( RET_ERROR == Tcl_GetIntFromObj(interp, - objv[ParCur+3],& (iPar[ParCur])) ) - { - Res = RET_ERROR; - break; - } - } - if (Res != RET_ERROR) { - Res = PaintPhoto(interp, objv[2], iPar[0], iPar[1], iPar[2], - iPar[3]); - } - break; - } - /* - * Free any intermediated strings. - */ - - /* String parameter. */ - Tcl_DStringFree(& sPar1); + Tcl_HashEntry *data; + + if ( ( data = Tcl_FindHashEntry(att, key) ) != 0 ) + return (char *)Tcl_GetHashValue(data); + return 0; +} - /* - * Format return value. - */ - switch (Res) - { - case RET_OK_NO_RESULT_SET: - Tcl_SetStringObj( resultPtr, "", -1); - /* FALLTHRU */ - case RET_OK: - return RET_OK; - case RET_ERROR_PRINTER_IO: - Tcl_SetStringObj( resultPtr, "Printer I/O error",-1); - return RET_ERROR; - case RET_ERROR_MEMORY: - Tcl_SetStringObj( resultPtr, "Out of memory",-1); - return RET_ERROR; - case RET_ERROR_PARAMETER: - Tcl_SetStringObj( resultPtr, "Wrong parameter",-1); - return RET_ERROR; - case RET_ERROR_USER: - Tcl_SetStringObj( resultPtr, "User abort",-1); - return RET_ERROR; - case RET_ERROR_PRINTER_NOT_OPEN: - Tcl_SetStringObj( resultPtr, "Printer not open",-1); - return RET_ERROR; - case RET_ERROR_PRINTER_DRIVER: - Tcl_SetStringObj( resultPtr, "Printer driver error",-1); - return RET_ERROR; - default: - case RET_ERROR: - return RET_ERROR; - } +/* + *---------------------------------------------------------------------- + * + * del_attribute -- + * + * Remove a printer attribute key/value from the hash table. + * + * Results: + * Removes attribute. + * + *---------------------------------------------------------------------- + */ + + +static int del_attribute(Tcl_HashTable *att, const char *key) +{ + Tcl_HashEntry *data; + + if ( ( data = Tcl_FindHashEntry(att, key) ) != 0 ) + { + char *val; + if ( (val = (char *)Tcl_GetHashValue(data) ) != 0 ) + Tcl_Free(val); + Tcl_DeleteHashEntry(data); + return 1; + } + return 0; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- + * + * is_valid_printer_values -- * - * ReturnLockedDeviceName -- + * This function verifies that there is a printer values structure, + * and that it has the magic number in it. + * + * Results: + * Verifies printer structure. * - * Extract the locked device name from the hDevNames structure and returns - * its pointer. hDevNames must be unlocked on success (which captures - * the return value). + *---------------------------------------------------------------------- + */ + +static int is_valid_printer_values ( const struct printer_values *ppv ) +{ + if (ppv && ppv->magic == PVMAGIC) + return 1; + return 0; +} +/* + *---------------------------------------------------------------------- + * + * make_printer_values -- + * + * Create and initialize a printer_values structure. + * * Results: - * Returns the device name. + * Create printer structure. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -static TCHAR * ReturnLockedDeviceName( HGLOBAL hDevNames ) +static struct printer_values *make_printer_values(HDC hdc) { - LPDEVNAMES pDevNames; - pDevNames = (LPDEVNAMES) GlobalLock( hDevNames ); - if ( NULL == pDevNames ) - return NULL; - if ( pDevNames->wDeviceOffset == 0) - { - GlobalUnlock( hDevNames ); - return NULL; - } - return ( (TCHAR *) pDevNames ) + ( pDevNames->wDeviceOffset ); + struct printer_values *ppv; + if ( (ppv = (struct printer_values *)Tcl_Alloc(sizeof(struct printer_values)) ) == 0 ) + return 0; + memset(ppv, 0, sizeof(struct printer_values) ); + ppv->magic = PVMAGIC; + ppv->hDC = hdc; + Tcl_InitHashTable(&(ppv->attribs), TCL_STRING_KEYS); + return ppv; } - /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * GetDeviceName -- + * delete_printer_values -- * - * Extract the device name from the hDevNames structure and put it in the - * interpreter result. + * Cleans up a printer_values structure. * * Results: - * Returns the device name. + * Cleans printer structure. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -static char GetDeviceName( - Tcl_Interp *interp, - HGLOBAL hDevNames, - char Flags ) +static void delete_printer_values (struct printer_values *ppv) { - char Ret; - TCHAR * pPrinter; - Tcl_DString Printer; - - pPrinter = ReturnLockedDeviceName( hDevNames ); - if ( pPrinter == NULL ) - return RET_ERROR_PRINTER_IO; - - Tcl_DStringInit( &Printer ); - Tcl_WinTCharToUtf( pPrinter, -1, &Printer); - Ret = RET_OK; - if ( Flags & F_RETURN_LIST ) - { - Tcl_Obj *PrinterObj; - Tcl_Obj *lResult; - - PrinterObj = Tcl_NewStringObj( - Tcl_DStringValue( &Printer ), - Tcl_DStringLength( &Printer ) ); - Tcl_DStringFree( &Printer ); - - lResult = Tcl_GetObjResult( interp ); - if ( RET_OK != - Tcl_ListObjAppendElement( interp, lResult, PrinterObj )) - { - /* Error already set in interp */ - Ret = RET_ERROR; - } - } else { - Tcl_DStringResult( interp, &Printer ); - } - GlobalUnlock( hDevNames ); - - if ( Flags & F_FREE_MEM ) - { - GlobalFree(hDevNames); - } - return Ret; + if ( is_valid_printer_values(ppv) ) + { + ppv->magic = 0L; /* Prevent re-deletion.... */ + Tcl_DeleteHashTable(&ppv->attribs); + if ( ppv->pdevmode ) { + Tcl_Free( (char *) ppv->pdevmode ); + ppv->pdevmode = 0; + } + Tcl_Free((char *)ppv); + } } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintSelectPrinter -- + * GetPrinterWithName -- * - * Return the selected printer using the printer selection box. + * Returns the triple needed for creating a DC. * * Results: - * Returns the selected printer. + * Returns data to create device context. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -static char PrintSelectPrinter( Tcl_Interp *interp ) +static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, int wildcard) { - PrintReset( 1 ); - pdlg.Flags = 0 - | PD_DISABLEPRINTTOFILE - | PD_HIDEPRINTTOFILE - | PD_NOPAGENUMS - | PD_NOSELECTION - | PD_USEDEVMODECOPIESANDCOLLATE - ; - if ( PrintDlg( &pdlg ) == FALSE) - return RET_ERROR_USER; - /* Return the selected printer name. */ - if ( NULL == pdlg.hDevNames ) - return RET_ERROR_USER; - /* Get device names. */ - return GetDeviceName( interp, pdlg.hDevNames, 0 ); + /* The following 3 declarations are only needed for the Win32s case. */ + static char devices_buffer[256]; + static char value[256]; + char *cp; + + /* First ensure dev, dvr, and port are initialized empty + * This is not needed for normal cases, but at least one report on + * WinNT with at least one printer, this is not initialized. + * Suggested by Jim Garrison + . */ + *dev = *dvr = *port = ""; + + /* + * The result should be useful for specifying the devices and/or OpenPrinter and/or lp -d. + * Rather than make this compilation-dependent, do a runtime check. + */ + switch ( WinVersion() ) + { + case VER_PLATFORM_WIN32s: /* Windows 3.1. */ + /* Getting the printer list isn't hard... the trick is which is right for WfW? + * [PrinterPorts] or [devices]? + * For now, use devices. + . */ + /* First, get the entries in the section. */ + GetProfileString("devices", 0, "", (LPSTR)devices_buffer, sizeof devices_buffer); + + /* Next get the values for each entry; construct each as a list of 3 elements. */ + for (cp = devices_buffer; *cp ; cp+=strlen(cp) + 1) + { + GetProfileString("devices", cp, "", (LPSTR)value, sizeof value); + if ( ( wildcard != 0 && Tcl_StringMatch(value, name) ) || + ( wildcard == 0 && lstrcmpi (value, name) == 0 ) ) + { + static char stable_val[80]; + strncpy (stable_val, value,80); + stable_val[79] = '\0'; + return SplitDevice(stable_val, dev, dvr, port); + } + } + return 0; + break; + case VER_PLATFORM_WIN32_WINDOWS: /* Windows 95, 98. */ + case VER_PLATFORM_WIN32_NT: /* Windows NT. */ + default: + /* Win32 implementation uses EnumPrinters. */ + + /* There is a hint in the documentation that this info is stored in the registry. + * if so, that interface would probably be even better! + * NOTE: This implementation was suggested by Brian Griffin , + * and replaces the older implementation which used PRINTER_INFO_4,5. + */ + { + DWORD bufsiz = 0; + DWORD needed = 0; + DWORD num_printers = 0; + PRINTER_INFO_2 *ary = 0; + DWORD i; + + /* First, get the size of array needed to enumerate the printers. */ + if ( EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, + NULL, + 2, (LPBYTE)ary, + bufsiz, &needed, + &num_printers) == FALSE ) + { + /* Expected failure--we didn't allocate space. */ + DWORD err = GetLastError(); + /* If the error isn't insufficient space, we have a real problem.. */ + if ( err != ERROR_INSUFFICIENT_BUFFER ) + return 0; + } + + /* Now that we know how much, allocate it. */ + if ( needed > 0 && (ary = (PRINTER_INFO_2 *)Tcl_Alloc(needed) ) != 0 ) + bufsiz = needed; + else + return 0; + + if ( EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, + 2, (LPBYTE)ary, + bufsiz, &needed, + &num_printers) == FALSE ) + { + /* Now we have a real failure! */ + return 0; + } + + for (i=0; ihDC == NULL ) + { + /* + * Use the name to create a DC if at all possible: + * This may require using the printer list and matching on the name. + . */ + char *dev, *dvr, *port; + if ( GetPrinterWithName ((char *)printer_name, &dev, &dvr, &port, 1) == 0 ) { + return GETDEFAULTS_NOSUCHPRINTER; /* Can't find a printer with that name. */ + } + if ( (ppv->hDC = CreateDC(dvr, dev, NULL, NULL) ) == NULL ) { + return GETDEFAULTS_CANTCREATEDC; /* Can't get defaults on non-existent DC. */ + } + if ( OpenPrinter((char *)printer_name, &pHandle, NULL) == 0 ) { + return GETDEFAULTS_CANTOPENPRINTER; + } + } + + + /* Use DocumentProperties to get the default devmode. */ + if ( set_default_devmode > 0 || ppv->pdevmode == 0 ) + /* First get the required size:. */ + { + LONG siz = 0L; + + char *cp; + + siz = DocumentProperties (GetActiveWindow(), + pHandle, + (char *)printer_name, + NULL, + NULL, + 0); + + if ( siz > 0 && (cp = Tcl_Alloc(siz)) != 0 ) + { + if ( (siz = DocumentProperties (GetActiveWindow(), + pHandle, + (char *)printer_name, + (DEVMODE *)cp, + NULL, + DM_OUT_BUFFER)) >= 0 ) + { + if ( ppv->pdevmode != 0 ) + Tcl_Free ( (char *)(ppv->pdevmode) ); + ppv->pdevmode = (DEVMODE *)cp; + SetDevModeAttribs ( &ppv->attribs, ppv->pdevmode); + } else { + /* added 8/7/02 by Jon Hilbert + This call may fail when the printer is known to Windows but unreachable + for some reason (e.g. network sharing property changes). Add code to + test for failures here.. */ + /* call failed -- get error code. */ + ppv->errorCode = GetLastError(); + result = GETDEFAULTS_WINDOWSERROR; + /* release the DC. */ + DeleteDC(ppv->hDC); + ppv->hDC = 0; + } + } + } + if (pHandle) + ClosePrinter(pHandle); + + if (result == 1) /* Only do this if the attribute setting code succeeded. */ + SetHDCAttribs (&ppv->attribs, ppv->hDC); + + return result; /* A return of 0 or less indicates failure. */ +} - if ( pDevMode == NULL) - return NULL; +/* + *---------------------------------------------------------------------- + * + * MakeDevMode -- + * + * Creates devmode structure for printer. + * + * Results: + * Sets structure. + * + *---------------------------------------------------------------------- + */ - pText = NULL; - for (IndexCur = 0; fg_orient_sub_cmds[IndexCur] != NULL ; IndexCur++) - { - if ( pDevMode->dmOrientation == fg_orient_i_command[IndexCur] ) - { - pText = fg_orient_sub_cmds[IndexCur]; - break; - } - } - if ( NULL == pText ) - return NULL; - return Tcl_NewStringObj( pText, -1 ); +static void MakeDevmode (struct printer_values *ppv, HANDLE hdevmode) +{ + DEVMODE *pdm; + + if (ppv->pdevmode) + { + Tcl_Free((char *)(ppv->pdevmode)); + ppv->pdevmode = 0; + } + + if ( (pdm = (DEVMODE *)GlobalLock(hdevmode)) != NULL ) + { + if ( (ppv->pdevmode = (DEVMODE *)Tcl_Alloc(pdm->dmSize + pdm->dmDriverExtra)) != NULL ) + memcpy (ppv->pdevmode, pdm, pdm->dmSize + pdm->dmDriverExtra); + GlobalUnlock(hdevmode); + } } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * GetPaperSize-- + * CopyDevname -- * - * Search the DevMode structure for a paper size value and return - * it as a Tcl object. If not found, NULL is returned. + * Unlock and copy the devnames portion of the printer dialog. * * Results: - * Returns the paper size. + * Returns devnames. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -static Tcl_Obj * GetPaperSize( DEVMODE * pDevMode ) +static void CopyDevnames (struct printer_values *ppv, HANDLE hdevnames) { - const char * pText; - int IndexCur; - - if ( pDevMode == NULL) - return NULL; + DEVNAMES *pdn; + + if ( (pdn = (DEVNAMES *)GlobalLock(hdevnames)) != NULL ) + { + strcpy(ppv->devnames_filename, (char *)pdn + pdn->wDriverOffset); + strcpy(ppv->devnames_printername, (char *)pdn + pdn->wDeviceOffset); + if (ppv && ppv->pdevmode) { + /* As reported by Steve Bold, protect against unusually long printer names. */ + strncpy(ppv->pdevmode->dmDeviceName, (char *)pdn + pdn->wDeviceOffset,sizeof(ppv->pdevmode->dmDeviceName)); + ppv->pdevmode->dmDeviceName[sizeof(ppv->pdevmode->dmDeviceName)-1] = '\0'; + } + strcpy(ppv->devnames_port, (char *)pdn + pdn->wOutputOffset); + GlobalUnlock(hdevnames); + } +} - pText = NULL; - for (IndexCur = 0; fg_papersize_sub_cmds[IndexCur] != NULL ; IndexCur++) - { - if ( pDevMode->dmPaperSize == fg_papersize_i_command[IndexCur] ) - { - pText = fg_papersize_sub_cmds[IndexCur]; - break; - } - } - if ( NULL == pText ) - return NULL; +/* A macro for converting 10ths of millimeters to 1000ths of inches. */ +#define MM_TO_MINCH(x) ( (x) / 0.0254 ) +#define TENTH_MM_TO_MINCH(x) ( (x) / 0.254 ) +#define MINCH_TO_TENTH_MM(x) ( 0.254 * (x) ) + +static const struct paper_size { int size; long wid; long len; } paper_sizes[] = { + { DMPAPER_LETTER, 8500, 11000 }, + { DMPAPER_LEGAL, 8500, 14000 }, + { DMPAPER_A4, (long)MM_TO_MINCH(210), (long)MM_TO_MINCH(297) }, + { DMPAPER_CSHEET, 17000, 22000 }, + { DMPAPER_DSHEET, 22000, 34000 }, + { DMPAPER_ESHEET, 34000, 44000 }, + { DMPAPER_LETTERSMALL, 8500, 11000 }, + { DMPAPER_TABLOID, 11000, 17000 }, + { DMPAPER_LEDGER, 17000, 11000 }, + { DMPAPER_STATEMENT, 5500, 8500 }, + { DMPAPER_A3, (long)MM_TO_MINCH(297), (long)MM_TO_MINCH(420) }, + { DMPAPER_A4SMALL, (long)MM_TO_MINCH(210), (long)MM_TO_MINCH(297) }, + { DMPAPER_A5, (long)MM_TO_MINCH(148), (long)MM_TO_MINCH(210) }, + { DMPAPER_B4, (long)MM_TO_MINCH(250), (long)MM_TO_MINCH(354) }, + { DMPAPER_B5, (long)MM_TO_MINCH(182), (long)MM_TO_MINCH(257) }, + { DMPAPER_FOLIO, 8500, 13000 }, + { DMPAPER_QUARTO, (long)MM_TO_MINCH(215), (long)MM_TO_MINCH(275) }, + { DMPAPER_10X14, 10000, 14000 }, + { DMPAPER_11X17, 11000, 17000 }, + { DMPAPER_NOTE, 8500, 11000 }, + { DMPAPER_ENV_9, 3875, 8875 }, + { DMPAPER_ENV_10, 4125, 9500 }, + { DMPAPER_ENV_11, 4500, 10375 }, + { DMPAPER_ENV_12, 4750, 11000 }, + { DMPAPER_ENV_14, 5000, 11500 }, + { DMPAPER_ENV_DL, (long)MM_TO_MINCH(110), (long)MM_TO_MINCH(220) }, + { DMPAPER_ENV_C5, (long)MM_TO_MINCH(162), (long)MM_TO_MINCH(229) }, + { DMPAPER_ENV_C3, (long)MM_TO_MINCH(324), (long)MM_TO_MINCH(458) }, + { DMPAPER_ENV_C4, (long)MM_TO_MINCH(229), (long)MM_TO_MINCH(324) }, + { DMPAPER_ENV_C6, (long)MM_TO_MINCH(114), (long)MM_TO_MINCH(162) }, + { DMPAPER_ENV_C65, (long)MM_TO_MINCH(114), (long)MM_TO_MINCH(229) }, + { DMPAPER_ENV_B4, (long)MM_TO_MINCH(250), (long)MM_TO_MINCH(353) }, + { DMPAPER_ENV_B5, (long)MM_TO_MINCH(176), (long)MM_TO_MINCH(250) }, + { DMPAPER_ENV_B6, (long)MM_TO_MINCH(176), (long)MM_TO_MINCH(125) }, + { DMPAPER_ENV_ITALY, (long)MM_TO_MINCH(110), (long)MM_TO_MINCH(230) }, + { DMPAPER_ENV_MONARCH, 3825, 7500 }, + { DMPAPER_ENV_PERSONAL, 3625, 6500 }, + { DMPAPER_FANFOLD_US, 14825, 11000 }, + { DMPAPER_FANFOLD_STD_GERMAN, 8500, 12000 }, + { DMPAPER_FANFOLD_LGL_GERMAN, 8500, 13000 }, +}; - return Tcl_NewStringObj( pText, -1 ); -} /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * AppendOrientPaperSize-- + * GetDevModeAttribs -- * - * Append orientation and paper size to the configuration. + * Sets the devmode copy based on the attributes (syncronization). * * Results: - * Returns the paper size. + * Sets devmode copy. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -static char AppendOrientPaperSize( Tcl_Interp *interp, DEVMODE * pDevMode ) +static void GetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) { - Tcl_Obj *lResult; - Tcl_Obj *pObj; - - lResult = Tcl_GetObjResult( interp ); - - /* Orientation */ - pObj = GetOrientation( pDevMode ); - if ( pObj == NULL ) - return RET_ERROR_PRINTER_IO; + /* This function sets the devmode based on the attributes. + * The attributes set are: + * page orientation + * Paper sizes (Added 8/1/02 by Jon Hilbert) + * + * Still needed: + * Scale + * Paper names + * Print quality + * duplexing + * font downloading + * collation + * gray scale + * ??Print to file + * + * Taken care of elsewhere + * #copies + . */ + const char *cp; + + if ( cp = get_attribute(att, "page orientation") ) + { + dm->dmFields |= DM_ORIENTATION; + if ( strcmp(cp, "portrait") == 0 ) + dm->dmOrientation = DMORIENT_PORTRAIT; + else + dm->dmOrientation = DMORIENT_LANDSCAPE; + } + /* -------------- added 8/1/02 by Jon Hilbert; modified 2/24/03 by Jon Hilbert. */ + else if ( cp = get_attribute(att, "page dimensions") ) + { + long width,length; + dm->dmFields |= (DM_PAPERLENGTH | DM_PAPERWIDTH | DM_PAPERSIZE ); + sscanf(cp, "%ld %ld", &width, &length); + dm->dmPaperWidth = (short)MINCH_TO_TENTH_MM(width); + dm->dmPaperLength = (short)MINCH_TO_TENTH_MM(length); + // indicate that size is specified by dmPaperWidth,dmPaperLength + dm->dmPaperSize = 0; + } +} - if ( RET_OK != - Tcl_ListObjAppendElement( interp, lResult, pObj )) - { - return RET_ERROR; - } +/* + *---------------------------------------------------------------------- + * + * SetDevModeAttribs -- + * + * Copy attributes from devmode in dialog to attribute hash table. + * + * Results: + * Sets attributes. + * + *---------------------------------------------------------------------- + */ - /* PaperSize */ - pObj = GetPaperSize( pDevMode ); - if ( pObj == NULL ) - return RET_ERROR_PRINTER_IO; - if ( RET_OK != - Tcl_ListObjAppendElement( interp, lResult, pObj )) - { - return RET_ERROR; - } - return RET_OK; +static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) +{ + char tmpbuf[2*11+2+1]; + + /* + * Some printers print multiple copies--if so, the devmode carries the number + * of copies, while ppv->pdlg->nCopies may be set to one. + * We wish the user to see the number of copies. + */ + sprintf(tmpbuf, "%d", dm->dmCopies); + set_attribute(att, "copies", tmpbuf); + + /* Everything depends on what flags are set. */ + if ( dm->dmDeviceName[0] ) + set_attribute(att, "device", dm->dmDeviceName); + if ( dm->dmFields & DM_ORIENTATION ) + set_attribute(att, "page orientation", + dm->dmOrientation==DMORIENT_PORTRAIT?"portrait":"landscape"); + if ( dm->dmFields & DM_YRESOLUTION ) + { + sprintf(tmpbuf, "%d %d", dm->dmYResolution, dm->dmPrintQuality); + set_attribute(att, "resolution", tmpbuf); + } + else if ( dm->dmFields & DM_PRINTQUALITY) + { + /* The result may be positive (DPI) or negative (preset value). */ + if ( dm->dmPrintQuality > 0 ) + { + sprintf(tmpbuf, "%d %d", dm->dmPrintQuality, dm->dmPrintQuality); + set_attribute(att, "resolution", tmpbuf); + } + else + { + static struct PrinterQuality { + short res; + const char *desc; + } print_quality[] = + { + { DMRES_HIGH, "High" }, + { DMRES_MEDIUM, "Medium" }, + { DMRES_LOW, "Low" }, + { DMRES_DRAFT, "Draft" } + }; + int i; + const char *cp = "Unknown"; + + for (i = 0; i < sizeof(print_quality) / sizeof(struct PrinterQuality); i++) + { + if ( print_quality[i].res == dm->dmPrintQuality ) + { + cp = print_quality[i].desc; + break; + } + } + set_attribute(att, "resolution", cp); + } + } + + /* If the page size is provided by the paper size, use the page size to update + * the previous size from the HDC. + */ + if ( (dm->dmFields & DM_PAPERLENGTH) && (dm->dmFields & DM_PAPERWIDTH ) ) + { + sprintf(tmpbuf, "%ld %ld", (long)TENTH_MM_TO_MINCH(dm->dmPaperWidth), + (long)TENTH_MM_TO_MINCH(dm->dmPaperLength) ); + set_attribute(att, "page dimensions", tmpbuf); + } + else if ( dm->dmFields & DM_PAPERSIZE ) + { + /* If we are in this case, we must also check for landscape vs. portrait; + * unfortunately, Windows does not distinguish properly in this subcase + . */ + int i; + for ( i=0; i < sizeof(paper_sizes)/sizeof (struct paper_size); i++) + { + if ( paper_sizes[i].size == dm->dmPaperSize ) + { + if ( dm->dmOrientation == DMORIENT_PORTRAIT ) + { + sprintf(tmpbuf, "%ld %ld", paper_sizes[i].wid, paper_sizes[i].len); + set_attribute(att, "page dimensions", tmpbuf); + } + else if ( dm->dmOrientation == DMORIENT_LANDSCAPE ) + { + sprintf(tmpbuf, "%ld %ld", paper_sizes[i].len, paper_sizes[i].wid); + set_attribute(att, "page dimensions", tmpbuf); + } + } + } + } } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintPrinterSetup-- + * SetDevNamesAttribs -- * - * Show the page setup dialogue box and for paper size and orientation - * and return the users selection as Tcl variables. + * Converts dialog terms to attributes. * * Results: - * Returns the paper size and orientation. + * Sets attributes. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -static char PrintPrinterSetup( Tcl_Interp *interp, TCHAR *pPrinter, - short Orientation, short PaperSize) +static void SetDevNamesAttribs (Tcl_HashTable *att, struct printer_values *dn) { - char Res; - DEVMODE *pDevMode; - - PrintReset( 1 ); - Res = CreateDevMode( pPrinter, Orientation, PaperSize, 1 ); - if ( RET_OK != Res ) - return Res; - if ( pdlg.hDevMode == NULL ) - { - return RET_ERROR_PRINTER_IO; - } - pDevMode = GlobalLock( pdlg.hDevMode ); - if ( NULL == pDevMode ) - return RET_ERROR_MEMORY; - - /* Orientation and paper size */ - if ( Res == RET_OK ) - { - Res = AppendOrientPaperSize( interp, pDevMode ); - } - - GlobalUnlock( pdlg.hDevMode ); - - return Res; + /* Set the "device", "driver" and "port" attributes - (belt and suspenders). */ + if (dn->devnames_printername != NULL && strlen(dn->devnames_printername) > 0 ) + set_attribute(att,"device",dn->devnames_printername); + if (dn->devnames_filename != NULL && strlen(dn->devnames_filename)>0) + set_attribute(att,"driver",dn->devnames_filename); + if (dn->devnames_port != NULL && strlen(dn->devnames_port)>0) + set_attribute(att,"port",dn->devnames_port); } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintPageSetup-- + * GetPageDlgAttribs -- * - * Show the page setup dialogue box and return the users selection -* as Tcl variables. + * Gets page dialog attributes. * * Results: - * Returns the complete page setup. + * Gets attributes. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -static char PrintPageSetup( Tcl_Interp *interp, TCHAR *pPrinter, - short Orientation, short PaperSize, - int Left, int Top, int Right, int Bottom - ) +static void GetPageDlgAttribs (Tcl_HashTable *att, PAGESETUPDLG *pgdlg) { - PAGESETUPDLG sPageSetupDlg; - char Res; - Tcl_Obj *pObj; - Tcl_Obj *lResult; - - PrintReset( 1 ); - - ZeroMemory( & sPageSetupDlg, sizeof( sPageSetupDlg ) ); - sPageSetupDlg.lStructSize = sizeof( sPageSetupDlg ); - - /* Get old device names */ - sPageSetupDlg.hDevNames = pdlg.hDevNames; - - Res = CreateDevMode( pPrinter, Orientation, PaperSize, 0); - if (Res != RET_OK || pdlg.hDevMode == NULL ) - return Res; - - /* Copy devmode pointer */ - sPageSetupDlg.hDevMode = pdlg.hDevMode; - - /* Initialise with current values */ - sPageSetupDlg.Flags = 0 - | PSD_INHUNDREDTHSOFMILLIMETERS - | PSD_MARGINS - ; - sPageSetupDlg.rtMargin.left = ( Left != -1) ? Left : 2500; - sPageSetupDlg.rtMargin.top = ( Top != -1) ? Top : 2500; - sPageSetupDlg.rtMargin.right = ( Right != -1) ? Right : 2500; - sPageSetupDlg.rtMargin.bottom = ( Bottom != -1) ? Bottom : 2500; - - /* Show page setup dialog box. */ - if ( FALSE == PageSetupDlg( & sPageSetupDlg ) ) - { - DWORD Err; - Err = CommDlgExtendedError(); - if ( Err == 0 ) - { - /* User cancel. */ - return RET_ERROR_USER; - } else { - /* Printer error. */ - return RET_ERROR_PRINTER_IO; - } - } - - /* Get device name. */ - Res = GetDeviceName( interp, sPageSetupDlg.hDevNames, F_RETURN_LIST ); - - if ( sPageSetupDlg.hDevNames != pdlg.hDevNames - && sPageSetupDlg.hDevNames != NULL) - { - if ( pdlg.hDevNames != NULL ) - GlobalFree( pdlg.hDevNames ); - - pdlg.hDevNames = sPageSetupDlg.hDevNames; - } - - /* Get device mode data. */ - if ( sPageSetupDlg.hDevMode != NULL ) - { - DEVMODE *pDevMode; - pDevMode = GlobalLock( sPageSetupDlg.hDevMode ); - if ( NULL == pDevMode ) - return RET_ERROR_MEMORY; - - /* Orientation and paper size. */ - if ( Res == RET_OK ) - { - Res = AppendOrientPaperSize( interp, pDevMode ); - } - - /* Save the DevMode structure handle */ - if ( pdlg.hDevMode != sPageSetupDlg.hDevMode ) - { - if ( pdlg.hDevMode != NULL ) - GlobalFree( pdlg.hDevMode ); - pdlg.hDevMode = sPageSetupDlg.hDevMode; - } - GlobalUnlock( sPageSetupDlg.hDevMode ); - } - - /* Get and treat margin rectangle. */ - - lResult = Tcl_GetObjResult( interp ); - - if ( Res == RET_OK ) - { - pObj = Tcl_NewDoubleObj( sPageSetupDlg.rtMargin.left / 100.0 ); - if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, pObj )) - Res = RET_ERROR; - } - if ( Res == RET_OK ) - { - pObj = Tcl_NewDoubleObj( sPageSetupDlg.rtMargin.top / 100.0 ); - if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, pObj )) - Res = RET_ERROR; - } - if ( Res == RET_OK ) - { - pObj = Tcl_NewDoubleObj( sPageSetupDlg.rtMargin.right / 100.0 ); - if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, pObj )) - Res = RET_ERROR; - } - if ( Res == RET_OK ) - { - pObj = Tcl_NewDoubleObj( sPageSetupDlg.rtMargin.bottom / 100.0 ); - if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, pObj )) - Res = RET_ERROR; - } - return Res; + const char *cp; + + if ( cp = get_attribute(att, "page margins") ) { + RestorePageMargins(cp, pgdlg); + } + } - /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * CreateDevMode-- + * GetPrintDlgAttribs-- * - * Create a DevMode structure for the given settings. The devmode - * structure is put in a moveable memory object. The handle is placed - * in pdlg.hDevMode. + * Gets print dialog attributes. * * Results: - * Creates a DevMode structure for the printer. + * Gets attributes. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize, - char fShowPropertySheet ) + +static void GetPrintDlgAttribs (Tcl_HashTable *att, PRINTDLG *pdlg) { - HANDLE hPrinter; - DEVMODE* lpDevMode; - LONG Size; - DWORD fMode; - char fDevNamesLocked; - char Res; - - Res = RET_OK; - /* If no printer given use last or default printer. */ - if ( pPrinter == NULL || pPrinter[0] == '\0' ) - { - if ( pdlg.hDevNames == NULL ) - { - Res = LoadDefaultPrinter( ); - if ( Res != RET_OK ) - return Res; - } - pPrinter = ReturnLockedDeviceName( pdlg.hDevNames ); - fDevNamesLocked = 1; - } else { - fDevNamesLocked = 0; - } - /* Get Printer handle. */ - if ( FALSE == OpenPrinter( pPrinter, &hPrinter, NULL) ) - { - hPrinter = NULL; - Res = RET_ERROR_PRINTER_IO; - } - /* Get DevMode structure size. */ - if (Res == RET_OK ) - { - Size = DocumentProperties( NULL, hPrinter, pPrinter, NULL, NULL, 0 ); - if ( Size < 0 ) - { - Res = RET_ERROR_PRINTER_IO; - } - } - - /* Adjust or get new memory. */ - lpDevMode = NULL; - if (Res == RET_OK ) - { - if ( pdlg.hDevMode != NULL ) - pdlg.hDevMode = GlobalReAlloc( pdlg.hDevMode, Size, GMEM_ZEROINIT); - else - pdlg.hDevMode = GlobalAlloc( GMEM_MOVEABLE | GMEM_ZEROINIT, Size); - lpDevMode = GlobalLock( pdlg.hDevMode ); - if ( pdlg.hDevMode == NULL || lpDevMode == NULL) - { - Res = RET_ERROR_MEMORY; - } - } - - /* Initialise if new. */ - if ( Res == RET_OK && lpDevMode->dmSize == 0 ) - { - /* Get default values */ - if ( IDOK != DocumentProperties( - NULL, - hPrinter, - pPrinter, - lpDevMode, - NULL, - DM_OUT_BUFFER ) ) - { - Res = RET_ERROR_PRINTER_IO; - } - } - - if (Res == RET_OK ) - { - /* Set values. */ - if (Orientation != -1 ) - { - - lpDevMode->dmFields |= DM_ORIENTATION; - lpDevMode->dmOrientation = Orientation; - } - if ( PaperSize != -1 ) - { - lpDevMode->dmFields |= DM_PAPERSIZE; - lpDevMode->dmPaperSize = PaperSize; - } - /* ---------------------------------------------------------------------- */ - /* Modify present and eventually show property dialogue */ - fMode = DM_IN_BUFFER | DM_OUT_BUFFER; - if ( fShowPropertySheet ) - fMode |= DM_IN_PROMPT; - - Size = DocumentProperties( - NULL, - hPrinter, - pPrinter, - lpDevMode, - lpDevMode, - fMode ); - - if ( Size < 0 ) - { - Res = RET_ERROR_PRINTER_IO; - } - } - if ( fDevNamesLocked ) - GlobalUnlock( pdlg.hDevNames ); - if ( hPrinter != NULL ) - ClosePrinter( hPrinter ); - if ( lpDevMode != NULL ) - GlobalUnlock( pdlg.hDevMode ); - if ( Res != RET_OK ) - { - GlobalFree( pdlg.hDevMode ); - pdlg.hDevMode = NULL; - } - /* User may pres the cancel button when interactive. */ - if ( Res == RET_OK && fShowPropertySheet && Size == IDCANCEL ) - return RET_ERROR_USER; - return Res; + const char *cp; + + if ( cp = get_attribute(att, "copies") ) + pdlg->nCopies = atoi(cp); + + /* Add minimum and maximum page numbers to enable print page selection. */ + if ( cp = get_attribute(att, "minimum page") ) + { + pdlg->nMinPage = atoi(cp); + if ( pdlg->nMinPage <= 0 ) + pdlg->nMinPage = 1; + } + + if ( cp = get_attribute(att, "maximum page") ) + { + pdlg->nMaxPage = atoi(cp); + if ( pdlg->nMaxPage < pdlg->nMinPage ) + pdlg->nMaxPage = pdlg->nMinPage; + } + + if ( cp = get_attribute(att, "first page") ) + { + pdlg->nFromPage = atoi(cp); + if (pdlg->nFromPage > 0) + { + pdlg->Flags &= (~PD_ALLPAGES); + pdlg->Flags |= PD_PAGENUMS; + if ( pdlg->nMinPage > pdlg->nFromPage ) + pdlg->nMinPage = 1; + } + } + + if ( cp = get_attribute(att, "last page") ) + { + pdlg->nToPage = atoi(cp); + if ( pdlg->nToPage > 0 ) + { + pdlg->Flags &= (~PD_ALLPAGES); + pdlg->Flags |= PD_PAGENUMS; + if ( pdlg->nMaxPage < pdlg->nToPage ) + pdlg->nMaxPage = pdlg->nToPage; + } + } + + /* Added to match the radiobuttons on the windows dialog. */ + if ( cp = get_attribute(att, "print flag" ) ) + { + if (lstrcmpi(cp, "all") == 0 ) + pdlg->Flags &= (~(PD_PAGENUMS|PD_SELECTION)); + else if ( lstrcmpi(cp, "selection") == 0 ) + { + pdlg->Flags |= PD_SELECTION; + pdlg->Flags &= (~(PD_PAGENUMS|PD_NOSELECTION)); + } + else if ( lstrcmpi(cp, "pagenums") == 0 ) + { + pdlg->Flags |= PD_PAGENUMS; + pdlg->Flags &= (~(PD_SELECTION|PD_NOPAGENUMS)); + } + } } - /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintOpenPrinter-- + * SetPrintDlgAttribs-- * - * Open the given printer. + * Sets print dialog attributes. * * Results: - * Opens the selected printer. + * Sets attributes. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintOpenPrinter( - TCHAR * pPrinter, short Orientation, short PaperSize) + +static void SetPrintDlgAttribs (Tcl_HashTable *att, PRINTDLG *pdlg) { - DEVMODE* lpInitData; - char Res; - char fDevNamesLocked; - - PrintReset( 1 ); - - Res = CreateDevMode( pPrinter, Orientation, PaperSize, 0 ); - if ( RET_OK != Res ) - return Res; - if ( pdlg.hDevMode == NULL - || NULL == ( lpInitData = GlobalLock( pdlg.hDevMode ) ) ) - { - return RET_ERROR_MEMORY; - } - - /* - * If no printer given, it was loaded by CreateDevMode in - * pdlg.hDeviceNames. - */ - if ( pPrinter == NULL || pPrinter[0] == '\0' ) - { - if (pdlg.hDevNames == NULL - || NULL == (pPrinter = ReturnLockedDeviceName( pdlg.hDevNames ) ) ) - { - return RET_ERROR_PRINTER_IO; - } - fDevNamesLocked = 1; - } else { - fDevNamesLocked = 0; - } - - pdlg.hDC = CreateDC( - /* "WINSPOOL", */ - NULL, - pPrinter, - NULL, - lpInitData); - - GlobalUnlock( pdlg.hDevMode ); - if ( fDevNamesLocked ) - GlobalUnlock( pdlg.hDevNames ); - if ( pdlg.hDC == NULL) - return RET_ERROR_PRINTER_IO; - return RET_OK; + char tmpbuf[11+1]; + + /* + * This represents the number of copies the program is expected to spool + * (e.g., if collation is on) + . */ + sprintf(tmpbuf, "%d", pdlg->nCopies); + set_attribute(att, "copiesToSpool", tmpbuf); + + /* Set the to and from page if they are nonzero. */ + if ( pdlg->nFromPage > 0 ) + { + sprintf(tmpbuf, "%d", pdlg->nFromPage); + set_attribute(att, "first page", tmpbuf); + } + + if ( pdlg->nToPage > 0 ) + { + sprintf(tmpbuf, "%d", pdlg->nToPage); + set_attribute(att, "last page", tmpbuf); + } + + if ( pdlg->Flags & PD_PAGENUMS ) + set_attribute(att, "print flag", "pagenums"); + else if ( pdlg->Flags & PD_SELECTION ) + set_attribute(att, "print flag", "selection"); + else if ( ( pdlg->Flags & (PD_PAGENUMS | PD_SELECTION)) == 0 ) + set_attribute(att, "print flag", "all"); } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintOpenJobDialog-- + * SetPageSetupDlgAttribs-- * - * Open the print job dialog. + * Sets page setup dialog attributes. * * Results: - * Opens the job dialog. + * Sets attributes. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintOpenJobDialog( - TCHAR * pPrinter, - short Orientation, - short PaperSize, - unsigned short MaxPage - ) + +static void SetPageSetupDlgAttribs (Tcl_HashTable *att, PAGESETUPDLG *pgdlg) { - char Res; - - PrintReset( 1 ); - - Res = CreateDevMode( pPrinter, Orientation, PaperSize, 0 ); - if ( RET_OK != Res ) - return Res; - - if (MaxPage == 0) - { - pdlg.nFromPage = 0; - pdlg.nToPage = 0; - pdlg.nMinPage = 0; - pdlg.nMaxPage = 0; - } else { - if (pdlg.nFromPage < 1) - pdlg.nFromPage = 1; - if (pdlg.nToPage > MaxPage) - pdlg.nToPage = MaxPage; - pdlg.nMinPage = 1; - pdlg.nMaxPage = MaxPage; - } - - pdlg.Flags = PD_NOSELECTION | PD_USEDEVMODECOPIESANDCOLLATE | PD_RETURNDC ; - - if ( PrintDlg( &pdlg ) == FALSE) - return RET_ERROR_USER; + char tmpbuf[4*11 + 3 + 1]; + /* According to the PAGESETUPDLG page, the paper size and margins may be + * provided in locale-specific units. We want thousandths of inches + * for consistency at this point. Look for the flag: + . */ + int metric = (pgdlg->Flags & PSD_INHUNDREDTHSOFMILLIMETERS)?1:0; + double factor = 1.0; + + if ( metric ) + factor = 2.54; + + sprintf(tmpbuf, "%ld %ld", (long)(pgdlg->ptPaperSize.x / factor), + (long)(pgdlg->ptPaperSize.y / factor)); + set_attribute(att, "page dimensions", tmpbuf); + sprintf(tmpbuf, "%ld %ld %ld %ld", (long)(pgdlg->rtMargin.left / factor), + (long)(pgdlg->rtMargin.top / factor), + (long)(pgdlg->rtMargin.right / factor), + (long)(pgdlg->rtMargin.bottom / factor)); + set_attribute(att, "page margins", tmpbuf); + sprintf(tmpbuf, "%ld %ld %ld %ld", (long)(pgdlg->rtMinMargin.left / factor), + (long)(pgdlg->rtMinMargin.top / factor), + (long)(pgdlg->rtMinMargin.right / factor), + (long)(pgdlg->rtMinMargin.bottom / factor)); + set_attribute(att, "page minimum margins", tmpbuf); +} - return RET_OK; +/* + *---------------------------------------------------------------------- + * + * SetHDCAttribs -- + * + * Sets HDC attributes. + * + * Results: + * Sets attributes. + * + *---------------------------------------------------------------------- + */ + +static void SetHDCAttribs (Tcl_HashTable *att, HDC hDC) +{ + char tmpbuf[2*11+2+1]; + int hsize, vsize, hscale, vscale, hoffset, voffset, hppi, vppi; + + sprintf(tmpbuf, "0x%lx", hDC); + set_attribute(att, "hDC", tmpbuf); + + if ( PrintPageAttr(hDC, &hsize, &vsize, + &hscale, &vscale, + &hoffset, &voffset, + &hppi, &vppi) == 0 && + hppi > 0 && vppi > 0 ) + { + sprintf(tmpbuf, "%d %d", (int)(hsize*1000L/hppi), (int)(vsize*1000L/vppi)); + set_attribute(att, "page dimensions", tmpbuf); + sprintf(tmpbuf, "%d %d", hppi, vppi); + set_attribute(att, "pixels per inch", tmpbuf); + + /* Perhaps what's below should only be done if not already set.... */ + sprintf(tmpbuf, "%d %d %d %d", (int)(hoffset*1000L/hppi), (int)(voffset*1000L/vppi), + (int)(hoffset*1000L/hppi), (int)(voffset*1000L/vppi)); + set_attribute(att, "page minimum margins", tmpbuf); + set_attribute(att, "page margins", "1000 1000 1000 1000"); + } } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintReset-- + * StorePrintVals -- * - * Free any resource which might be opened by a print command. - * Initialise the print dialog structure. + * Stores the new DEVMODE and DEVNAMES structures + * if needed, and converts relevant portions of the structures + * to attribute/value pairs. * * Results: - * Free print resources and re-start the print dialog structure. + * Sets attributes. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintReset( char fPreserveDeviceData ) + +static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg) { - int i; - if (hPen != NULL) - { - SelectObject(pdlg.hDC, GetStockObject (BLACK_PEN)); - DeleteObject(hPen); - hPen = NULL; - } - if (SelectedFont != -1) - { - SelectObject(pdlg.hDC, GetStockObject(SYSTEM_FONT)); - SelectedFont = -1; - } - for (i = 0; i < 10 ; i++) - { - if (hFont[i] != NULL) - { - DeleteObject(hFont[i]); - hFont[i] = NULL; - } - } - /* - * Free members of the pdlg structure. - */ - if ( fPDLGInitialised ) - { - if (pdlg.hDC != NULL) - { - DeleteDC(pdlg.hDC); - pdlg.hDC = NULL; - } - if ( ! fPreserveDeviceData ) - { - - /* Free any Device mode data */ - if ( pdlg.hDevMode != NULL ) - { - GlobalFree( pdlg.hDevMode ); - pdlg.hDevMode = NULL; - } - /* Free any Device Names data. */ - if ( pdlg.hDevNames != NULL ) - { - GlobalFree( pdlg.hDevNames ); - pdlg.hDevNames = NULL; - } - } - } else { - /* - * Initialise pdlg structure. - */ - memset( &pdlg, 0, sizeof( PRINTDLG ) ); - pdlg.lStructSize = sizeof( PRINTDLG ); - fPDLGInitialised = TRUE; - } - return RET_OK; + /* + * If pdlg or pgdlg are nonzero, attribute/value pairs are + * extracted from them as well. + * A companion function is intended to convert attribute/value + * pairs in the ppv->attribs hash table to set the appropriate + * dialog values. + * All values in the hash table are strings to simplify getting + * and setting by the user; the job of converting to and from + * the platform-specific notion is left to the conversion function. + */ + + /* First, take care of the hDC structure. */ + if ( pdlg != NULL ) + { + const char *cp; + if ( ppv->hDC != NULL ) + { + delete_dc (ppv->hDC); + DeleteDC(ppv->hDC); + } + if ( ppv->hdcname[0] != '\0') + { + if (hdc_delete) + hdc_delete(0, ppv->hdcname); + ppv->hdcname[0] = '\0'; + } + ppv->hDC = pdlg->hDC; + /* Only need to do this if the hDC has changed. */ + if (ppv->hDC) + { + SetHDCAttribs(&ppv->attribs, ppv->hDC); + if (cp = make_printer_dc_name(0, ppv->hDC, ppv)) + { + strncpy(ppv->hdcname, cp, sizeof (current_printer_values->hdcname)); + set_attribute(&ppv->attribs, "hdcname", cp); + } + ppv->hdcname[sizeof (current_printer_values->hdcname) - 1] = '\0'; + } + } + + /* Next, get the DEVMODE out of the pdlg if present; + * if not, try the page dialog; if neither, skip this step + . */ + if ( pdlg != NULL && pdlg->hDevMode != NULL) + { + MakeDevmode(ppv, pdlg->hDevMode); + GlobalFree(pdlg->hDevMode); + pdlg->hDevMode = NULL; + SetDevModeAttribs(&ppv->attribs, ppv->pdevmode); + } + else if (pgdlg != NULL && pgdlg->hDevMode != NULL) + { + MakeDevmode (ppv, pgdlg->hDevMode); + GlobalFree(pgdlg->hDevMode); + pgdlg->hDevMode = NULL; + SetDevModeAttribs(&ppv->attribs, ppv->pdevmode); + } + + /* Next, get the DEVNAMES out of the pdlg if present; + * if not, try the page dialog; if neither, skip this step + . */ + if ( pdlg != NULL && pdlg->hDevNames != NULL) + { + CopyDevnames(ppv, pdlg->hDevNames); + GlobalFree(pdlg->hDevNames); + pdlg->hDevNames = NULL; + SetDevNamesAttribs(&ppv->attribs, ppv); + } + else if (pgdlg != NULL && pgdlg->hDevNames != NULL) + { + CopyDevnames(ppv, pgdlg->hDevNames); + GlobalFree(pgdlg->hDevNames); + pgdlg->hDevNames = NULL; + SetDevNamesAttribs(&ppv->attribs, ppv); + } + + /* Set attributes peculiar to the print dialog. */ + if (pdlg != NULL) + SetPrintDlgAttribs(&ppv->attribs, pdlg); + + /* Set attributes peculiar to the page setup dialog. */ + if (pgdlg != NULL) + SetPageSetupDlgAttribs(&ppv->attribs, pgdlg); } + /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintOpenDoc-- + * RestorePageMargins -- * - * Opens the document for printing. + * Restores page margins. * * Results: - * Opens the print document. + * Page margins are restored. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char PrintOpenDoc(Tcl_Obj *resultPtr, TCHAR *DocName) +static void RestorePageMargins (const char *attrib, PAGESETUPDLG *pgdlg) { - int JobID; - DOCINFO di; - - if (pdlg.hDC == NULL) - return RET_ERROR_PRINTER_NOT_OPEN; - memset( &di, 0, sizeof( DOCINFO ) ); - di.cbSize = sizeof( DOCINFO ); - di.lpszDocName = DocName; - JobID = StartDoc(pdlg.hDC, &di); - if ( JobID > 0 ) - { - Tcl_SetIntObj(resultPtr, JobID); - return RET_OK; - } - return RET_ERROR_PRINTER_IO; + /* + * This function is domain-specific (in the longer term, probably + * an attribute to determine read-only vs. read-write and which + * dialog it's relevant to and a function to do the conversion + * would be appropriate). + * Fix for metric measurements submitted by Michael Thomsen . + */ + RECT r; + double left, top, right, bottom; + + /* According to the PAGESETUPDLG page, the paper size and margins may be + * provided in locale-specific units. We want thousandths of inches + * for consistency at this point. Look for the flag: + . */ + int metric = (default_printer_values.pgdlg.Flags & PSD_INHUNDREDTHSOFMILLIMETERS)?1:0; + double factor = 1.0; + + if ( metric ) + factor = 2.54; + + if ( sscanf(attrib, "%lf %lf %lf %lf", &left, &top, &right, &bottom) == 4 ) { + r.left = (long) (floor(left * factor + 0.5)); + r.top = (long) (floor(top * factor + 0.5)); + r.right = (long) (floor(right * factor + 0.5)); + r.bottom = (long) (floor(bottom * factor + 0.5)); + pgdlg->rtMargin = r; + pgdlg->Flags |= PSD_MARGINS|PSD_INTHOUSANDTHSOFINCHES; + } } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintCloseDoc-- + * RestorePrintVals -- * - * Closes the document for printing. + * Sets the attributes in ppv->attribs into the + * print dialog or page setup dialog as requested. * * Results: - * Closes the print document. + * Sets attributes. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ + +static void RestorePrintVals (struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg) +{ + if (pdlg) + { + /* + * Values to be restored: + * copies + * first page + * last page + . */ + GetPrintDlgAttribs(&ppv->attribs, pdlg); + + /* Note: if DEVMODE is not null, copies is taken from the DEVMODE structure. */ + if (ppv->pdevmode ) + ppv->pdevmode->dmCopies = pdlg->nCopies; + + } + + if (pgdlg) + { + /* + * Values to be restored: + * page margins + . */ + GetPageDlgAttribs(&ppv->attribs, pgdlg); + } +} +/* + * To make the print command easier to extend and administer, + * the subcommands are in a table. + * Since I may not make the correct assumptions about what is + * considered safe and unsafe, this is parameterized in the + * function table. + * For now the commands will be searched linearly (there are only + * a few), but keep them sorted, so a binary search could be used. + */ +typedef int (*tcl_prtcmd) (ClientData, Tcl_Interp *, int, const char * ); +struct prt_cmd +{ + const char *name; + tcl_prtcmd func; + int safe; +}; -char PrintCloseDoc() +static struct prt_cmd printer_commands[] = + { + { "attr", PrintAttr, 1 }, + { "close", PrintClose, 1 }, + { "dialog", PrintDialog, 1 }, + { "job", PrintJob, 1 }, + { "list", PrintList, 1 }, + { "open", PrintOpen, 1 }, + { "option", PrintOption, 0 }, + { "page", PrintPage, 1 }, + { "send", PrintSend, 1 }, + { "version", Version, 1 }, + }; + +/* + * We can also build the global usage message dynamically. + */ +static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, int safe) { - if ( EndDoc(pdlg.hDC) > 0) - return RET_OK; - return RET_ERROR_PRINTER_IO; + int i; + int last = sizeof printer_commands / sizeof (struct prt_cmd); + int first=1; + Tcl_AppendResult(interp, "printer [", 0); + for (i=0; i < last; i++) + { + if ( printer_commands[i].safe >= safe ) + { + if (first) + { + Tcl_AppendResult(interp, " ", printer_commands[i].name, 0); + first = 0; + } + else + Tcl_AppendResult(interp, " | ", printer_commands[i].name, 0); + } + if ( i == (last - 1) ) + Tcl_AppendResult(interp, " ]", 0); + } + if (argc) + { + Tcl_AppendResult(interp, "\n(Bad command: ", 0 ); + for (i=0; i= safe ) + if ( strcmp(argv[0], printer_commands[i].name) == 0 ) + return printer_commands[i].func(defaults, interp, argc-1, argv+1); + + top_usage_message(interp, argc+1, argv-1, safe); + return TCL_ERROR; } + /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintClosePage-- + * printer -- * - * Closes the printed page. + * Core command. * * Results: - * Closes the page. + * Executes print command/subcommand. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char PrintClosePage() +static int printer (ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - if ( EndPage(pdlg.hDC) > 0) - return RET_OK; - return RET_ERROR_PRINTER_IO; + if ( argc > 1 ) + { + argv++; + argc--; + return Print(data, interp, argc, argv, 0); + } + + top_usage_message(interp, argc, argv, 0); + return TCL_ERROR; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintGetAttr-- + * Winprint_Init -- * - * Get the printer attributes. + * Initializes this command. * * Results: - * Returns the printer attributes. + * Command is initialized. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ + +int Winprint_Init(Tcl_Interp * interp) { -char PrintGetAttr(Tcl_Interp *interp, int Index) -{ - char Res; - DEVMODE * pDevMode; + Tcl_CreateObjCommand(interp, "::tk::print::_print", printer, + (ClientData)( & current_printer_values), 0); - /* - * State variables. - */ + /* Initialize the attribute hash table. */ + init_printer_dc_contexts(interp); - /* Check for open printer when hDC is required. */ - switch ( Index ) - { - case iMapMode: - case iAveCharHeight: - case iAveCharWidth: - case iHorzRes: - case iVertRes: - case iDPI: - case iPhysicalOffsetX: - case iPhysicalOffsetY: - case iFonts: - case iFontNames: - case iFontUnicodeRanges: - if (pdlg.hDC == NULL) - return RET_ERROR_PRINTER_NOT_OPEN; - } + /* Initialize the attribute hash table. */ + Tcl_InitHashTable( & (current_printer_values -> attribs), TCL_STRING_KEYS); - /* Check for Allocated DeviceMode structure. */ - switch ( Index ) - { - case iOrientation: - case iPaperSize: - if (pdlg.hDevMode == NULL) - return RET_ERROR_PRINTER_NOT_OPEN; - pDevMode = GlobalLock( pdlg.hDevMode ); - if ( pDevMode == NULL ) - return RET_ERROR_MEMORY; - break; - default: - pDevMode = NULL; - break; - } + /* Initialize the list of HDCs hash table. */ + Tcl_InitHashTable( & printer_hdcs, TCL_ONE_WORD_KEYS); - /* Choice of option. */ - Res = RET_OK; - switch ( Index ) - { - case iCopies: - Tcl_SetIntObj(Tcl_GetObjResult(interp), pdlg.nCopies); - return RET_OK; - case iFirstPage: - Tcl_SetIntObj(Tcl_GetObjResult(interp), - 0 != (pdlg.Flags & PD_PAGENUMS) ? pdlg.nFromPage : pdlg.nMinPage); - return RET_OK; - case iLastPage: - Tcl_SetIntObj(Tcl_GetObjResult(interp), - 0 != (pdlg.Flags & PD_PAGENUMS) ? pdlg.nToPage : pdlg.nMaxPage); - return RET_OK; - case iMapMode: - { - int MapMode; - int Pos; - MapMode = GetMapMode(pdlg.hDC); - if ( 0 == MapMode ) - return RET_ERROR_PRINTER_IO; - for ( Pos = 0 ; NULL != fg_map_modes_sub_cmds[Pos] ; Pos++ ) - { - if ( MapMode == fg_map_modes_i_command[Pos] ) - { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - fg_map_modes_sub_cmds[Pos], -1); - return RET_OK; - } - } - return RET_ERROR_PARAMETER; - } - case iAveCharHeight: - { - TEXTMETRIC tm; - if( TRUE==GetTextMetrics(pdlg.hDC, &tm)) - { - Tcl_SetIntObj( - Tcl_GetObjResult(interp), - tm.tmHeight + tm.tmExternalLeading); - return RET_OK; - } - return RET_ERROR_PRINTER_IO; - } - case iAveCharWidth: - { - TEXTMETRIC tm; - if( TRUE==GetTextMetrics(pdlg.hDC, &tm)) - { - Tcl_SetIntObj(Tcl_GetObjResult( interp ), tm.tmAveCharWidth); - return RET_OK; - } - return RET_ERROR_PRINTER_IO; - } - case iHorzRes: - Tcl_SetIntObj( - Tcl_GetObjResult( interp ), - GetDeviceCaps(pdlg.hDC, HORZRES)); - return RET_OK; - case iVertRes: - Tcl_SetIntObj( - Tcl_GetObjResult( interp ), - GetDeviceCaps(pdlg.hDC, VERTRES)); - return RET_OK; - case iDPI: - Tcl_SetIntObj( - Tcl_GetObjResult( interp ), - GetDeviceCaps(pdlg.hDC, LOGPIXELSX)); - return RET_OK; - case iPhysicalOffsetX: - Tcl_SetIntObj( - Tcl_GetObjResult( interp ), - GetDeviceCaps(pdlg.hDC, PHYSICALOFFSETX)); - return RET_OK; - case iPhysicalOffsetY: - Tcl_SetIntObj( - Tcl_GetObjResult( interp ), - GetDeviceCaps(pdlg.hDC, PHYSICALOFFSETY)); - return RET_OK; - case iPrinter: - if ( fPDLGInitialised - && pdlg.hDevNames != NULL) - { - return GetDeviceName( interp, pdlg.hDevNames, FALSE ); - } else { - return RET_ERROR_PRINTER_IO; - } - case iOrientation: - { - Tcl_Obj * pObj; - pObj = GetOrientation( pDevMode ); - if ( pObj != NULL ) - { - Tcl_SetObjResult( interp, pObj ); - } else { - Res = RET_ERROR_PRINTER_IO; - } - } - break; - case iPaperSize: - { - Tcl_Obj * pObj; - pObj = GetPaperSize( pDevMode ); - if ( pObj != NULL ) - { - Tcl_SetObjResult( interp, pObj ); - } else { - Res = RET_ERROR_PRINTER_IO; - } - } - break; - case iDefaultPrinter: - return DefaultPrinterGet( interp ); - case iPrinters: - return ListPrinters( interp ); - case iPaperTypes: - return ListChoices( interp, fg_papersize_sub_cmds ); - case iMapModes: - return ListChoices( interp, fg_map_modes_sub_cmds ); - case iFontWeights: - return ListChoices( interp, fg_font_weight_sub_cmds ); - case iFontCharsets: - return ListChoices( interp, fg_font_charset_sub_cmds ); - case iFontPitchValues: - return ListChoices( interp, fg_font_pitch_sub_cmds ); - case iFontFamilies: - return ListChoices( interp, fg_font_family_sub_cmds ); - case iFonts: - return ListFonts( interp, pdlg.hDC, 0 ); - case iFontNames: - return ListFonts( interp, pdlg.hDC, 1 ); - case iFontUnicodeRanges: - return ListFontUnicodeRanges( interp, pdlg.hDC); - default: - Res = RET_ERROR_PARAMETER; - break; - } - - /* Unlock pDevMode. */ - if ( NULL != pDevMode ) - GlobalUnlock( pdlg.hDevMode ); + /* Initialize the default page settings. */ + current_printer_values -> pgdlg.lStructSize = sizeof(PAGESETUPDLG); + current_printer_values -> pgdlg.Flags |= PSD_RETURNDEFAULT; - return Res; + return TCL_OK; } + + /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintSetAttr-- + * SplitDevice -- * - * Set the printer attributes. + * Divide the default printing device into its component parts. * * Results: - * Returns the printer attributes. + * Device components are returned. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char PrintSetAttr(Tcl_Interp *interp, int Index, Tcl_Obj *oParam) +static int SplitDevice(LPSTR device, LPSTR *dev, LPSTR *dvr, LPSTR *port) { - switch ( Index ) - { - case iMapMode: - { - int IndexMapMode; - if (RET_ERROR == - Tcl_GetIndexFromObj( - interp, oParam, fg_map_modes_sub_cmds, - "setmapmode", 1, &IndexMapMode)) - { - return RET_ERROR; - } - return PrintSetMapMode( fg_map_modes_i_command[IndexMapMode] ); - } - default: - return RET_ERROR_PARAMETER; - } + static char buffer[256]; + if (device == 0 ) + { + switch ( WinVersion() ) + { + case VER_PLATFORM_WIN32s: + GetProfileString("windows", "device", "", (LPSTR)buffer, sizeof buffer); + device = (LPSTR)buffer; + break; + case VER_PLATFORM_WIN32_WINDOWS: + case VER_PLATFORM_WIN32_NT: + default: + device = (LPSTR)"WINSPOOL,Postscript,"; + break; + } + } + + *dev = strtok(device, ","); + *dvr = strtok(NULL, ","); + *port = strtok(NULL, ","); + + if (*dev) + while ( * dev == ' ') + (*dev)++; + if (*dvr) + while ( * dvr == ' ') + (*dvr)++; + if (*port) + while ( * port == ' ') + (*port)++; + + return 1; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * LoadDefaultPrinter-- + * GetPrinterDC -- * - * Loads the default printer in the pdlg structure. + * Build a compatible printer DC for the default printer. * * Results: - * Loads the default printer. + * Returns DC. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char LoadDefaultPrinter( ) + +static HDC GetPrinterDC (const char *printer) { - PrintReset( 1 ); - pdlg.Flags = PD_RETURNDEFAULT ; - if ( PrintDlg( &pdlg ) == FALSE) - return RET_ERROR_PRINTER_IO; - if ( pdlg.hDevNames == NULL) - return RET_ERROR_PRINTER_IO; - return RET_OK; + HDC hdcPrint; + + LPSTR lpPrintDevice = ""; + LPSTR lpPrintDriver = ""; + LPSTR lpPrintPort = ""; + + SplitDevice ((LPSTR)printer, &lpPrintDevice, &lpPrintDriver, &lpPrintPort); + switch ( WinVersion() ) + { + case VER_PLATFORM_WIN32s: + hdcPrint = CreateDC (lpPrintDriver, + lpPrintDevice, + lpPrintPort, + NULL); + break; + case VER_PLATFORM_WIN32_WINDOWS: + case VER_PLATFORM_WIN32_NT: + default: + hdcPrint = CreateDC (lpPrintDriver, + lpPrintDevice, + NULL, + NULL); + break; + } + + return hdcPrint; } +/* End of support for file printing. */ + + /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * DefaultPrinterGet-- + * PrintStatusToStr -- * - * Gets the default printer in the pdlg structure. + * Convert a status code to a string. + * Function created by Brian Griffin * * Results: - * Returns the default printer. + * Returns status code. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char DefaultPrinterGet( Tcl_Interp *interp ) +static const char *PrintStatusToStr( DWORD status ) { - char Res; - Res = LoadDefaultPrinter(); - if ( Res == RET_OK ) - Res = GetDeviceName( interp, pdlg.hDevNames, FALSE ); - return RET_OK; + switch (status) { + case PRINTER_STATUS_PAUSED: return "Paused"; + case PRINTER_STATUS_ERROR: return "Error"; + case PRINTER_STATUS_PENDING_DELETION: return "Pending Deletion"; + case PRINTER_STATUS_PAPER_JAM: return "Paper jam"; + case PRINTER_STATUS_PAPER_OUT: return "Paper out"; + case PRINTER_STATUS_MANUAL_FEED: return "Manual feed"; + case PRINTER_STATUS_PAPER_PROBLEM: return "Paper problem"; + case PRINTER_STATUS_OFFLINE: return "Offline"; + case PRINTER_STATUS_IO_ACTIVE: return "IO Active"; + case PRINTER_STATUS_BUSY: return "Busy"; + case PRINTER_STATUS_PRINTING: return "Printing"; + case PRINTER_STATUS_OUTPUT_BIN_FULL: return "Output bit full"; + case PRINTER_STATUS_NOT_AVAILABLE: return "Not available"; + case PRINTER_STATUS_WAITING: return "Waiting"; + case PRINTER_STATUS_PROCESSING: return "Processing"; + case PRINTER_STATUS_INITIALIZING: return "Initializing"; + case PRINTER_STATUS_WARMING_UP: return "Warming up"; + case PRINTER_STATUS_TONER_LOW: return "Toner low"; + case PRINTER_STATUS_NO_TONER: return "No toner"; + case PRINTER_STATUS_PAGE_PUNT: return "Page punt"; + case PRINTER_STATUS_USER_INTERVENTION: return "User intervention"; + case PRINTER_STATUS_OUT_OF_MEMORY: return "Out of memory"; + case PRINTER_STATUS_DOOR_OPEN: return "Door open"; + case PRINTER_STATUS_SERVER_UNKNOWN: return "Server unknown"; + case PRINTER_STATUS_POWER_SAVE: return "Power save"; + case 0: return "Ready"; + default: break; + } + return "Unknown"; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * ListPrinters-- + * PrintList -- * - * Lists all available printers on the system. + * Returns the list of available printers in + * a format convenient for the print command. + * Brian Griffin suggested and implemented + * the -verbose flag, and the new Win32 implementation. * * Results: - * Returns the printer list. + * Returns printer list. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - - -char ListPrinters(Tcl_Interp *interp) + +static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const char * argv) { - DWORD dwSize = 0; - DWORD dwPrinters = 0; - PRINTER_INFO_5* pInfo; - char Res; - - /* Initialise result value. */ - Res = RET_OK; - - /* Find required buffer size. */ - if (! EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_CONNECTIONS, - NULL, 5, NULL, 0, &dwSize, &dwPrinters)) - { - /* - * Check for ERROR_INSUFFICIENT_BUFFER. - * If something else, then quit. - */ - if ( GetLastError() != ERROR_INSUFFICIENT_BUFFER) - { - /* No printer. */ - return RET_ERROR_PRINTER_IO; - } - /* Fall through */ - } - - /* Allocate the buffer memory */ - pInfo = (PRINTER_INFO_5 *) GlobalAlloc(GMEM_FIXED, dwSize); - if (pInfo == NULL) - { - /* Out of memory */ - return RET_ERROR_MEMORY; - } - - /* - * Fill the buffer. Again, - * this depends on the O/S. - */ - if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_CONNECTIONS, - NULL, 5, (unsigned char *)pInfo, dwSize, &dwSize, &dwPrinters)) - { - /* We have got the list of printers. */ - DWORD PrinterCur; - Tcl_Obj *lPrinter; - - /* Initialise return list.*/ - lPrinter = Tcl_GetObjResult( interp ); - - /* Loop adding the printers to the list. */ - for ( PrinterCur = 0; PrinterCur < dwPrinters; PrinterCur++, pInfo++) - { - Tcl_DString Printer; - Tcl_Obj *PrinterObj; - Tcl_DStringInit( &Printer ); - Tcl_WinTCharToUtf(pInfo->pPrinterName, -1, &Printer); - PrinterObj = Tcl_NewStringObj( - Tcl_DStringValue( &Printer ), - Tcl_DStringLength( &Printer ) ); - Tcl_DStringFree( &Printer ); - if ( RET_OK != Tcl_ListObjAppendElement( interp, lPrinter, PrinterObj )) + char *usgmsg = "::tk::print::_print list [-match matchstring] [-verbose]"; + const char *match = 0; + const char *illegal = 0; + + /* The following 3 declarations are only needed for the Win32s case. */ + static char devices_buffer[256]; + static char value[256]; + char *cp; + + int i; + int verbose = 0; + + for (i=0; i, + * and replaces the older implementation which used PRINTER_INFO_4,5 + . */ + { + DWORD bufsiz = 0; + DWORD needed = 0; + DWORD num_printers = 0; + PRINTER_INFO_2 *ary = 0; + DWORD i; + + /* First, get the size of array needed to enumerate the printers. */ + if ( EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, + NULL, + 2, (LPBYTE)ary, + bufsiz, &needed, + &num_printers) == FALSE ) + { + /* Expected failure--we didn't allocate space. */ + DWORD err = GetLastError(); + /* If the error isn't insufficient space, we have a real problem.. */ + if ( err != ERROR_INSUFFICIENT_BUFFER ) + { + sprintf (msgbuf, "EnumPrinters: unexpected error code: %ld", (long)err); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + } + + if ( needed > 0 ) { + if ( (ary = (PRINTER_INFO_2 *)Tcl_Alloc(needed) ) != 0 ) + bufsiz = needed; + else + { + sprintf (msgbuf, "EnumPrinters: Out of memory in request for %ld bytes", (long)needed); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + } else { /* No printers to report!. */ + return TCL_OK; + } + + /* Now that we know how much, allocate it -- if there is a printer!. */ + if ( EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, + 2, (LPBYTE)ary, + bufsiz, &needed, + &num_printers) == FALSE ) + { + /* Now we have a real failure!. */ + sprintf(msgbuf, "::tk::print::_print list: Cannot enumerate printers: %ld", (long)GetLastError()); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + return TCL_ERROR; + } + + /* Question for UTF: Do I need to convert all visible output? + * Or just the printer name and location? + . */ + + /* Question for Win95: Do I need to provide the port number?. */ + for (i=0; i 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) + { + const char *ostring; + Tcl_DString tds; + Tcl_DStringInit(&tds); + Tcl_UtfToExternalDString(NULL, ary[i].pPrinterName, -1, &tds); + ostring = Tcl_DStringValue(&tds); + Tcl_AppendElement(interp, ostring); + Tcl_DStringFree(&tds); + } +#else + Tcl_AppendElement(interp, ary[i].pPrinterName); +#endif + Tcl_AppendResult(interp, "} ", 0); + Tcl_AppendResult(interp, "{", 0); + Tcl_AppendElement(interp, "Status"); + Tcl_AppendElement(interp, PrintStatusToStr(ary[i].Status) ); + Tcl_AppendResult(interp, "} ", 0); + if ( ary[i].pDriverName && ary[i].pDriverName[0] != '\0') + { + Tcl_AppendResult(interp, "{", 0); + Tcl_AppendElement(interp, "Driver"); + Tcl_AppendElement(interp, ary[i].pDriverName ); + Tcl_AppendResult(interp, "} ", 0); + } + if ( ary[i].pServerName && ary[i].pServerName[0] != '\0') + { + Tcl_AppendResult(interp, "{", 0); + Tcl_AppendElement(interp, "Control"); + Tcl_AppendElement(interp, "Server" ); + Tcl_AppendResult(interp, "} ", 0); + Tcl_AppendResult(interp, "{", 0); + Tcl_AppendElement(interp, "Server"); + Tcl_AppendElement(interp, ary[i].pServerName ); + Tcl_AppendResult(interp, "} ", 0); + } + else + { + Tcl_AppendResult(interp, "{", 0); + Tcl_AppendElement(interp, "Control"); + Tcl_AppendElement(interp, "Local" ); + Tcl_AppendResult(interp, "} ", 0); + Tcl_AppendResult(interp, "{", 0); + Tcl_AppendElement(interp, "Port"); + Tcl_AppendElement(interp, ary[i].pPortName ); + Tcl_AppendResult(interp, "} ", 0); + } + if ( ary[i].pLocation && ary[i].pLocation[0] != '\0') + { + Tcl_AppendResult(interp, "{", 0); + Tcl_AppendElement(interp, "Location"); +#if TCL_MAJOR_VERSION > 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) { - /* Error already set in interp. */ - Res = RET_ERROR; - break; + const char *ostring; + Tcl_DString tds; + Tcl_DStringInit(&tds); + Tcl_UtfToExternalDString(NULL, ary[i].pLocation, -1, &tds); + ostring = Tcl_DStringValue(&tds); + Tcl_AppendElement(interp, ostring); + Tcl_DStringFree(&tds); } - } - } else { - /* Error - unlikely though as first call to EnumPrinters succeeded! */ - return RET_ERROR_PRINTER_IO; - } - - GlobalFree( pInfo ); - - return Res; +#else + Tcl_AppendElement(interp, ary[i].pLocation); +#endif + Tcl_AppendResult(interp, "} ", 0); + } + Tcl_AppendResult(interp, "{", 0); + Tcl_AppendElement(interp, "Queued Jobs"); + sprintf(msgbuf, "%ld", (long)ary[i].cJobs); + Tcl_AppendElement(interp, msgbuf ); + Tcl_AppendResult(interp, "} ", 0); + /* End of this printer's list. */ + Tcl_AppendResult(interp, "}\n", 0); + } + else + Tcl_AppendElement(interp, ary[i].pPrinterName); + } + } + Tcl_Free((char *)ary); + } + break; + } + return TCL_OK; } +#define PRINT_FROM_FILE 0 +#define PRINT_FROM_DATA 1 + /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * ListChoices-- + * PrintSend -- * - * Presents a list of printer choices. + * Main routine for sending data or files to a printer. * * Results: - * Returns the printer choices. + * Sends data to printer. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char ListChoices(Tcl_Interp *interp, const char *ppChoiceList[]) +static int PrintSend (ClientData defaults, Tcl_Interp *interp, int argc, const char * argv) { - int Index; - Tcl_Obj *lResult; + static char *usgmsg = + "::tk::print::_print send " + "[-postscript|-nopostscript] " + "[-binary|-ascii] " + "[-printer printer] " + "[-datalen nnnnnn] " + "[-file|-data] file_or_data ... "; + int ps = 0; /* The default is nopostscript. */ + int binary = 1; /* The default is binary. */ + long datalen = 0L; + + const char *printer = 0; + const char *hdcString = 0; + static char last_printer[255+1]; + int debug = 0; + int printtype = PRINT_FROM_FILE; + struct printer_values * ppv = *(struct printer_values * ) defaults; + struct printer_values * oldppv = 0; + int self_created = 0; /* Remember if we specially created the DC. */ + int direct_to_port = 0; + HANDLE hdc = NULL; + + while ( argc > 0 ) + { + if (argv[0][0] == '-') + { + /* Check for -postscript / -nopostscript flag. */ + if (strcmp(argv[0], "-postscript") == 0) + ps = 1; + else if (strcmp(argv[0], "-nopostscript") == 0) + ps = 0; + else if (strcmp(argv[0], "-ascii") == 0) + binary = 0; + else if (strcmp(argv[0], "-binary") == 0) + binary = 1; + else if ( strcmp(argv[0], "-printer") == 0) + { + argc--; + argv++; + printer = argv[0]; + } + else if ( strcmp(argv[0], "-file") == 0) + printtype = PRINT_FROM_FILE; + else if ( strcmp(argv[0], "-data") == 0) { + printtype = PRINT_FROM_DATA; + } + else if ( strcmp(argv[0], "-datalen") == 0 ) + { + argc--; + argv++; + datalen = atol(argv[0]); + } + else if ( strcmp(argv[0], "-debug") == 0) + debug++; + else if ( strcmp(argv[0], "-direct") == 0 ) + direct_to_port = 1; + } + else + break; + argc--; + argv++; + } + + if (argc <= 0) + { + Tcl_SetResult(interp,usgmsg, TCL_STATIC); + return TCL_ERROR; + } + + + /* + * Ensure we have a good HDC. If not, we'll have to abort. + * First, go by printer name, if provided. + * Next, use the last printer we opened, if any + * Finally, use the default printer. + * If we still don't have a good HDC, we've failed. + * + */ + if ( hdc == NULL ) + { + if ( printer ) + OpenPrinter((char *)printer, &hdc, NULL); + else if ( last_printer[0] != '\0' ) + OpenPrinter(last_printer, &hdc, NULL); + else if ( current_printer_values != 0 && current_printer_values->devnames_printername[0] != '\0') + OpenPrinter(current_printer_values->devnames_printername, &hdc, NULL); + else + { + } + + if ( hdc == NULL ) /* STILL can't get a good printer DC. */ + { + Tcl_SetResult (interp, "Error: Can't get a valid printer context", TCL_STATIC); + return TCL_ERROR; + } + } + + /* Now save off a bit of information for the next call.... */ + if (printer) + strncpy ( last_printer, printer, sizeof(last_printer) - 1); + else if ( ppv && ppv->devnames_printername[0] ) + strncpy ( last_printer, ppv->devnames_printername, sizeof(last_printer) - 1 ); + + /* * + * Everything left is a file or data. Just print it. + * */ + while (argc > 0) + { + static const char init_postscript[] = "\r\nsave\r\ninitmatrix\r\n"; + static const char fini_postscript[] = "\r\nrestore\r\n"; + + const char *docname; + + if ( argv[0][0] == '-') { + if ( strcmp(argv[0], "-datalen") == 0 ) + { + argc--; + argv++; + datalen = atol(argv[0]); + continue; + } + else if ( strcmp(argv[0], "-file") == 0) { + argc--; + argv++; + printtype = PRINT_FROM_FILE; + continue; + } + else if ( strcmp(argv[0], "-data") == 0) { + argc--; + argv++; + printtype = PRINT_FROM_DATA; + continue; + } + } + + switch (printtype) { + case PRINT_FROM_FILE: + docname = argv[0]; + break; + case PRINT_FROM_DATA: + default: + docname = "Tcl Print Data"; + if (datalen == 0L ) { + Tcl_AppendResult(interp, "Printer warning: ::tk::print::_print send ... -data requires a -datalen preceding argument. Using strlen as a poor substitute.\n", 0); + datalen = strlen(argv[0]); + } + break; + } + + if ( PrintStart(hdc, interp, docname) == 1 ) { + if (ps) { + DWORD inCount = strlen(init_postscript); + DWORD outCount = 0; + if ( WritePrinter(hdc,(LPVOID)init_postscript,inCount,&outCount) == 0 || + inCount != outCount ) { + Tcl_AppendResult(interp,"Printer error: Postscript init failed\n", 0); + } + } + + switch (printtype) { + case PRINT_FROM_FILE: + if ( PrintRawFileData(hdc,interp,argv[0],binary) == 0 ) { + Tcl_AppendResult(interp,"Printer error: Could not print file ", argv[0], "\n", 0); + } + break; + case PRINT_FROM_DATA: + default: + if ( PrintRawData(hdc,interp,(LPBYTE)argv[0],datalen) == 0 ) { + Tcl_AppendResult(interp,"Printer error: Could not print raw data\n", 0); + } + datalen=0L; /* reset the data length, so it is not reused. */ + break; + } + + if (ps) { + DWORD inCount = strlen(fini_postscript); + DWORD outCount = 0; + if ( WritePrinter(hdc,(LPVOID)fini_postscript,inCount,&outCount) == 0 || + inCount != outCount ) { + Tcl_AppendResult(interp,"Printer error: Postscript finish failed\n", 0); + } + } + + PrintFinish(hdc, interp); + } + argv++; + argc--; + } + + ClosePrinter(hdc); + + return TCL_OK; +} - /* Initialise return list. */ - lResult = Tcl_GetObjResult( interp ); +/* + * Support for file printing + */ - /* Loop adding the printers to the list */ - for ( Index = 0; ppChoiceList[Index] != NULL; Index++) - { - Tcl_Obj *ChoiceText; - ChoiceText = Tcl_NewStringObj( ppChoiceList[Index], -1 ); - if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, ChoiceText)) - { - /* Error already set in interp. */ - return RET_ERROR; - } - } - return RET_OK; +/* + *---------------------------------------------------------------------- + * + * PrintRawData -- + * + * Prints raw data to a printer. + * + * Results: + * Sends data to printer. + * + *---------------------------------------------------------------------- + */ + +static int PrintRawData (HANDLE printer, Tcl_Interp *interp, LPBYTE lpData, DWORD dwCount) +{ + int retval = 0; + DWORD dwBytesWritten = 0; + + /* Send the data. */ + if ( WritePrinter( printer, lpData, dwCount, &dwBytesWritten) == 0 ) { + /* Error writing the data. */ + Tcl_AppendResult(interp, "Printer error: Cannot write data to printer"); + } else if ( dwBytesWritten != dwCount ) { + /* Wrong number of bytes were written.... */ + sprintf(msgbuf, "%ld written; %ld requested", dwBytesWritten, dwCount); + Tcl_AppendResult(interp, "Printer error: Wrong number of bytes were written", + msgbuf, "\n", 0); + } else + retval = 1; + + return retval; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * ListFonts-- + * PrintRawFileData -- * - * List fonts on system. + * Prints raw file data to a printer. * * Results: - * Returns the font list. + * Sends file data to printer. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char ListFonts(Tcl_Interp *interp, HDC hDC, int fFontNameOnly) +static int PrintRawFileData (HANDLE printer, Tcl_Interp *interp, const char *filename, int binary) { + int retval = 0; + DWORD dwBytesWritten = 0; + DWORD dwBytesRequested = 0; + + Tcl_Channel channel; + + struct { + WORD len; /* Defined to be 16 bits..... */ + char buffer[128+1]; + } indata; + + if ( (channel = Tcl_OpenFileChannel(interp, (char *)filename, "r", 0444)) == NULL) + { + /* Can't open the file!. */ + return 0; + } + + if ( binary ) + Tcl_SetChannelOption(interp, channel, "-translation", "binary"); + + /* Send the data. */ + while ( (indata.len = Tcl_Read(channel, indata.buffer, sizeof(indata.buffer)-1)) > 0) + { + DWORD dwWritten = 0; + dwBytesRequested += indata.len; + indata.buffer[indata.len] = '\0'; + if ( WritePrinter( printer, indata.buffer, indata.len, &dwWritten) == 0 ) + { + /* Error writing the data. */ + Tcl_AppendResult(interp, "Printer error: Can't write data to printer\n", 0); + Tcl_Close(interp, channel); + break; + } + dwBytesWritten += dwWritten; + if ( dwWritten != indata.len ) { + sprintf(msgbuf, "%ld requested; %ld written", (long)indata.len, dwWritten); + Tcl_AppendResult(interp, "Printer warning: Short write: ", msgbuf, "\n", 0); + } + } + + if ( dwBytesWritten == dwBytesRequested ) + retval = 1; + + Tcl_Close(interp, channel); + + return retval; +} -/* This function is used by getattr fonts and getattr fontnamestyle. - * getattr fonts: lParam is passed as 0 to EnumFontFamExProc. - * getattr fontnames: lParam is passed with an initialized last fontname - * to EnumFontFamExProc. - * This value is used to check for duplicate listed font names. - */ - LOGFONT LogFont; - TCHAR *pCompareFont; - - /* Initialise LogFont */ - LogFont.lfCharSet = DEFAULT_CHARSET; - LogFont.lfPitchAndFamily = 0; - LogFont.lfFaceName[0] = '\0'; - - /*> Save interpreter ptr in global variable to use it for automatic */ - /*> error feedback. */ - fg_interp = interp; - if (fFontNameOnly) { - pCompareFont = _alloca(sizeof(TCHAR) * LF_FULLFACESIZE); - pCompareFont[0] = 0; - } else { - pCompareFont = 0; - } +/* + *---------------------------------------------------------------------- + * + * PrintStart -- + * + * Sets up the job and starts the DocPrinter and PagePrinter. + * + * Results: + * Returns 1 upon success, and 0 if anything goes wrong. + * + *---------------------------------------------------------------------- + */ - /* Initialise return list */ - if ( EnumFontFamiliesEx( - hDC, - &LogFont, - (FONTENUMPROC) EnumFontFamExProc, /* callback function */ - (LPARAM) pCompareFont, - 0 - ) ) - return RET_OK; - else - return RET_ERROR; + +static int PrintStart (HDC printer, Tcl_Interp *interp, const char *docname) +{ + DOC_INFO_1 DocInfo; + DWORD dwJob; + + /* Fill in the document information with the details. */ + if ( docname != 0 ) + DocInfo.pDocName = (LPTSTR)docname; + else + DocInfo.pDocName = (LPTSTR)"Tcl Document"; + DocInfo.pOutputFile = 0; + DocInfo.pDatatype = "RAW"; + + /* Start the job. */ + if ( (dwJob = StartDocPrinter(printer, 1, (LPSTR)&DocInfo)) == 0 ) { + /* Error starting doc printer. */ + Tcl_AppendResult(interp, "Printer error: Cannot start document printing\n", 0); + return 0; + } + /* Start the first page. */ + if ( StartPagePrinter(printer) == 0 ) { + /* Error starting the page. */ + Tcl_AppendResult(interp, "Printer error: Cannot start document page\n", 0); + EndDocPrinter(printer); + return 0; + } + return 1; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * EnumFontFamExProc -- + * PrintFinish -- * - * Enumerate font families and styles. + * Finishes the print job. * * Results: - * Returns font families and styles. + * Print job ends. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -int CALLBACK EnumFontFamExProc( - ENUMLOGFONTEX *lpelfe, /* logical-font data */ - TCL_UNUSED(NEWTEXTMETRICEX *), /* physical-font data */ - TCL_UNUSED(DWORD), /* type of font */ - LPARAM lParam /* application-defined data */ -) +static int PrintFinish (HDC printer, Tcl_Interp *interp) { + /* Finish the last page. */ + if ( EndPagePrinter(printer) == 0 ) { + Tcl_AppendResult(interp, "Printer warning: Cannot end document page\n", 0); + /* Error ending the last page. */ + } + /* Conclude the document. */ + if ( EndDocPrinter(printer) == 0 ) { + Tcl_AppendResult(interp, "Printer warning: Cannot end document printing\n", 0); + /* Error ending document. */ + } + + JobInfo(0,0,0); + + return 1; +} /* - * This function is used by getattr fonts and getattr fontnamestyle. - * - * getattr fonts: the font attributes name, style, charset and normal/fixed are - * added. In this case, the parameter lParam is 0. - * - * getattr fontnamestyle: it is checked if the current font has different name - * or style as the last font. If yes, name and style is added. - * If not, nothing is added. In this case, the parameter lParam contains a pointer - * to a ENUMLOGFONTEX variable. On a change, the current content is copied into - * that variable for the next comparison round. - */ - Tcl_Obj *AppendObj; - Tcl_Obj *pResultObj; - Tcl_DString dStr; - - if (lParam != 0) { - TCHAR *pCompareFont = (TCHAR *)lParam; - if ( 0 == _tcscmp(pCompareFont, lpelfe->elfFullName) ) { - return TRUE; - } else { - _tcscpy( pCompareFont, lpelfe->elfFullName ); - } - } - - pResultObj = Tcl_GetObjResult(fg_interp); + *---------------------------------------------------------------------- + * + * PrintOpenDefault -- + * + * Opens the default printer. + * + * Results: + * Default printer opened. + * + *---------------------------------------------------------------------- + */ - /*> Add font name */ - Tcl_DStringInit(& dStr); - Tcl_WinTCharToUtf(lpelfe->elfFullName,-1, &dStr); - AppendObj = Tcl_NewStringObj(Tcl_DStringValue(&dStr),-1); - Tcl_DStringFree(& dStr); - if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj)) - return FALSE; +static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, const char * argv) +{ + struct printer_values *ppv = *(struct printer_values * )data; + if ( autoclose && ppv && ppv->hDC) + { + char tmpbuf[11+1+1]; + char *args[3]; + sprintf(tmpbuf, "0x%lx", ppv->hDC); + args[0] = "-hDC"; + args[1] = tmpbuf; + args[2] = 0; + PrintClose(data, interp, 2, args); + } + *(struct printer_values * )data = ppv + = make_printer_values(0); /* Get a default printer_values context. */ + + /* This version uses PrintDlg, and works under Win32s. */ + { + HWND tophwnd; + int retval; + + /* The following is an attempt to get the right owners notified of + * repaint requests from the dialog. It doesn't quite work. + * It does make the dialog box modal to the toplevel it's working with, though. + . */ + if ( (ppv->pdlg.hwndOwner = GetActiveWindow()) != 0 ) + while ( (tophwnd = GetParent(ppv->pdlg.hwndOwner) ) != 0 ) + ppv->pdlg.hwndOwner = tophwnd; + + /* + * Since we are doing the "default" dialog, we must put NULL in the + * hDevNames and hDevMode members. + * Use '::tk::printer::_print dialog select' for selecting a printer from a list + . */ + ppv->pdlg.lStructSize = sizeof( PRINTDLG ); + ppv->pdlg.Flags = PD_RETURNDEFAULT | PD_RETURNDC; + ppv->pdlg.hDevNames = 0; + ppv->pdlg.hDevMode = 0; + + retval = PrintDlg ( &(ppv->pdlg) ); + + if ( retval == 1 ) + { + const char *name; + if ( ppv->hdcname[0] && hdc_delete ) + hdc_delete(interp, ppv->hdcname); + ppv->hdcname[0] = '\0'; + /* StorePrintVals creates and stores the hdcname as well. */ + StorePrintVals(ppv, &ppv->pdlg, 0); + if ( (name = get_attribute (&ppv->attribs, "device")) != 0 ) + if ( PrinterGetDefaults(ppv, name, 1) > 0 ) { /* Set default DEVMODE too. */ + current_printer_values = ppv; /* This is now the default printer. */ + } + } + else + { + /* Failed or cancelled. Leave everything else the same. */ + Tcl_Free( (char *) ppv); + /* Per Steve Bold--restore the default printer values + In any case the current_printer_values shouldn't be left hanging + . */ + *(struct printer_values * )data = &default_printer_values; + } + } + + /* The status does not need to be supplied. either hDC is OK or it's NULL. */ + if ( ppv->hdcname[0] ) + Tcl_SetResult(interp, ppv->hdcname, TCL_VOLATILE); + else + { + sprintf(msgbuf, "0x%lx", ppv->hDC); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + } + + return TCL_OK; +} - /*> For getattr fontnames, end here */ - if (lParam != 0) { - return TRUE; - } - /* - * Transform style to weight. - * - * Style may have other words like condensed etc, so map all unknown weights - * to "Normal". - */ - - if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Thin")) - || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Light")) - || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Medium")) - || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Bold")) ) - { - Tcl_DStringInit(& dStr); - Tcl_WinTCharToUtf(lpelfe->elfStyle,-1, &dStr); - AppendObj = Tcl_NewStringObj(Tcl_DStringValue(&dStr),-1); - Tcl_DStringFree(& dStr); - } else if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Extralight")) - || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Ultralight")) ) { - AppendObj = Tcl_NewStringObj("Extralight",-1); - } else if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Semibold")) - || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Demibold")) ) { - AppendObj = Tcl_NewStringObj("Semibold",-1); - } else if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Extrabold")) - || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Ultrabold")) ) { - AppendObj = Tcl_NewStringObj("Extrabold",-1); - } else if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Heavy")) - || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Black")) ) { - AppendObj = Tcl_NewStringObj("Heavy",-1); - } else { - AppendObj = Tcl_NewStringObj("Normal",-1); - } - if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj)) - return FALSE; - - /* Add script. */ - Tcl_DStringInit(& dStr); - Tcl_WinTCharToUtf(lpelfe->elfScript,-1, &dStr); - AppendObj = Tcl_NewStringObj(Tcl_DStringValue(&dStr),-1); - Tcl_DStringFree(& dStr); - if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj)) - return FALSE; - - /* Pitch. */ - switch ( (lpelfe->elfLogFont.lfPitchAndFamily) & 0xf ) - { - case FIXED_PITCH: - AppendObj = Tcl_NewStringObj("fixed",-1); - break; - default: - AppendObj = Tcl_NewStringObj("variable",-1); - break; - } - if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj)) - return FALSE; +/* + *---------------------------------------------------------------------- + * + * PrintOpen -- + * + * Open any named printer (or the default printer if no name + * is provided). + * + * Results: + * Printer opened. + * + *---------------------------------------------------------------------- + */ - /* Continue enumeration. */ - return TRUE; +static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char * argv) +{ + /* The ClientData is the default printer--this may be overridden by the proc arguments. */ + struct printer_values *ppv = *(struct printer_values * )data; + const char *printer_name; + int use_printer_name = 0; + int use_default = 0; + int use_attrs = 0; + const char * attrs = 0; + int j; + int retval = TCL_OK; + static const char usage_message[] = "::tk::print::_print open [-name printername|-default]"; + + /* Command line should specify everything needed. Don't bring up dialog. */ + /* This should also SET the default to any overridden printer name. */ + for (j=0; jhDC) + { + char tmpbuf[11+1+1]; + char *args[3]; + sprintf(tmpbuf, "0x%lx", ppv->hDC); + args[0] = "-hDC"; + args[1] = tmpbuf; + args[2] = 0; + PrintClose(data, interp, 2, args); + } + + ppv = make_printer_values(0); /* Get a default printer_values context. */ + *(struct printer_values * )data = ppv; + /* + * Since this is a print open, a new HDC will be created--at this point, starting + * with the default attributes. + */ + if (ppv) { + int retval = 0; + + if ( (retval = PrinterGetDefaults(ppv, printer_name, 1)) > 0 ) /* Set devmode if available. */ + { + const char *cp; + if ( (cp = make_printer_dc_name(interp, ppv->hDC, ppv) ) != 0 ) + { + strncpy(ppv->hdcname, cp, sizeof (current_printer_values->hdcname)); + set_attribute(&ppv->attribs, "hdcname", cp); + } + current_printer_values = ppv; /* This is now the default printer. */ + } else { + /* an error occurred - printer is not usable for some reason, so report that. */ + switch ( retval ) { + case GETDEFAULTS_UNSUPPORTED: /* Not supported. */ + Tcl_AppendResult(interp, "PrinterGetDefaults: Not supported for this OS\n", 0); + break; + case GETDEFAULTS_NOSUCHPRINTER: /* Can't find printer. */ + Tcl_AppendResult(interp, "PrinterGetDefaults: Can't find printer ", printer_name, "\n", 0); + break; + case GETDEFAULTS_CANTCREATEDC: /* Can't create DC. */ + Tcl_AppendResult(interp, "PrinterGetDefaults: Can't create DC: Insufficient printer information\n", 0); + break; + case GETDEFAULTS_CANTOPENPRINTER: /* Can't open printer. */ + Tcl_AppendResult(interp, "PrinterGetDefaults: Can't open printer ", printer_name, "\n", 0); + break; + case GETDEFAULTS_WINDOWSERROR: /* Windows error. */ + Tcl_AppendResult(interp, "PrinterGetDefaults: Windows error\n", 0); + break; + default: /* ???. */ + Tcl_AppendResult(interp, "PrinterGetDefaults: Unknown error\n", 0); + break; + } + + if (ppv->errorCode != 0 ) + ReportWindowsError(interp,ppv->errorCode); + + /* release the ppv. */ + delete_printer_values(ppv); + + return TCL_ERROR; + } + } + } + else /* It's a default. */ + { + retval = PrintOpenDefault(data, interp, argc, argv); /* argc, argv unused. */ + ppv = *(struct printer_values * )data; + } + + /* Get device names information. */ + { + char *dev, *dvr, *port; + /* + * retval test added by Jon Hilbert, 8/8/02. + * The printer name in this function should not be matched with wildcards. + */ + if ( retval == TCL_OK && ppv && ppv->pdevmode && ppv->pdevmode->dmDeviceName && + GetPrinterWithName((char *)(ppv->pdevmode->dmDeviceName), &dev, &dvr, &port, 0) != 0 ) + { + strcpy(ppv->devnames_filename, dvr ); + strcpy(ppv->devnames_port, port ); + } + } + + /* Check for attribute modifications. */ + if ( use_attrs != 0 && retval == TCL_OK ) + { + char hdcbuffer[20]; + const char *args[5]; +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) + Tcl_SavedResult state; + Tcl_SaveResult(interp, &state); +#endif + args[0] = "-hDC"; + sprintf(hdcbuffer, "0x%lx", ppv->hDC); + args[1] = hdcbuffer; + args[2] = "-set"; + args[3] = attrs; + args[4] = 0; + PrintAttr(data, interp, 4, args); +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) + Tcl_RestoreResult(interp,&state); +#endif + } + + /* The status does not need to be supplied. either hDC is OK or it's NULL. */ + if ( ppv->hdcname[0] ) + Tcl_SetResult(interp, ppv->hdcname, TCL_VOLATILE); + else + { + sprintf(msgbuf, "0x%lx", ppv->hDC); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + } + + return retval; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * ListFontUnicodeRanges -- + * PrintClose -- * - * Get the unicode ranges of the current font. + * Frees the printer DC and releases it. * * Results: - * Returns unicode range. + * Printer closed. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC) +static int PrintClose(ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - size_t StructSize; - LPGLYPHSET pGlyphSet; - int PosCur; - Tcl_Obj *oList; - - /* Get structure size. */ - StructSize = GetFontUnicodeRanges(hDC,NULL); - if (StructSize == 0) { - return RET_ERROR_PRINTER_IO; - } - /* Alloc return memory on the stack */ - pGlyphSet = _alloca(StructSize); + int j; + const char *hdcString = 0; + + /* Start with the default printer. */ + struct printer_values *ppv = *(struct printer_values * )data; + + /* See if there are any command line arguments. */ + for (j=0; jhDC, interp); + ppv->in_page = 0; + ppv->in_job = 0; + + /* Free the printer DC. */ + if (ppv->hDC) + { + delete_dc(ppv->hDC); + DeleteDC(ppv->hDC); + ppv->hDC = NULL; + } + + if ( ppv->hdcname[0] != '\0' && hdc_delete != 0 ) + hdc_delete(interp, ppv->hdcname); + ppv->hdcname[0] = '\0'; + + /* We should also clean up the devmode and devname structures. */ + if ( ppv && ppv != current_printer_values ) + delete_printer_values(ppv); + + return TCL_OK; +} - /* Get glyph set structure */ - if (0 == GetFontUnicodeRanges(hDC,pGlyphSet)) { - return RET_ERROR_PRINTER_IO; - } +/* + *---------------------------------------------------------------------- + * + * PrintDialog-- + * + * Main dialog for selecting printer and page setup. + * + * Results: + * Printer or page setup selected. + * + *---------------------------------------------------------------------- + */ - /* Prepare result list. */ - oList = Tcl_NewListObj(0,NULL); - - for (PosCur = 0 ; PosCur < (int)(pGlyphSet->cRanges) ; PosCur++) { - /* Starting glyph */ - if (RET_OK != Tcl_ListObjAppendElement(interp, oList, - Tcl_NewWideIntObj(pGlyphSet->ranges[PosCur].wcLow))) { - return RET_ERROR; - } - /* Length of range */ - if (RET_OK != Tcl_ListObjAppendElement(interp, oList, - Tcl_NewWideIntObj(pGlyphSet->ranges[PosCur].cGlyphs))) { - return RET_ERROR; - } - } - Tcl_SetObjResult(interp,oList); - return RET_OK; +static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char * argv) +{ + /* Which dialog is requested: one of select, page_setup. */ + static char usage_message[] = "::tk::print::_print dialog [-hDC hdc ] [select|page_setup] [-flags flagsnum]"; + struct printer_values *ppv = *(struct printer_values * )data; + int flags; + int oldMode; + int print_retcode; + HDC hdc = 0; + const char *hdcString = 0; + + int is_new_ppv = 0; + struct printer_values *old_ppv = ppv; + + static const int PRINT_ALLOWED_SET = PD_ALLPAGES|PD_SELECTION|PD_PAGENUMS| + PD_NOSELECTION|PD_NOPAGENUMS|PD_COLLATE| + PD_PRINTTOFILE|PD_PRINTSETUP|PD_NOWARNING| + PD_RETURNDC|PD_RETURNDEFAULT| + PD_DISABLEPRINTTOFILE|PD_HIDEPRINTTOFILE| + PD_NONETWORKBUTTON; + static const int PRINT_REQUIRED_SET = PD_NOWARNING|PD_RETURNDC; + + static const int PAGE_ALLOWED_SET = + PSD_MINMARGINS|PSD_MARGINS|PSD_NOWARNING| + PSD_DEFAULTMINMARGINS|PSD_DISABLEMARGINS| + PSD_DISABLEORIENTATION|PSD_DISABLEPAGEPAINTING| + PSD_DISABLEPAPER|PSD_DISABLEPRINTER| + PSD_INHUNDREDTHSOFMILLIMETERS|PSD_INTHOUSANDTHSOFINCHES| + PSD_RETURNDEFAULT; + static const int PAGE_REQUIRED_SET = + PSD_NOWARNING | PSD_DISABLEPRINTER; + + /* Create matching devmode and devnames to match the defaults. */ + HANDLE hDevMode = 0; + HANDLE hDevNames = 0; + DEVMODE *pdm = 0; + DEVNAMES *pdn = 0; + int dmsize = 0; + + int errors = 0; + const int alloc_devmode = 1; + const int lock_devmode = 2; + const int alloc_devname = 4; + const int lock_devname = 8; + const int change_devmode = 16; + int k; + int do_select= 0; + int do_page = 0; + int do_flags = 0; + int do_sync = 0; + + if (argc < 1) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + for (k = 0; k < argc; k++ ) + { + if ( strcmp(argv[k], "select") == 0 ) + do_select = 1; + else if ( strcmp(argv[k], "page_setup") == 0 ) + do_page = 1; + else if ( strcmp(argv[k], "-hdc") == 0 || strcmp (argv[k], "-hDC") == 0 ) + { + k++; + hdcString = argv[k]; + } + else if ( strcmp(argv[k], "-flags") == 0 ) + { + char *endstr; + if (argv[k+1]) + { + flags = strtol(argv[++k], &endstr, 0); /* Take any valid base. */ + if (endstr != argv[k]) /* if this was a valid numeric string. */ + do_flags = 1; + } + } + } + + if ( (do_page + do_select) != 1 ) + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + if ( ppv == 0 || ppv == &default_printer_values || ppv->hDC == 0 ) + { + is_new_ppv = 1; + old_ppv = 0; + } + + if ( hdcString ) + { + hdc = get_printer_dc(interp,hdcString); + ppv = find_dc_by_hdc(hdc); + *(struct printer_values * )data = ppv; + if (hdc == 0 ) + { + is_new_ppv = 1; + } + if (ppv == 0 ) + { + is_new_ppv = 1; + } + } + + if ( is_new_ppv == 1 ) + { + /* Open a brand new printer values structure. */ + old_ppv = ppv; + ppv = make_printer_values(0); + *(struct printer_values * )data = ppv; + } + + /* Copy the devmode and devnames into usable components. */ + if (ppv && ppv->pdevmode) + dmsize = ppv->pdevmode->dmSize+ppv->pdevmode->dmDriverExtra; + + if ( dmsize <= 0 ) + ; /* Don't allocate a devmode structure. */ + else if ( (hDevMode = GlobalAlloc(GMEM_MOVEABLE|GMEM_ZEROINIT, dmsize) ) == NULL ) + { + /* Failure!. */ + errors |= alloc_devmode; + pdm = 0; /* Use the default devmode. */ + } + else if ( (pdm = (DEVMODE *)GlobalLock(hDevMode)) == NULL ) + { + /* Failure!. */ + errors |= lock_devmode; + } + + /* If this is the first time we've got a ppv, just leave the names null. */ + if ( ppv->devnames_filename[0] == 0 || + ppv->devnames_port[0] == 0 || + ppv->pdevmode == 0 ) + ; /* Don't allocate the devnames structure. */ + else if ( (hDevNames = GlobalAlloc(GMEM_MOVEABLE|GMEM_ZEROINIT, + sizeof(DEVNAMES)+ + sizeof(ppv->devnames_filename) + + CCHDEVICENAME + + sizeof(ppv->devnames_port) + 2 ) + ) == NULL) + { + /* Failure!. */ + errors |= alloc_devname; + pdn = 0; + } + else if ( (pdn = (DEVNAMES *)GlobalLock(hDevNames)) == NULL) + { + /* Failure!. */ + errors |= lock_devname; + } + + if (pdm) + memcpy (pdm, ppv->pdevmode, dmsize); + + if (pdn) + { + pdn->wDefault = 0; + pdn->wDriverOffset = 4*sizeof (WORD); + strcpy( (char *)pdn + pdn->wDriverOffset, ppv->devnames_filename); + pdn->wDeviceOffset = pdn->wDriverOffset + strlen(ppv->devnames_filename) + 2; + strcpy ( (char *)pdn + pdn->wDeviceOffset, ppv->pdevmode->dmDeviceName); + pdn->wOutputOffset = pdn->wDeviceOffset + strlen(ppv->pdevmode->dmDeviceName) + 2; + strcpy ( (char *)pdn + pdn->wOutputOffset, ppv->devnames_port); + } + + if (hDevMode) + GlobalUnlock(hDevMode); + if (hDevNames) + GlobalUnlock(hDevNames); + + if ( do_select ) + { + /* + * Looking at the return value of PrintDlg, we want to + * save the values in the PAGEDIALOG for the next time. + * The tricky part is that PrintDlg and PageSetupDlg + * have the ability to move their hDevMode and hDevNames memory. + * This never seems to happen under NT, + * seems not to happen under Windows 3.1, + * but can be demonstrated under Windows 95 (and presumably Windows 98). + * + * As the handles are shared among the Print and Page dialogs, we must + * consistently establish and free the handles. + * Current thinking is to preserve them in the PageSetup structure ONLY, + * thus avoiding the problem here. + . */ + + HWND tophwnd; + + /* Assign the copied, moveable handles to the dialog structure. */ + ppv->pdlg.hDevMode = hDevMode; + ppv->pdlg.hDevNames = hDevNames; + + /* + * This loop make the dialog box modal to the toplevel it's working with. + * It also avoids any reliance on Tk code (for Tcl users). + . */ + if ( (ppv->pdlg.hwndOwner = GetActiveWindow()) != 0 ) + while ( (tophwnd = GetParent(ppv->pdlg.hwndOwner) ) != 0 ) + ppv->pdlg.hwndOwner = tophwnd; + + /* Leaving the memory alone will preserve selections. */ + /* memset (&(ppv->pdlg), 0, sizeof(PRINTDLG) );. */ + ppv->pdlg.lStructSize = sizeof(PRINTDLG); + ppv->pdlg.Flags |= PRINT_REQUIRED_SET; + + /* Vista (Win95) Fix Start. */ + /* Seems to be needed to print multiple copies. */ + ppv->pdlg.Flags |= PD_USEDEVMODECOPIES; + ppv->pdlg.nCopies = (WORD)PD_USEDEVMODECOPIES; /* Value shouldn't matter. */ + /* Vista Fix End. */ + + if ( do_flags ) + { + /* Enable requested flags, but disable the flags we don't want to support. */ + ppv->pdlg.Flags |= flags; + ppv->pdlg.Flags &= PRINT_ALLOWED_SET; + } + + /* One may not specify return default when devmode or devnames are present. */ + /* Since the copied flags in the ppv's pdevmode may have been created by + * the "PrintOpen" call, this flag _might_ be set + . */ + if (ppv->pdlg.hDevMode || ppv->pdlg.hDevNames) + ppv->pdlg.Flags &= (~PD_RETURNDEFAULT); + +#if TCL_MAJOR_VERSION > 7 + /* In Tcl versions 8 and later, a service call to the notifier is provided. */ + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); +#endif + + print_retcode = PrintDlg(&(ppv->pdlg)); + +#if TCL_MAJOR_VERSION > 7 + /* Return the service mode to its original state. */ + Tcl_SetServiceMode(oldMode); +#endif + + if ( print_retcode == 1 ) /* Not canceled. */ + { + const char *name; + StorePrintVals (ppv, &ppv->pdlg, 0); + + if ( (name = get_attribute (&ppv->attribs, "device")) != 0 ) + PrinterGetDefaults(ppv, name, 0); /* Don't set default DEVMODE: + user may have already set it in properties. */ + + add_dc(ppv->hDC, ppv); + current_printer_values = ppv; + + hDevNames = NULL; + hDevMode = NULL; + } + else /* Canceled. */ + { + DWORD extError = CommDlgExtendedError(); + if (ppv->pdlg.hDevMode) + GlobalFree(ppv->pdlg.hDevMode); + else + GlobalFree(hDevMode); + hDevMode = ppv->pdlg.hDevMode = NULL; + + if ( ppv->pdlg.hDevNames ) + GlobalFree (ppv->pdlg.hDevNames); + else + GlobalFree (hDevNames); + hDevNames = ppv->pdlg.hDevNames = NULL; + + if (is_new_ppv) + { + Tcl_Free((char *)ppv); + ppv = old_ppv; + if ( ppv == 0 ) + ppv = &default_printer_values; + *(struct printer_values * )data = ppv; + } + } + + /* Results are available through printer attr; HDC now returned. */ + /* This would be a good place for Tcl_SetObject, but for now, support + * older implementations by returning a Hex-encoded value. + * Note: Added a 2nd parameter to allow caller to note cancellation. + */ + { + const char *cp = ppv->hdcname; + if (cp && cp[0]) + sprintf(msgbuf, "%s %d", cp, print_retcode ); + else + sprintf(msgbuf, "0x%lx %d", ppv->hDC, print_retcode); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + } + } + else if (do_page) + { + if ( do_flags == 0 ) + flags = PSD_MARGINS|PSD_NOWARNING|PSD_DISABLEPRINTER|PSD_INTHOUSANDTHSOFINCHES; + + ppv->pgdlg.Flags = flags; + /* Restrict flags to those we wish to support. */ + ppv->pgdlg.Flags |= PAGE_REQUIRED_SET; + ppv->pgdlg.Flags &= PAGE_ALLOWED_SET; + + /* Set the devmode and devnames to match our structures. */ + ppv->pgdlg.hDevMode = hDevMode; + ppv->pgdlg.hDevNames = hDevNames; + + ppv->pgdlg.lStructSize = sizeof(PAGESETUPDLG); +#if TCL_MAJOR_VERSION > 7 + /* In Tcl versions 8 and later, a service call to the notifier is provided. */ + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); +#endif + + print_retcode = PageSetupDlg(&(ppv->pgdlg)); + +#if TCL_MAJOR_VERSION > 7 + /* Return the service mode to its original state. */ + Tcl_SetServiceMode(oldMode); +#endif + + if ( print_retcode == 1 ) /* Not cancelled. */ + { + StorePrintVals(ppv, 0, &ppv->pgdlg); + /* Modify the HDC using ResetDC. */ + ResetDC(ppv->hDC, ppv->pdevmode); + hDevNames = NULL; + hDevMode = NULL; + } + else /* Canceled. */ + { + if (ppv->pgdlg.hDevMode) + GlobalFree(ppv->pgdlg.hDevMode); + else + GlobalFree(hDevMode); + hDevMode = ppv->pgdlg.hDevMode = NULL; + + if ( ppv->pgdlg.hDevNames ) + GlobalFree (ppv->pgdlg.hDevNames); + else + GlobalFree (hDevNames); + hDevNames = ppv->pgdlg.hDevNames = NULL; + if ( is_new_ppv ) + { + Tcl_Free ((char *)ppv); + ppv = old_ppv; + if (ppv == 0 ) + ppv = &default_printer_values; + *(struct printer_values * )data = ppv; + } + } + + { + const char *cp = ppv->hdcname; + if (cp && cp[0]) + sprintf(msgbuf, "%s %d", cp, print_retcode ); + else + sprintf(msgbuf, "0x%lx %d", ppv->hDC, print_retcode); + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + } + Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); + } + else + { + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; + } + + if (errors) + { + if (errors & alloc_devmode) + Tcl_AppendResult(interp, "\nError allocating global DEVMODE structure", 0); + if (errors & lock_devmode) + Tcl_AppendResult(interp, "\nError locking global DEVMODE structure", 0); + if (errors & alloc_devname) + Tcl_AppendResult(interp, "\nError allocating global DEVNAMES structure", 0); + if (errors & lock_devname) + Tcl_AppendResult(interp, "\nError locking global DEVNAMES structure", 0); + } + + return TCL_OK; } +static int JobInfo(int state, const char *name, const char * outname) +{ + static int inJob = 0; + static char jobname[63+1]; + + switch (state) + { + case 0: + inJob = 0; + jobname[0] = '\0'; + break; + case 1: + inJob = 1; + if ( name ) + strncpy (jobname, name, sizeof(jobname) - 1 ); + break; + default: + break; + } + if ( outname ) + *outname = jobname; + return inJob; +} /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * GetFirstTextNoChar -- + * PrintJob-- * - * Get data on glyph structure. + * Manage print jobs. * * Results: - * Returns glyph structure. + * Print job executed. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText) + +static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - size_t StructSize; - LPGLYPHSET pGlyphSet; - int PosCur; - int IndexCur; - Tcl_Obj *oList; - - /* Get structure size. */ - StructSize = GetFontUnicodeRanges(pdlg.hDC,NULL); - if (StructSize == 0) { - return RET_ERROR_PRINTER_IO; - } - /* Alloc return memory on the stack. */ - pGlyphSet = _alloca(StructSize); + DOCINFO di; + struct printer_values * ppv = *(struct printer_values * ) data; + + static char usage_message[] = "::tk::print::_print job [ -hDC hdc ] [ [start [-name docname] ] | end ]"; + HDC hdc = 0; + const char *hdcString = 0; + + /* Parameters for document name and output file (if any) should be supported. */ + if ( argc > 0 && (strcmp(argv[0], "-hdc") == 0 || strcmp (argv[0], "-hDC") == 0) ) + { + argc--; + argv++; + hdcString = argv[0]; + argc--; + argv++; + } + + if ( hdcString ) + { + hdc = get_printer_dc(interp,hdcString); + ppv = find_dc_by_hdc(hdc); + *(struct printer_values * )data = ppv; + + if (hdc == 0 ) + { + Tcl_AppendResult(interp, "printer job got unrecognized hdc ", hdcString, 0); + return TCL_ERROR; + } + if (ppv == 0 ) + { + } + } + + if (ppv && hdc == 0 ) + hdc = ppv->hDC; + + /* Should this command keep track of start/end state so two starts in a row + * automatically have an end inserted? + . */ + if ( argc == 0 ) /* printer job by itself. */ + { + const char *jobname; + int status; + + status = JobInfo (-1, 0, &jobname); + if ( status ) + Tcl_SetResult(interp, (char *)jobname, TCL_VOLATILE); + return TCL_OK; + } + else if ( argc >= 1 ) + { + if ( strcmp (*argv, "start") == 0 ) + { + const char *docname = "Tcl Printer Document"; + int oldMode; + + argc--; + argv++; + /* handle -name argument if present. */ + if ( argc >= 1 && strcmp( *argv, "-name" ) == 0 ) + { + argv++; + if ( --argc > 0 ) + { + docname = *argv; + } + } + + /* Ensure the hDC is valid before continuing. */ + if ( hdc == NULL ) + { + Tcl_SetResult (interp, "Error starting print job: no printer context", TCL_STATIC); + return TCL_ERROR; + } + + /* Close off any other job if already in progress. */ + if ( JobInfo(-1, 0, 0) ) + { + EndDoc(ppv->hDC); + JobInfo(0, 0, 0); + } + + memset ( &di, 0, sizeof(DOCINFO) ); + di.cbSize = sizeof(DOCINFO); + di.lpszDocName = docname; + + /* * + * If print to file is selected, this causes a popup dialog. + * Therefore, in Tcl 8 and above, enable event handling + * */ +#if TCL_MAJOR_VERSION > 7 + /* In Tcl versions 8 and later, a service call to the notifier is provided. */ + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); +#endif + StartDoc(hdc, &di); + JobInfo (1, docname, 0); +#if TCL_MAJOR_VERSION > 7 + /* Return the service mode to its original state. */ + Tcl_SetServiceMode(oldMode); +#endif + if (ppv) + ppv->in_job = 1; + + return TCL_OK; + } + else if ( strcmp (*argv, "end") == 0 ) + { + EndDoc(hdc); + JobInfo (0, 0, 0); + if (ppv) + ppv->in_job = 0; + + return TCL_OK; + } + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} - /* Get glyph set structure. */ - if (0 == GetFontUnicodeRanges(pdlg.hDC,pGlyphSet)) { - return RET_ERROR_PRINTER_IO; - } +/* + *---------------------------------------------------------------------- + * + * PrintPage-- + * + * Manage page by page printing. + * + * Results: + * Page printing executed. + * + *---------------------------------------------------------------------- + */ - /* Prepare result list. */ - oList = Tcl_NewListObj(0,NULL); - - /*> Loop over characters. */ - for (IndexCur = 0;;IndexCur++) { - int fFound = 0; - /*> Check for end of string */ - if (pText[IndexCur] == 0) { - break; - } - /* Loop over glyph ranges. */ - for (PosCur = 0 ; PosCur < (int)(pGlyphSet->cRanges) ; PosCur++) { - if ( pText[IndexCur] >= pGlyphSet->ranges[PosCur].wcLow - && pText[IndexCur] < pGlyphSet->ranges[PosCur].wcLow - + pGlyphSet->ranges[PosCur].cGlyphs ) - { - /* Glyph found. */ - fFound = 1; - break; - } - } - if (!fFound) { - Tcl_SetObjResult(interp,Tcl_NewWideIntObj(IndexCur)); - return RET_OK; - } - } - Tcl_SetObjResult(interp,Tcl_NewWideIntObj(-1)); - return RET_OK; +static int PrintPage(ClientData data, Tcl_Interp *interp, int argc, const char * argv) +{ + struct printer_values * ppv = *(struct printer_values * ) data; + static char usage_message[] = "::tk::print::_print [-hDC hdc] [start|end]"; + HDC hdc = 0; + const char *hdcString = 0; + + if ( argv[0] && ( strcmp(argv[0], "-hdc") == 0 || strcmp (argv[0], "-hDC") == 0 ) ) + { + argc--; + argv++; + hdcString = argv[0]; + argc--; + argv++; + } + + if ( hdcString ) + { + hdc = get_printer_dc(interp,hdcString); + ppv = find_dc_by_hdc(hdc); + *(struct printer_values * )data = ppv; + + if (hdc == 0 ) + { + Tcl_AppendResult(interp, "printer page got unrecognized hdc ", hdcString, 0); + return TCL_ERROR; + } + if (ppv == 0 ) + { + Tcl_AppendResult(interp, "printer page got unrecognized hdc ", hdcString, 0); + return TCL_ERROR; + } + } + /* + * Should this command keep track of start/end state so two starts in a row + * automatically have an end inserted? + * Also, if no job has started, should it start a printer job? + . */ + if ( argc >= 1 ) + { + if ( strcmp (*argv, "start") == 0 ) + { + StartPage(ppv->hDC); + ppv->in_page = 1; + return TCL_OK; + } + else if ( strcmp (*argv, "end") == 0 ) + { + EndPage(ppv->hDC); + ppv->in_page = 0; + return TCL_OK; + } + } + + Tcl_SetResult(interp, usage_message, TCL_STATIC); + return TCL_ERROR; +} + +/* + * This function gets physical page size in case the user hasn't + * performed any action to set it + */ +static int PrintPageAttr (HDC hdc, int *hsize, int *vsize, + int *hscale, int *vscale, + int *hoffset, int *voffset, + int *hppi, int *vppi) +{ + int status = 0; + if ( hdc == 0 ) + { + return -1; /* A value indicating failure. */ + } + + *hsize = GetDeviceCaps(hdc, PHYSICALWIDTH); + *vsize = GetDeviceCaps(hdc, PHYSICALHEIGHT); + *hscale = GetDeviceCaps(hdc, SCALINGFACTORX); + *vscale = GetDeviceCaps(hdc, SCALINGFACTORY); + *hoffset = GetDeviceCaps (hdc, PHYSICALOFFSETX); + *voffset = GetDeviceCaps (hdc, PHYSICALOFFSETY); + *hppi = GetDeviceCaps (hdc, LOGPIXELSX); + *vppi = GetDeviceCaps (hdc, LOGPIXELSY); + + return status; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintSetMapMode -- + * PrintAttr-- * - * Set the map mode for the printer. + * Report printer attributes. In some cases, this function should probably get the information + * if not already available from user action. * * Results: - * Returns the map mode. + * Returns printer attributes. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -char PrintSetMapMode( int MapMode ) +static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - /* Check for open printer when hDC is required. */ - if (pdlg.hDC == NULL) - return RET_ERROR_PRINTER_NOT_OPEN; - if ( 0 == SetMapMode( pdlg.hDC, MapMode ) ) - { - return RET_ERROR_PRINTER_IO; - } - return RET_OK; + HDC hdc = 0; + const char *hdcString = 0; + /* + * Note: Currently, attributes are maintained ONCE per Tcl session. + * Later design may allow a set of attributes per hDC. + * In that case, the hDC is a component of this command. + * Meanwhile, the hDC is consulted as a means of ensuring initialization of + * the printer attributes only. + */ + static char usage_message[] = "::tk::print::_print attr " + "[-hDC hdc] " + "[ [-get keylist] | [-set key-value-pair list] | [-delete key-list] | [-prompt] ]"; + + struct printer_values * ppv = *(struct printer_values * ) data; + + Tcl_HashEntry *ent; + Tcl_HashSearch srch; + + /* + * Get and set options? Depends on further arguments? Pattern matching?. + * Returns a collection of key/value pairs. Should it use a user-specified array name?. + * The attributes of interest are the ones buried in the dialog structures. + */ + + /* For the first implementation, more than 100 keys/pairs will be ignored. */ + char * keys=0; + int key_count = 0; + + int do_get = 0; + int do_set = 0; + int do_delete = 0; + int do_prompt = 0; + int i; + + /* + * This command should take an HDC as an optional parameter, otherwise using + * the one in the ppv structure? + . */ + for (i=0; i 1 ) + { + Tcl_AppendResult(interp, "\nCannot use two options from " + "-get, -set, -delete, and -prompt in same request.\n", + usage_message, + 0); + if (keys) + Tcl_Free((char *)keys); + return TCL_ERROR; + } + + if ( hdcString ) + { + hdc = get_printer_dc(interp,hdcString); + ppv = find_dc_by_hdc(hdc); + *(struct printer_values * )data = ppv; + + if (hdc == 0 ) + { + Tcl_AppendResult(interp, "::tk::print::_print attr got unrecognized hdc ", hdcString, 0); + return TCL_ERROR; + } + if (ppv == 0 ) + { + Tcl_AppendResult(interp, "::tk::print::_print attr got unrecognized hdc ", hdcString, 0); + return TCL_ERROR; + } + } + + /* + * Handle the case where we are asking for attributes on a non-opened printer + * The two choices are (a) to consider this a fatal error for the printer attr + * command; and (b) to open the default printer. For now, we use choice (b) + */ + if ( ppv == 0 || ppv == &default_printer_values || ppv->hDC == NULL ) + { + /* In these cases, open the default printer, if any. If none, return an error. */ + if ( PrintOpen(data, interp, 0, 0) != TCL_OK ) + { + Tcl_AppendResult(interp, "\nThere appears to be no default printer." + "\nUse '::tk::print::_print dialog select' before '::tk::print::_print attr'\n", + 0); + if (keys) + Tcl_Free((char *)keys); + return TCL_ERROR; + } + else + Tcl_ResetResult(interp); /* Remove the hDC from the result. */ + + /* This changes the ppv (via changing data in PrintOpen!. */ + ppv = *(struct printer_values * )data; + + } + + /* + * This command must support two switches: + * -get: the list following this switch represents a set of + * "wildcard-matchable" values to retrieve from the attribute list. + * When found, they are reported ONCE in alphabetical order. + * -set: the LIST OF PAIRS following this switch represents a set + * of LITERAL keys and values to be added or replaced into the + * attribute list. Values CAN be set in this list that are not + * recognized by the printer dialogs or structures. + */ + /* This is the "delete" part, used only by the -delete case. */ + if ( do_delete ) + { + int count_del = 0; + char count_str[12+1]; + + /* The only trick here is to ensure that only permitted + * items are deleted + . */ + static const char *illegal[] = { + "device", + "driver", + "hDC", + "hdcname", + "pixels per inch", + "port", + "resolution", + }; + for ( ent = Tcl_FirstHashEntry(&ppv->attribs, &srch); + ent != 0; + ent = Tcl_NextHashEntry(&srch) ) + { + const char *key; + if ( (key = (const char *)Tcl_GetHashKey(&ppv->attribs, ent)) != 0 ) + { + /* Test here to see if a list is available, and if this element is on it. */ + int found=0; + int i; + for (i=0; iattribs, key); + count_del++; + } + + /* If the delete option is chosen, we're done. */ + if (keys) + Tcl_Free((char *)keys); + sprintf(count_str, "%d", count_del); + Tcl_SetResult(interp, count_str, TCL_VOLATILE); + return TCL_OK; + } + /* This is the "set" part, used only by the -set case. */ + else if ( do_set ) + { + int k; + /* Split each key, do the set, and then free the result. + * Also, replace keys[k] with just the key part. + . */ + for (k=0; k 1 ) + { + set_attribute (&ppv->attribs, slist[0], slist[1]); + strcpy(keys[k], slist[0]); /* Always shorter, so this should be OK. */ + } + if ( slist ) + Tcl_Free((char *)slist); + } + } + + /* Here we should "synchronize" the pairs with the devmode. */ + GetDevModeAttribs (&ppv->attribs, ppv->pdevmode); + RestorePrintVals (ppv, &ppv->pdlg, &ppv->pgdlg); + /* -------------- added 8/1/02 by Jon Hilbert. */ + /* tell the printer about the devmode changes + This is necessary to support paper size setting changes + . */ + DocumentProperties(GetActiveWindow(),ppv->hDC,ppv->pdevmode->dmDeviceName, + ppv->pdevmode,ppv->pdevmode,DM_IN_BUFFER|DM_OUT_BUFFER); + + /* Here we should modify the DEVMODE by calling ResetDC. */ + ResetDC(ppv->hDC, ppv->pdevmode); + } + else if ( do_prompt ) + { + DWORD dwRet; + HANDLE hPrinter; + PRINTER_DEFAULTS pd = {0, 0, 0}; + + pd.DesiredAccess = PRINTER_ALL_ACCESS; + pd.pDevMode = ppv->pdevmode; + + OpenPrinter (ppv->pdevmode->dmDeviceName, &hPrinter, &pd); + dwRet = DocumentProperties ( + GetActiveWindow(), hPrinter, ppv->pdevmode->dmDeviceName, + ppv->pdevmode, ppv->pdevmode, DM_PROMPT | DM_IN_BUFFER | DM_OUT_BUFFER); + if ( dwRet == IDCANCEL ) + { + /* The dialog was canceled. Don't do anything. */ + } + else + { + if (dwRet != IDOK) { + ppv->errorCode = GetLastError(); + sprintf(msgbuf, "::tk::print::_print attr -prompt: Cannot retrieve printer attributes: %ld (%ld)", (long) ppv->errorCode, dwRet); + Tcl_SetResult (interp, msgbuf, TCL_VOLATILE); + ClosePrinter(hPrinter); + return TCL_ERROR; + } + + ppv->pdevmode->dmFields |= DM_PAPERSIZE; + if (ppv->pdevmode->dmPaperLength && ppv->pdevmode->dmPaperWidth) { + ppv->pdevmode->dmFields |= DM_PAPERWIDTH | DM_PAPERLENGTH; + } + SetDevModeAttribs (&ppv->attribs, ppv->pdevmode); + + dwRet = DocumentProperties(GetActiveWindow(),hPrinter, ppv->pdevmode->dmDeviceName, + ppv->pdevmode,ppv->pdevmode,DM_IN_BUFFER | DM_OUT_BUFFER); + if (dwRet != IDOK) { + ppv->errorCode = GetLastError(); + sprintf(msgbuf, "::tk::print::_print attr -prompt: Cannot set printer attributes: %ld", (long) ppv->errorCode); + Tcl_SetResult (interp, msgbuf, TCL_VOLATILE); + ClosePrinter(hPrinter); + return TCL_ERROR; + } + ResetDC(hPrinter, ppv->pdevmode); + } + ClosePrinter(hPrinter); + } + + /* This is the "get" part, used for all cases of the command. */ + for ( ent = Tcl_FirstHashEntry(&ppv->attribs, &srch); + ent != 0; + ent = Tcl_NextHashEntry(&srch) ) + { + const char *key, *value; + if ( (value = (const char *)Tcl_GetHashValue(ent)) != 0 && + (key = (const char *)Tcl_GetHashKey(&ppv->attribs, ent)) != 0 ) + { + /* Test here to see if a list is available, and if this element is on it. */ + if (do_set || do_get ) + { + int found=0; + int i; + for (i=0; i 0 ) + Tcl_AppendResult(interp, "\n", usage, "\n", 0); + + return TCL_OK; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintBrushColor -- + * add_dc-- * - * Set the brush color for the printer. + * Adds device context. * * Results: - * Returns the brush color. + * Device context added. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintBrushColor(COLORREF Color) + +static void add_dc(HDC hdc, struct printer_values *pv) { - if (CLR_INVALID == SetDCBrushColor(pdlg.hDC, Color) ) - return RET_ERROR_PRINTER_IO; - return RET_OK; + Tcl_HashEntry *data; + int status; + data = Tcl_CreateHashEntry(&printer_hdcs, (const char *)hdc, &status); + Tcl_SetHashValue(data,(const char *)pv); } - + /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintBkColor -- + * delete_dc-- * - * Set the background color for the printer. + * Deletes device context. * * Results: - * Returns the background color. + * Device context deleted. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintBkColor(COLORREF Color) + + +static struct printer_values *delete_dc (HDC hdc) { - if (CLR_INVALID == SetBkColor(pdlg.hDC, Color) ) - return RET_ERROR_PRINTER_IO; - return RET_OK; + Tcl_HashEntry *data; + struct printer_values *pv = 0; + if ( (data = Tcl_FindHashEntry(&printer_hdcs, (const char *)hdc)) != 0 ) + { + pv = (struct printer_values *)Tcl_GetHashValue(data); + Tcl_DeleteHashEntry(data); + } + return pv; } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintRuler -- + * find_dc_by_hdc -- * - * Set the ruler for the printer. + * Finds device context. * * Results: - * Returns the ruler. + * Device context found. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintRuler(int X0, int Y0, int LenX, int LenY) + + +static struct printer_values *find_dc_by_hdc(HDC hdc) { - POINT pt[2]; - pt[0].x = X0; - pt[0].y = Y0; - pt[1].x = X0+LenX; - pt[1].y = Y0+LenY; - if (FALSE == Polyline(pdlg.hDC, pt, 2)) - return RET_ERROR_PRINTER_IO; - return RET_OK; + Tcl_HashEntry *data; + if ( (data = Tcl_FindHashEntry(&printer_hdcs, (const char *)hdc)) != 0 ) + return (struct printer_values *)Tcl_GetHashValue(data); + return 0; } + +#define PRINTER_dc_type 32 /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintRectangle -- + * init_printer_dc_contexts -- * - * Set the print rectangle. + * Initializes DC contexts. * * Results: - * Returns the print rectangle. + * Device contexts initialized. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintRectangle(int X0, int Y0, int X1, int Y1) + + +static void init_printer_dc_contexts(Tcl_Interp *interp) { - if (FALSE == Rectangle(pdlg.hDC, X0,Y0,X1,Y1)) - return RET_ERROR_PRINTER_IO; - return RET_OK; + if (hdc_prefixof) + hdc_prefixof(interp, PRINTER_dc_type, "printerDc"); } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintFontCreate -- + * delete_printer_dc_contexts -- * - * Set the print font. + * Deletes DC contexts. * * Results: - * Returns the print font. + * Device contexts deleted. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintFontCreate(int FontNumber, - TCHAR *Name, double dPointSize, int Weight, int Italic, int Charset, - int Pitch, int Family) + + +static void delete_printer_dc_contexts(Tcl_Interp *interp) { - -/* - * Charset: - * ANSI 0 - * DEFAULT_ 1 - * GREEK_ 161 (0xA1) - * Italic - * 0 No - * 1 Yes - * Pitch - * 0 Default - * 1 Fixed - * 2 Variable - * Family - * 0 FF_DONTCARE - * 1 FF_ROMAN Variable stroke width, serifed. Times Roman, Century Schoolbook, etc. - * 2 FF_SWISS Variable stroke width, sans-serifed. Helvetica, Swiss, etc. - * 3 FF_MODERN Constant stroke width, serifed or sans-serifed. Pica, Elite, Courier, etc. - * 4 FF_SCRIPT Cursive, etc. - * 5 FF_DECORATIVE Old English, etc. - */ - - POINT pt; /* To convert to logical scale. */ - LOGFONT lf; - - if (FontNumber < 0 || FontNumber > 9) - return RET_ERROR_PARAMETER; - if (hFont[FontNumber] != NULL) + const char *contexts[1000]; + int outlen = sizeof(contexts) / sizeof(const char *); + int i; + HDC hdc; + + + /* Note: hdc_List, hdc_get, and hdc_delete do not use the interp argument. */ + hdc_list(interp, PRINTER_dc_type, contexts, &outlen); + for (i=0; i 9 || hFont[FontNumber] == NULL) - return RET_ERROR_PARAMETER; - - if (NULL == SelectObject (pdlg.hDC, hFont[FontNumber])) - return RET_ERROR_PRINTER_IO; - - SelectedFont = FontNumber; - return RET_OK; + add_dc(hdc, pv); + + if (hdc_create) + return hdc_create(interp, hdc, PRINTER_dc_type); + else + return 0; } + /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintText -- + * printer_name_valid -- * - * Prints a page of text. + * Tests validity of printer name. * * Results: - * Returns the printed text. + * Printer name tested. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintText(int X0, int Y0, TCHAR *pText, COLORREF Color ) + +static int printer_name_valid(Tcl_Interp *interp, const char *name) { - if (CLR_INVALID == SetTextColor(pdlg.hDC, Color ) ) - return RET_ERROR_PRINTER_IO; - - if (FALSE == ExtTextOut(pdlg.hDC, X0, Y0, - 0, /* Options */ - NULL, /* Clipping rectangle */ - pText, _tcslen(pText), /* Text and length */ - NULL ) ) /* Distance array */ - { - return RET_ERROR_PRINTER_IO; - } - return RET_OK; + if (hdc_loaded == 0 || hdc_valid == 0) + return 0; + return hdc_valid(interp, name, PRINTER_dc_type); } /* - * -------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * PrintGetTextSize -- + * is_valid_dc -- * - * Gets the text size. + * Tests validity of DC. * * Results: - * Returns the text side. + * DC tested. * - * ------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - -char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText ) + + +static int is_valid_hdc (HDC hdc) { - SIZE Size; - - int Res = RET_OK; - Tcl_Obj *lResult; - Tcl_Obj *IntObj; - - if ( FALSE == GetTextExtentPoint32( - pdlg.hDC, - pText, _tcslen(pText), - &Size ) ) - { - return RET_ERROR_PRINTER_IO; - } - - /* - * We have got the size values. - * Initialise return list. - */ - lResult = Tcl_GetObjResult( interp ); - - /* X Size */ - IntObj = Tcl_NewWideIntObj( Size.cx ); - if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, IntObj )) - { - /* Error already set in interp. */ - Res = RET_ERROR; - } - - /* Y Size */ - IntObj = Tcl_NewWideIntObj( Size.cy ); - if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, IntObj )) - { - /* Error already set in interp */ - Res = RET_ERROR; - } - return Res; + int retval = 0; + DWORD objtype = GetObjectType((HGDIOBJ)hdc); + switch (objtype) + { + /* Any of the DC types are OK. */ + case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: + retval = 1; + break; + /* Anything else is invalid. */ + case 0: /* Function failed. */ + default: + break; + } + return retval; } - -/* Paint a photo image to the printer DC */ -/* @param interp tcl interpreter */ -/* @param oImageName tcl object with tk imsge name */ -/* @param DestPosX Destination X position */ -/* @param DestPosY Destination Y position */ -/* @param DestWidth Width of destination image, or 0 to use original size */ -/* @param DestHeight Height of destination image or 0 to use original size */ -char PaintPhoto( - Tcl_Interp *interp, - Tcl_Obj *const oImageName, - int DestPosX, - int DestPosY, - int DestWidth, - int DestHeight) + + +/* + *---------------------------------------------------------------------- + * + * get_printer_dc -- + * + * Gets printer dc. + * + * Results: + * DC returned. + * + *---------------------------------------------------------------------- + */ + +static HDC get_printer_dc(Tcl_Interp *interp, const char *name) { -#if 0 - Tk_PhotoImageBlock sImageBlock; - Tk_PhotoHandle hPhoto; - HBITMAP hDIB; - int IndexCur; - /* Access bgraPixel as void ptr or unsigned char ptr */ - union {unsigned char *ptr; void *voidPtr;} bgraPixel; - BITMAPINFO bmInfo; - - if (pdlg.hDC == NULL) - return RET_ERROR_PRINTER_NOT_OPEN; - - /* The creation of the DIP is from */ - /* tk8.6.9 win/tkWinWm.c, proc WmIconphotoCmd */ - if ( NULL == (hPhoto = Tk_FindPhoto(interp, Tcl_GetString(oImageName)))) { - return RET_ERROR; - } - Tk_PhotoGetImage(hPhoto, &sImageBlock); - /* pixelSize = 4 */ - /* pitch = width * 4 */ - /* offset = 0:0,1:1,2:2,3:3 */ - - /* Create device-independant color bitmap. */ - ZeroMemory(&bmInfo, sizeof bmInfo); - bmInfo.bmiHeader.biSize = sizeof(BITMAPINFOHEADER); - bmInfo.bmiHeader.biWidth = sImageBlock.width; - bmInfo.bmiHeader.biHeight = -sImageBlock.height; - bmInfo.bmiHeader.biPlanes = 1; - bmInfo.bmiHeader.biBitCount = 32; - bmInfo.bmiHeader.biCompression = BI_RGB; - - /* the first parameter is the dc, which may be 0. */ - /* no difference to specify it */ - hDIB = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS, - &bgraPixel.voidPtr, NULL, 0); - if (!hDIB) { - return RET_ERROR_MEMORY; - } - /* Convert the photo image data into BGRA format (RGBQUAD). */ - for (IndexCur = 0 ; - IndexCur < sImageBlock.height * sImageBlock.width * 4 ; - IndexCur += 4) + if ( printer_name_valid(interp, name) == 0 ) + { + char *strend; + unsigned long tmp; + + /* Perhaps it is a numeric DC. */ + tmp = strtoul(name, &strend, 0); + if ( strend != 0 && strend > name ) { - bgraPixel.ptr[IndexCur] = sImageBlock.pixelPtr[IndexCur+2]; - bgraPixel.ptr[IndexCur+1] = sImageBlock.pixelPtr[IndexCur+1]; - bgraPixel.ptr[IndexCur+2] = sImageBlock.pixelPtr[IndexCur+0]; - bgraPixel.ptr[IndexCur+3] = sImageBlock.pixelPtr[IndexCur+3]; - } - /* Use original width and height if not given. */ - if (DestWidth == 0) { DestWidth = sImageBlock.width; } - if (DestHeight == 0) { DestHeight = sImageBlock.height; } - /* Use StretchDIBits with full image. */ - /* The printer driver may use additional color info to do better */ - /* interpolation */ - if (GDI_ERROR == StretchDIBits( - pdlg.hDC, /* handle to DC */ - DestPosX, /* x-coord of destination upper-left corner */ - DestPosY, /* y-coord of destination upper-left corner */ - DestWidth, /* width of destination rectangle */ - DestHeight, /* height of destination rectangle */ - 0, /* x-coord of source upper-left corner */ - 0, /* y-coord of source upper-left corner */ - sImageBlock.width, /* width of source rectangle */ - sImageBlock.height, /* height of source rectangle */ - bgraPixel.voidPtr, /* bitmap bits */ - &bmInfo, /* bitmap data */ - DIB_RGB_COLORS, /* usage options */ - SRCCOPY /* raster operation code */ - ) ) + if ( is_valid_hdc((HDC)tmp) == 0 ) + { + tmp = 0; + Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", + "need a printer drawing context, got non-context address: ", name, "\n", 0); + } + return (HDC)tmp; + } + else { - DeleteObject(hDIB); - /* As this is invoked within the driver, return a driver error */ - return RET_ERROR_PRINTER_DRIVER; + Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", + "need a printer drawing context, got: ", name, "\n", 0); + return 0; } - DeleteObject(hDIB); -#else - (void)interp; - (void)oImageName; - (void)DestPosX; - (void)DestPosY; - (void)DestWidth; - (void)DestHeight; -#endif - return RET_OK; + } + return (HDC)hdc_get(interp, name); + } - + + /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 - * End: - */ - + * End: +*/ -- cgit v0.12 From 0ebc73a13bcaf93d2f5b06558a85092fa3e5b665 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 18 Apr 2021 02:09:52 +0000 Subject: Add print.tcl --- library/print.tcl | 1684 ++++++++++++++++++++++++----------------------------- 1 file changed, 747 insertions(+), 937 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 42a84fd..69f6e59 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -1,976 +1,786 @@ -################################################################ -## page_args -## Description: -## This is a helper proc used to parse common arguments for -## text processing in the other commands. -## Args: -## Name of an array in which to store the various pieces -## needed for text processing -################################################################ -proc page_args { array } { - upvar #0 $array ary - - # First we check whether we have a valid hDC - # (perhaps we can later make this also an optional argument, defaulting to - # the default printer) - set attr [ printer attr ] - foreach attrpair $attr { - set key [lindex $attrpair 0] - set val [lindex $attrpair 1] - switch -exact $key { - "hDC" { set ary(hDC) $val } - "copies" { if { $val >= 0 } { set ary(copies) $val } } - "page dimensions" { - set wid [lindex $val 0] - set hgt [lindex $val 1] - if { $wid > 0 } { set ary(pw) $wid } - if { $hgt > 0 } { set ary(pl) $hgt } - } - "page margins" { - if { [scan [lindex $val 0] %d tmp] > 0 } { +# print.tcl -- + +# This file defines the 'tk print' command for printing of the canvas widget and text on X11, Windows, and macOS. It implements an abstraction layer that +# presents a consistent API across the three platforms. + +# Copyright © 2009 Michael I. Schwartz. +# Copyright © 2021 Kevin Walzer/WordTech Communications LLC. +# Copyright © 2021 Harald Oehlmann, Elmicron GmbH +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + + +namespace eval ::tk::print { + + + if [tk windowingsystem] eq "win32" { + + variable printargs + set printargs "" + + # Multiple utility procedures for printing text based on the C printer + # primitives. + + # _page_args: + # Parse common arguments for text processing in the other commands. + # + # Arguments: + # array - name of an array in which to store the various pieces needed for text processing. + proc _page_args { array } { + upvar #0 $array ary + + # First we check whether we have a valid hDC + # (perhaps we can later make this also an optional argument, defaulting to + # the default printer) + set attr [ ::tk::print::_print attr ] + foreach attrpair $attr { + set key [lindex $attrpair 0] + set val [lindex $attrpair 1] + switch -exact $key { + "hDC" { set ary(hDC) $val } + "copies" { if { $val >= 0 } { set ary(copies) $val } } + "page dimensions" { + set wid [lindex $val 0] + set hgt [lindex $val 1] + if { $wid > 0 } { set ary(pw) $wid } + if { $hgt > 0 } { set ary(pl) $hgt } + } + "page margins" { + if { [scan [lindex $val 0] %d tmp] > 0 } { set ary(lm) [ lindex $val 0 ] set ary(tm) [ lindex $val 1 ] set ary(rm) [ lindex $val 2 ] set ary(bm) [ lindex $val 3 ] - } - } - "resolution" { - if { [scan [lindex $val 0] %d tmp] > 0 } { + } + } + "resolution" { + if { [scan [lindex $val 0] %d tmp] > 0 } { set ary(resx) [ lindex $val 0 ] set ary(resy) [ lindex $val 1 ] - } else { + } else { set ary(resx) 200 ;# Set some defaults for this... set ary(resy) 200 - } - } - } - } - - if { ( [ info exist ary(hDC) ] == 0 ) || ($ary(hDC) == 0x0) } { - error "Can't get printer attributes" - } - - # Now, set "reasonable" defaults if some values were unavailable - if { [ info exist ary(resx) ] == 0 } { set ary(resx) 200 } - if { [ info exist ary(resy) ] == 0 } { set ary(resy) 200 } - if { [ info exist ary(tm) ] == 0 } { set ary(tm) 1000 } - if { [ info exist ary(bm) ] == 0 } { set ary(bm) 1000 } - if { [ info exist ary(lm) ] == 0 } { set ary(lm) 1000 } - if { [ info exist ary(rm) ] == 0 } { set ary(rm) 1000 } - if { [ info exist ary(pw) ] == 0 } { set ary(pw) 8500 } - if { [ info exist ary(pl) ] == 0 } { set ary(pl) 11000 } - if { [ info exist ary(copies) ] == 0 } { set ary(copies) 1 } - - debug_puts "Dimensions: $ary(pw) x $ary(pl) ; Margins (tblr): $ary(tm) $ary(bm) $ary(lm) $ary(rm)" -} + } + } + } + } + + if { ( [ info exist ary(hDC) ] == 0 ) || ($ary(hDC) == 0x0) } { + error "Can't get printer attributes" + } + + # Now, set "reasonable" defaults if some values were unavailable + if { [ info exist ary(resx) ] == 0 } { set ary(resx) 200 } + if { [ info exist ary(resy) ] == 0 } { set ary(resy) 200 } + if { [ info exist ary(tm) ] == 0 } { set ary(tm) 1000 } + if { [ info exist ary(bm) ] == 0 } { set ary(bm) 1000 } + if { [ info exist ary(lm) ] == 0 } { set ary(lm) 1000 } + if { [ info exist ary(rm) ] == 0 } { set ary(rm) 1000 } + if { [ info exist ary(pw) ] == 0 } { set ary(pw) 8500 } + if { [ info exist ary(pl) ] == 0 } { set ary(pl) 11000 } + if { [ info exist ary(copies) ] == 0 } { set ary(copies) 1 } -################################################################ -## print_page_data -## Description: -## This is the simplest way to print a small amount of text -## on a page. The text is formatted in a box the size of the -## selected page and margins. -## Args: -## data Text data for printing -## fontargs Optional arguments to supply to the text command -################################################################ -proc print_page_data { data {fontargs {}} } { - - global printargs - page_args printargs - if { ! [info exist printargs(hDC)] } { - printer open - page_args printargs - } - - set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] - set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] - set pw [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] - printer job start - printer page start - eval gdi text $printargs(hDC) $lm $tm \ - -anchor nw -text [list $data] \ - -width $pw \ - $fontargs - printer page end - printer job end -} + } -################################################################ -## print_page_file -## Description: -## This is the simplest way to print a small file -## on a page. The text is formatted in a box the size of the -## selected page and margins. -## Args: -## data Text data for printing -## fontargs Optional arguments to supply to the text command -################################################################ -proc print_page_file { filename {fontargs {}} } { - set fn [open $filename r] + # _ print_page_data + # This proc is the simplest way to print a small amount of + # text on a page. The text is formatted in a box the size of the + # selected page and margins. + # + # Arguments: + # data - Text data for printing + # fontargs - Optional arguments to supply to the text command + + proc _print_page_data { data {fontargs {}} } { + + variable printargs + _page_args printargs + if { ! [info exist printargs(hDC)] } { + printer open + _page_args printargs + } + + set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] + set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] + set pw [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] + ::tk::print::_print job start + ::tk::print::_print page start + eval gdi text $printargs(hDC) $lm $tm \ + -anchor nw -text [list $data] \ + -width $pw \ + $fontargs + ::tk::print::_print page end + ::tk::print::_print job end + } - set data [ read $fn ] - close $fn + # _print_page_file + # This is the simplest way to print a small file + # on a page. The text is formatted in a box the size of the + # selected page and margins. + # Arguments: + # data - Text data for printing + # fontargs - Optional arguments to supply to the text command - print_page_data $data $fontargs -} + proc _print_page_file { filename {fontargs {}} } { + set fn [open $filename r] -################################################################ -## print_data -## Description: -## This function prints multiple-page files, using a line-oriented -## function, taking advantage of knowing the character widths. -## Many fancier things could be done with it: -## e.g. page titles, page numbering, user-provided boundary to override -## page margins, HTML-tag interpretation, etc. -## Args: -## data Text data for printing -## breaklines If non-zero, keep newlines in the string as -## newlines in the output. -## font Font for printing -################################################################ -proc print_data { data {breaklines 1 } {font {}} } { - global printargs - - page_args printargs - if { ! [info exist printargs(hDC)] } { - printer open - page_args printargs - } - if { $printargs(hDC) == "?" || $printargs(hDC) == 0 } { - printer open - page_args printargs - } - - if { [string length $font] == 0 } { - eval gdi characters $printargs(hDC) -array printcharwid - } else { - eval gdi characters $printargs(hDC) -font $font -array printcharwid - } - - set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] - set pagehgt [ expr ( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) ] - set totallen [ string length $data ] - debug_puts "page width: $pagewid; page height: $pagehgt; Total length: $totallen" - set curlen 0 - set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] - - printer job start - printer page start - while { $curlen < $totallen } { - set linestring [ string range $data $curlen end ] - if { $breaklines } { - set endind [ string first "\n" $linestring ] - if { $endind != -1 } { - set linestring [ string range $linestring 0 $endind ] - # handle blank lines.... - if { $linestring == "" } { - set linestring " " - } - } - } - - set result [print_page_nextline $linestring \ - printcharwid printargs $curhgt $font] - incr curlen [lindex $result 0] - incr curhgt [lindex $result 1] - if { [expr $curhgt + [lindex $result 1] ] > $pagehgt } { - printer page end - printer page start - set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] - } - } - printer page end - printer job end -} + set data [ read $fn ] -################################################################ -## print_file -## Description: -## This function prints multiple-page files -## It will either break lines or just let them run over the -## margins (and thus truncate). -## The font argument is JUST the font name, not any additional -## arguments. -## Args: -## filename File to open for printing -## breaklines 1 to break lines as done on input, 0 to ignore newlines -## font Optional arguments to supply to the text command -################################################################ -proc print_file { filename {breaklines 1 } { font {}} } { - set fn [open $filename r] - - set data [ read $fn ] - - close $fn - - print_data $data $breaklines $font -} + close $fn -################################################################ -## print_page_nextline -## -## Args: -## string Data to print -## parray Array of values for printer characteristics -## carray Array of values for character widths -## y Y value to begin printing at -## font if non-empty specifies a font to draw the line in -## Return: -## Returns the pair "chars y" -## where chars is the number of characters printed on the line -## and y is the height of the line printed -################################################################ -proc print_page_nextline { string carray parray y font } { - upvar #0 $carray charwidths - upvar #0 $parray printargs - - set endindex 0 - set totwidth 0 - set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] - set maxstring [ string length $string ] - set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] - - for { set i 0 } { ( $i < $maxstring ) && ( $totwidth < $maxwidth ) } { incr i } { - set ch [ string index $string $i ] - if [ info exist charwidths($ch) ] { - incr totwidth $charwidths([string index $string $i]) - } else { - incr totwidth $charwidths(n) - } - # set width($i) $totwidth - } - - set endindex $i - set startindex $endindex - - if { $i < $maxstring } { - # In this case, the whole data string is not used up, and we wish to break on a - # word. Since we have all the partial widths calculated, this should be easy. - set endindex [ expr [string wordstart $string $endindex] - 1 ] - set startindex [ expr $endindex + 1 ] - - # If the line is just too long (no word breaks), print as much as you can.... - if { $endindex <= 1 } { - set endindex $i - set startindex $i - } - } - - if { [string length $font] > 0 } { - set result [ gdi text $printargs(hDC) $lm $y \ - -anchor nw -justify left \ - -text [ string trim [ string range $string 0 $endindex ] "\r\n" ] \ - -font $font ] - } else { - set result [ gdi text $printargs(hDC) $lm $y \ - -anchor nw -justify left \ - -text [string trim [ string range $string 0 $endindex ] "\r\n" ] ] - } - - debug_puts "Maxwidth: $maxwidth; Max String: $maxstring ; Ending at $endindex" - debug_puts "Printed line at ($lm, $y). Now starting at $startindex" - return "$startindex $result" -} + _print_page_data $data $fontargs + } -################################################################ -## prntcanv.tcl -## -## Usage: -## printer::print_widget p -## If the parameter p is anything but default, uses the -## print dialog. If it is default, it uses the default printer. -## -## Prints a canvas "reasonably" well (as GDI matures...) -## John Blattner contributed the original -## version of this code. -## Modifications made by Michael Schwartz (mschwart@nyx.net) -## -## Handles some additional printer types that do not put numbers in the -## resolution field -## Darcy Kahle contributed the origianl -## version of this code. -## Modifications made by Michael Schwartz (mschwart@nyx.net) -## Several suggestions and code contributions were made by Mick O'Donnell (micko@wagsoft.com) -## -## This version (0.1) scales the canvas to "fit" the page. -## It is very limited now, by may meet simple user needs. -## LIMITATIONS: -## This is limited by GDI (e.g., no arrows on the lines, stipples), -## and is also limited in current canvas items supported. -## For instance, bitmaps and images are not yet supported. -## -## Idea mill for future enhancements: -## c) Add an optional page title and footer -## d) Add tk font support to the gdi command if tk is loaded. -## e) Make scaling an option -## f) Make rendering the canvas something done as PART of a -## print. -################################################################ - -namespace eval printer { - - # First some utilities to ensure we can debug this sucker. - - variable debug - variable option - variable vtgPrint - - proc init_print_canvas { } { - variable debug - variable option - variable vtgPrint - - set debug 0 - set option(use_copybits) 1 - set vtgPrint(printer.bg) white - } - - proc is_win {} { - return [ info exist tk_patchLevel ] - } - - proc debug_puts {str} { - variable debug - if $debug { - if [ is_win ] { - if [! winfo exist .debug ] { - set tl [ toplevel .debug ] - frame $tl.buttons - pack $tl.buttons -side bottom -fill x - button $tl.buttons.ok -text OK -command "destroy .debug" - pack $tl.buttons.ok - text $tl.text -yscroll "$tl.yscroll set" - scrollbar $tl.yscroll -orient vertical -command "$tl.text yview" - pack $tl.yscroll -side right -fill y -expand false - pack $tl.text -side left -fill both -expand true - } - $tl.text insert end $str - } else { - puts "Debug: $str" - after 100 - } - } - } - - ################################################################ - ## page_args - ## Description: - ## This is a helper proc used to parse common arguments for - ## text processing in the other commands. - ## "Reasonable" defaults are provided if not present - ## Args: - ## Name of an array in which to store the various pieces - ## needed for text processing - ################################################################ - proc page_args { array } { - # use upvar one level to get into the context of the immediate caller. - upvar 1 $array ary - - # First we check whether we have a valid hDC - # (perhaps we can later make this also an optional argument, defaulting to - # the default printer) - set attr [ printer attr ] - foreach attrpair $attr { - set key [lindex $attrpair 0] - set val [lindex $attrpair 1] - set ary($key) $val - switch -exact $key { - "page dimensions" { - set wid [lindex $val 0] - set hgt [lindex $val 1] - if { $wid > 0 } { set ary(pw) $wid } - if { $hgt > 0 } { set ary(pl) $hgt } - } - "page margins" { - if { [scan [lindex $val 0] %d tmp] > 0 } { - set ary(lm) [ lindex $val 0 ] - set ary(tm) [ lindex $val 1 ] - set ary(rm) [ lindex $val 2 ] - set ary(bm) [ lindex $val 3 ] - } - } - "resolution" { - if { [scan [lindex $val 0] %d tmp] > 0 } { - set ary(resx) [ lindex $val 0 ] - set ary(resy) [ lindex $val 1 ] - } else { - set ary(resolution) [lindex $val 0] - ;# set ary(resx) 200 ;# Set some defaults for this... - ;# set ary(resy) 200 - } - } - } - } - - if { ( [ info exist ary(hDC) ] == 0 ) || ($ary(hDC) == 0x0) } { - error "Can't get printer attributes" - } - - # Now, set "reasonable" defaults if some values were unavailable - # Resolution is the hardest. Uses "resolution" first, if it was numeric. - # Uses "pixels per inch" second, if it is set. - # Use the words medium and best for resolution third--these are guesses - # Uses 200 as a last resort. - if { [ info exist ary(resx) ] == 0 } { - set ppi "pixels per inch" - if { [ info exist ary($ppt) ] == 0 } { - if { [ scan $ary($ppt) "%d%d" tmp1 tmp2 ] > 0 } { - set ary(resx) $tmp1 - if { $tmp2 > 0 } { - set ary(resy) $tmp2 - } - } else { - if [ string match -nocase $ary($ppt) "medium" ] { - set ary(resx) 300 - set ary(resy) 300 - } elseif [ string match -nocase $ary($ppt) "best" ] { - set ary(resx) 600 - set ary(resy) 600 - } else { - set ary(resx) 200 - set ary(resy) 200 - } - } - } else { - set ary(resx) 200 - } - } - if { [ info exist ary(resy) ] == 0 } { set ary(resy) $ary(resx) } - if { [ info exist ary(tm) ] == 0 } { set ary(tm) 1000 } - if { [ info exist ary(bm) ] == 0 } { set ary(bm) 1000 } - if { [ info exist ary(lm) ] == 0 } { set ary(lm) 1000 } - if { [ info exist ary(rm) ] == 0 } { set ary(rm) 1000 } - if { [ info exist ary(pw) ] == 0 } { set ary(pw) 8500 } - if { [ info exist ary(pl) ] == 0 } { set ary(pl) 11000 } - if { [ info exist ary(copies) ] == 0 } { set ary(copies) 1 } - } - - ################################################################ - # These procedures read in the canvas widget, and write all of # - # its contents out to the Windows printer. # - ################################################################ - - ################################################################ - ## print_widget - ## Description: - ## Main procedure for printing a widget. Currently supports - ## canvas widgets. Handles opening and closing of printer. - ## Assumes that printer and gdi packages are loaded. - ## Args: - ## wid The widget to be printed. - ## printer Flag whether to use the default printer. - ## name App name to pass to printer. - ################################################################ - - proc print_widget { wid {printer default} {name "tcl canvas"} } { - - # start printing process ------ - if {[string match "default" $printer]} { - set hdc [printer open] - } else { - set hdc [printer dialog select] - if { [lindex $hdc 1] == 0 } { - # User has canceled printing - return - } - set hdc [ lindex $hdc 0 ] - } + # _print_data + # This function prints multiple-page files, using a line-oriented + # function, taking advantage of knowing the character widths. + # Arguments: + # data - Text data for printing + # breaklines - If non-zero, keep newlines in the string as + # newlines in the output. + # font - Font for printing + + proc _print_data { data {breaklines 1 } {font {}} } { + variable printargs + + _page_args printargs + if { ! [info exist printargs(hDC)] } { + ::tk::print::_print open + _page_args printargs + } + if { $printargs(hDC) == "?" || $printargs(hDC) == 0 } { + ::tk::print::_print open + _page_args printargs + } + + if { [string length $font] == 0 } { + eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid + } else { + eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid + } + + set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] + set pagehgt [ expr ( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) ] + set totallen [ string length $data ] + set curlen 0 + set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] + + ::tk::print::_print job start -name "Tk Print Job" + ::tk::print::_print page start + while { $curlen < $totallen } { + set linestring [ string range $data $curlen end ] + if { $breaklines } { + set endind [ string first "\n" $linestring ] + if { $endind != -1 } { + set linestring [ string range $linestring 0 $endind ] + # handle blank lines.... + if { $linestring == "" } { + set linestring " " + } + } + } + + set result [_print_page_nextline $linestring \ + printcharwid printargs $curhgt $font] + incr curlen [lindex $result 0] + incr curhgt [lindex $result 1] + if { [expr $curhgt + [lindex $result 1] ] > $pagehgt } { + ::tk::print::_print page end + ::tk::print::_print page start + set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] + } + } + ::tk::print::_print page end + ::tk::print::_print job end + } - variable p - set p(0) 0 ; unset p(0) - page_args p + + # _print_file + # This function prints multiple-page files + # It will either break lines or just let them run over the + # margins (and thus truncate). + # The font argument is JUST the font name, not any additional + # arguments. + # Arguments: + # filename - File to open for printing + # breaklines - 1 to break lines as done on input, 0 to ignore newlines + # font - Optional arguments to supply to the text command + + proc _print_file { filename {breaklines 1 } { font {}} } { + set fn [open $filename r] + + set data [ read $fn ] + + close $fn + + _print_data $data $breaklines $font + } - if {![info exist p(hDC)]} { - set hdc [printer open] - page_args p - } - if {[string match "?" $hdc] || [string match 0x0 $hdc]} { - catch {printer close} - error "Problem opening printer: printer context cannot be established" - } + # _print_page_nextline + # Returns the pair "chars y" + # where chars is the number of characters printed on the line + # and y is the height of the line printed + # Arguments: + # string - Data to print + # parray - Array of values for printer characteristics + # carray - Array of values for character widths + # y - Y value to begin printing at + # font - if non-empty specifies a font to draw the line in + + proc _print_page_nextline { string carray parray y font } { + upvar #0 $carray charwidths + upvar #0 $parray printargs + + set endindex 0 + set totwidth 0 + set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] + set maxstring [ string length $string ] + set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] + + for { set i 0 } { ( $i < $maxstring ) && ( $totwidth < $maxwidth ) } { incr i } { + set ch [ string index $string $i ] + if [ info exist charwidths($ch) ] { + incr totwidth $charwidths([string index $string $i]) + } else { + incr totwidth $charwidths(n) + } + # set width($i) $totwidth + } + + set endindex $i + set startindex $endindex + + if { $i < $maxstring } { + # In this case, the whole data string is not used up, and we wish to break on a + # word. Since we have all the partial widths calculated, this should be easy. + set endindex [ expr [string wordstart $string $endindex] - 1 ] + set startindex [ expr $endindex + 1 ] + + # If the line is just too long (no word breaks), print as much as you can.... + if { $endindex <= 1 } { + set endindex $i + set startindex $i + } + } + + if { [string length $font] > 0 } { + set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ + -anchor nw -justify left \ + -text [ string trim [ string range $string 0 $endindex ] "\r\n" ] \ + -font $font ] + } else { + set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ + -anchor nw -justify left \ + -text [string trim [ string range $string 0 $endindex ] "\r\n" ] ] + } + + return "$startindex $result" + } - printer job start -name "$name" - printer page start - - # Here is where any scaling/gdi mapping should take place - # For now, scale so the dimensions of the window are sized to the - # width of the page. Scale evenly. - - # For normal windows, this may be fine--but for a canvas, one wants the - # canvas dimensions, and not the WINDOW dimensions. - if { [winfo class $wid] == "Canvas" } { - set sc [ lindex [ $wid configure -scrollregion ] 4 ] - # if there is no scrollregion, use width and height. - if { "$sc" == "" } { - set window_x [ lindex [ $wid configure -width ] 4 ] - set window_y [ lindex [ $wid configure -height ] 4 ] - } else { - set window_x [ lindex $sc 2 ] - set window_y [ lindex $sc 3 ] - } - } else { - set window_x [ winfo width $wid ] - set window_y [ winfo height $wid ] - } - set pd "page dimensions" - set pm "page margins" - set ppi "pixels per inch" - - set printer_x [ expr ( [lindex $p($pd) 0] - \ - [lindex $p($pm) 0 ] - \ - [lindex $p($pm) 2 ] \ - ) * \ - [lindex $p($ppi) 0] / 1000.0 ] - set printer_y [ expr ( [lindex $p($pd) 1] - \ - [lindex $p($pm) 1 ] - \ - [lindex $p($pm) 3 ] \ - ) * \ - [lindex $p($ppi) 1] / 1000.0 ] - set factor_x [ expr $window_x / $printer_x ] - set factor_y [ expr $window_y / $printer_y ] - - debug_puts "printer: ($printer_x, $printer_y)" - debug_puts "window : ($window_x, $window_y)" - debug_puts "factor : $factor_x $factor_y" - - if { $factor_x < $factor_y } { - set lo $window_y - set ph $printer_y - } else { - set lo $window_x - set ph $printer_x - } + + # These procedures read in the canvas widget, and write all of + # its contents out to the Windows printer. + + variable option + variable vtgPrint + + proc _init_print_canvas { } { + variable option + variable vtgPrint - # The offset still needs to be set based on page margins - debug_puts [ list \ - gdi map $hdc -logical $lo -physical $ph -offset $p(resolution) \ - ] - - gdi map $hdc -logical $lo -physical $ph -offset $p(resolution) - - # handling of canvas widgets - # additional procs can be added for other widget types - switch [winfo class $wid] { - Canvas { - # if {[catch { - print_canvas [lindex $hdc 0] $wid - # } msg]} { - # debug_puts "print_widget: $msg" - # error "Windows Printing Problem: $msg" - # } + set option(use_copybits) 1 + set vtgPrint(printer.bg) white } - default { - debug_puts "Can't print items of type [winfo class $wid]. No handler registered" - } - } - # end printing process ------ - printer page end - printer job end - printer close - } - - - ################################################################ - ## print_canvas - ## Description: - ## Main procedure for writing canvas widget items to printer. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ################################################################ - - proc print_canvas {hdc cw} { - variable vtgPrint - - # get information about page being printed to - # print_canvas.CalcSizing $cw - set vtgPrint(canvas.bg) [string tolower [$cw cget -background]] - - # re-write each widget from cw to printer - foreach id [$cw find all] { - set type [$cw type $id] - if { [ info commands print_canvas.$type ] == "print_canvas.$type" } { - print_canvas.[$cw type $id] $hdc $cw $id - } else { - debug_puts "Omitting canvas item of type $type since there is no handler registered for it" - } - } - } - - - ################################################################ - ## These procedures support the various canvas item types, # - ## reading the information about the item on the real canvas # - ## and then writing a similar item to the printer. # - ################################################################ - - ################################################################ - ## print_canvas.line - ## Description: - ## Prints a line item. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ## id The id of the canvas item. - ################################################################ - - proc print_canvas.line {hdc cw id} { - variable vtgPrint - - set color [print_canvas.TransColor [$cw itemcget $id -fill]] - if {[string match $vtgPrint(printer.bg) $color]} {return} - - set coords [$cw coords $id] - set wdth [$cw itemcget $id -width] - set arrow [$cw itemcget $id -arrow] - set arwshp [$cw itemcget $id -arrowshape] - set dash [$cw itemcget $id -dash] - set smooth [$cw itemcget $id -smooth ] - set splinesteps [ $cw itemcget $id -splinesteps ] - - set cmmd "gdi line $hdc $coords -fill $color -arrow $arrow -arrowshape [list $arwshp]" - - if { $wdth > 1 } { - set cmmd "$cmmd -width $wdth" - } - - if { $dash != "" } { - set cmmd "$cmmd -dash [list $dash]" - } - - if { $smooth != "" } { - set cmmd "$cmmd -smooth $smooth" - } - - if { $splinesteps != "" } { - set cmmd "$cmmd -splinesteps $splinesteps" - } - - debug_puts "$cmmd" - set result [eval $cmmd] - if { $result != "" } { - debug_puts $result - } - } + proc _is_win {} { + return [ info exist tk_patchLevel ] + } + + # _print_widget + # Main procedure for printing a widget. Currently supports + # canvas widgets. Handles opening and closing of printer. + # Arguments: + # wid - The widget to be printed. + # printer - Flag whether to use the default printer. + # name - App name to pass to printer. + + proc _print_widget { wid {printer default} {name "Tk Print Job"} } { + + # start printing process ------ + if {[string match "default" $printer]} { + set hdc [::tk::print::_print open] + } else { + set hdc [::tk::print::_print dialog select] + if { [lindex $hdc 1] == 0 } { + # User has canceled printing + return + } + set hdc [ lindex $hdc 0 ] + } + + variable p + set p(0) 0 ; unset p(0) + _page_args p + + if {![info exist p(hDC)]} { + set hdc [::tk::print::_print open] + _page_args p + } + if {[string match "?" $hdc] || [string match 0x0 $hdc]} { + catch {::tk::print::_print close} + error "Problem opening printer: printer context cannot be established" + } + + ::tk::print::_print job start -name "$name" + ::tk::print::_print page start + + # Here is where any scaling/gdi mapping should take place + # For now, scale so the dimensions of the window are sized to the + # width of the page. Scale evenly. + + # For normal windows, this may be fine--but for a canvas, one wants the + # canvas dimensions, and not the WINDOW dimensions. + if { [winfo class $wid] == "Canvas" } { + set sc [ lindex [ $wid configure -scrollregion ] 4 ] + # if there is no scrollregion, use width and height. + if { "$sc" == "" } { + set window_x [ lindex [ $wid configure -width ] 4 ] + set window_y [ lindex [ $wid configure -height ] 4 ] + } else { + set window_x [ lindex $sc 2 ] + set window_y [ lindex $sc 3 ] + } + } else { + set window_x [ winfo width $wid ] + set window_y [ winfo height $wid ] + } + + set pd "page dimensions" + set pm "page margins" + set ppi "pixels per inch" + + set printer_x [ expr ( [lindex $p($pd) 0] - \ + [lindex $p($pm) 0 ] - \ + [lindex $p($pm) 2 ] \ + ) * \ + [lindex $p($ppi) 0] / 1000.0 ] + set printer_y [ expr ( [lindex $p($pd) 1] - \ + [lindex $p($pm) 1 ] - \ + [lindex $p($pm) 3 ] \ + ) * \ + [lindex $p($ppi) 1] / 1000.0 ] + set factor_x [ expr $window_x / $printer_x ] + set factor_y [ expr $window_y / $printer_y ] + + if { $factor_x < $factor_y } { + set lo $window_y + set ph $printer_y + } else { + set lo $window_x + set ph $printer_x + } + + ::tk::print::_gdi map $hdc -logical $lo -physical $ph -offset $p(resolution) + + # handling of canvas widgets + # additional procs can be added for other widget types + switch [winfo class $wid] { + Canvas { + # if {[catch { + _print_canvas [lindex $hdc 0] $wid + # } msg]} { + # debug_puts "print_widget: $msg" + # error "Windows Printing Problem: $msg" + # } + } + default { + puts "Can't print items of type [winfo class $wid]. No handler registered" + } + } + + # end printing process ------ + ::tk::print::_print page end + ::tk::print::_printj job end + ::tk::print::_print close + } - ################################################################ - ## print_canvas.arc - ## Description: - ## Prints a arc item. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ## id The id of the canvas item. - ################################################################ - proc print_canvas.arc {hdc cw id} { - variable vtgPrint + + # _print_canvas + # Main procedure for writing canvas widget items to printer. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + + + proc _print_canvas {hdc cw} { + variable vtgPrint + + # get information about page being printed to + # print_canvas.CalcSizing $cw + set vtgPrint(canvas.bg) [string tolower [$cw cget -background]] + + # re-write each widget from cw to printer + foreach id [$cw find all] { + set type [$cw type $id] + if { [ info commands _print_canvas.$type ] == "_print_canvas.$type" } { + _print_canvas.[$cw type $id] $hdc $cw $id + } else { + puts "Omitting canvas item of type $type since there is no handler registered for it" + } + } + } + + # These procedures support the various canvas item types, + # reading the information about the item on the real canvas + # and then writing a similar item to the printer. + + # _print_canvas.line + # Description: + # Prints a line item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + + + proc _print_canvas.line {hdc cw id} { + variable vtgPrint + + set color [_print_canvas.TransColor [$cw itemcget $id -fill]] + if {[string match $vtgPrint(printer.bg) $color]} {return} + + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set arrow [$cw itemcget $id -arrow] + set arwshp [$cw itemcget $id -arrowshape] + set dash [$cw itemcget $id -dash] + set smooth [$cw itemcget $id -smooth ] + set splinesteps [ $cw itemcget $id -splinesteps ] + + set cmmd "::tk::print::_gdi line $hdc $coords -fill $color -arrow $arrow -arrowshape [list $arwshp]" + + if { $wdth > 1 } { + set cmmd "$cmmd -width $wdth" + } + + if { $dash != "" } { + set cmmd "$cmmd -dash [list $dash]" + } + + if { $smooth != "" } { + set cmmd "$cmmd -smooth $smooth" + } + + if { $splinesteps != "" } { + set cmmd "$cmmd -splinesteps $splinesteps" + } + + set result [eval $cmmd] + if { $result != "" } { + puts $result + } + } - set color [print_canvas.TransColor [$cw itemcget $id -outline]] - if { [string match $vtgPrint(printer.bg) $color] } { - return - } - set coords [$cw coords $id] - set wdth [$cw itemcget $id -width] - set style [ $cw itemcget $id -style ] - set start [ $cw itemcget $id -start ] - set extent [ $cw itemcget $id -extent ] - set fill [ $cw itemcget $id -fill ] - - set cmmd "gdi arc $hdc $coords -outline $color -style $style -start $start -extent $extent" - if { $wdth > 1 } { - set cmmd "$cmmd -width $wdth" - } - if { $fill != "" } { - set cmmd "$cmmd -fill $fill" - } - - debug_puts "$cmmd" - eval $cmmd - } - - ################################################################ - ## print_canvas.polygon - ## Description: - ## Prints a polygon item. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ## id The id of the canvas item. - ################################################################ - - proc print_canvas.polygon {hdc cw id} { - variable vtgPrint - - set fcolor [print_canvas.TransColor [$cw itemcget $id -fill]] - if { ![string length $fcolor] } { - set fcolor $vtgPrint(printer.bg) - } - set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] - if { ![string length $ocolor] } { - set ocolor $vtgPrint(printer.bg) - } - set coords [$cw coords $id] - set wdth [$cw itemcget $id -width] - set smooth [$cw itemcget $id -smooth ] - set splinesteps [ $cw itemcget $id -splinesteps ] - - set cmmd "gdi polygon $hdc $coords -width $wdth \ + + # _print_canvas.arc + # Prints a arc item. + # Args: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + + + proc _print_canvas.arc {hdc cw id} { + variable vtgPrint + + set color [print_canvas.TransColor [$cw itemcget $id -outline]] + if { [string match $vtgPrint(printer.bg) $color] } { + return + } + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set style [ $cw itemcget $id -style ] + set start [ $cw itemcget $id -start ] + set extent [ $cw itemcget $id -extent ] + set fill [ $cw itemcget $id -fill ] + + set cmmd "::tk::print::_gdi arc $hdc $coords -outline $color -style $style -start $start -extent $extent" + if { $wdth > 1 } { + set cmmd "$cmmd -width $wdth" + } + if { $fill != "" } { + set cmmd "$cmmd -fill $fill" + } + + eval $cmmd + } + + + # _print_canvas.polygon + # Prints a polygon item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + + + proc _print_canvas.polygon {hdc cw id} { + variable vtgPrint + + set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] + if { ![string length $fcolor] } { + set fcolor $vtgPrint(printer.bg) + } + set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] + if { ![string length $ocolor] } { + set ocolor $vtgPrint(printer.bg) + } + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set smooth [$cw itemcget $id -smooth ] + set splinesteps [ $cw itemcget $id -splinesteps ] + + + set cmmd "::tk::print::_gdi polygon $hdc $coords -width $wdth \ -fill $fcolor -outline $ocolor" - if { $smooth != "" } { - set cmmd "$cmmd -smooth $smooth" - } - - if { $splinesteps != "" } { - set cmmd "$cmmd -splinesteps $splinesteps" - } - - debug_puts "$cmmd" - eval $cmmd - } - - - ################################################################ - ## print_canvas.oval - ## Description: - ## Prints an oval item. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ## id The id of the canvas item. - ################################################################ - - proc print_canvas.oval { hdc cw id } { - variable vtgPrint - - set fcolor [print_canvas.TransColor [$cw itemcget $id -fill]] - if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} - set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] - if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} - set coords [$cw coords $id] - set wdth [$cw itemcget $id -width] - - set cmmd "gdi oval $hdc $coords -width $wdth \ + if { $smooth != "" } { + set cmmd "$cmmd -smooth $smooth" + } + + if { $splinesteps != "" } { + set cmmd "$cmmd -splinesteps $splinesteps" + } + + eval $cmmd + } + + + + # _print_canvas.oval + # Prints an oval item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + + proc _print_canvas.oval { hdc cw id } { + variable vtgPrint + + set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] + if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} + set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] + if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + + set cmmd "::tk::print::_gdi oval $hdc $coords -width $wdth \ -fill $fcolor -outline $ocolor" - debug_puts "$cmmd" - eval $cmmd - } - - ################################################################ - ## print_canvas.rectangle - ## Description: - ## Prints a rectangle item. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ## id The id of the canvas item. - ################################################################ - - proc print_canvas.rectangle {hdc cw id} { - variable vtgPrint - - set fcolor [print_canvas.TransColor [$cw itemcget $id -fill]] - if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} - set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] - if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} - set coords [$cw coords $id] - set wdth [$cw itemcget $id -width] - - set cmmd "gdi rectangle $hdc $coords -width $wdth \ + + eval $cmmd + } + + + # _print_canvas.rectangle + # Prints a rectangle item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + + + proc _print_canvas.rectangle {hdc cw id} { + variable vtgPrint + + set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] + if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} + set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] + if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + + set cmmd "::tk::print::_gdi rectangle $hdc $coords -width $wdth \ -fill $fcolor -outline $ocolor" - debug_puts "$cmmd" - eval $cmmd - } - - - ################################################################ - ## print_canvas.text - ## Description: - ## Prints a text item. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ## id The id of the canvas item. - ################################################################ - - proc print_canvas.text {hdc cw id} { - variable vtgPrint - variable p - - set p(0) 1 ; unset p(0) - page_args p - - set color [print_canvas.TransColor [$cw itemcget $id -fill]] - # if {[string match white [string tolower $color]]} {return} - # set color black - set txt [$cw itemcget $id -text] - if {![string length $txt]} {return} - set coords [$cw coords $id] - set anchr [$cw itemcget $id -anchor] - - set bbox [$cw bbox $id] - set wdth [expr [lindex $bbox 2] - [lindex $bbox 0]] - - set just [$cw itemcget $id -justify] - - # Get the canvas font info - set font [ $cw itemcget $id -font ] - # Find the real font info - set font [font actual $font] - # Create a compatible font, suitable for printer name extraction - set font [ eval font create $font ] - # Just get the name and family, or some of the gdi commands will fail. - # Improve this as GDI improves - set font [list [font configure $font -family] -[font configure $font -size] ] - - set cmmd "gdi text $hdc $coords -fill $color -text [list $txt] \ + + eval $cmmd + } + + # _print_canvas.text + # Prints a text item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + + + proc _print_canvas.text {hdc cw id} { + variable vtgPrint + variable p + + set p(0) 1 ; unset p(0) + _page_args p + + set color [_print_canvas.TransColor [$cw itemcget $id -fill]] + # if {[string match white [string tolower $color]]} {return} + # set color black + set txt [$cw itemcget $id -text] + if {![string length $txt]} {return} + set coords [$cw coords $id] + set anchr [$cw itemcget $id -anchor] + + set bbox [$cw bbox $id] + set wdth [expr [lindex $bbox 2] - [lindex $bbox 0]] + + set just [$cw itemcget $id -justify] + + # Get the canvas font info + set font [ $cw itemcget $id -font ] + # Find the real font info + set font [font actual $font] + # Create a compatible font, suitable for printer name extraction + set font [ eval font create $font ] + # Just get the name and family, or some of the ::tk::print::_gdi commands will fail. + # Improve this as GDI improves + set font [list [font configure $font -family] -[font configure $font -size] ] + + set cmmd "::tk::print::_gdi text $hdc $coords -fill $color -text [list $txt] \ -anchor $anchr -font [ list $font ] \ -width $wdth -justify $just" - debug_puts "$cmmd" - eval $cmmd - } - - - ################################################################ - ## print_canvas.image - ## Description: - ## Prints an image item. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ## id The id of the canvas item. - ################################################################ - - proc print_canvas.image {hdc cw id} { - - variable vtgPrint - variable option - - # First, we have to get the image name - set imagename [ $cw itemcget $id -image] - # Now we get the size - set wid [ image width $imagename] - set hgt [ image height $imagename ] - # next, we get the location and anchor - set anchor [ $cw itemcget $id -anchor ] - set coords [ $cw coords $id ] - - - # Since the GDI commands don't yet support images and bitmaps, - # and since this represents a rendered bitmap, we CAN use - # copybits IF we create a new temporary toplevel to hold the beast. - # if this is too ugly, change the option! - if { [ info exist option(use_copybits) ] } { - set firstcase $option(use_copybits) - } else { - set firstcase 0 - } + eval $cmmd + } + + + # _print_canvas.image + # Prints an image item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + + + proc _print_canvas.image {hdc cw id} { + + variable vtgPrint + variable option + + # First, we have to get the image name + set imagename [ $cw itemcget $id -image] + # Now we get the size + set wid [ image width $imagename] + set hgt [ image height $imagename ] + # next, we get the location and anchor + set anchor [ $cw itemcget $id -anchor ] + set coords [ $cw coords $id ] + + + # Since the GDI commands don't yet support images and bitmaps, + # and since this represents a rendered bitmap, we CAN use + # copybits IF we create a new temporary toplevel to hold the beast. + # if this is too ugly, change the option! + if { [ info exist option(use_copybits) ] } { + set firstcase $option(use_copybits) + } else { + set firstcase 0 + } + + if { $firstcase > 0 } { + set tl [toplevel .tmptop[expr int( rand() * 65535 ) ] -height $hgt -width $wid -background $vtgPrint(printer.bg) ] + canvas $tl.canvas -width $wid -height $hgt + $tl.canvas create image 0 0 -image $imagename -anchor nw + pack $tl.canvas -side left -expand false -fill none + tkwait visibility $tl.canvas + update + #set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] + #set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] + set srccoords [ list "0 0 $wid $hgt" ] + set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] $wid $hgt" ] + set cmmd "::tk::print::_gdi copybits $hdc -window $tl -client -source $srccoords -destination $dstcoords " + eval $cmmd + destroy $tl + } else { + set cmmd "::tk::print::_gdi image $hdc $coords -anchor $anchor -image $imagename " + eval $cmmd + } + } - if { $firstcase > 0 } { - set tl [toplevel .tmptop[expr int( rand() * 65535 ) ] -height $hgt -width $wid -background $vtgPrint(printer.bg) ] - canvas $tl.canvas -width $wid -height $hgt - $tl.canvas create image 0 0 -image $imagename -anchor nw - pack $tl.canvas -side left -expand false -fill none - tkwait visibility $tl.canvas - update - #set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] - #set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] - set srccoords [ list "0 0 $wid $hgt" ] - set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] $wid $hgt" ] - set cmmd "gdi copybits $hdc -window $tl -client -source $srccoords -destination $dstcoords " - debug_puts "$cmmd" - eval $cmmd - destroy $tl - } else { - set cmmd "gdi image $hdc $coords -anchor $anchor -image $imagename" - debug_puts "$cmmd" - eval $cmmd - } - } - - ################################################################ - ## print_canvas.bitmap - ## Description: - ## Prints a bitmap item. - ## Args: - ## hdc The printer handle. - ## cw The canvas widget. - ## id The id of the canvas item. - ################################################################ - - proc print_canvas.bitmap {hdc cw id} { - variable option - variable vtgPrint - - # First, we have to get the bitmap name - set imagename [ $cw itemcget $id -image] - # Now we get the size - set wid [ image width $imagename] - set hgt [ image height $imagename ] - # next, we get the location and anchor - set anchor [ $cw itemcget $id -anchor ] - set coords [ $cw coords $id ] - - # Since the GDI commands don't yet support images and bitmaps, - # and since this represents a rendered bitmap, we CAN use - # copybits IF we create a new temporary toplevel to hold the beast. - # if this is too ugly, change the option! - if { [ info exist option(use_copybits) ] } { - set firstcase $option(use_copybits) - } else { - set firstcase 0 - } - if { $firstcase > 0 } { - set tl [toplevel .tmptop[expr int( rand() * 65535 ) ] -height $hgt -width $wid -background $vtgPrint(canvas.bg) ] - canvas $tl.canvas -width $wid -height $hgt - $tl.canvas create image 0 0 -image $imagename -anchor nw - pack $tl.canvas -side left -expand false -fill none - tkwait visibility $tl.canvas - update - set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] - set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] - set cmmd "gdi copybits $hdc -window $tl -client -source $srccoords -destination $dstcoords " - debug_puts "$cmmd" - eval $cmmd - destroy $tl - } else { - set cmmd "gdi bitmap $hdc $coords -anchor $anchor -bitmap $imagename" - debug_puts "$cmmd" - eval $cmmd - } - } - - ################################################################ - ## These procedures transform attribute setting from the real # - ## canvas to the appropriate setting for printing to paper. # - ################################################################ - - ################################################################ - ## print_canvas.TransColor - ## Description: - ## Does the actual transformation of colors from the - ## canvas widget to paper. - ## Args: - ## color The color value to be transformed. - ################################################################ - - proc print_canvas.TransColor {color} { - variable vtgPrint - - switch [string toupper $color] { - $vtgPrint(canvas.bg) {return $vtgPrint(printer.bg)} - } - return $color - } + + # _print_canvas.bitmap + # Prints a bitmap item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + + + proc _print_canvas.bitmap {hdc cw id} { + variable option + variable vtgPrint + + # First, we have to get the bitmap name + set imagename [ $cw itemcget $id -image] + # Now we get the size + set wid [ image width $imagename] + set hgt [ image height $imagename ] + # next, we get the location and anchor + set anchor [ $cw itemcget $id -anchor ] + set coords [ $cw coords $id ] + + # Since the GDI commands don't yet support images and bitmaps, + # and since this represents a rendered bitmap, we CAN use + # copybits IF we create a new temporary toplevel to hold the beast. + # if this is too ugly, change the option! + if { [ info exist option(use_copybits) ] } { + set firstcase $option(use_copybits) + } else { + set firstcase 0 + } + if { $firstcase > 0 } { + set tl [toplevel .tmptop[expr int( rand() * 65535 ) ] -height $hgt -width $wid -background $vtgPrint(canvas.bg) ] + canvas $tl.canvas -width $wid -height $hgt + $tl.canvas create image 0 0 -image $imagename -anchor nw + pack $tl.canvas -side left -expand false -fill none + tkwait visibility $tl.canvas + update + set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] + set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] + set cmmd "::tk::print::_gdi copybits $hdc -window $tl -client -source $srccoords -destination $dstcoords " + eval $cmmd + destroy $tl + } else { + set cmmd "::tk::print::_gdi bitmap $hdc $coords -anchor $anchor -bitmap $imagename" + eval $cmmd + } + } - # Initialize all the variables once - init_print_canvas + + # These procedures transform attribute setting from the real + # canvas to the appropriate setting for printing to paper. + + # _print_canvas.TransColor + # Does the actual transformation of colors from the + # canvas widget to paper. + # Arguments: + # color - The color value to be transformed. + + + proc _print_canvas.TransColor {color} { + variable vtgPrint + + switch [string toupper $color] { + $vtgPrint(canvas.bg) {return $vtgPrint(printer.bg)} + } + return $color + } + + # Initialize all the variables once + _init_print_canvas + } + #end win32 procedures } -- cgit v0.12 From a95c64be8e92790102936145c186f1ed76af137b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 19 Apr 2021 02:07:24 +0000 Subject: Remove some compiler warnings, still more work to get build in place --- win/tkWinHDC.c | 39 ++++++++++++++++++++++++++++++++++++++- win/tkWinHDC.h | 13 +++++++------ win/tkWinPrint.c | 14 ++++++-------- 3 files changed, 51 insertions(+), 15 deletions(-) diff --git a/win/tkWinHDC.c b/win/tkWinHDC.c index 67a96f7..daca149 100644 --- a/win/tkWinHDC.c +++ b/win/tkWinHDC.c @@ -14,6 +14,43 @@ #include "tkWinHDC.h" +/* + *---------------------------------------------------------------------- + * + * Hdc_build_name -- + * + * Creates HDC name. + * + * Results: + * HDC name created. + * + *---------------------------------------------------------------------- + */ + +static const char *Hdc_build_name(int type) +{ + const char *prefix; + Tcl_HashEntry *data; + int status; + + if ( (data = Tcl_FindHashEntry(&hdcprefixes, (char *)type)) != 0 ) + prefix = (const char *)Tcl_GetHashValue(data); + else + { + char *cp; + prefix = "hdc"; + if ( (cp = (char *)Tcl_Alloc(4)) != 0 ) + { + strcpy (cp, prefix); + if ( (data = Tcl_CreateHashEntry(&hdcprefixes, (char *)type, &status)) != 0 ) + Tcl_SetHashValue(data, (ClientData)cp); + } + } + + sprintf(hdc_name, "%s%ld", prefix, ++hdc_count); + return hdc_name; +} + /* *---------------------------------------------------------------------- @@ -183,7 +220,7 @@ const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix) if ( newprefix ) { char *cp; - int siz, len; + size_t siz, len; siz = strlen(newprefix); len = siz > 32 ? 32 : siz; diff --git a/win/tkWinHDC.h b/win/tkWinHDC.h index 9341927..c83c894 100644 --- a/win/tkWinHDC.h +++ b/win/tkWinHDC.h @@ -20,9 +20,10 @@ static Tcl_HashTable hdcprefixes; static char hdc_name [32+12+1]; -int hdc_create(ClientData data, Tcl_Interp *interp, int argc, char **argv); -int hdc_delete(ClientData data, Tcl_Interp *interp, int argc, char **argv); -int hdc_list(ClientData data, Tcl_Interp *interp, int argc, char **argv); -int hdc_prefixof(ClientData data, Tcl_Interp *interp, int argc, char **argv); -int hdc_typeof(ClientData data, Tcl_Interp *interp, int argc, char **argv); -void * hdc_get (Tcl_Interp *interp, const char *hdcname); \ No newline at end of file +const char * hdc_create (Tcl_Interp *interp, void *ptr, int type); +int hdc_valid (Tcl_Interp *interp, const char *hdcname, int type); +int hdc_delete (Tcl_Interp *interp, const char *hdcname); +const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix); +int hdc_typeof (Tcl_Interp *interp, const char *hdcname); +void * hdc_get (Tcl_Interp *interp, const char *hdcname); +static const char *Hdc_build_name(int type); \ No newline at end of file diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 06693bc..7021116 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -3589,8 +3589,7 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char { int found=0; int i; - for (i=0; i Date: Tue, 20 Apr 2021 12:28:39 +0000 Subject: Start to remove compiler warnings --- win/tkWinGDI.c | 8 - win/tkWinPrint.c | 1207 +++++++++++++++++++++++++++--------------------------- 2 files changed, 604 insertions(+), 611 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index d8422b9..aae31f5 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -218,14 +218,6 @@ static int GdiArc( int dodash = 0; const char *dashdata = 0; - static const char usage_message[] = "::tk::print::_gdi arc hdc x1 y1 x2 y2 " - "-extent degrees " - "-fill color -outline color " - "-outlinestipple bitmap " - "-start degrees -stipple bitmap " - "-dash pattern " - "-style [pieslice|chord|arc] -width linewid"; - drawfunc = Pie; /* Verrrrrry simple for now.... */ diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 7021116..8715916 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -3,10 +3,10 @@ * * This module implements Win32 printer access. * - * Copyright © 1998-2019 Harald Oehlmann, Elmicron GmbH - * Copyright © 2009 Michael I. Schwartz. - * Copyright © 2018 Microsoft Corporation. - * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * Copyright (c) 1998-2019 Harald Oehlmann, Elmicron GmbH + * Copyright (c) 2009 Michael I. Schwartz. + * Copyright (c) 2018 Microsoft Corporation. + * Copyright (c) 2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -20,17 +20,16 @@ * end of the file. */ #if defined(__WIN32__) || defined (__WIN32S__) || defined (WIN32S) -/* Suppress Vista Warnings. */ +/* Suppress Vista Warnings. */ #define _CRT_SECURE_NO_WARNINGS +#endif + #include #include - - - #include #include #include -#include /* For floor(), used later. */ +#include /* For floor(), used later. */ #include "tkWinHDC.h" /* @@ -65,21 +64,21 @@ static struct printer_values { - unsigned long magic; /* Give some indication if this is a "real" structure. */ - HDC hDC; /* Default printer context--override via args?. */ - char hdcname[19+1]; /* Name of hdc. */ - PRINTDLG pdlg; /* Printer dialog and associated values. */ - PAGESETUPDLG pgdlg; /* Printer setup dialog and associated values. */ - DEVMODE *pdevmode; /* Allocated when the printer_values is built. */ - char extra_space[1024+1]; /* space just in case.... */ - int space_count; /* How much extra space. */ - char devnames_filename[255+1]; /* Driver filename. */ - char devnames_port[255+1]; /* Output port. */ - char devnames_printername[255+1]; /* Full printer name. */ - Tcl_HashTable attribs; /* Hold the attribute name/value pairs.. */ - int in_job; /* Set to 1 after job start and before job end. */ - int in_page; /* Set to 1 after page start and before page end. */ - DWORD errorCode; /* Under some conditions, save the Windows error code. */ + unsigned long magic; /* Give some indication if this is a "real" structure. */ + HDC hDC; /* Default printer context--override via args?. */ + char hdcname[19+1]; /* Name of hdc. */ + PRINTDLG pdlg; /* Printer dialog and associated values. */ + PAGESETUPDLG pgdlg; /* Printer setup dialog and associated values. */ + DEVMODE *pdevmode; /* Allocated when the printer_values is built. */ + char extra_space[1024+1]; /* space just in case.... */ + int space_count; /* How much extra space. */ + char devnames_filename[255+1]; /* Driver filename. */ + char devnames_port[255+1]; /* Output port. */ + char devnames_printername[255+1]; /* Full printer name. */ + Tcl_HashTable attribs; /* Hold the attribute name/value pairs.. */ + int in_job; /* Set to 1 after job start and before job end. */ + int in_page; /* Set to 1 after page start and before page end. */ + DWORD errorCode; /* Under some conditions, save the Windows error code. */ } default_printer_values; /* @@ -87,7 +86,7 @@ static struct printer_values * managing printer_values structures. */ struct printer_values *current_printer_values = &default_printer_values; -static int is_valid_printer_values ( const struct printer_values *ppv ); +static int is_valid_printer_values (const struct printer_values *ppv); static struct printer_values *make_printer_values(HDC hdc); static void delete_printer_values (struct printer_values *ppv); @@ -138,7 +137,7 @@ static int PrintPageAttr (HDC hdc, int *hsize, int *vsize, static int is_valid_hdc (HDC hdc); static void RestorePageMargins (const char *attrib, PAGESETUPDLG *pgdlg); -/* New functions from Mark Roseman. */ +/* New functions from Mark Roseman. */ static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char * argv); static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, const char * argv); static int PrintClose(ClientData data, Tcl_Interp *interp, int argc, const char * argv); @@ -148,9 +147,9 @@ static int PrintPage(ClientData data, Tcl_Interp *interp, int argc, const char static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char * argv); static int PrintOption(ClientData data, Tcl_Interp *interp, int argc, const char * argv); static int JobInfo(int state, const char *name, const char * outname); -/* End new functions. */ +/* End new functions. */ -/* Functions to give printer contexts names. */ +/* Functions to give printer contexts names. */ static void init_printer_dc_contexts(Tcl_Interp *interp); static void delete_printer_dc_contexts(Tcl_Interp *inter); static const char *make_printer_dc_name(Tcl_Interp *interp, HDC hdc, struct printer_values *pv); @@ -163,7 +162,7 @@ static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, i * Internal static data structures (ClientData) */ static char msgbuf[255+1]; -int autoclose = 1; /* Default is old behavior--one open printer at a time. */ +int autoclose = 1; /* Default is old behavior--one open printer at a time. */ static struct { char *tmpname; @@ -189,10 +188,10 @@ static struct { static long WinVersion(void) { static OSVERSIONINFO osinfo; - if ( osinfo.dwOSVersionInfoSize == 0 ) + if (osinfo.dwOSVersionInfoSize == 0) { osinfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osinfo); /* Should never fail--only failure is if size too small. */ + GetVersionEx(&osinfo); /* Should never fail--only failure is if size too small. */ } return osinfo.dwPlatformId; } @@ -215,7 +214,7 @@ static long WinVersion(void) static void ReportWindowsError(Tcl_Interp * interp, DWORD errorCode) { LPVOID lpMsgBuf; - FormatMessage( + FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, @@ -225,10 +224,10 @@ static void ReportWindowsError(Tcl_Interp * interp, DWORD errorCode) (LPTSTR) &lpMsgBuf, 0, NULL - ); + ); Tcl_AppendResult(interp,(char *)lpMsgBuf,0); // Free the buffer. - LocalFree( lpMsgBuf ); + LocalFree(lpMsgBuf); } @@ -262,12 +261,12 @@ static const char *set_attribute(Tcl_HashTable *att, const char *key, const char char *val = 0; data = Tcl_CreateHashEntry(att, key, &status); - if ( status == 0) /* Already existing item!. */ - if ( (val = (char *)Tcl_GetHashValue(data)) != 0 ) + if (status == 0) /* Already existing item!. */ + if ((val = (char *)Tcl_GetHashValue(data)) != 0) Tcl_Free(val); - /* In any case, now set the new value. */ - if ( value != 0 && (val = (char *)Tcl_Alloc(strlen(value)+1)) != 0 ) + /* In any case, now set the new value. */ + if (value != 0 && (val = (char *)Tcl_Alloc(strlen(value)+1)) != 0) { strcpy (val, value); Tcl_SetHashValue(data, val); @@ -292,7 +291,7 @@ static const char *get_attribute(Tcl_HashTable *att, const char *key) { Tcl_HashEntry *data; - if ( ( data = Tcl_FindHashEntry(att, key) ) != 0 ) + if ((data = Tcl_FindHashEntry(att, key)) != 0) return (char *)Tcl_GetHashValue(data); return 0; } @@ -315,10 +314,10 @@ static int del_attribute(Tcl_HashTable *att, const char *key) { Tcl_HashEntry *data; - if ( ( data = Tcl_FindHashEntry(att, key) ) != 0 ) + if ((data = Tcl_FindHashEntry(att, key)) != 0) { char *val; - if ( (val = (char *)Tcl_GetHashValue(data) ) != 0 ) + if ((val = (char *)Tcl_GetHashValue(data)) != 0) Tcl_Free(val); Tcl_DeleteHashEntry(data); return 1; @@ -340,7 +339,7 @@ static int del_attribute(Tcl_HashTable *att, const char *key) *---------------------------------------------------------------------- */ -static int is_valid_printer_values ( const struct printer_values *ppv ) +static int is_valid_printer_values (const struct printer_values *ppv) { if (ppv && ppv->magic == PVMAGIC) return 1; @@ -363,9 +362,9 @@ static int is_valid_printer_values ( const struct printer_values *ppv ) static struct printer_values *make_printer_values(HDC hdc) { struct printer_values *ppv; - if ( (ppv = (struct printer_values *)Tcl_Alloc(sizeof(struct printer_values)) ) == 0 ) + if ((ppv = (struct printer_values *)Tcl_Alloc(sizeof(struct printer_values))) == 0) return 0; - memset(ppv, 0, sizeof(struct printer_values) ); + memset(ppv, 0, sizeof(struct printer_values)); ppv->magic = PVMAGIC; ppv->hDC = hdc; Tcl_InitHashTable(&(ppv->attribs), TCL_STRING_KEYS); @@ -388,12 +387,12 @@ static struct printer_values *make_printer_values(HDC hdc) static void delete_printer_values (struct printer_values *ppv) { - if ( is_valid_printer_values(ppv) ) + if (is_valid_printer_values(ppv)) { - ppv->magic = 0L; /* Prevent re-deletion.... */ + ppv->magic = 0L; /* Prevent re-deletion.... */ Tcl_DeleteHashTable(&ppv->attribs); - if ( ppv->pdevmode ) { - Tcl_Free( (char *) ppv->pdevmode ); + if (ppv->pdevmode) { + Tcl_Free((char *) ppv->pdevmode); ppv->pdevmode = 0; } Tcl_Free((char *)ppv); @@ -415,7 +414,7 @@ static void delete_printer_values (struct printer_values *ppv) static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, int wildcard) { - /* The following 3 declarations are only needed for the Win32s case. */ + /* The following 3 declarations are only needed for the Win32s case. */ static char devices_buffer[256]; static char value[256]; char *cp; @@ -424,29 +423,31 @@ static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, i * This is not needed for normal cases, but at least one report on * WinNT with at least one printer, this is not initialized. * Suggested by Jim Garrison - . */ - *dev = *dvr = *port = ""; + . */ + *dev = ""; + *dvr = ""; + *port = ""; /* * The result should be useful for specifying the devices and/or OpenPrinter and/or lp -d. * Rather than make this compilation-dependent, do a runtime check. */ - switch ( WinVersion() ) + switch (WinVersion()) { - case VER_PLATFORM_WIN32s: /* Windows 3.1. */ + case VER_PLATFORM_WIN32s: /* Windows 3.1. */ /* Getting the printer list isn't hard... the trick is which is right for WfW? * [PrinterPorts] or [devices]? * For now, use devices. - . */ - /* First, get the entries in the section. */ + . */ + /* First, get the entries in the section. */ GetProfileString("devices", 0, "", (LPSTR)devices_buffer, sizeof devices_buffer); - /* Next get the values for each entry; construct each as a list of 3 elements. */ + /* Next get the values for each entry; construct each as a list of 3 elements. */ for (cp = devices_buffer; *cp ; cp+=strlen(cp) + 1) { GetProfileString("devices", cp, "", (LPSTR)value, sizeof value); - if ( ( wildcard != 0 && Tcl_StringMatch(value, name) ) || - ( wildcard == 0 && lstrcmpi (value, name) == 0 ) ) + if ((wildcard != 0 && Tcl_StringMatch(value, name)) || + (wildcard == 0 && lstrcmpi (value, name) == 0) ) { static char stable_val[80]; strncpy (stable_val, value,80); @@ -456,10 +457,10 @@ static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, i } return 0; break; - case VER_PLATFORM_WIN32_WINDOWS: /* Windows 95, 98. */ - case VER_PLATFORM_WIN32_NT: /* Windows NT. */ + case VER_PLATFORM_WIN32_WINDOWS: /* Windows 95, 98. */ + case VER_PLATFORM_WIN32_NT: /* Windows NT. */ default: - /* Win32 implementation uses EnumPrinters. */ + /* Win32 implementation uses EnumPrinters. */ /* There is a hint in the documentation that this info is stored in the registry. * if so, that interface would probably be even better! @@ -473,30 +474,30 @@ static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, i PRINTER_INFO_2 *ary = 0; DWORD i; - /* First, get the size of array needed to enumerate the printers. */ - if ( EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, + /* First, get the size of array needed to enumerate the printers. */ + if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, 2, (LPBYTE)ary, bufsiz, &needed, - &num_printers) == FALSE ) + &num_printers) == FALSE) { - /* Expected failure--we didn't allocate space. */ + /* Expected failure--we didn't allocate space. */ DWORD err = GetLastError(); - /* If the error isn't insufficient space, we have a real problem.. */ - if ( err != ERROR_INSUFFICIENT_BUFFER ) + /* If the error isn't insufficient space, we have a real problem. */ + if (err != ERROR_INSUFFICIENT_BUFFER) return 0; } - /* Now that we know how much, allocate it. */ - if ( needed > 0 && (ary = (PRINTER_INFO_2 *)Tcl_Alloc(needed) ) != 0 ) + /* Now that we know how much, allocate it. */ + if (needed > 0 && (ary = (PRINTER_INFO_2 *)Tcl_Alloc(needed)) != 0) bufsiz = needed; else return 0; - if ( EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, + if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, 2, (LPBYTE)ary, bufsiz, &needed, - &num_printers) == FALSE ) + &num_printers) == FALSE) { /* Now we have a real failure! */ return 0; @@ -504,10 +505,10 @@ static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, i for (i=0; ihDC == NULL ) + if (ppv->hDC == NULL) { /* * Use the name to create a DC if at all possible: * This may require using the printer list and matching on the name. - . */ + . */ char *dev, *dvr, *port; - if ( GetPrinterWithName ((char *)printer_name, &dev, &dvr, &port, 1) == 0 ) { - return GETDEFAULTS_NOSUCHPRINTER; /* Can't find a printer with that name. */ + if (GetPrinterWithName ((char *)printer_name, &dev, &dvr, &port, 1) == 0) { + return GETDEFAULTS_NOSUCHPRINTER; /* Can't find a printer with that name. */ } - if ( (ppv->hDC = CreateDC(dvr, dev, NULL, NULL) ) == NULL ) { - return GETDEFAULTS_CANTCREATEDC; /* Can't get defaults on non-existent DC. */ + if ((ppv->hDC = CreateDC(dvr, dev, NULL, NULL)) == NULL) { + return GETDEFAULTS_CANTCREATEDC; /* Can't get defaults on non-existent DC. */ } - if ( OpenPrinter((char *)printer_name, &pHandle, NULL) == 0 ) { + if (OpenPrinter((char *)printer_name, &pHandle, NULL) == 0) { return GETDEFAULTS_CANTOPENPRINTER; } } - /* Use DocumentProperties to get the default devmode. */ - if ( set_default_devmode > 0 || ppv->pdevmode == 0 ) - /* First get the required size:. */ + /* Use DocumentProperties to get the default devmode. */ + if (set_default_devmode > 0 || ppv->pdevmode == 0) + /* First get the required size:. */ { LONG siz = 0L; @@ -597,28 +598,28 @@ static int PrinterGetDefaults(struct printer_values *ppv, NULL, 0); - if ( siz > 0 && (cp = Tcl_Alloc(siz)) != 0 ) + if (siz > 0 && (cp = Tcl_Alloc(siz)) != 0) { - if ( (siz = DocumentProperties (GetActiveWindow(), + if ((siz = DocumentProperties (GetActiveWindow(), pHandle, (char *)printer_name, (DEVMODE *)cp, NULL, - DM_OUT_BUFFER)) >= 0 ) + DM_OUT_BUFFER)) >= 0) { - if ( ppv->pdevmode != 0 ) - Tcl_Free ( (char *)(ppv->pdevmode) ); + if (ppv->pdevmode != 0) + Tcl_Free ((char *)(ppv->pdevmode)); ppv->pdevmode = (DEVMODE *)cp; - SetDevModeAttribs ( &ppv->attribs, ppv->pdevmode); + SetDevModeAttribs (&ppv->attribs, ppv->pdevmode); } else { /* added 8/7/02 by Jon Hilbert This call may fail when the printer is known to Windows but unreachable for some reason (e.g. network sharing property changes). Add code to - test for failures here.. */ - /* call failed -- get error code. */ + test for failures here.. */ + /* call failed -- get error code. */ ppv->errorCode = GetLastError(); result = GETDEFAULTS_WINDOWSERROR; - /* release the DC. */ + /* release the DC. */ DeleteDC(ppv->hDC); ppv->hDC = 0; } @@ -627,10 +628,10 @@ static int PrinterGetDefaults(struct printer_values *ppv, if (pHandle) ClosePrinter(pHandle); - if (result == 1) /* Only do this if the attribute setting code succeeded. */ + if (result == 1) /* Only do this if the attribute setting code succeeded. */ SetHDCAttribs (&ppv->attribs, ppv->hDC); - return result; /* A return of 0 or less indicates failure. */ + return result; /* A return of 0 or less indicates failure. */ } /* @@ -657,9 +658,9 @@ static void MakeDevmode (struct printer_values *ppv, HANDLE hdevmode) ppv->pdevmode = 0; } - if ( (pdm = (DEVMODE *)GlobalLock(hdevmode)) != NULL ) + if ((pdm = (DEVMODE *)GlobalLock(hdevmode)) != NULL) { - if ( (ppv->pdevmode = (DEVMODE *)Tcl_Alloc(pdm->dmSize + pdm->dmDriverExtra)) != NULL ) + if ((ppv->pdevmode = (DEVMODE *)Tcl_Alloc(pdm->dmSize + pdm->dmDriverExtra)) != NULL) memcpy (ppv->pdevmode, pdm, pdm->dmSize + pdm->dmDriverExtra); GlobalUnlock(hdevmode); } @@ -682,13 +683,13 @@ static void CopyDevnames (struct printer_values *ppv, HANDLE hdevnames) { DEVNAMES *pdn; - if ( (pdn = (DEVNAMES *)GlobalLock(hdevnames)) != NULL ) + if ((pdn = (DEVNAMES *)GlobalLock(hdevnames)) != NULL) { strcpy(ppv->devnames_filename, (char *)pdn + pdn->wDriverOffset); strcpy(ppv->devnames_printername, (char *)pdn + pdn->wDeviceOffset); if (ppv && ppv->pdevmode) { - /* As reported by Steve Bold, protect against unusually long printer names. */ - strncpy(ppv->pdevmode->dmDeviceName, (char *)pdn + pdn->wDeviceOffset,sizeof(ppv->pdevmode->dmDeviceName)); + /* As reported by Steve Bold, protect against unusually long printer names. */ + strncpy((char* restrict)ppv->pdevmode->dmDeviceName, (char *)pdn + pdn->wDeviceOffset,sizeof(ppv->pdevmode->dmDeviceName)); ppv->pdevmode->dmDeviceName[sizeof(ppv->pdevmode->dmDeviceName)-1] = '\0'; } strcpy(ppv->devnames_port, (char *)pdn + pdn->wOutputOffset); @@ -696,10 +697,10 @@ static void CopyDevnames (struct printer_values *ppv, HANDLE hdevnames) } } -/* A macro for converting 10ths of millimeters to 1000ths of inches. */ -#define MM_TO_MINCH(x) ( (x) / 0.0254 ) -#define TENTH_MM_TO_MINCH(x) ( (x) / 0.254 ) -#define MINCH_TO_TENTH_MM(x) ( 0.254 * (x) ) +/* A macro for converting 10ths of millimeters to 1000ths of inches. */ +#define MM_TO_MINCH(x) ((x) / 0.0254) +#define TENTH_MM_TO_MINCH(x) ((x) / 0.254) +#define MINCH_TO_TENTH_MM(x) (0.254 * (x)) static const struct paper_size { int size; long wid; long len; } paper_sizes[] = { { DMPAPER_LETTER, 8500, 11000 }, @@ -777,22 +778,22 @@ static void GetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) * * Taken care of elsewhere * #copies - . */ + . */ const char *cp; - if ( cp = get_attribute(att, "page orientation") ) + if (cp = get_attribute(att, "page orientation")) { dm->dmFields |= DM_ORIENTATION; - if ( strcmp(cp, "portrait") == 0 ) + if (strcmp(cp, "portrait") == 0) dm->dmOrientation = DMORIENT_PORTRAIT; else dm->dmOrientation = DMORIENT_LANDSCAPE; } - /* -------------- added 8/1/02 by Jon Hilbert; modified 2/24/03 by Jon Hilbert. */ - else if ( cp = get_attribute(att, "page dimensions") ) + /* -------------- added 8/1/02 by Jon Hilbert; modified 2/24/03 by Jon Hilbert. */ + else if (cp = get_attribute(att, "page dimensions")) { long width,length; - dm->dmFields |= (DM_PAPERLENGTH | DM_PAPERWIDTH | DM_PAPERSIZE ); + dm->dmFields |= (DM_PAPERLENGTH | DM_PAPERWIDTH | DM_PAPERSIZE); sscanf(cp, "%ld %ld", &width, &length); dm->dmPaperWidth = (short)MINCH_TO_TENTH_MM(width); dm->dmPaperLength = (short)MINCH_TO_TENTH_MM(length); @@ -827,21 +828,21 @@ static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) sprintf(tmpbuf, "%d", dm->dmCopies); set_attribute(att, "copies", tmpbuf); - /* Everything depends on what flags are set. */ - if ( dm->dmDeviceName[0] ) - set_attribute(att, "device", dm->dmDeviceName); - if ( dm->dmFields & DM_ORIENTATION ) + /* Everything depends on what flags are set. */ + if (dm->dmDeviceName[0]) + set_attribute(att, "device", (const *char) dm->dmDeviceName); + if (dm->dmFields & DM_ORIENTATION) set_attribute(att, "page orientation", dm->dmOrientation==DMORIENT_PORTRAIT?"portrait":"landscape"); - if ( dm->dmFields & DM_YRESOLUTION ) + if (dm->dmFields & DM_YRESOLUTION) { sprintf(tmpbuf, "%d %d", dm->dmYResolution, dm->dmPrintQuality); set_attribute(att, "resolution", tmpbuf); } - else if ( dm->dmFields & DM_PRINTQUALITY) + else if (dm->dmFields & DM_PRINTQUALITY) { - /* The result may be positive (DPI) or negative (preset value). */ - if ( dm->dmPrintQuality > 0 ) + /* The result may be positive (DPI) or negative (preset value). */ + if (dm->dmPrintQuality > 0) { sprintf(tmpbuf, "%d %d", dm->dmPrintQuality, dm->dmPrintQuality); set_attribute(att, "resolution", tmpbuf); @@ -858,12 +859,12 @@ static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) { DMRES_LOW, "Low" }, { DMRES_DRAFT, "Draft" } }; - int i; + unsigned int i; const char *cp = "Unknown"; for (i = 0; i < sizeof(print_quality) / sizeof(struct PrinterQuality); i++) { - if ( print_quality[i].res == dm->dmPrintQuality ) + if (print_quality[i].res == dm->dmPrintQuality) { cp = print_quality[i].desc; break; @@ -876,28 +877,28 @@ static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) /* If the page size is provided by the paper size, use the page size to update * the previous size from the HDC. */ - if ( (dm->dmFields & DM_PAPERLENGTH) && (dm->dmFields & DM_PAPERWIDTH ) ) + if ((dm->dmFields & DM_PAPERLENGTH) && (dm->dmFields & DM_PAPERWIDTH)) { sprintf(tmpbuf, "%ld %ld", (long)TENTH_MM_TO_MINCH(dm->dmPaperWidth), - (long)TENTH_MM_TO_MINCH(dm->dmPaperLength) ); + (long)TENTH_MM_TO_MINCH(dm->dmPaperLength)); set_attribute(att, "page dimensions", tmpbuf); } - else if ( dm->dmFields & DM_PAPERSIZE ) + else if (dm->dmFields & DM_PAPERSIZE) { /* If we are in this case, we must also check for landscape vs. portrait; * unfortunately, Windows does not distinguish properly in this subcase - . */ - int i; - for ( i=0; i < sizeof(paper_sizes)/sizeof (struct paper_size); i++) + */ + unsigned int i; + for (i=0; i < sizeof(paper_sizes)/sizeof (struct paper_size); i++) { - if ( paper_sizes[i].size == dm->dmPaperSize ) + if (paper_sizes[i].size == dm->dmPaperSize) { - if ( dm->dmOrientation == DMORIENT_PORTRAIT ) + if (dm->dmOrientation == DMORIENT_PORTRAIT) { sprintf(tmpbuf, "%ld %ld", paper_sizes[i].wid, paper_sizes[i].len); set_attribute(att, "page dimensions", tmpbuf); } - else if ( dm->dmOrientation == DMORIENT_LANDSCAPE ) + else if (dm->dmOrientation == DMORIENT_LANDSCAPE) { sprintf(tmpbuf, "%ld %ld", paper_sizes[i].len, paper_sizes[i].wid); set_attribute(att, "page dimensions", tmpbuf); @@ -922,8 +923,8 @@ static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) static void SetDevNamesAttribs (Tcl_HashTable *att, struct printer_values *dn) { - /* Set the "device", "driver" and "port" attributes - (belt and suspenders). */ - if (dn->devnames_printername != NULL && strlen(dn->devnames_printername) > 0 ) + /* Set the "device", "driver" and "port" attributes - (belt and suspenders). */ + if (dn->devnames_printername != NULL && strlen(dn->devnames_printername) > 0) set_attribute(att,"device",dn->devnames_printername); if (dn->devnames_filename != NULL && strlen(dn->devnames_filename)>0) set_attribute(att,"driver",dn->devnames_filename); @@ -948,7 +949,7 @@ static void GetPageDlgAttribs (Tcl_HashTable *att, PAGESETUPDLG *pgdlg) { const char *cp; - if ( cp = get_attribute(att, "page margins") ) { + if (cp = get_attribute(att, "page margins")) { RestorePageMargins(cp, pgdlg); } @@ -971,59 +972,59 @@ static void GetPrintDlgAttribs (Tcl_HashTable *att, PRINTDLG *pdlg) { const char *cp; - if ( cp = get_attribute(att, "copies") ) + if (cp = get_attribute(att, "copies")) pdlg->nCopies = atoi(cp); - /* Add minimum and maximum page numbers to enable print page selection. */ - if ( cp = get_attribute(att, "minimum page") ) + /* Add minimum and maximum page numbers to enable print page selection. */ + if (cp = get_attribute(att, "minimum page")) { pdlg->nMinPage = atoi(cp); - if ( pdlg->nMinPage <= 0 ) + if (pdlg->nMinPage <= 0) pdlg->nMinPage = 1; } - if ( cp = get_attribute(att, "maximum page") ) + if (cp = get_attribute(att, "maximum page")) { pdlg->nMaxPage = atoi(cp); - if ( pdlg->nMaxPage < pdlg->nMinPage ) + if (pdlg->nMaxPage < pdlg->nMinPage) pdlg->nMaxPage = pdlg->nMinPage; } - if ( cp = get_attribute(att, "first page") ) + if (cp = get_attribute(att, "first page")) { pdlg->nFromPage = atoi(cp); if (pdlg->nFromPage > 0) { pdlg->Flags &= (~PD_ALLPAGES); pdlg->Flags |= PD_PAGENUMS; - if ( pdlg->nMinPage > pdlg->nFromPage ) + if (pdlg->nMinPage > pdlg->nFromPage) pdlg->nMinPage = 1; } } - if ( cp = get_attribute(att, "last page") ) + if (cp = get_attribute(att, "last page")) { pdlg->nToPage = atoi(cp); - if ( pdlg->nToPage > 0 ) + if (pdlg->nToPage > 0) { pdlg->Flags &= (~PD_ALLPAGES); pdlg->Flags |= PD_PAGENUMS; - if ( pdlg->nMaxPage < pdlg->nToPage ) + if (pdlg->nMaxPage < pdlg->nToPage) pdlg->nMaxPage = pdlg->nToPage; } } - /* Added to match the radiobuttons on the windows dialog. */ - if ( cp = get_attribute(att, "print flag" ) ) + /* Added to match the radiobuttons on the windows dialog. */ + if (cp = get_attribute(att, "print flag")) { - if (lstrcmpi(cp, "all") == 0 ) + if (lstrcmpi(cp, "all") == 0) pdlg->Flags &= (~(PD_PAGENUMS|PD_SELECTION)); - else if ( lstrcmpi(cp, "selection") == 0 ) + else if (lstrcmpi(cp, "selection") == 0) { pdlg->Flags |= PD_SELECTION; pdlg->Flags &= (~(PD_PAGENUMS|PD_NOSELECTION)); } - else if ( lstrcmpi(cp, "pagenums") == 0 ) + else if (lstrcmpi(cp, "pagenums") == 0) { pdlg->Flags |= PD_PAGENUMS; pdlg->Flags &= (~(PD_SELECTION|PD_NOPAGENUMS)); @@ -1051,28 +1052,28 @@ static void SetPrintDlgAttribs (Tcl_HashTable *att, PRINTDLG *pdlg) /* * This represents the number of copies the program is expected to spool * (e.g., if collation is on) - . */ + . */ sprintf(tmpbuf, "%d", pdlg->nCopies); set_attribute(att, "copiesToSpool", tmpbuf); - /* Set the to and from page if they are nonzero. */ - if ( pdlg->nFromPage > 0 ) + /* Set the to and from page if they are nonzero. */ + if (pdlg->nFromPage > 0) { sprintf(tmpbuf, "%d", pdlg->nFromPage); set_attribute(att, "first page", tmpbuf); } - if ( pdlg->nToPage > 0 ) + if (pdlg->nToPage > 0) { sprintf(tmpbuf, "%d", pdlg->nToPage); set_attribute(att, "last page", tmpbuf); } - if ( pdlg->Flags & PD_PAGENUMS ) + if (pdlg->Flags & PD_PAGENUMS) set_attribute(att, "print flag", "pagenums"); - else if ( pdlg->Flags & PD_SELECTION ) + else if (pdlg->Flags & PD_SELECTION) set_attribute(att, "print flag", "selection"); - else if ( ( pdlg->Flags & (PD_PAGENUMS | PD_SELECTION)) == 0 ) + else if ((pdlg->Flags & (PD_PAGENUMS | PD_SELECTION)) == 0) set_attribute(att, "print flag", "all"); } @@ -1095,11 +1096,11 @@ static void SetPageSetupDlgAttribs (Tcl_HashTable *att, PAGESETUPDLG *pgdlg) /* According to the PAGESETUPDLG page, the paper size and margins may be * provided in locale-specific units. We want thousandths of inches * for consistency at this point. Look for the flag: - . */ + . */ int metric = (pgdlg->Flags & PSD_INHUNDREDTHSOFMILLIMETERS)?1:0; double factor = 1.0; - if ( metric ) + if (metric) factor = 2.54; sprintf(tmpbuf, "%ld %ld", (long)(pgdlg->ptPaperSize.x / factor), @@ -1135,21 +1136,21 @@ static void SetHDCAttribs (Tcl_HashTable *att, HDC hDC) char tmpbuf[2*11+2+1]; int hsize, vsize, hscale, vscale, hoffset, voffset, hppi, vppi; - sprintf(tmpbuf, "0x%lx", hDC); + sprintf(tmpbuf, "0x%lx", (long) hDC); set_attribute(att, "hDC", tmpbuf); - if ( PrintPageAttr(hDC, &hsize, &vsize, + if (PrintPageAttr(hDC, &hsize, &vsize, &hscale, &vscale, &hoffset, &voffset, &hppi, &vppi) == 0 && - hppi > 0 && vppi > 0 ) + hppi > 0 && vppi > 0) { sprintf(tmpbuf, "%d %d", (int)(hsize*1000L/hppi), (int)(vsize*1000L/vppi)); set_attribute(att, "page dimensions", tmpbuf); sprintf(tmpbuf, "%d %d", hppi, vppi); set_attribute(att, "pixels per inch", tmpbuf); - /* Perhaps what's below should only be done if not already set.... */ + /* Perhaps what's below should only be done if not already set.... */ sprintf(tmpbuf, "%d %d %d %d", (int)(hoffset*1000L/hppi), (int)(voffset*1000L/vppi), (int)(hoffset*1000L/hppi), (int)(voffset*1000L/vppi)); set_attribute(att, "page minimum margins", tmpbuf); @@ -1187,23 +1188,23 @@ static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUP * the platform-specific notion is left to the conversion function. */ - /* First, take care of the hDC structure. */ - if ( pdlg != NULL ) + /* First, take care of the hDC structure. */ + if (pdlg != NULL) { const char *cp; - if ( ppv->hDC != NULL ) + if (ppv->hDC != NULL) { delete_dc (ppv->hDC); DeleteDC(ppv->hDC); } - if ( ppv->hdcname[0] != '\0') + if (ppv->hdcname[0] != '\0') { if (hdc_delete) hdc_delete(0, ppv->hdcname); ppv->hdcname[0] = '\0'; } ppv->hDC = pdlg->hDC; - /* Only need to do this if the hDC has changed. */ + /* Only need to do this if the hDC has changed. */ if (ppv->hDC) { SetHDCAttribs(&ppv->attribs, ppv->hDC); @@ -1217,9 +1218,9 @@ static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUP } /* Next, get the DEVMODE out of the pdlg if present; - * if not, try the page dialog; if neither, skip this step - . */ - if ( pdlg != NULL && pdlg->hDevMode != NULL) + * if not, try the page dialog; if neither, skip this step. + */ + if (pdlg != NULL && pdlg->hDevMode != NULL) { MakeDevmode(ppv, pdlg->hDevMode); GlobalFree(pdlg->hDevMode); @@ -1236,8 +1237,8 @@ static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUP /* Next, get the DEVNAMES out of the pdlg if present; * if not, try the page dialog; if neither, skip this step - . */ - if ( pdlg != NULL && pdlg->hDevNames != NULL) + . */ + if (pdlg != NULL && pdlg->hDevNames != NULL) { CopyDevnames(ppv, pdlg->hDevNames); GlobalFree(pdlg->hDevNames); @@ -1252,11 +1253,11 @@ static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUP SetDevNamesAttribs(&ppv->attribs, ppv); } - /* Set attributes peculiar to the print dialog. */ + /* Set attributes peculiar to the print dialog. */ if (pdlg != NULL) SetPrintDlgAttribs(&ppv->attribs, pdlg); - /* Set attributes peculiar to the page setup dialog. */ + /* Set attributes peculiar to the page setup dialog. */ if (pgdlg != NULL) SetPageSetupDlgAttribs(&ppv->attribs, pgdlg); } @@ -1291,14 +1292,14 @@ static void RestorePageMargins (const char *attrib, PAGESETUPDLG *pgdlg) /* According to the PAGESETUPDLG page, the paper size and margins may be * provided in locale-specific units. We want thousandths of inches * for consistency at this point. Look for the flag: - . */ + . */ int metric = (default_printer_values.pgdlg.Flags & PSD_INHUNDREDTHSOFMILLIMETERS)?1:0; double factor = 1.0; - if ( metric ) + if (metric) factor = 2.54; - if ( sscanf(attrib, "%lf %lf %lf %lf", &left, &top, &right, &bottom) == 4 ) { + if (sscanf(attrib, "%lf %lf %lf %lf", &left, &top, &right, &bottom) == 4) { r.left = (long) (floor(left * factor + 0.5)); r.top = (long) (floor(top * factor + 0.5)); r.right = (long) (floor(right * factor + 0.5)); @@ -1331,11 +1332,11 @@ static void RestorePrintVals (struct printer_values *ppv, PRINTDLG *pdlg, PAGESE * copies * first page * last page - . */ + . */ GetPrintDlgAttribs(&ppv->attribs, pdlg); - /* Note: if DEVMODE is not null, copies is taken from the DEVMODE structure. */ - if (ppv->pdevmode ) + /* Note: if DEVMODE is not null, copies is taken from the DEVMODE structure. */ + if (ppv->pdevmode) ppv->pdevmode->dmCopies = pdlg->nCopies; } @@ -1345,7 +1346,7 @@ static void RestorePrintVals (struct printer_values *ppv, PRINTDLG *pdlg, PAGESE /* * Values to be restored: * page margins - . */ + . */ GetPageDlgAttribs(&ppv->attribs, pgdlg); } } @@ -1359,7 +1360,7 @@ static void RestorePrintVals (struct printer_values *ppv, PRINTDLG *pdlg, PAGESE * For now the commands will be searched linearly (there are only * a few), but keep them sorted, so a binary search could be used. */ -typedef int (*tcl_prtcmd) (ClientData, Tcl_Interp *, int, const char * ); +typedef int (*tcl_prtcmd) (ClientData, Tcl_Interp *, int, const char *); struct prt_cmd { const char *name; @@ -1392,7 +1393,7 @@ static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, Tcl_AppendResult(interp, "printer [", 0); for (i=0; i < last; i++) { - if ( printer_commands[i].safe >= safe ) + if (printer_commands[i].safe >= safe) { if (first) { @@ -1402,14 +1403,14 @@ static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, else Tcl_AppendResult(interp, " | ", printer_commands[i].name, 0); } - if ( i == (last - 1) ) + if (i == (last - 1)) Tcl_AppendResult(interp, " ]", 0); } if (argc) { - Tcl_AppendResult(interp, "\n(Bad command: ", 0 ); + Tcl_AppendResult(interp, "\n(Bad command: ", 0); for (i=0; i= safe ) - if ( strcmp(argv[0], printer_commands[i].name) == 0 ) + for (i=0; i < (sizeof printer_commands / sizeof (struct prt_cmd)); i++) + if (printer_commands[i].safe >= safe) + if (strcmp((const char*) argv[0], printer_commands[i].name) == 0) return printer_commands[i].func(defaults, interp, argc-1, argv+1); top_usage_message(interp, argc+1, argv-1, safe); @@ -1466,7 +1467,7 @@ static int Print (ClientData defaults, Tcl_Interp *interp, int argc, const char static int printer (ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - if ( argc > 1 ) + if (argc > 1) { argv++; argc--; @@ -1492,19 +1493,19 @@ static int printer (ClientData data, Tcl_Interp *interp, int argc, const char * int Winprint_Init(Tcl_Interp * interp) { - Tcl_CreateObjCommand(interp, "::tk::print::_print", printer, - (ClientData)( & current_printer_values), 0); + Tcl_CreateCommand(interp, "::tk::print::_print", printer, + (ClientData)(& current_printer_values), 0); - /* Initialize the attribute hash table. */ + /* Initialize the attribute hash table. */ init_printer_dc_contexts(interp); - /* Initialize the attribute hash table. */ - Tcl_InitHashTable( & (current_printer_values -> attribs), TCL_STRING_KEYS); + /* Initialize the attribute hash table. */ + Tcl_InitHashTable(& (current_printer_values -> attribs), TCL_STRING_KEYS); - /* Initialize the list of HDCs hash table. */ - Tcl_InitHashTable( & printer_hdcs, TCL_ONE_WORD_KEYS); + /* Initialize the list of HDCs hash table. */ + Tcl_InitHashTable(& printer_hdcs, TCL_ONE_WORD_KEYS); - /* Initialize the default page settings. */ + /* Initialize the default page settings. */ current_printer_values -> pgdlg.lStructSize = sizeof(PAGESETUPDLG); current_printer_values -> pgdlg.Flags |= PSD_RETURNDEFAULT; @@ -1529,9 +1530,9 @@ int Winprint_Init(Tcl_Interp * interp) { static int SplitDevice(LPSTR device, LPSTR *dev, LPSTR *dvr, LPSTR *port) { static char buffer[256]; - if (device == 0 ) + if (device == 0) { - switch ( WinVersion() ) + switch (WinVersion()) { case VER_PLATFORM_WIN32s: GetProfileString("windows", "device", "", (LPSTR)buffer, sizeof buffer); @@ -1550,13 +1551,13 @@ static int SplitDevice(LPSTR device, LPSTR *dev, LPSTR *dvr, LPSTR *port) *port = strtok(NULL, ","); if (*dev) - while ( * dev == ' ') + while ( * dev == ' ') (*dev)++; if (*dvr) - while ( * dvr == ' ') + while ( * dvr == ' ') (*dvr)++; if (*port) - while ( * port == ' ') + while ( * port == ' ') (*port)++; return 1; @@ -1570,7 +1571,7 @@ static int SplitDevice(LPSTR device, LPSTR *dev, LPSTR *dvr, LPSTR *port) * Build a compatible printer DC for the default printer. * * Results: - * Returns DC. + * Returns DC. * *---------------------------------------------------------------------- */ @@ -1585,7 +1586,7 @@ static HDC GetPrinterDC (const char *printer) LPSTR lpPrintPort = ""; SplitDevice ((LPSTR)printer, &lpPrintDevice, &lpPrintDriver, &lpPrintPort); - switch ( WinVersion() ) + switch (WinVersion()) { case VER_PLATFORM_WIN32s: hdcPrint = CreateDC (lpPrintDriver, @@ -1606,7 +1607,7 @@ static HDC GetPrinterDC (const char *printer) return hdcPrint; } -/* End of support for file printing. */ +/* End of support for file printing. */ /* @@ -1623,7 +1624,7 @@ static HDC GetPrinterDC (const char *printer) *---------------------------------------------------------------------- */ -static const char *PrintStatusToStr( DWORD status ) +static const char *PrintStatusToStr(DWORD status) { switch (status) { case PRINTER_STATUS_PAUSED: return "Paused"; @@ -1679,7 +1680,7 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha const char *match = 0; const char *illegal = 0; - /* The following 3 declarations are only needed for the Win32s case. */ + /* The following 3 declarations are only needed for the Win32s case. */ static char devices_buffer[256]; static char value[256]; char *cp; @@ -1691,7 +1692,7 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha { if (strcmp(argv[i], "-match") == 0) match = argv[++i]; - else if ( strcmp(argv[i], "-verbose") == 0 ) + else if (strcmp(argv[i], "-verbose") == 0) verbose = 1; else illegal = argv[i]; @@ -1707,16 +1708,16 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha * The result should be useful for specifying the devices and/or OpenPrinter and/or lp -d. * Rather than make this compilation-dependent, do a runtime check. */ - switch ( WinVersion() ) + switch (WinVersion()) { - case VER_PLATFORM_WIN32_NT: /* Windows NT. */ + case VER_PLATFORM_WIN32_NT: /* Windows NT. */ default: - /* Win32 implementation uses EnumPrinters. */ + /* Win32 implementation uses EnumPrinters. */ /* There is a hint in the documentation that this info is stored in the registry. * if so, that interface would probably be even better! * NOTE: This implementation was suggested by Brian Griffin , * and replaces the older implementation which used PRINTER_INFO_4,5 - . */ + . */ { DWORD bufsiz = 0; DWORD needed = 0; @@ -1724,17 +1725,17 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha PRINTER_INFO_2 *ary = 0; DWORD i; - /* First, get the size of array needed to enumerate the printers. */ - if ( EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, + /* First, get the size of array needed to enumerate the printers. */ + if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, 2, (LPBYTE)ary, bufsiz, &needed, - &num_printers) == FALSE ) + &num_printers) == FALSE) { - /* Expected failure--we didn't allocate space. */ + /* Expected failure--we didn't allocate space. */ DWORD err = GetLastError(); - /* If the error isn't insufficient space, we have a real problem.. */ - if ( err != ERROR_INSUFFICIENT_BUFFER ) + /* If the error isn't insufficient space, we have a real problem.. */ + if (err != ERROR_INSUFFICIENT_BUFFER) { sprintf (msgbuf, "EnumPrinters: unexpected error code: %ld", (long)err); Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); @@ -1742,8 +1743,8 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha } } - if ( needed > 0 ) { - if ( (ary = (PRINTER_INFO_2 *)Tcl_Alloc(needed) ) != 0 ) + if (needed > 0) { + if ((ary = (PRINTER_INFO_2 *)Tcl_Alloc(needed)) != 0) bufsiz = needed; else { @@ -1751,17 +1752,17 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); return TCL_ERROR; } - } else { /* No printers to report!. */ + } else { /* No printers to report!. */ return TCL_OK; } - /* Now that we know how much, allocate it -- if there is a printer!. */ - if ( EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, + /* Now that we know how much, allocate it -- if there is a printer!. */ + if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, 2, (LPBYTE)ary, bufsiz, &needed, - &num_printers) == FALSE ) + &num_printers) == FALSE) { - /* Now we have a real failure!. */ + /* Now we have a real failure! */ sprintf(msgbuf, "::tk::print::_print list: Cannot enumerate printers: %ld", (long)GetLastError()); Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); return TCL_ERROR; @@ -1769,21 +1770,21 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha /* Question for UTF: Do I need to convert all visible output? * Or just the printer name and location? - . */ + . */ - /* Question for Win95: Do I need to provide the port number?. */ + /* Question for Win95: Do I need to provide the port number?. */ for (i=0; i 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) { const char *ostring; Tcl_DString tds; @@ -1799,42 +1800,42 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha Tcl_AppendResult(interp, "} ", 0); Tcl_AppendResult(interp, "{", 0); Tcl_AppendElement(interp, "Status"); - Tcl_AppendElement(interp, PrintStatusToStr(ary[i].Status) ); + Tcl_AppendElement(interp, PrintStatusToStr(ary[i].Status)); Tcl_AppendResult(interp, "} ", 0); - if ( ary[i].pDriverName && ary[i].pDriverName[0] != '\0') + if (ary[i].pDriverName && ary[i].pDriverName[0] != '\0') { Tcl_AppendResult(interp, "{", 0); Tcl_AppendElement(interp, "Driver"); - Tcl_AppendElement(interp, ary[i].pDriverName ); + Tcl_AppendElement(interp, ary[i].pDriverName); Tcl_AppendResult(interp, "} ", 0); } - if ( ary[i].pServerName && ary[i].pServerName[0] != '\0') + if (ary[i].pServerName && ary[i].pServerName[0] != '\0') { Tcl_AppendResult(interp, "{", 0); Tcl_AppendElement(interp, "Control"); - Tcl_AppendElement(interp, "Server" ); + Tcl_AppendElement(interp, "Server"); Tcl_AppendResult(interp, "} ", 0); Tcl_AppendResult(interp, "{", 0); Tcl_AppendElement(interp, "Server"); - Tcl_AppendElement(interp, ary[i].pServerName ); + Tcl_AppendElement(interp, ary[i].pServerName); Tcl_AppendResult(interp, "} ", 0); } else { Tcl_AppendResult(interp, "{", 0); Tcl_AppendElement(interp, "Control"); - Tcl_AppendElement(interp, "Local" ); + Tcl_AppendElement(interp, "Local"); Tcl_AppendResult(interp, "} ", 0); Tcl_AppendResult(interp, "{", 0); Tcl_AppendElement(interp, "Port"); - Tcl_AppendElement(interp, ary[i].pPortName ); + Tcl_AppendElement(interp, ary[i].pPortName); Tcl_AppendResult(interp, "} ", 0); } - if ( ary[i].pLocation && ary[i].pLocation[0] != '\0') + if (ary[i].pLocation && ary[i].pLocation[0] != '\0') { Tcl_AppendResult(interp, "{", 0); Tcl_AppendElement(interp, "Location"); -#if TCL_MAJOR_VERSION > 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) { const char *ostring; Tcl_DString tds; @@ -1852,9 +1853,9 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha Tcl_AppendResult(interp, "{", 0); Tcl_AppendElement(interp, "Queued Jobs"); sprintf(msgbuf, "%ld", (long)ary[i].cJobs); - Tcl_AppendElement(interp, msgbuf ); + Tcl_AppendElement(interp, msgbuf); Tcl_AppendResult(interp, "} ", 0); - /* End of this printer's list. */ + /* End of this printer's list. */ Tcl_AppendResult(interp, "}\n", 0); } else @@ -1893,8 +1894,8 @@ static int PrintSend (ClientData defaults, Tcl_Interp *interp, int argc, const c "[-printer printer] " "[-datalen nnnnnn] " "[-file|-data] file_or_data ... "; - int ps = 0; /* The default is nopostscript. */ - int binary = 1; /* The default is binary. */ + int ps = 0; /* The default is nopostscript. */ + int binary = 1; /* The default is binary. */ long datalen = 0L; const char *printer = 0; @@ -1902,17 +1903,17 @@ static int PrintSend (ClientData defaults, Tcl_Interp *interp, int argc, const c static char last_printer[255+1]; int debug = 0; int printtype = PRINT_FROM_FILE; - struct printer_values * ppv = *(struct printer_values * ) defaults; + struct printer_values * ppv = *(struct printer_values *) defaults; struct printer_values * oldppv = 0; - int self_created = 0; /* Remember if we specially created the DC. */ + int self_created = 0; /* Remember if we specially created the DC. */ int direct_to_port = 0; HANDLE hdc = NULL; - while ( argc > 0 ) + while (argc > 0) { if (argv[0][0] == '-') { - /* Check for -postscript / -nopostscript flag. */ + /* Check for -postscript / -nopostscript flag. */ if (strcmp(argv[0], "-postscript") == 0) ps = 1; else if (strcmp(argv[0], "-nopostscript") == 0) @@ -1921,26 +1922,26 @@ static int PrintSend (ClientData defaults, Tcl_Interp *interp, int argc, const c binary = 0; else if (strcmp(argv[0], "-binary") == 0) binary = 1; - else if ( strcmp(argv[0], "-printer") == 0) + else if (strcmp(argv[0], "-printer") == 0) { argc--; argv++; printer = argv[0]; } - else if ( strcmp(argv[0], "-file") == 0) + else if (strcmp(argv[0], "-file") == 0) printtype = PRINT_FROM_FILE; - else if ( strcmp(argv[0], "-data") == 0) { + else if (strcmp(argv[0], "-data") == 0) { printtype = PRINT_FROM_DATA; } - else if ( strcmp(argv[0], "-datalen") == 0 ) + else if (strcmp(argv[0], "-datalen") == 0) { argc--; argv++; datalen = atol(argv[0]); } - else if ( strcmp(argv[0], "-debug") == 0) + else if (strcmp(argv[0], "-debug") == 0) debug++; - else if ( strcmp(argv[0], "-direct") == 0 ) + else if (strcmp(argv[0], "-direct") == 0) direct_to_port = 1; } else @@ -1964,30 +1965,30 @@ static int PrintSend (ClientData defaults, Tcl_Interp *interp, int argc, const c * If we still don't have a good HDC, we've failed. * */ - if ( hdc == NULL ) + if (hdc == NULL ) { - if ( printer ) + if (printer) OpenPrinter((char *)printer, &hdc, NULL); - else if ( last_printer[0] != '\0' ) + else if (last_printer[0] != '\0') OpenPrinter(last_printer, &hdc, NULL); - else if ( current_printer_values != 0 && current_printer_values->devnames_printername[0] != '\0') + else if (current_printer_values != 0 && current_printer_values->devnames_printername[0] != '\0') OpenPrinter(current_printer_values->devnames_printername, &hdc, NULL); else { } - if ( hdc == NULL ) /* STILL can't get a good printer DC. */ + if (hdc == NULL) /* STILL can't get a good printer DC. */ { Tcl_SetResult (interp, "Error: Can't get a valid printer context", TCL_STATIC); return TCL_ERROR; } } - /* Now save off a bit of information for the next call.... */ + /* Now save off a bit of information for the next call.... */ if (printer) - strncpy ( last_printer, printer, sizeof(last_printer) - 1); - else if ( ppv && ppv->devnames_printername[0] ) - strncpy ( last_printer, ppv->devnames_printername, sizeof(last_printer) - 1 ); + strncpy (last_printer, printer, sizeof(last_printer) - 1); + else if (ppv && ppv->devnames_printername[0]) + strncpy (last_printer, ppv->devnames_printername, sizeof(last_printer) - 1); /* * * Everything left is a file or data. Just print it. @@ -1999,21 +2000,21 @@ static int PrintSend (ClientData defaults, Tcl_Interp *interp, int argc, const c const char *docname; - if ( argv[0][0] == '-') { - if ( strcmp(argv[0], "-datalen") == 0 ) + if (argv[0][0] == '-') { + if (strcmp(argv[0], "-datalen") == 0) { argc--; argv++; datalen = atol(argv[0]); continue; } - else if ( strcmp(argv[0], "-file") == 0) { + else if (strcmp(argv[0], "-file") == 0) { argc--; argv++; printtype = PRINT_FROM_FILE; continue; } - else if ( strcmp(argv[0], "-data") == 0) { + else if (strcmp(argv[0], "-data") == 0) { argc--; argv++; printtype = PRINT_FROM_DATA; @@ -2028,43 +2029,43 @@ static int PrintSend (ClientData defaults, Tcl_Interp *interp, int argc, const c case PRINT_FROM_DATA: default: docname = "Tcl Print Data"; - if (datalen == 0L ) { + if (datalen == 0L) { Tcl_AppendResult(interp, "Printer warning: ::tk::print::_print send ... -data requires a -datalen preceding argument. Using strlen as a poor substitute.\n", 0); datalen = strlen(argv[0]); } break; } - if ( PrintStart(hdc, interp, docname) == 1 ) { + if (PrintStart(hdc, interp, docname) == 1) { if (ps) { DWORD inCount = strlen(init_postscript); DWORD outCount = 0; - if ( WritePrinter(hdc,(LPVOID)init_postscript,inCount,&outCount) == 0 || - inCount != outCount ) { + if (WritePrinter(hdc,(LPVOID)init_postscript,inCount,&outCount) == 0 || + inCount != outCount) { Tcl_AppendResult(interp,"Printer error: Postscript init failed\n", 0); } } switch (printtype) { case PRINT_FROM_FILE: - if ( PrintRawFileData(hdc,interp,argv[0],binary) == 0 ) { + if (PrintRawFileData(hdc,interp,argv[0],binary) == 0) { Tcl_AppendResult(interp,"Printer error: Could not print file ", argv[0], "\n", 0); } break; case PRINT_FROM_DATA: default: - if ( PrintRawData(hdc,interp,(LPBYTE)argv[0],datalen) == 0 ) { + if (PrintRawData(hdc,interp,(LPBYTE)argv[0],datalen) == 0) { Tcl_AppendResult(interp,"Printer error: Could not print raw data\n", 0); } - datalen=0L; /* reset the data length, so it is not reused. */ + datalen=0L; /* reset the data length, so it is not reused. */ break; } if (ps) { DWORD inCount = strlen(fini_postscript); DWORD outCount = 0; - if ( WritePrinter(hdc,(LPVOID)fini_postscript,inCount,&outCount) == 0 || - inCount != outCount ) { + if (WritePrinter(hdc,(LPVOID)fini_postscript,inCount,&outCount) == 0 || + inCount != outCount) { Tcl_AppendResult(interp,"Printer error: Postscript finish failed\n", 0); } } @@ -2102,12 +2103,12 @@ static int PrintRawData (HANDLE printer, Tcl_Interp *interp, LPBYTE lpData, DWOR int retval = 0; DWORD dwBytesWritten = 0; - /* Send the data. */ - if ( WritePrinter( printer, lpData, dwCount, &dwBytesWritten) == 0 ) { - /* Error writing the data. */ + /* Send the data. */ + if (WritePrinter(printer, lpData, dwCount, &dwBytesWritten) == 0) { + /* Error writing the data. */ Tcl_AppendResult(interp, "Printer error: Cannot write data to printer"); - } else if ( dwBytesWritten != dwCount ) { - /* Wrong number of bytes were written.... */ + } else if (dwBytesWritten != dwCount) { + /* Wrong number of bytes were written.... */ sprintf(msgbuf, "%ld written; %ld requested", dwBytesWritten, dwCount); Tcl_AppendResult(interp, "Printer error: Wrong number of bytes were written", msgbuf, "\n", 0); @@ -2139,40 +2140,40 @@ static int PrintRawFileData (HANDLE printer, Tcl_Interp *interp, const char *fil Tcl_Channel channel; struct { - WORD len; /* Defined to be 16 bits..... */ + WORD len; /* Defined to be 16 bits..... */ char buffer[128+1]; } indata; - if ( (channel = Tcl_OpenFileChannel(interp, (char *)filename, "r", 0444)) == NULL) + if ((channel = Tcl_OpenFileChannel(interp, (char *)filename, "r", 0444)) == NULL) { - /* Can't open the file!. */ + /* Can't open the file!. */ return 0; } - if ( binary ) + if (binary) Tcl_SetChannelOption(interp, channel, "-translation", "binary"); - /* Send the data. */ - while ( (indata.len = Tcl_Read(channel, indata.buffer, sizeof(indata.buffer)-1)) > 0) + /* Send the data. */ + while ((indata.len = Tcl_Read(channel, indata.buffer, sizeof(indata.buffer)-1)) > 0) { DWORD dwWritten = 0; dwBytesRequested += indata.len; indata.buffer[indata.len] = '\0'; - if ( WritePrinter( printer, indata.buffer, indata.len, &dwWritten) == 0 ) + if (WritePrinter(printer, indata.buffer, indata.len, &dwWritten) == 0) { - /* Error writing the data. */ + /* Error writing the data. */ Tcl_AppendResult(interp, "Printer error: Can't write data to printer\n", 0); Tcl_Close(interp, channel); break; } dwBytesWritten += dwWritten; - if ( dwWritten != indata.len ) { + if (dwWritten != indata.len) { sprintf(msgbuf, "%ld requested; %ld written", (long)indata.len, dwWritten); Tcl_AppendResult(interp, "Printer warning: Short write: ", msgbuf, "\n", 0); } } - if ( dwBytesWritten == dwBytesRequested ) + if (dwBytesWritten == dwBytesRequested) retval = 1; Tcl_Close(interp, channel); @@ -2199,23 +2200,23 @@ static int PrintStart (HDC printer, Tcl_Interp *interp, const char *docname) DOC_INFO_1 DocInfo; DWORD dwJob; - /* Fill in the document information with the details. */ - if ( docname != 0 ) + /* Fill in the document information with the details. */ + if (docname != 0) DocInfo.pDocName = (LPTSTR)docname; else DocInfo.pDocName = (LPTSTR)"Tcl Document"; DocInfo.pOutputFile = 0; DocInfo.pDatatype = "RAW"; - /* Start the job. */ - if ( (dwJob = StartDocPrinter(printer, 1, (LPSTR)&DocInfo)) == 0 ) { - /* Error starting doc printer. */ + /* Start the job. */ + if ((dwJob = StartDocPrinter(printer, 1, (LPSTR)&DocInfo)) == 0) { + /* Error starting doc printer. */ Tcl_AppendResult(interp, "Printer error: Cannot start document printing\n", 0); return 0; } - /* Start the first page. */ - if ( StartPagePrinter(printer) == 0 ) { - /* Error starting the page. */ + /* Start the first page. */ + if (StartPagePrinter(printer) == 0) { + /* Error starting the page. */ Tcl_AppendResult(interp, "Printer error: Cannot start document page\n", 0); EndDocPrinter(printer); return 0; @@ -2238,15 +2239,15 @@ static int PrintStart (HDC printer, Tcl_Interp *interp, const char *docname) static int PrintFinish (HDC printer, Tcl_Interp *interp) { - /* Finish the last page. */ - if ( EndPagePrinter(printer) == 0 ) { + /* Finish the last page. */ + if (EndPagePrinter(printer) == 0) { Tcl_AppendResult(interp, "Printer warning: Cannot end document page\n", 0); - /* Error ending the last page. */ + /* Error ending the last page. */ } - /* Conclude the document. */ - if ( EndDocPrinter(printer) == 0 ) { + /* Conclude the document. */ + if (EndDocPrinter(printer) == 0) { Tcl_AppendResult(interp, "Printer warning: Cannot end document printing\n", 0); - /* Error ending document. */ + /* Error ending document. */ } JobInfo(0,0,0); @@ -2269,8 +2270,8 @@ static int PrintFinish (HDC printer, Tcl_Interp *interp) static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - struct printer_values *ppv = *(struct printer_values * )data; - if ( autoclose && ppv && ppv->hDC) + struct printer_values *ppv = *(struct printer_values *)data; + if (autoclose && ppv && ppv->hDC) { char tmpbuf[11+1+1]; char *args[3]; @@ -2280,10 +2281,10 @@ static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, cons args[2] = 0; PrintClose(data, interp, 2, args); } - *(struct printer_values * )data = ppv - = make_printer_values(0); /* Get a default printer_values context. */ + *(struct printer_values *)data = ppv + = make_printer_values(0); /* Get a default printer_values context. */ - /* This version uses PrintDlg, and works under Win32s. */ + /* This version uses PrintDlg, and works under Win32s. */ { HWND tophwnd; int retval; @@ -2291,49 +2292,49 @@ static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, cons /* The following is an attempt to get the right owners notified of * repaint requests from the dialog. It doesn't quite work. * It does make the dialog box modal to the toplevel it's working with, though. - . */ - if ( (ppv->pdlg.hwndOwner = GetActiveWindow()) != 0 ) - while ( (tophwnd = GetParent(ppv->pdlg.hwndOwner) ) != 0 ) + . */ + if ((ppv->pdlg.hwndOwner = GetActiveWindow()) != 0) + while ((tophwnd = GetParent(ppv->pdlg.hwndOwner)) != 0) ppv->pdlg.hwndOwner = tophwnd; /* * Since we are doing the "default" dialog, we must put NULL in the * hDevNames and hDevMode members. * Use '::tk::printer::_print dialog select' for selecting a printer from a list - . */ - ppv->pdlg.lStructSize = sizeof( PRINTDLG ); + . */ + ppv->pdlg.lStructSize = sizeof(PRINTDLG); ppv->pdlg.Flags = PD_RETURNDEFAULT | PD_RETURNDC; ppv->pdlg.hDevNames = 0; ppv->pdlg.hDevMode = 0; - retval = PrintDlg ( &(ppv->pdlg) ); + retval = PrintDlg (&(ppv->pdlg)); - if ( retval == 1 ) + if (retval == 1) { const char *name; - if ( ppv->hdcname[0] && hdc_delete ) + if (ppv->hdcname[0] && hdc_delete) hdc_delete(interp, ppv->hdcname); ppv->hdcname[0] = '\0'; - /* StorePrintVals creates and stores the hdcname as well. */ + /* StorePrintVals creates and stores the hdcname as well. */ StorePrintVals(ppv, &ppv->pdlg, 0); - if ( (name = get_attribute (&ppv->attribs, "device")) != 0 ) - if ( PrinterGetDefaults(ppv, name, 1) > 0 ) { /* Set default DEVMODE too. */ - current_printer_values = ppv; /* This is now the default printer. */ + if ((name = get_attribute (&ppv->attribs, "device")) != 0) + if (PrinterGetDefaults(ppv, name, 1) > 0) { /* Set default DEVMODE too. */ + current_printer_values = ppv; /* This is now the default printer. */ } } else { - /* Failed or cancelled. Leave everything else the same. */ - Tcl_Free( (char *) ppv); + /* Failed or cancelled. Leave everything else the same. */ + Tcl_Free((char *) ppv); /* Per Steve Bold--restore the default printer values In any case the current_printer_values shouldn't be left hanging - . */ - *(struct printer_values * )data = &default_printer_values; + . */ + *(struct printer_values *)data = &default_printer_values; } } - /* The status does not need to be supplied. either hDC is OK or it's NULL. */ - if ( ppv->hdcname[0] ) + /* The status does not need to be supplied. either hDC is OK or it's NULL. */ + if (ppv->hdcname[0]) Tcl_SetResult(interp, ppv->hdcname, TCL_VOLATILE); else { @@ -2361,8 +2362,8 @@ static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, cons static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - /* The ClientData is the default printer--this may be overridden by the proc arguments. */ - struct printer_values *ppv = *(struct printer_values * )data; + /* The ClientData is the default printer--this may be overridden by the proc arguments. */ + struct printer_values *ppv = *(struct printer_values *)data; const char *printer_name; int use_printer_name = 0; int use_default = 0; @@ -2372,26 +2373,26 @@ static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char int retval = TCL_OK; static const char usage_message[] = "::tk::print::_print open [-name printername|-default]"; - /* Command line should specify everything needed. Don't bring up dialog. */ - /* This should also SET the default to any overridden printer name. */ + /* Command line should specify everything needed. Don't bring up dialog. */ + /* This should also SET the default to any overridden printer name. */ for (j=0; jhDC) { @@ -2414,8 +2415,8 @@ static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char PrintClose(data, interp, 2, args); } - ppv = make_printer_values(0); /* Get a default printer_values context. */ - *(struct printer_values * )data = ppv; + ppv = make_printer_values(0); /* Get a default printer_values context. */ + *(struct printer_values *)data = ppv; /* * Since this is a print open, a new HDC will be created--at this point, starting * with the default attributes. @@ -2423,71 +2424,71 @@ static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char if (ppv) { int retval = 0; - if ( (retval = PrinterGetDefaults(ppv, printer_name, 1)) > 0 ) /* Set devmode if available. */ + if ((retval = PrinterGetDefaults(ppv, printer_name, 1)) > 0) /* Set devmode if available. */ { const char *cp; - if ( (cp = make_printer_dc_name(interp, ppv->hDC, ppv) ) != 0 ) + if ((cp = make_printer_dc_name(interp, ppv->hDC, ppv)) != 0) { strncpy(ppv->hdcname, cp, sizeof (current_printer_values->hdcname)); set_attribute(&ppv->attribs, "hdcname", cp); } - current_printer_values = ppv; /* This is now the default printer. */ + current_printer_values = ppv; /* This is now the default printer. */ } else { - /* an error occurred - printer is not usable for some reason, so report that. */ - switch ( retval ) { - case GETDEFAULTS_UNSUPPORTED: /* Not supported. */ + /* an error occurred - printer is not usable for some reason, so report that. */ + switch (retval) { + case GETDEFAULTS_UNSUPPORTED: /* Not supported. */ Tcl_AppendResult(interp, "PrinterGetDefaults: Not supported for this OS\n", 0); break; - case GETDEFAULTS_NOSUCHPRINTER: /* Can't find printer. */ + case GETDEFAULTS_NOSUCHPRINTER: /* Can't find printer. */ Tcl_AppendResult(interp, "PrinterGetDefaults: Can't find printer ", printer_name, "\n", 0); break; - case GETDEFAULTS_CANTCREATEDC: /* Can't create DC. */ + case GETDEFAULTS_CANTCREATEDC: /* Can't create DC. */ Tcl_AppendResult(interp, "PrinterGetDefaults: Can't create DC: Insufficient printer information\n", 0); break; - case GETDEFAULTS_CANTOPENPRINTER: /* Can't open printer. */ + case GETDEFAULTS_CANTOPENPRINTER: /* Can't open printer. */ Tcl_AppendResult(interp, "PrinterGetDefaults: Can't open printer ", printer_name, "\n", 0); break; - case GETDEFAULTS_WINDOWSERROR: /* Windows error. */ + case GETDEFAULTS_WINDOWSERROR: /* Windows error. */ Tcl_AppendResult(interp, "PrinterGetDefaults: Windows error\n", 0); break; - default: /* ???. */ + default: /* ???. */ Tcl_AppendResult(interp, "PrinterGetDefaults: Unknown error\n", 0); break; } - if (ppv->errorCode != 0 ) + if (ppv->errorCode != 0) ReportWindowsError(interp,ppv->errorCode); - /* release the ppv. */ + /* release the ppv. */ delete_printer_values(ppv); return TCL_ERROR; } } } - else /* It's a default. */ + else /* It's a default. */ { - retval = PrintOpenDefault(data, interp, argc, argv); /* argc, argv unused. */ - ppv = *(struct printer_values * )data; + retval = PrintOpenDefault(data, interp, argc, argv); /* argc, argv unused. */ + ppv = *(struct printer_values *)data; } - /* Get device names information. */ + /* Get device names information. */ { char *dev, *dvr, *port; /* * retval test added by Jon Hilbert, 8/8/02. * The printer name in this function should not be matched with wildcards. */ - if ( retval == TCL_OK && ppv && ppv->pdevmode && ppv->pdevmode->dmDeviceName && - GetPrinterWithName((char *)(ppv->pdevmode->dmDeviceName), &dev, &dvr, &port, 0) != 0 ) + if (retval == TCL_OK && ppv && ppv->pdevmode && ppv->pdevmode->dmDeviceName && + GetPrinterWithName((char *)(ppv->pdevmode->dmDeviceName), &dev, &dvr, &port, 0) != 0) { - strcpy(ppv->devnames_filename, dvr ); - strcpy(ppv->devnames_port, port ); + strcpy(ppv->devnames_filename, dvr); + strcpy(ppv->devnames_port, port); } } - /* Check for attribute modifications. */ - if ( use_attrs != 0 && retval == TCL_OK ) + /* Check for attribute modifications. */ + if (use_attrs != 0 && retval == TCL_OK) { char hdcbuffer[20]; const char *args[5]; @@ -2507,8 +2508,8 @@ static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char #endif } - /* The status does not need to be supplied. either hDC is OK or it's NULL. */ - if ( ppv->hdcname[0] ) + /* The status does not need to be supplied. either hDC is OK or it's NULL. */ + if (ppv->hdcname[0]) Tcl_SetResult(interp, ppv->hdcname, TCL_VOLATILE); else { @@ -2537,40 +2538,40 @@ static int PrintClose(ClientData data, Tcl_Interp *interp, int argc, const char int j; const char *hdcString = 0; - /* Start with the default printer. */ - struct printer_values *ppv = *(struct printer_values * )data; + /* Start with the default printer. */ + struct printer_values *ppv = *(struct printer_values *)data; - /* See if there are any command line arguments. */ + /* See if there are any command line arguments. */ for (j=0; jhDC, interp); ppv->in_page = 0; ppv->in_job = 0; - /* Free the printer DC. */ + /* Free the printer DC. */ if (ppv->hDC) { delete_dc(ppv->hDC); @@ -2578,12 +2579,12 @@ static int PrintClose(ClientData data, Tcl_Interp *interp, int argc, const char ppv->hDC = NULL; } - if ( ppv->hdcname[0] != '\0' && hdc_delete != 0 ) + if (ppv->hdcname[0] != '\0' && hdc_delete != 0) hdc_delete(interp, ppv->hdcname); ppv->hdcname[0] = '\0'; - /* We should also clean up the devmode and devname structures. */ - if ( ppv && ppv != current_printer_values ) + /* We should also clean up the devmode and devname structures. */ + if (ppv && ppv != current_printer_values) delete_printer_values(ppv); return TCL_OK; @@ -2605,9 +2606,9 @@ static int PrintClose(ClientData data, Tcl_Interp *interp, int argc, const char static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - /* Which dialog is requested: one of select, page_setup. */ + /* Which dialog is requested: one of select, page_setup. */ static char usage_message[] = "::tk::print::_print dialog [-hDC hdc ] [select|page_setup] [-flags flagsnum]"; - struct printer_values *ppv = *(struct printer_values * )data; + struct printer_values *ppv = *(struct printer_values *)data; int flags; int oldMode; int print_retcode; @@ -2635,7 +2636,7 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char static const int PAGE_REQUIRED_SET = PSD_NOWARNING | PSD_DISABLEPRINTER; - /* Create matching devmode and devnames to match the defaults. */ + /* Create matching devmode and devnames to match the defaults. */ HANDLE hDevMode = 0; HANDLE hDevNames = 0; DEVMODE *pdm = 0; @@ -2660,101 +2661,101 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char return TCL_ERROR; } - for (k = 0; k < argc; k++ ) + for (k = 0; k < argc; k++) { - if ( strcmp(argv[k], "select") == 0 ) + if (strcmp(argv[k], "select") == 0) do_select = 1; - else if ( strcmp(argv[k], "page_setup") == 0 ) + else if (strcmp(argv[k], "page_setup") == 0) do_page = 1; - else if ( strcmp(argv[k], "-hdc") == 0 || strcmp (argv[k], "-hDC") == 0 ) + else if (strcmp(argv[k], "-hdc") == 0 || strcmp (argv[k], "-hDC") == 0) { k++; hdcString = argv[k]; } - else if ( strcmp(argv[k], "-flags") == 0 ) + else if (strcmp(argv[k], "-flags") == 0) { char *endstr; if (argv[k+1]) { - flags = strtol(argv[++k], &endstr, 0); /* Take any valid base. */ - if (endstr != argv[k]) /* if this was a valid numeric string. */ + flags = strtol(argv[++k], &endstr, 0); /* Take any valid base. */ + if (endstr != argv[k]) /* if this was a valid numeric string. */ do_flags = 1; } } } - if ( (do_page + do_select) != 1 ) + if ((do_page + do_select) != 1) { Tcl_SetResult(interp, usage_message, TCL_STATIC); return TCL_ERROR; } - if ( ppv == 0 || ppv == &default_printer_values || ppv->hDC == 0 ) + if (ppv == 0 || ppv == &default_printer_values || ppv->hDC == 0) { is_new_ppv = 1; old_ppv = 0; } - if ( hdcString ) + if (hdcString) { hdc = get_printer_dc(interp,hdcString); ppv = find_dc_by_hdc(hdc); - *(struct printer_values * )data = ppv; - if (hdc == 0 ) + *(struct printer_values *)data = ppv; + if (hdc == 0) { is_new_ppv = 1; } - if (ppv == 0 ) + if (ppv == 0) { is_new_ppv = 1; } } - if ( is_new_ppv == 1 ) + if (is_new_ppv == 1) { - /* Open a brand new printer values structure. */ + /* Open a brand new printer values structure. */ old_ppv = ppv; ppv = make_printer_values(0); - *(struct printer_values * )data = ppv; + *(struct printer_values *)data = ppv; } - /* Copy the devmode and devnames into usable components. */ + /* Copy the devmode and devnames into usable components. */ if (ppv && ppv->pdevmode) dmsize = ppv->pdevmode->dmSize+ppv->pdevmode->dmDriverExtra; - if ( dmsize <= 0 ) - ; /* Don't allocate a devmode structure. */ - else if ( (hDevMode = GlobalAlloc(GMEM_MOVEABLE|GMEM_ZEROINIT, dmsize) ) == NULL ) + if (dmsize <= 0) + ; /* Don't allocate a devmode structure. */ + else if ((hDevMode = GlobalAlloc(GMEM_MOVEABLE|GMEM_ZEROINIT, dmsize)) == NULL) { - /* Failure!. */ + /* Failure!. */ errors |= alloc_devmode; - pdm = 0; /* Use the default devmode. */ + pdm = 0; /* Use the default devmode. */ } - else if ( (pdm = (DEVMODE *)GlobalLock(hDevMode)) == NULL ) + else if ((pdm = (DEVMODE *)GlobalLock(hDevMode)) == NULL) { - /* Failure!. */ + /* Failure!. */ errors |= lock_devmode; } - /* If this is the first time we've got a ppv, just leave the names null. */ - if ( ppv->devnames_filename[0] == 0 || + /* If this is the first time we've got a ppv, just leave the names null. */ + if (ppv->devnames_filename[0] == 0 || ppv->devnames_port[0] == 0 || - ppv->pdevmode == 0 ) - ; /* Don't allocate the devnames structure. */ - else if ( (hDevNames = GlobalAlloc(GMEM_MOVEABLE|GMEM_ZEROINIT, + ppv->pdevmode == 0) + ; /* Don't allocate the devnames structure. */ + else if ((hDevNames = GlobalAlloc(GMEM_MOVEABLE|GMEM_ZEROINIT, sizeof(DEVNAMES)+ sizeof(ppv->devnames_filename) + CCHDEVICENAME + - sizeof(ppv->devnames_port) + 2 ) - ) == NULL) + sizeof(ppv->devnames_port) + 2) + ) == NULL) { - /* Failure!. */ + /* Failure!. */ errors |= alloc_devname; pdn = 0; } - else if ( (pdn = (DEVNAMES *)GlobalLock(hDevNames)) == NULL) + else if ((pdn = (DEVNAMES *)GlobalLock(hDevNames)) == NULL) { - /* Failure!. */ + /* Failure!. */ errors |= lock_devname; } @@ -2765,11 +2766,11 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char { pdn->wDefault = 0; pdn->wDriverOffset = 4*sizeof (WORD); - strcpy( (char *)pdn + pdn->wDriverOffset, ppv->devnames_filename); + strcpy((char *)pdn + pdn->wDriverOffset, ppv->devnames_filename); pdn->wDeviceOffset = pdn->wDriverOffset + strlen(ppv->devnames_filename) + 2; - strcpy ( (char *)pdn + pdn->wDeviceOffset, ppv->pdevmode->dmDeviceName); + strcpy ((char *)pdn + pdn->wDeviceOffset, ppv->pdevmode->dmDeviceName); pdn->wOutputOffset = pdn->wDeviceOffset + strlen(ppv->pdevmode->dmDeviceName) + 2; - strcpy ( (char *)pdn + pdn->wOutputOffset, ppv->devnames_port); + strcpy ((char *)pdn + pdn->wOutputOffset, ppv->devnames_port); } if (hDevMode) @@ -2777,7 +2778,7 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char if (hDevNames) GlobalUnlock(hDevNames); - if ( do_select ) + if (do_select) { /* * Looking at the return value of PrintDlg, we want to @@ -2792,67 +2793,67 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char * consistently establish and free the handles. * Current thinking is to preserve them in the PageSetup structure ONLY, * thus avoiding the problem here. - . */ + . */ HWND tophwnd; - /* Assign the copied, moveable handles to the dialog structure. */ + /* Assign the copied, moveable handles to the dialog structure. */ ppv->pdlg.hDevMode = hDevMode; ppv->pdlg.hDevNames = hDevNames; /* * This loop make the dialog box modal to the toplevel it's working with. * It also avoids any reliance on Tk code (for Tcl users). - . */ - if ( (ppv->pdlg.hwndOwner = GetActiveWindow()) != 0 ) - while ( (tophwnd = GetParent(ppv->pdlg.hwndOwner) ) != 0 ) + . */ + if ((ppv->pdlg.hwndOwner = GetActiveWindow()) != 0) + while ((tophwnd = GetParent(ppv->pdlg.hwndOwner)) != 0) ppv->pdlg.hwndOwner = tophwnd; - /* Leaving the memory alone will preserve selections. */ - /* memset (&(ppv->pdlg), 0, sizeof(PRINTDLG) );. */ + /* Leaving the memory alone will preserve selections. */ + /* memset (&(ppv->pdlg), 0, sizeof(PRINTDLG));. */ ppv->pdlg.lStructSize = sizeof(PRINTDLG); ppv->pdlg.Flags |= PRINT_REQUIRED_SET; - /* Vista (Win95) Fix Start. */ - /* Seems to be needed to print multiple copies. */ + /* Vista (Win95) Fix Start. */ + /* Seems to be needed to print multiple copies. */ ppv->pdlg.Flags |= PD_USEDEVMODECOPIES; - ppv->pdlg.nCopies = (WORD)PD_USEDEVMODECOPIES; /* Value shouldn't matter. */ - /* Vista Fix End. */ + ppv->pdlg.nCopies = (WORD)PD_USEDEVMODECOPIES; /* Value shouldn't matter. */ + /* Vista Fix End. */ - if ( do_flags ) + if (do_flags) { - /* Enable requested flags, but disable the flags we don't want to support. */ + /* Enable requested flags, but disable the flags we don't want to support. */ ppv->pdlg.Flags |= flags; ppv->pdlg.Flags &= PRINT_ALLOWED_SET; } - /* One may not specify return default when devmode or devnames are present. */ + /* One may not specify return default when devmode or devnames are present. */ /* Since the copied flags in the ppv's pdevmode may have been created by * the "PrintOpen" call, this flag _might_ be set - . */ + . */ if (ppv->pdlg.hDevMode || ppv->pdlg.hDevNames) ppv->pdlg.Flags &= (~PD_RETURNDEFAULT); #if TCL_MAJOR_VERSION > 7 - /* In Tcl versions 8 and later, a service call to the notifier is provided. */ + /* In Tcl versions 8 and later, a service call to the notifier is provided. */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); #endif print_retcode = PrintDlg(&(ppv->pdlg)); #if TCL_MAJOR_VERSION > 7 - /* Return the service mode to its original state. */ + /* Return the service mode to its original state. */ Tcl_SetServiceMode(oldMode); #endif - if ( print_retcode == 1 ) /* Not canceled. */ + if (print_retcode == 1) /* Not canceled. */ { const char *name; StorePrintVals (ppv, &ppv->pdlg, 0); - if ( (name = get_attribute (&ppv->attribs, "device")) != 0 ) + if ((name = get_attribute (&ppv->attribs, "device")) != 0) PrinterGetDefaults(ppv, name, 0); /* Don't set default DEVMODE: - user may have already set it in properties. */ + user may have already set it in properties. */ add_dc(ppv->hDC, ppv); current_printer_values = ppv; @@ -2860,7 +2861,7 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char hDevNames = NULL; hDevMode = NULL; } - else /* Canceled. */ + else /* Canceled. */ { DWORD extError = CommDlgExtendedError(); if (ppv->pdlg.hDevMode) @@ -2869,7 +2870,7 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char GlobalFree(hDevMode); hDevMode = ppv->pdlg.hDevMode = NULL; - if ( ppv->pdlg.hDevNames ) + if (ppv->pdlg.hDevNames) GlobalFree (ppv->pdlg.hDevNames); else GlobalFree (hDevNames); @@ -2879,13 +2880,13 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char { Tcl_Free((char *)ppv); ppv = old_ppv; - if ( ppv == 0 ) + if (ppv == 0) ppv = &default_printer_values; - *(struct printer_values * )data = ppv; + *(struct printer_values *)data = ppv; } } - /* Results are available through printer attr; HDC now returned. */ + /* Results are available through printer attr; HDC now returned. */ /* This would be a good place for Tcl_SetObject, but for now, support * older implementations by returning a Hex-encoded value. * Note: Added a 2nd parameter to allow caller to note cancellation. @@ -2893,7 +2894,7 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char { const char *cp = ppv->hdcname; if (cp && cp[0]) - sprintf(msgbuf, "%s %d", cp, print_retcode ); + sprintf(msgbuf, "%s %d", cp, print_retcode); else sprintf(msgbuf, "0x%lx %d", ppv->hDC, print_retcode); Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); @@ -2901,40 +2902,40 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char } else if (do_page) { - if ( do_flags == 0 ) + if (do_flags == 0) flags = PSD_MARGINS|PSD_NOWARNING|PSD_DISABLEPRINTER|PSD_INTHOUSANDTHSOFINCHES; ppv->pgdlg.Flags = flags; - /* Restrict flags to those we wish to support. */ + /* Restrict flags to those we wish to support. */ ppv->pgdlg.Flags |= PAGE_REQUIRED_SET; ppv->pgdlg.Flags &= PAGE_ALLOWED_SET; - /* Set the devmode and devnames to match our structures. */ + /* Set the devmode and devnames to match our structures. */ ppv->pgdlg.hDevMode = hDevMode; ppv->pgdlg.hDevNames = hDevNames; ppv->pgdlg.lStructSize = sizeof(PAGESETUPDLG); #if TCL_MAJOR_VERSION > 7 - /* In Tcl versions 8 and later, a service call to the notifier is provided. */ + /* In Tcl versions 8 and later, a service call to the notifier is provided. */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); #endif print_retcode = PageSetupDlg(&(ppv->pgdlg)); #if TCL_MAJOR_VERSION > 7 - /* Return the service mode to its original state. */ + /* Return the service mode to its original state. */ Tcl_SetServiceMode(oldMode); #endif - if ( print_retcode == 1 ) /* Not cancelled. */ + if (print_retcode == 1) /* Not cancelled. */ { StorePrintVals(ppv, 0, &ppv->pgdlg); - /* Modify the HDC using ResetDC. */ + /* Modify the HDC using ResetDC. */ ResetDC(ppv->hDC, ppv->pdevmode); hDevNames = NULL; hDevMode = NULL; } - else /* Canceled. */ + else /* Canceled. */ { if (ppv->pgdlg.hDevMode) GlobalFree(ppv->pgdlg.hDevMode); @@ -2942,25 +2943,25 @@ static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char GlobalFree(hDevMode); hDevMode = ppv->pgdlg.hDevMode = NULL; - if ( ppv->pgdlg.hDevNames ) + if (ppv->pgdlg.hDevNames) GlobalFree (ppv->pgdlg.hDevNames); else GlobalFree (hDevNames); hDevNames = ppv->pgdlg.hDevNames = NULL; - if ( is_new_ppv ) + if (is_new_ppv) { Tcl_Free ((char *)ppv); ppv = old_ppv; - if (ppv == 0 ) + if (ppv == 0) ppv = &default_printer_values; - *(struct printer_values * )data = ppv; + *(struct printer_values *)data = ppv; } } { const char *cp = ppv->hdcname; if (cp && cp[0]) - sprintf(msgbuf, "%s %d", cp, print_retcode ); + sprintf(msgbuf, "%s %d", cp, print_retcode); else sprintf(msgbuf, "0x%lx %d", ppv->hDC, print_retcode); Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); @@ -3001,13 +3002,13 @@ static int JobInfo(int state, const char *name, const char * outname) break; case 1: inJob = 1; - if ( name ) - strncpy (jobname, name, sizeof(jobname) - 1 ); + if (name) + strncpy (jobname, name, sizeof(jobname) - 1); break; default: break; } - if ( outname ) + if (outname) *outname = jobname; return inJob; } @@ -3029,14 +3030,14 @@ static int JobInfo(int state, const char *name, const char * outname) static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * argv) { DOCINFO di; - struct printer_values * ppv = *(struct printer_values * ) data; + struct printer_values * ppv = *(struct printer_values *) data; static char usage_message[] = "::tk::print::_print job [ -hDC hdc ] [ [start [-name docname] ] | end ]"; HDC hdc = 0; const char *hdcString = 0; - /* Parameters for document name and output file (if any) should be supported. */ - if ( argc > 0 && (strcmp(argv[0], "-hdc") == 0 || strcmp (argv[0], "-hDC") == 0) ) + /* Parameters for document name and output file (if any) should be supported. */ + if (argc > 0 && (strcmp(argv[0], "-hdc") == 0 || strcmp (argv[0], "-hDC") == 0)) { argc--; argv++; @@ -3045,72 +3046,72 @@ static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * argv++; } - if ( hdcString ) + if (hdcString) { hdc = get_printer_dc(interp,hdcString); ppv = find_dc_by_hdc(hdc); - *(struct printer_values * )data = ppv; + *(struct printer_values *)data = ppv; - if (hdc == 0 ) + if (hdc == 0) { Tcl_AppendResult(interp, "printer job got unrecognized hdc ", hdcString, 0); return TCL_ERROR; } - if (ppv == 0 ) + if (ppv == 0) { } } - if (ppv && hdc == 0 ) + if (ppv && hdc == 0) hdc = ppv->hDC; /* Should this command keep track of start/end state so two starts in a row * automatically have an end inserted? - . */ - if ( argc == 0 ) /* printer job by itself. */ + . */ + if (argc == 0) /* printer job by itself. */ { const char *jobname; int status; status = JobInfo (-1, 0, &jobname); - if ( status ) + if (status) Tcl_SetResult(interp, (char *)jobname, TCL_VOLATILE); return TCL_OK; } - else if ( argc >= 1 ) + else if (argc >= 1) { - if ( strcmp (*argv, "start") == 0 ) + if (strcmp (*argv, "start") == 0) { const char *docname = "Tcl Printer Document"; int oldMode; argc--; argv++; - /* handle -name argument if present. */ - if ( argc >= 1 && strcmp( *argv, "-name" ) == 0 ) + /* handle -name argument if present. */ + if (argc >= 1 && strcmp(*argv, "-name") == 0) { argv++; - if ( --argc > 0 ) + if (--argc > 0) { docname = *argv; } } - /* Ensure the hDC is valid before continuing. */ - if ( hdc == NULL ) + /* Ensure the hDC is valid before continuing. */ + if (hdc == NULL) { Tcl_SetResult (interp, "Error starting print job: no printer context", TCL_STATIC); return TCL_ERROR; } - /* Close off any other job if already in progress. */ - if ( JobInfo(-1, 0, 0) ) + /* Close off any other job if already in progress. */ + if (JobInfo(-1, 0, 0)) { EndDoc(ppv->hDC); JobInfo(0, 0, 0); } - memset ( &di, 0, sizeof(DOCINFO) ); + memset (&di, 0, sizeof(DOCINFO)); di.cbSize = sizeof(DOCINFO); di.lpszDocName = docname; @@ -3119,13 +3120,13 @@ static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * * Therefore, in Tcl 8 and above, enable event handling * */ #if TCL_MAJOR_VERSION > 7 - /* In Tcl versions 8 and later, a service call to the notifier is provided. */ + /* In Tcl versions 8 and later, a service call to the notifier is provided. */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); #endif StartDoc(hdc, &di); JobInfo (1, docname, 0); #if TCL_MAJOR_VERSION > 7 - /* Return the service mode to its original state. */ + /* Return the service mode to its original state. */ Tcl_SetServiceMode(oldMode); #endif if (ppv) @@ -3133,7 +3134,7 @@ static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * return TCL_OK; } - else if ( strcmp (*argv, "end") == 0 ) + else if (strcmp (*argv, "end") == 0) { EndDoc(hdc); JobInfo (0, 0, 0); @@ -3164,12 +3165,12 @@ static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * static int PrintPage(ClientData data, Tcl_Interp *interp, int argc, const char * argv) { - struct printer_values * ppv = *(struct printer_values * ) data; + struct printer_values * ppv = *(struct printer_values *) data; static char usage_message[] = "::tk::print::_print [-hDC hdc] [start|end]"; HDC hdc = 0; const char *hdcString = 0; - if ( argv[0] && ( strcmp(argv[0], "-hdc") == 0 || strcmp (argv[0], "-hDC") == 0 ) ) + if (argv[0] && (strcmp(argv[0], "-hdc") == 0 || strcmp (argv[0], "-hDC") == 0)) { argc--; argv++; @@ -3178,18 +3179,18 @@ static int PrintPage(ClientData data, Tcl_Interp *interp, int argc, const char argv++; } - if ( hdcString ) + if (hdcString) { hdc = get_printer_dc(interp,hdcString); ppv = find_dc_by_hdc(hdc); - *(struct printer_values * )data = ppv; + *(struct printer_values *)data = ppv; - if (hdc == 0 ) + if (hdc == 0) { Tcl_AppendResult(interp, "printer page got unrecognized hdc ", hdcString, 0); return TCL_ERROR; } - if (ppv == 0 ) + if (ppv == 0) { Tcl_AppendResult(interp, "printer page got unrecognized hdc ", hdcString, 0); return TCL_ERROR; @@ -3199,16 +3200,16 @@ static int PrintPage(ClientData data, Tcl_Interp *interp, int argc, const char * Should this command keep track of start/end state so two starts in a row * automatically have an end inserted? * Also, if no job has started, should it start a printer job? - . */ - if ( argc >= 1 ) + . */ + if (argc >= 1) { - if ( strcmp (*argv, "start") == 0 ) + if (strcmp (*argv, "start") == 0) { StartPage(ppv->hDC); ppv->in_page = 1; return TCL_OK; } - else if ( strcmp (*argv, "end") == 0 ) + else if (strcmp (*argv, "end") == 0) { EndPage(ppv->hDC); ppv->in_page = 0; @@ -3230,9 +3231,9 @@ static int PrintPageAttr (HDC hdc, int *hsize, int *vsize, int *hppi, int *vppi) { int status = 0; - if ( hdc == 0 ) + if (hdc == 0) { - return -1; /* A value indicating failure. */ + return -1; /* A value indicating failure. */ } *hsize = GetDeviceCaps(hdc, PHYSICALWIDTH); @@ -3276,7 +3277,7 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char "[-hDC hdc] " "[ [-get keylist] | [-set key-value-pair list] | [-delete key-list] | [-prompt] ]"; - struct printer_values * ppv = *(struct printer_values * ) data; + struct printer_values * ppv = *(struct printer_values *) data; Tcl_HashEntry *ent; Tcl_HashSearch srch; @@ -3287,7 +3288,7 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char * The attributes of interest are the ones buried in the dialog structures. */ - /* For the first implementation, more than 100 keys/pairs will be ignored. */ + /* For the first implementation, more than 100 keys/pairs will be ignored. */ char * keys=0; int key_count = 0; @@ -3300,75 +3301,75 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char /* * This command should take an HDC as an optional parameter, otherwise using * the one in the ppv structure? - . */ + . */ for (i=0; i 1 ) + /* Check for any illegal implementations. */ + if (do_set + do_get + do_delete + do_prompt > 1) { Tcl_AppendResult(interp, "\nCannot use two options from " "-get, -set, -delete, and -prompt in same request.\n", @@ -3379,18 +3380,18 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char return TCL_ERROR; } - if ( hdcString ) + if (hdcString) { hdc = get_printer_dc(interp,hdcString); ppv = find_dc_by_hdc(hdc); - *(struct printer_values * )data = ppv; + *(struct printer_values *)data = ppv; - if (hdc == 0 ) + if (hdc == 0) { Tcl_AppendResult(interp, "::tk::print::_print attr got unrecognized hdc ", hdcString, 0); return TCL_ERROR; } - if (ppv == 0 ) + if (ppv == 0) { Tcl_AppendResult(interp, "::tk::print::_print attr got unrecognized hdc ", hdcString, 0); return TCL_ERROR; @@ -3402,10 +3403,10 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char * The two choices are (a) to consider this a fatal error for the printer attr * command; and (b) to open the default printer. For now, we use choice (b) */ - if ( ppv == 0 || ppv == &default_printer_values || ppv->hDC == NULL ) + if (ppv == 0 || ppv == &default_printer_values || ppv->hDC == NULL) { - /* In these cases, open the default printer, if any. If none, return an error. */ - if ( PrintOpen(data, interp, 0, 0) != TCL_OK ) + /* In these cases, open the default printer, if any. If none, return an error. */ + if (PrintOpen(data, interp, 0, 0) != TCL_OK) { Tcl_AppendResult(interp, "\nThere appears to be no default printer." "\nUse '::tk::print::_print dialog select' before '::tk::print::_print attr'\n", @@ -3415,10 +3416,10 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char return TCL_ERROR; } else - Tcl_ResetResult(interp); /* Remove the hDC from the result. */ + Tcl_ResetResult(interp); /* Remove the hDC from the result. */ - /* This changes the ppv (via changing data in PrintOpen!. */ - ppv = *(struct printer_values * )data; + /* This changes the ppv (via changing data in PrintOpen!. */ + ppv = *(struct printer_values *)data; } @@ -3432,15 +3433,15 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char * attribute list. Values CAN be set in this list that are not * recognized by the printer dialogs or structures. */ - /* This is the "delete" part, used only by the -delete case. */ - if ( do_delete ) + /* This is the "delete" part, used only by the -delete case. */ + if (do_delete) { int count_del = 0; char count_str[12+1]; /* The only trick here is to ensure that only permitted * items are deleted - . */ + . */ static const char *illegal[] = { "device", "driver", @@ -3450,25 +3451,25 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char "port", "resolution", }; - for ( ent = Tcl_FirstHashEntry(&ppv->attribs, &srch); + for (ent = Tcl_FirstHashEntry(&ppv->attribs, &srch); ent != 0; - ent = Tcl_NextHashEntry(&srch) ) + ent = Tcl_NextHashEntry(&srch)) { const char *key; - if ( (key = (const char *)Tcl_GetHashKey(&ppv->attribs, ent)) != 0 ) + if ((key = (const char *)Tcl_GetHashKey(&ppv->attribs, ent)) != 0 ) { - /* Test here to see if a list is available, and if this element is on it. */ + /* Test here to see if a list is available, and if this element is on it. */ int found=0; int i; for (i=0; i 1 ) + if (scount > 1) { set_attribute (&ppv->attribs, slist[0], slist[1]); - strcpy(keys[k], slist[0]); /* Always shorter, so this should be OK. */ + strcpy(keys[k], slist[0]); /* Always shorter, so this should be OK. */ } - if ( slist ) + if (slist) Tcl_Free((char *)slist); } } - /* Here we should "synchronize" the pairs with the devmode. */ + /* Here we should "synchronize" the pairs with the devmode. */ GetDevModeAttribs (&ppv->attribs, ppv->pdevmode); RestorePrintVals (ppv, &ppv->pdlg, &ppv->pgdlg); - /* -------------- added 8/1/02 by Jon Hilbert. */ + /* -------------- added 8/1/02 by Jon Hilbert. */ /* tell the printer about the devmode changes This is necessary to support paper size setting changes - . */ + . */ DocumentProperties(GetActiveWindow(),ppv->hDC,ppv->pdevmode->dmDeviceName, ppv->pdevmode,ppv->pdevmode,DM_IN_BUFFER|DM_OUT_BUFFER); - /* Here we should modify the DEVMODE by calling ResetDC. */ + /* Here we should modify the DEVMODE by calling ResetDC. */ ResetDC(ppv->hDC, ppv->pdevmode); } - else if ( do_prompt ) + else if (do_prompt) { DWORD dwRet; HANDLE hPrinter; @@ -3541,9 +3542,9 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char dwRet = DocumentProperties ( GetActiveWindow(), hPrinter, ppv->pdevmode->dmDeviceName, ppv->pdevmode, ppv->pdevmode, DM_PROMPT | DM_IN_BUFFER | DM_OUT_BUFFER); - if ( dwRet == IDCANCEL ) + if (dwRet == IDCANCEL) { - /* The dialog was canceled. Don't do anything. */ + /* The dialog was canceled. Don't do anything. */ } else { @@ -3575,22 +3576,22 @@ static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char ClosePrinter(hPrinter); } - /* This is the "get" part, used for all cases of the command. */ - for ( ent = Tcl_FirstHashEntry(&ppv->attribs, &srch); + /* This is the "get" part, used for all cases of the command. */ + for (ent = Tcl_FirstHashEntry(&ppv->attribs, &srch); ent != 0; - ent = Tcl_NextHashEntry(&srch) ) + ent = Tcl_NextHashEntry(&srch)) { const char *key, *value; - if ( (value = (const char *)Tcl_GetHashValue(ent)) != 0 && - (key = (const char *)Tcl_GetHashKey(&ppv->attribs, ent)) != 0 ) + if ((value = (const char *)Tcl_GetHashValue(ent)) != 0 && + (key = (const char *)Tcl_GetHashKey(&ppv->attribs, ent)) != 0 ) { - /* Test here to see if a list is available, and if this element is on it. */ - if (do_set || do_get ) + /* Test here to see if a list is available, and if this element is on it. */ + if (do_set || do_get) { int found=0; int i; for (i=0; i 0 ) + 0); + if (errors > 0) Tcl_AppendResult(interp, "\n", usage, "\n", 0); return TCL_OK; @@ -3733,7 +3734,7 @@ static struct printer_values *delete_dc (HDC hdc) { Tcl_HashEntry *data; struct printer_values *pv = 0; - if ( (data = Tcl_FindHashEntry(&printer_hdcs, (const char *)hdc)) != 0 ) + if ((data = Tcl_FindHashEntry(&printer_hdcs, (const char *)hdc)) != 0) { pv = (struct printer_values *)Tcl_GetHashValue(data); Tcl_DeleteHashEntry(data); @@ -3758,7 +3759,7 @@ static struct printer_values *delete_dc (HDC hdc) static struct printer_values *find_dc_by_hdc(HDC hdc) { Tcl_HashEntry *data; - if ( (data = Tcl_FindHashEntry(&printer_hdcs, (const char *)hdc)) != 0 ) + if ((data = Tcl_FindHashEntry(&printer_hdcs, (const char *)hdc)) != 0) return (struct printer_values *)Tcl_GetHashValue(data); return 0; } @@ -3807,11 +3808,11 @@ static void delete_printer_dc_contexts(Tcl_Interp *interp) HDC hdc; - /* Note: hdc_List, hdc_get, and hdc_delete do not use the interp argument. */ + /* Note: hdc_List, hdc_get, and hdc_delete do not use the interp argument. */ hdc_list(interp, PRINTER_dc_type, contexts, &outlen); for (i=0; i name ) + if (strend != 0 && strend > name) { - if ( is_valid_hdc((HDC)tmp) == 0 ) + if (is_valid_hdc((HDC)tmp) == 0) { tmp = 0; Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", @@ -3941,10 +3942,10 @@ static HDC get_printer_dc(Tcl_Interp *interp, const char *name) } - + \0x0C /* * Local variables: * mode: c * indent-tabs-mode: nil * End: - */ \ No newline at end of file + */ -- cgit v0.12 From 35f49ca7de0bce63f7f8a90ea0a4488faac74246 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 22 Apr 2021 01:05:17 +0000 Subject: Minor tweaks --- win/tkWinPrint.c | 207 ++++++++++++++----------------------------------------- 1 file changed, 53 insertions(+), 154 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 8715916..ef70a0b 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -109,7 +109,8 @@ int Winprint_Init (Tcl_Interp *Interp); /* * Internal function prototypes */ -static int Print (ClientData unused, Tcl_Interp *interp, int argc, const char * argv, int safe); +static int printer (ClientData data, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +static int Print (ClientData unused, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[], int safe); static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const char * argv); static int PrintSend (ClientData unused, Tcl_Interp *interp, int argc, const char * argv); static int PrintRawData (HANDLE printer, Tcl_Interp *interp, LPBYTE lpData, DWORD dwCount); @@ -117,7 +118,6 @@ static int PrintRawFileData (HANDLE printer, Tcl_Interp *interp, const char *fil static int PrintStart (HDC hdc, Tcl_Interp *interp, const char *docname); static int PrintFinish (HDC hdc, Tcl_Interp *interp); static int Version(ClientData unused, Tcl_Interp *interp, int argc, const char * argv); -static long WinVersion(void); static void ReportWindowsError(Tcl_Interp * interp, DWORD errorCode); static int PrinterGetDefaults(struct printer_values *ppv, const char *printer_name, int set_default_devmode); static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg); @@ -174,32 +174,6 @@ static struct { /* *---------------------------------------------------------------------- * - * WinVersion -- - * - * WinVersion returns an integer representing the current version - * of Windows. - * - * Results: - * Returns Windows version. - * - *---------------------------------------------------------------------- - */ - -static long WinVersion(void) -{ - static OSVERSIONINFO osinfo; - if (osinfo.dwOSVersionInfoSize == 0) - { - osinfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osinfo); /* Should never fail--only failure is if size too small. */ - } - return osinfo.dwPlatformId; -} - - -/* - *---------------------------------------------------------------------- - * * ReportWindowsError -- * * This function sets the Tcl error code to the provided @@ -226,7 +200,7 @@ static void ReportWindowsError(Tcl_Interp * interp, DWORD errorCode) NULL ); Tcl_AppendResult(interp,(char *)lpMsgBuf,0); - // Free the buffer. + /* Free the buffer. */ LocalFree(lpMsgBuf); } @@ -414,52 +388,7 @@ static void delete_printer_values (struct printer_values *ppv) static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, int wildcard) { - /* The following 3 declarations are only needed for the Win32s case. */ - static char devices_buffer[256]; - static char value[256]; - char *cp; - - /* First ensure dev, dvr, and port are initialized empty - * This is not needed for normal cases, but at least one report on - * WinNT with at least one printer, this is not initialized. - * Suggested by Jim Garrison - . */ - *dev = ""; - *dvr = ""; - *port = ""; - - /* - * The result should be useful for specifying the devices and/or OpenPrinter and/or lp -d. - * Rather than make this compilation-dependent, do a runtime check. - */ - switch (WinVersion()) - { - case VER_PLATFORM_WIN32s: /* Windows 3.1. */ - /* Getting the printer list isn't hard... the trick is which is right for WfW? - * [PrinterPorts] or [devices]? - * For now, use devices. - . */ - /* First, get the entries in the section. */ - GetProfileString("devices", 0, "", (LPSTR)devices_buffer, sizeof devices_buffer); - - /* Next get the values for each entry; construct each as a list of 3 elements. */ - for (cp = devices_buffer; *cp ; cp+=strlen(cp) + 1) - { - GetProfileString("devices", cp, "", (LPSTR)value, sizeof value); - if ((wildcard != 0 && Tcl_StringMatch(value, name)) || - (wildcard == 0 && lstrcmpi (value, name) == 0) ) - { - static char stable_val[80]; - strncpy (stable_val, value,80); - stable_val[79] = '\0'; - return SplitDevice(stable_val, dev, dvr, port); - } - } - return 0; - break; - case VER_PLATFORM_WIN32_WINDOWS: /* Windows 95, 98. */ - case VER_PLATFORM_WIN32_NT: /* Windows NT. */ - default: + /* Win32 implementation uses EnumPrinters. */ /* There is a hint in the documentation that this info is stored in the registry. @@ -524,10 +453,9 @@ static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, i } } Tcl_Free((char *)ary); - } - break; - } + return 1; + } } /* @@ -558,18 +486,12 @@ static int PrinterGetDefaults(struct printer_values *ppv, HANDLE pHandle; int result = 1; - switch (WinVersion()) - { - case VER_PLATFORM_WIN32s: - return GETDEFAULTS_UNSUPPORTED; - } - if (ppv->hDC == NULL) { /* * Use the name to create a DC if at all possible: * This may require using the printer list and matching on the name. - . */ + */ char *dev, *dvr, *port; if (GetPrinterWithName ((char *)printer_name, &dev, &dvr, &port, 1) == 0) { return GETDEFAULTS_NOSUCHPRINTER; /* Can't find a printer with that name. */ @@ -582,10 +504,9 @@ static int PrinterGetDefaults(struct printer_values *ppv, } } - /* Use DocumentProperties to get the default devmode. */ if (set_default_devmode > 0 || ppv->pdevmode == 0) - /* First get the required size:. */ + /* First get the required size. */ { LONG siz = 0L; @@ -697,15 +618,16 @@ static void CopyDevnames (struct printer_values *ppv, HANDLE hdevnames) } } -/* A macro for converting 10ths of millimeters to 1000ths of inches. */ -#define MM_TO_MINCH(x) ((x) / 0.0254) -#define TENTH_MM_TO_MINCH(x) ((x) / 0.254) -#define MINCH_TO_TENTH_MM(x) (0.254 * (x)) +/* A macro for converting 10ths of millimeters to 1000ths of inches. */ +#define MM_TO_MINCH(x)((x) / 0.0254) +#define TENTH_MM_TO_MINCH(x)((x) / 0.254) +#define MINCH_TO_TENTH_MM(x)(0.254 * (x)) + static const struct paper_size { int size; long wid; long len; } paper_sizes[] = { { DMPAPER_LETTER, 8500, 11000 }, { DMPAPER_LEGAL, 8500, 14000 }, - { DMPAPER_A4, (long)MM_TO_MINCH(210), (long)MM_TO_MINCH(297) }, + { DMPAPER_A4, (long)(8267.72), (long)(11692.91) }, { DMPAPER_CSHEET, 17000, 22000 }, { DMPAPER_DSHEET, 22000, 34000 }, { DMPAPER_ESHEET, 34000, 44000 }, @@ -713,13 +635,13 @@ static const struct paper_size { int size; long wid; long len; } paper_sizes[] = { DMPAPER_TABLOID, 11000, 17000 }, { DMPAPER_LEDGER, 17000, 11000 }, { DMPAPER_STATEMENT, 5500, 8500 }, - { DMPAPER_A3, (long)MM_TO_MINCH(297), (long)MM_TO_MINCH(420) }, - { DMPAPER_A4SMALL, (long)MM_TO_MINCH(210), (long)MM_TO_MINCH(297) }, - { DMPAPER_A5, (long)MM_TO_MINCH(148), (long)MM_TO_MINCH(210) }, - { DMPAPER_B4, (long)MM_TO_MINCH(250), (long)MM_TO_MINCH(354) }, - { DMPAPER_B5, (long)MM_TO_MINCH(182), (long)MM_TO_MINCH(257) }, + { DMPAPER_A3, (long)(11692.91), (long)(16535.43) }, + { DMPAPER_A4SMALL, (long)(8267.72), (long)(11692.91) }, + { DMPAPER_A5, (long)(5826.77), (long)(8267.72) }, + { DMPAPER_B4, (long)(9842.52), (long)(13937) }, + { DMPAPER_B5, (long)(7165.35), (long)(10118.11) }, { DMPAPER_FOLIO, 8500, 13000 }, - { DMPAPER_QUARTO, (long)MM_TO_MINCH(215), (long)MM_TO_MINCH(275) }, + { DMPAPER_QUARTO, (long)(8464.57), (long)(10826.77) }, { DMPAPER_10X14, 10000, 14000 }, { DMPAPER_11X17, 11000, 17000 }, { DMPAPER_NOTE, 8500, 11000 }, @@ -728,16 +650,16 @@ static const struct paper_size { int size; long wid; long len; } paper_sizes[] = { DMPAPER_ENV_11, 4500, 10375 }, { DMPAPER_ENV_12, 4750, 11000 }, { DMPAPER_ENV_14, 5000, 11500 }, - { DMPAPER_ENV_DL, (long)MM_TO_MINCH(110), (long)MM_TO_MINCH(220) }, - { DMPAPER_ENV_C5, (long)MM_TO_MINCH(162), (long)MM_TO_MINCH(229) }, - { DMPAPER_ENV_C3, (long)MM_TO_MINCH(324), (long)MM_TO_MINCH(458) }, - { DMPAPER_ENV_C4, (long)MM_TO_MINCH(229), (long)MM_TO_MINCH(324) }, - { DMPAPER_ENV_C6, (long)MM_TO_MINCH(114), (long)MM_TO_MINCH(162) }, - { DMPAPER_ENV_C65, (long)MM_TO_MINCH(114), (long)MM_TO_MINCH(229) }, - { DMPAPER_ENV_B4, (long)MM_TO_MINCH(250), (long)MM_TO_MINCH(353) }, - { DMPAPER_ENV_B5, (long)MM_TO_MINCH(176), (long)MM_TO_MINCH(250) }, - { DMPAPER_ENV_B6, (long)MM_TO_MINCH(176), (long)MM_TO_MINCH(125) }, - { DMPAPER_ENV_ITALY, (long)MM_TO_MINCH(110), (long)MM_TO_MINCH(230) }, + { DMPAPER_ENV_DL, (long)(4330.71), (long)(8661.42) }, + { DMPAPER_ENV_C5, (long)(6377.95), (long)(9015.75) }, + { DMPAPER_ENV_C3, (long)(12755.91), (long)(18031.5) }, + { DMPAPER_ENV_C4, (long)(9015.75), (long)(12755.91) }, + { DMPAPER_ENV_C6, (long)(4488.19), (long)(6377.95) }, + { DMPAPER_ENV_C65, (long)(4488.19), (long)(9015.75) }, + { DMPAPER_ENV_B4, (long)(9842.52), (long)(13897.64) }, + { DMPAPER_ENV_B5, (long)(6929.13), (long)(9842.52) }, + { DMPAPER_ENV_B6, (long)(6929.13), (long)(4921.26) }, + { DMPAPER_ENV_ITALY, (long)(4330.71), (long)(9055.12) }, { DMPAPER_ENV_MONARCH, 3825, 7500 }, { DMPAPER_ENV_PERSONAL, 3625, 6500 }, { DMPAPER_FANFOLD_US, 14825, 11000 }, @@ -797,7 +719,7 @@ static void GetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) sscanf(cp, "%ld %ld", &width, &length); dm->dmPaperWidth = (short)MINCH_TO_TENTH_MM(width); dm->dmPaperLength = (short)MINCH_TO_TENTH_MM(length); - // indicate that size is specified by dmPaperWidth,dmPaperLength + /* Indicate that size is specified by dmPaperWidth,dmPaperLength. */ dm->dmPaperSize = 0; } } @@ -830,10 +752,16 @@ static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) /* Everything depends on what flags are set. */ if (dm->dmDeviceName[0]) - set_attribute(att, "device", (const *char) dm->dmDeviceName); + { + const char * devicename; + devicename = dm->dmDeviceName; + set_attribute(att, "device", devicename); + } if (dm->dmFields & DM_ORIENTATION) + { set_attribute(att, "page orientation", dm->dmOrientation==DMORIENT_PORTRAIT?"portrait":"landscape"); + } if (dm->dmFields & DM_YRESOLUTION) { sprintf(tmpbuf, "%d %d", dm->dmYResolution, dm->dmPrintQuality); @@ -1429,12 +1357,12 @@ static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, *---------------------------------------------------------------------- */ -static int Print (ClientData defaults, Tcl_Interp *interp, int argc, const char * argv, int safe) +static int Print (ClientData defaults, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[], int safe) { unsigned int i; if (argc == 0) { - top_usage_message(interp, argc+1, argv-1, safe); + top_usage_message(interp, argc+1, objv-1, safe); return TCL_ERROR; } @@ -1444,10 +1372,10 @@ static int Print (ClientData defaults, Tcl_Interp *interp, int argc, const char */ for (i=0; i < (sizeof printer_commands / sizeof (struct prt_cmd)); i++) if (printer_commands[i].safe >= safe) - if (strcmp((const char*) argv[0], printer_commands[i].name) == 0) - return printer_commands[i].func(defaults, interp, argc-1, argv+1); + if (strcmp(objv[0], printer_commands[i].name) == 0) + return printer_commands[i].func(defaults, interp, argc-1, objv+1); - top_usage_message(interp, argc+1, argv-1, safe); + top_usage_message(interp, argc+1, objv-1, safe); return TCL_ERROR; } @@ -1465,16 +1393,16 @@ static int Print (ClientData defaults, Tcl_Interp *interp, int argc, const char *---------------------------------------------------------------------- */ -static int printer (ClientData data, Tcl_Interp *interp, int argc, const char * argv) +static int printer (ClientData data, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) { if (argc > 1) { - argv++; + objv++; argc--; - return Print(data, interp, argc, argv, 0); + return Print(data, interp, argc, objv, 0); } - top_usage_message(interp, argc, argv, 0); + top_usage_message(interp, argc, objv, 0); return TCL_ERROR; } @@ -1493,7 +1421,7 @@ static int printer (ClientData data, Tcl_Interp *interp, int argc, const char * int Winprint_Init(Tcl_Interp * interp) { - Tcl_CreateCommand(interp, "::tk::print::_print", printer, + Tcl_CreateObjCommand(interp, "::tk::print::_print", printer, (ClientData)(& current_printer_values), 0); /* Initialize the attribute hash table. */ @@ -1532,18 +1460,7 @@ static int SplitDevice(LPSTR device, LPSTR *dev, LPSTR *dvr, LPSTR *port) static char buffer[256]; if (device == 0) { - switch (WinVersion()) - { - case VER_PLATFORM_WIN32s: - GetProfileString("windows", "device", "", (LPSTR)buffer, sizeof buffer); - device = (LPSTR)buffer; - break; - case VER_PLATFORM_WIN32_WINDOWS: - case VER_PLATFORM_WIN32_NT: - default: device = (LPSTR)"WINSPOOL,Postscript,"; - break; - } } *dev = strtok(device, ","); @@ -1586,24 +1503,12 @@ static HDC GetPrinterDC (const char *printer) LPSTR lpPrintPort = ""; SplitDevice ((LPSTR)printer, &lpPrintDevice, &lpPrintDriver, &lpPrintPort); - switch (WinVersion()) - { - case VER_PLATFORM_WIN32s: - hdcPrint = CreateDC (lpPrintDriver, - lpPrintDevice, - lpPrintPort, - NULL); - break; - case VER_PLATFORM_WIN32_WINDOWS: - case VER_PLATFORM_WIN32_NT: - default: + hdcPrint = CreateDC (lpPrintDriver, lpPrintDevice, NULL, NULL); - break; - } - + return hdcPrint; } @@ -1708,22 +1613,19 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha * The result should be useful for specifying the devices and/or OpenPrinter and/or lp -d. * Rather than make this compilation-dependent, do a runtime check. */ - switch (WinVersion()) - { - case VER_PLATFORM_WIN32_NT: /* Windows NT. */ - default: + /* Win32 implementation uses EnumPrinters. */ /* There is a hint in the documentation that this info is stored in the registry. * if so, that interface would probably be even better! * NOTE: This implementation was suggested by Brian Griffin , * and replaces the older implementation which used PRINTER_INFO_4,5 . */ - { + DWORD bufsiz = 0; DWORD needed = 0; DWORD num_printers = 0; PRINTER_INFO_2 *ary = 0; - DWORD i; + DWORD _i; /* First, get the size of array needed to enumerate the printers. */ if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, @@ -1863,9 +1765,6 @@ static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const cha } } Tcl_Free((char *)ary); - } - break; - } return TCL_OK; } -- cgit v0.12 From bf9c22a77eb9bf516eb667cb290dcb827a94d638 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 22 Apr 2021 13:10:19 +0000 Subject: Incremental progress --- win/tkWinPrint.c | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index ef70a0b..599feda 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -89,6 +89,7 @@ struct printer_values *current_printer_values = &default_printer_values; static int is_valid_printer_values (const struct printer_values *ppv); static struct printer_values *make_printer_values(HDC hdc); static void delete_printer_values (struct printer_values *ppv); +static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, int safe); /* * These declarations and variables are related to managing a @@ -109,8 +110,8 @@ int Winprint_Init (Tcl_Interp *Interp); /* * Internal function prototypes */ -static int printer (ClientData data, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int Print (ClientData unused, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[], int safe); +static int printer (ClientData data, Tcl_Interp *interp, int argc, char * argv); +static int Print (ClientData unused, Tcl_Interp *interp, int argc, char * argv, int safe); static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const char * argv); static int PrintSend (ClientData unused, Tcl_Interp *interp, int argc, const char * argv); static int PrintRawData (HANDLE printer, Tcl_Interp *interp, LPBYTE lpData, DWORD dwCount); @@ -1349,7 +1350,7 @@ static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, * Print -- * * Takes the print command, parses it, and calls - * the correct subfunction. + * the correct subfunction.st * * Results: * Executes print command/subcommand. @@ -1357,12 +1358,12 @@ static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, *---------------------------------------------------------------------- */ -static int Print (ClientData defaults, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[], int safe) +static int Print (ClientData defaults, Tcl_Interp *interp, int argc, char * argv, int safe) { unsigned int i; if (argc == 0) { - top_usage_message(interp, argc+1, objv-1, safe); + top_usage_message(interp, argc+1, argv-1, safe); return TCL_ERROR; } @@ -1371,11 +1372,14 @@ static int Print (ClientData defaults, Tcl_Interp *interp, int argc, Tcl_Obj *co * Exact match for now--could be case-insensitive, leading match. */ for (i=0; i < (sizeof printer_commands / sizeof (struct prt_cmd)); i++) - if (printer_commands[i].safe >= safe) - if (strcmp(objv[0], printer_commands[i].name) == 0) - return printer_commands[i].func(defaults, interp, argc-1, objv+1); + if (printer_commands[i].safe >= safe) { + const char *name = (char *)argv[0]; + const char *cmd = printer_commands[i].name; + if (strcmp(name, cmd) == 0) + return printer_commands[i].func(defaults, interp, argc-1, argv+1); + } - top_usage_message(interp, argc+1, objv-1, safe); + top_usage_message(interp, argc+1, argv-1, safe); return TCL_ERROR; } @@ -1393,16 +1397,16 @@ static int Print (ClientData defaults, Tcl_Interp *interp, int argc, Tcl_Obj *co *---------------------------------------------------------------------- */ -static int printer (ClientData data, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +static int printer (ClientData data, Tcl_Interp *interp, int argc, char * argv) { if (argc > 1) { - objv++; + argv++; argc--; - return Print(data, interp, argc, objv, 0); + return Print(data, interp, argc, argv, 0); } - top_usage_message(interp, argc, objv, 0); + top_usage_message(interp, argc, argv, 0); return TCL_ERROR; } -- cgit v0.12 From a0e456106d6ba6cfc970425c901c9d6fb217aa5a Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 28 Apr 2021 02:13:38 +0000 Subject: tkWinPrint.c not building, and not working if it builds; going to start building my own using Michael Schwartz API and Harald Oehlmann function structure, and radically simplifying down to printer access, dialogs, and job control; this is my very basic start, much more to come --- win/tkWinPrint.c | 3921 ++---------------------------------------------------- 1 file changed, 119 insertions(+), 3802 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 599feda..66833d2 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -3,3852 +3,169 @@ * * This module implements Win32 printer access. * - * Copyright (c) 1998-2019 Harald Oehlmann, Elmicron GmbH - * Copyright (c) 2009 Michael I. Schwartz. - * Copyright (c) 2018 Microsoft Corporation. - * Copyright (c) 2021 Kevin Walzer/WordTech Communications LLC. + * Copyright © 1998-2019 Harald Oehlmann, Elmicron GmbH + * Copyright © 2009 Michael I. Schwartz. + * Copyright © 2018 Microsoft Corporation. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ - -/* - * This section contains windows-specific includes and structures - * global to the file. - * Windows-specific functions will be found in a section at the - * end of the file. - */ -#if defined(__WIN32__) || defined (__WIN32S__) || defined (WIN32S) -/* Suppress Vista Warnings. */ -#define _CRT_SECURE_NO_WARNINGS -#endif - #include +#include #include +#include #include +#include +#include "tkWinInt.h" #include #include -#include /* For floor(), used later. */ -#include "tkWinHDC.h" - -/* - * This value structure is intended for ClientData in all Print functions. - * Major philosophical change: - * Instead of relying on windows to maintain the various dialog structures, - * relevant parts of this printer_values structure will be copied in and out of - * the windows structures before the dialog calls. - * This will allow the PrintAttr function to behave properly, setting and getting - * various aspects of the printer settings without concern about other - * side effects in the program. - * - * The DEVMODE and DEVNAMES structures are static rather than - * global movable objects in order to simplify access. The - * global objects will be allocated and freed as needed, - * when the appropriate functions are called. - * - * If performance suffers drastically, or so many device drivers - * require extra device-specific information that the base information - * is insufficient, this is subject to change. - * If changed, the printer_values structure will maintain its - * own handle to the devmode and devnames, still copying them - * as needed to the dialogs. - * - * Really, this structure should be attached to all printer HDCs, - * and the hash table should track which printer_values structure - * is associated with the given hDC. - * Added the new member hdcname to track the named hDC. - */ - -#define PVMAGIC 0x4e495250 - -static struct printer_values -{ - unsigned long magic; /* Give some indication if this is a "real" structure. */ - HDC hDC; /* Default printer context--override via args?. */ - char hdcname[19+1]; /* Name of hdc. */ - PRINTDLG pdlg; /* Printer dialog and associated values. */ - PAGESETUPDLG pgdlg; /* Printer setup dialog and associated values. */ - DEVMODE *pdevmode; /* Allocated when the printer_values is built. */ - char extra_space[1024+1]; /* space just in case.... */ - int space_count; /* How much extra space. */ - char devnames_filename[255+1]; /* Driver filename. */ - char devnames_port[255+1]; /* Output port. */ - char devnames_printername[255+1]; /* Full printer name. */ - Tcl_HashTable attribs; /* Hold the attribute name/value pairs.. */ - int in_job; /* Set to 1 after job start and before job end. */ - int in_page; /* Set to 1 after page start and before page end. */ - DWORD errorCode; /* Under some conditions, save the Windows error code. */ -} default_printer_values; - -/* - * These declarations are related to creating, destroying, and - * managing printer_values structures. - */ -struct printer_values *current_printer_values = &default_printer_values; -static int is_valid_printer_values (const struct printer_values *ppv); -static struct printer_values *make_printer_values(HDC hdc); -static void delete_printer_values (struct printer_values *ppv); -static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, int safe); - -/* - * These declarations and variables are related to managing a - * list of hdcs created by this extension, and their associated - * printer value structures. - */ - -static Tcl_HashTable printer_hdcs; -static void add_dc(HDC hdc, struct printer_values *pv); -static struct printer_values *delete_dc (HDC hdc); -static struct printer_values *find_dc_by_hdc(HDC hdc); - -static HDC GetPrinterDC (const char *printer); -static int SplitDevice(LPSTR device, LPSTR *dev, LPSTR *dvr, LPSTR *port); - -int Winprint_Init (Tcl_Interp *Interp); - -/* - * Internal function prototypes - */ -static int printer (ClientData data, Tcl_Interp *interp, int argc, char * argv); -static int Print (ClientData unused, Tcl_Interp *interp, int argc, char * argv, int safe); -static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const char * argv); -static int PrintSend (ClientData unused, Tcl_Interp *interp, int argc, const char * argv); -static int PrintRawData (HANDLE printer, Tcl_Interp *interp, LPBYTE lpData, DWORD dwCount); -static int PrintRawFileData (HANDLE printer, Tcl_Interp *interp, const char *filename, int binary); -static int PrintStart (HDC hdc, Tcl_Interp *interp, const char *docname); -static int PrintFinish (HDC hdc, Tcl_Interp *interp); -static int Version(ClientData unused, Tcl_Interp *interp, int argc, const char * argv); -static void ReportWindowsError(Tcl_Interp * interp, DWORD errorCode); -static int PrinterGetDefaults(struct printer_values *ppv, const char *printer_name, int set_default_devmode); -static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg); -static void RestorePrintVals (struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg); -static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm); -static void SetDevNamesAttribs (Tcl_HashTable *att, struct printer_values *dn); -static void SetPrintDlgAttribs (Tcl_HashTable *att, PRINTDLG *pdlg); -static void SetPageSetupDlgAttribs (Tcl_HashTable *att, PAGESETUPDLG *pgdlg); -static void SetHDCAttribs (Tcl_HashTable *att, HDC hDC); -static const char *set_attribute(Tcl_HashTable *att, const char *key, const char *value); -static const char *get_attribute(Tcl_HashTable *att, const char *key); -static int del_attribute(Tcl_HashTable *att, const char *key); -static int PrintPageAttr (HDC hdc, int *hsize, int *vsize, - int *hscale, int *vscale, - int *hoffset, int *voffset, - int *hppi, int *vppi); -static int is_valid_hdc (HDC hdc); -static void RestorePageMargins (const char *attrib, PAGESETUPDLG *pgdlg); - -/* New functions from Mark Roseman. */ -static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char * argv); -static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, const char * argv); -static int PrintClose(ClientData data, Tcl_Interp *interp, int argc, const char * argv); -static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char * argv); -static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * argv); -static int PrintPage(ClientData data, Tcl_Interp *interp, int argc, const char * argv); -static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char * argv); -static int PrintOption(ClientData data, Tcl_Interp *interp, int argc, const char * argv); -static int JobInfo(int state, const char *name, const char * outname); -/* End new functions. */ - -/* Functions to give printer contexts names. */ -static void init_printer_dc_contexts(Tcl_Interp *interp); -static void delete_printer_dc_contexts(Tcl_Interp *inter); -static const char *make_printer_dc_name(Tcl_Interp *interp, HDC hdc, struct printer_values *pv); -static int printer_name_valid(Tcl_Interp *interp, const char *name); -static HDC get_printer_dc(Tcl_Interp *interp, const char *string); -static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, int wildcard); - - -/* - * Internal static data structures (ClientData) - */ -static char msgbuf[255+1]; -int autoclose = 1; /* Default is old behavior--one open printer at a time. */ - -static struct { - char *tmpname; -} option_defaults = - { - 0 - }; - -/* - *---------------------------------------------------------------------- - * - * ReportWindowsError -- - * - * This function sets the Tcl error code to the provided - Windows error message in the default language. - * - * Results: - * Sets error code. - * - *---------------------------------------------------------------------- - */ - -static void ReportWindowsError(Tcl_Interp * interp, DWORD errorCode) -{ - LPVOID lpMsgBuf; - FormatMessage( - FORMAT_MESSAGE_ALLOCATE_BUFFER | - FORMAT_MESSAGE_FROM_SYSTEM | - FORMAT_MESSAGE_IGNORE_INSERTS, - NULL, - errorCode, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language - (LPTSTR) &lpMsgBuf, - 0, - NULL - ); - Tcl_AppendResult(interp,(char *)lpMsgBuf,0); - /* Free the buffer. */ - LocalFree(lpMsgBuf); - -} - -/* - * The following two functions manage the hash table for - * attribute/value pairs. - * The keys are assumed managed by the Hash structure, but the - * values are 'strdup'ed, and managed by these routines. - * Other than cleanup, there seems to be no reason to delete attributes, - * so this part is ignored. - */ - -/* - *---------------------------------------------------------------------- - * - * set_attribute -- - * - * Sets the value of a printer attribute. - * - * Results: - * Sets attribute. - * - *---------------------------------------------------------------------- - */ - - -static const char *set_attribute(Tcl_HashTable *att, const char *key, const char *value) -{ - Tcl_HashEntry *data; - int status; - char *val = 0; - - data = Tcl_CreateHashEntry(att, key, &status); - if (status == 0) /* Already existing item!. */ - if ((val = (char *)Tcl_GetHashValue(data)) != 0) - Tcl_Free(val); - - /* In any case, now set the new value. */ - if (value != 0 && (val = (char *)Tcl_Alloc(strlen(value)+1)) != 0) - { - strcpy (val, value); - Tcl_SetHashValue(data, val); - } - return val; -} - -/* - *---------------------------------------------------------------------- - * - * get_attribute -- - * - * Retrieve the value of a printer attribute. - * - * Results: - * Gets attribute. - * - *---------------------------------------------------------------------- - */ - -static const char *get_attribute(Tcl_HashTable *att, const char *key) -{ - Tcl_HashEntry *data; - - if ((data = Tcl_FindHashEntry(att, key)) != 0) - return (char *)Tcl_GetHashValue(data); - return 0; -} +#include -/* - *---------------------------------------------------------------------- - * - * del_attribute -- - * - * Remove a printer attribute key/value from the hash table. - * - * Results: - * Removes attribute. - * - *---------------------------------------------------------------------- - */ - - -static int del_attribute(Tcl_HashTable *att, const char *key) -{ - Tcl_HashEntry *data; - - if ((data = Tcl_FindHashEntry(att, key)) != 0) - { - char *val; - if ((val = (char *)Tcl_GetHashValue(data)) != 0) - Tcl_Free(val); - Tcl_DeleteHashEntry(data); - return 1; - } - return 0; -} -/* - *---------------------------------------------------------------------- - * - * is_valid_printer_values -- - * - * This function verifies that there is a printer values structure, - * and that it has the magic number in it. - * - * Results: - * Verifies printer structure. - * - *---------------------------------------------------------------------- - */ - -static int is_valid_printer_values (const struct printer_values *ppv) -{ - if (ppv && ppv->magic == PVMAGIC) - return 1; - return 0; -} +/* Initialize variables for later use. */ +Tcl_HashTable *attribs; +static PRINTDLG pd; +static PAGESETUPDLG pgdlg; +static DOCINFO di; +static int PrintSelectPrinter( Tcl_Interp *interp ); -/* - *---------------------------------------------------------------------- +/*---------------------------------------------------------------------- * - * make_printer_values -- + * PrintSelectPrinter-- * - * Create and initialize a printer_values structure. + * Main dialog for selecting printer and initializing data for print job. * * Results: - * Create printer structure. + * Printer selected. * *---------------------------------------------------------------------- */ -static struct printer_values *make_printer_values(HDC hdc) +static int PrintSelectPrinter( Tcl_Interp *interp ) { - struct printer_values *ppv; - if ((ppv = (struct printer_values *)Tcl_Alloc(sizeof(struct printer_values))) == 0) - return 0; - memset(ppv, 0, sizeof(struct printer_values)); - ppv->magic = PVMAGIC; - ppv->hDC = hdc; - Tcl_InitHashTable(&(ppv->attribs), TCL_STRING_KEYS); - return ppv; -} - -/* - *---------------------------------------------------------------------- - * - * delete_printer_values -- - * - * Cleans up a printer_values structure. - * - * Results: - * Cleans printer structure. - * - *---------------------------------------------------------------------- - */ + HDC hDC; + PDEVMODE returnedDevmode; + PDEVMODE localDevmode; + LPWSTR localPrinterName; + int copies, paper_width, paper_height, dpi_x, dpi_y, new; + Tcl_HashEntry *hPtr; -static void delete_printer_values (struct printer_values *ppv) -{ - if (is_valid_printer_values(ppv)) - { - ppv->magic = 0L; /* Prevent re-deletion.... */ - Tcl_DeleteHashTable(&ppv->attribs); - if (ppv->pdevmode) { - Tcl_Free((char *) ppv->pdevmode); - ppv->pdevmode = 0; - } - Tcl_Free((char *)ppv); - } -} + returnedDevmode = NULL; + localDevmode = NULL; + localPrinterName = NULL; + copies, paper_width, paper_height, dpi_x, dpi_y, new = 0; -/* - *---------------------------------------------------------------------- - * - * GetPrinterWithName -- - * - * Returns the triple needed for creating a DC. - * - * Results: - * Returns data to create device context. - * - *---------------------------------------------------------------------- - */ + /* Set up print dialog and initalize property structure. */ -static int GetPrinterWithName(char *name, LPSTR *dev, LPSTR *dvr, LPSTR *port, int wildcard) -{ - - /* Win32 implementation uses EnumPrinters. */ - - /* There is a hint in the documentation that this info is stored in the registry. - * if so, that interface would probably be even better! - * NOTE: This implementation was suggested by Brian Griffin , - * and replaces the older implementation which used PRINTER_INFO_4,5. - */ - { - DWORD bufsiz = 0; - DWORD needed = 0; - DWORD num_printers = 0; - PRINTER_INFO_2 *ary = 0; - DWORD i; - - /* First, get the size of array needed to enumerate the printers. */ - if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, - NULL, - 2, (LPBYTE)ary, - bufsiz, &needed, - &num_printers) == FALSE) - { - /* Expected failure--we didn't allocate space. */ - DWORD err = GetLastError(); - /* If the error isn't insufficient space, we have a real problem. */ - if (err != ERROR_INSUFFICIENT_BUFFER) - return 0; - } - - /* Now that we know how much, allocate it. */ - if (needed > 0 && (ary = (PRINTER_INFO_2 *)Tcl_Alloc(needed)) != 0) - bufsiz = needed; + ZeroMemory( &pd, sizeof(pd)); + pd.lStructSize = sizeof(pd); + pd.hwndOwner = GetDesktopWindow(); + pd.Flags = PD_RETURNDC | PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; + + if (PrintDlg(&pd) == TRUE) { + hDC = pd.hDC; + if (hDC == NULL) { + Tcl_AppendResult(interp, "can't allocate printer DC", NULL); + return TCL_ERROR; + } + + /*Get document info.*/ + ZeroMemory( &di, sizeof(di)); + di.cbSize = sizeof(di); + di.lpszDocName = "Tk Output"; + + + /* Copy print attributes to local structure. */ + returnedDevmode = (PDEVMODE)GlobalLock(pd.hDevMode); + localDevmode = (LPDEVMODE)HeapAlloc( + GetProcessHeap(), + HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, + returnedDevmode->dmSize); + + if (NULL != localDevmode) + { + memcpy( + (LPVOID)localDevmode, + (LPVOID)returnedDevmode, + returnedDevmode->dmSize); + /* Get printer name and number of copies set by user. */ + localPrinterName = localDevmode->dmDeviceName; + copies = pd.nCopies; + } else - return 0; - - if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, - 2, (LPBYTE)ary, - bufsiz, &needed, - &num_printers) == FALSE) - { - /* Now we have a real failure! */ - return 0; - } - - for (i=0; ihDC == NULL) - { - /* - * Use the name to create a DC if at all possible: - * This may require using the printer list and matching on the name. - */ - char *dev, *dvr, *port; - if (GetPrinterWithName ((char *)printer_name, &dev, &dvr, &port, 1) == 0) { - return GETDEFAULTS_NOSUCHPRINTER; /* Can't find a printer with that name. */ - } - if ((ppv->hDC = CreateDC(dvr, dev, NULL, NULL)) == NULL) { - return GETDEFAULTS_CANTCREATEDC; /* Can't get defaults on non-existent DC. */ - } - if (OpenPrinter((char *)printer_name, &pHandle, NULL) == 0) { - return GETDEFAULTS_CANTOPENPRINTER; - } - } - - /* Use DocumentProperties to get the default devmode. */ - if (set_default_devmode > 0 || ppv->pdevmode == 0) - /* First get the required size. */ - { - LONG siz = 0L; - - char *cp; - - siz = DocumentProperties (GetActiveWindow(), - pHandle, - (char *)printer_name, - NULL, - NULL, - 0); - - if (siz > 0 && (cp = Tcl_Alloc(siz)) != 0) - { - if ((siz = DocumentProperties (GetActiveWindow(), - pHandle, - (char *)printer_name, - (DEVMODE *)cp, - NULL, - DM_OUT_BUFFER)) >= 0) - { - if (ppv->pdevmode != 0) - Tcl_Free ((char *)(ppv->pdevmode)); - ppv->pdevmode = (DEVMODE *)cp; - SetDevModeAttribs (&ppv->attribs, ppv->pdevmode); - } else { - /* added 8/7/02 by Jon Hilbert - This call may fail when the printer is known to Windows but unreachable - for some reason (e.g. network sharing property changes). Add code to - test for failures here.. */ - /* call failed -- get error code. */ - ppv->errorCode = GetLastError(); - result = GETDEFAULTS_WINDOWSERROR; - /* release the DC. */ - DeleteDC(ppv->hDC); - ppv->hDC = 0; - } - } - } - if (pHandle) - ClosePrinter(pHandle); - - if (result == 1) /* Only do this if the attribute setting code succeeded. */ - SetHDCAttribs (&ppv->attribs, ppv->hDC); - - return result; /* A return of 0 or less indicates failure. */ -} - -/* - *---------------------------------------------------------------------- - * - * MakeDevMode -- - * - * Creates devmode structure for printer. - * - * Results: - * Sets structure. - * - *---------------------------------------------------------------------- - */ - - -static void MakeDevmode (struct printer_values *ppv, HANDLE hdevmode) -{ - DEVMODE *pdm; - - if (ppv->pdevmode) - { - Tcl_Free((char *)(ppv->pdevmode)); - ppv->pdevmode = 0; - } - - if ((pdm = (DEVMODE *)GlobalLock(hdevmode)) != NULL) - { - if ((ppv->pdevmode = (DEVMODE *)Tcl_Alloc(pdm->dmSize + pdm->dmDriverExtra)) != NULL) - memcpy (ppv->pdevmode, pdm, pdm->dmSize + pdm->dmDriverExtra); - GlobalUnlock(hdevmode); + { + localDevmode = NULL; + } + if (pd.hDevMode !=NULL) + { + GlobalFree(pd.hDevMode); + } } -} - -/* - *---------------------------------------------------------------------- - * - * CopyDevname -- - * - * Unlock and copy the devnames portion of the printer dialog. - * - * Results: - * Returns devnames. - * - *---------------------------------------------------------------------- - */ - -static void CopyDevnames (struct printer_values *ppv, HANDLE hdevnames) -{ - DEVNAMES *pdn; + + /* + * Get printer resolution and paper size. + */ + dpi_x = GetDeviceCaps(hDC, LOGPIXELSX); + dpi_y = GetDeviceCaps(hDC, LOGPIXELSY); + paper_width = GetDeviceCaps(hDC, PHYSICALWIDTH); + paper_height = GetDeviceCaps(hDC, PHYSICALHEIGHT); + + /* + * Store print properties in hash table and link variables + * so they can be accessed from script level. + */ + hPtr = Tcl_CreateHashEntry (attribs, "hDC", &new); + Tcl_SetHashValue (hPtr, &hDC); + hPtr = Tcl_CreateHashEntry (attribs, "copies", &new); + Tcl_SetHashValue (hPtr, &copies); + Tcl_LinkVar(interp, "::tk::print::copies", &copies, TCL_LINK_INT); + hPtr = Tcl_CreateHashEntry (attribs, "dpi_x", &new); + Tcl_SetHashValue (hPtr, &dpi_x); + Tcl_LinkVar(interp, "::tk::print::dpi_x", &dpi_x, TCL_LINK_INT); + hPtr = Tcl_CreateHashEntry (attribs, "dpi_y", &new); + Tcl_SetHashValue (hPtr, &dpi_y); + Tcl_LinkVar(interp, "::tk::print::dpi_y", &dpi_y, TCL_LINK_INT); + hPtr = Tcl_CreateHashEntry (attribs, "paper_width", &new); + Tcl_SetHashValue (hPtr, &paper_width); + Tcl_LinkVar(interp, "::tk::print::paper_width", &paper_width, TCL_LINK_INT); + hPtr = Tcl_CreateHashEntry (attribs, "paper_height", &new); + Tcl_SetHashValue (hPtr, &paper_height); + Tcl_LinkVar(interp, "::tk::print::paper_height", &paper_height, TCL_LINK_INT); - if ((pdn = (DEVNAMES *)GlobalLock(hdevnames)) != NULL) - { - strcpy(ppv->devnames_filename, (char *)pdn + pdn->wDriverOffset); - strcpy(ppv->devnames_printername, (char *)pdn + pdn->wDeviceOffset); - if (ppv && ppv->pdevmode) { - /* As reported by Steve Bold, protect against unusually long printer names. */ - strncpy((char* restrict)ppv->pdevmode->dmDeviceName, (char *)pdn + pdn->wDeviceOffset,sizeof(ppv->pdevmode->dmDeviceName)); - ppv->pdevmode->dmDeviceName[sizeof(ppv->pdevmode->dmDeviceName)-1] = '\0'; - } - strcpy(ppv->devnames_port, (char *)pdn + pdn->wOutputOffset); - GlobalUnlock(hdevnames); - } + return TCL_OK; } -/* A macro for converting 10ths of millimeters to 1000ths of inches. */ -#define MM_TO_MINCH(x)((x) / 0.0254) -#define TENTH_MM_TO_MINCH(x)((x) / 0.254) -#define MINCH_TO_TENTH_MM(x)(0.254 * (x)) - - -static const struct paper_size { int size; long wid; long len; } paper_sizes[] = { - { DMPAPER_LETTER, 8500, 11000 }, - { DMPAPER_LEGAL, 8500, 14000 }, - { DMPAPER_A4, (long)(8267.72), (long)(11692.91) }, - { DMPAPER_CSHEET, 17000, 22000 }, - { DMPAPER_DSHEET, 22000, 34000 }, - { DMPAPER_ESHEET, 34000, 44000 }, - { DMPAPER_LETTERSMALL, 8500, 11000 }, - { DMPAPER_TABLOID, 11000, 17000 }, - { DMPAPER_LEDGER, 17000, 11000 }, - { DMPAPER_STATEMENT, 5500, 8500 }, - { DMPAPER_A3, (long)(11692.91), (long)(16535.43) }, - { DMPAPER_A4SMALL, (long)(8267.72), (long)(11692.91) }, - { DMPAPER_A5, (long)(5826.77), (long)(8267.72) }, - { DMPAPER_B4, (long)(9842.52), (long)(13937) }, - { DMPAPER_B5, (long)(7165.35), (long)(10118.11) }, - { DMPAPER_FOLIO, 8500, 13000 }, - { DMPAPER_QUARTO, (long)(8464.57), (long)(10826.77) }, - { DMPAPER_10X14, 10000, 14000 }, - { DMPAPER_11X17, 11000, 17000 }, - { DMPAPER_NOTE, 8500, 11000 }, - { DMPAPER_ENV_9, 3875, 8875 }, - { DMPAPER_ENV_10, 4125, 9500 }, - { DMPAPER_ENV_11, 4500, 10375 }, - { DMPAPER_ENV_12, 4750, 11000 }, - { DMPAPER_ENV_14, 5000, 11500 }, - { DMPAPER_ENV_DL, (long)(4330.71), (long)(8661.42) }, - { DMPAPER_ENV_C5, (long)(6377.95), (long)(9015.75) }, - { DMPAPER_ENV_C3, (long)(12755.91), (long)(18031.5) }, - { DMPAPER_ENV_C4, (long)(9015.75), (long)(12755.91) }, - { DMPAPER_ENV_C6, (long)(4488.19), (long)(6377.95) }, - { DMPAPER_ENV_C65, (long)(4488.19), (long)(9015.75) }, - { DMPAPER_ENV_B4, (long)(9842.52), (long)(13897.64) }, - { DMPAPER_ENV_B5, (long)(6929.13), (long)(9842.52) }, - { DMPAPER_ENV_B6, (long)(6929.13), (long)(4921.26) }, - { DMPAPER_ENV_ITALY, (long)(4330.71), (long)(9055.12) }, - { DMPAPER_ENV_MONARCH, 3825, 7500 }, - { DMPAPER_ENV_PERSONAL, 3625, 6500 }, - { DMPAPER_FANFOLD_US, 14825, 11000 }, - { DMPAPER_FANFOLD_STD_GERMAN, 8500, 12000 }, - { DMPAPER_FANFOLD_LGL_GERMAN, 8500, 13000 }, -}; - - -/* - *---------------------------------------------------------------------- - * - * GetDevModeAttribs -- - * - * Sets the devmode copy based on the attributes (syncronization). - * - * Results: - * Sets devmode copy. - * - *---------------------------------------------------------------------- - */ - -static void GetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) -{ - /* This function sets the devmode based on the attributes. - * The attributes set are: - * page orientation - * Paper sizes (Added 8/1/02 by Jon Hilbert) - * - * Still needed: - * Scale - * Paper names - * Print quality - * duplexing - * font downloading - * collation - * gray scale - * ??Print to file - * - * Taken care of elsewhere - * #copies - . */ - const char *cp; - - if (cp = get_attribute(att, "page orientation")) - { - dm->dmFields |= DM_ORIENTATION; - if (strcmp(cp, "portrait") == 0) - dm->dmOrientation = DMORIENT_PORTRAIT; - else - dm->dmOrientation = DMORIENT_LANDSCAPE; - } - /* -------------- added 8/1/02 by Jon Hilbert; modified 2/24/03 by Jon Hilbert. */ - else if (cp = get_attribute(att, "page dimensions")) - { - long width,length; - dm->dmFields |= (DM_PAPERLENGTH | DM_PAPERWIDTH | DM_PAPERSIZE); - sscanf(cp, "%ld %ld", &width, &length); - dm->dmPaperWidth = (short)MINCH_TO_TENTH_MM(width); - dm->dmPaperLength = (short)MINCH_TO_TENTH_MM(length); - /* Indicate that size is specified by dmPaperWidth,dmPaperLength. */ - dm->dmPaperSize = 0; - } -} /* - *---------------------------------------------------------------------- + * ---------------------------------------------------------------------- * - * SetDevModeAttribs -- + * PrintInit -- * - * Copy attributes from devmode in dialog to attribute hash table. + * Initialize this package and create script-level commands. * * Results: - * Sets attributes. + * Initialization of code. * - *---------------------------------------------------------------------- + * ---------------------------------------------------------------------- */ -static void SetDevModeAttribs (Tcl_HashTable *att, DEVMODE *dm) -{ - char tmpbuf[2*11+2+1]; - - /* - * Some printers print multiple copies--if so, the devmode carries the number - * of copies, while ppv->pdlg->nCopies may be set to one. - * We wish the user to see the number of copies. - */ - sprintf(tmpbuf, "%d", dm->dmCopies); - set_attribute(att, "copies", tmpbuf); - - /* Everything depends on what flags are set. */ - if (dm->dmDeviceName[0]) - { - const char * devicename; - devicename = dm->dmDeviceName; - set_attribute(att, "device", devicename); - } - if (dm->dmFields & DM_ORIENTATION) - { - set_attribute(att, "page orientation", - dm->dmOrientation==DMORIENT_PORTRAIT?"portrait":"landscape"); - } - if (dm->dmFields & DM_YRESOLUTION) - { - sprintf(tmpbuf, "%d %d", dm->dmYResolution, dm->dmPrintQuality); - set_attribute(att, "resolution", tmpbuf); - } - else if (dm->dmFields & DM_PRINTQUALITY) - { - /* The result may be positive (DPI) or negative (preset value). */ - if (dm->dmPrintQuality > 0) - { - sprintf(tmpbuf, "%d %d", dm->dmPrintQuality, dm->dmPrintQuality); - set_attribute(att, "resolution", tmpbuf); - } - else - { - static struct PrinterQuality { - short res; - const char *desc; - } print_quality[] = - { - { DMRES_HIGH, "High" }, - { DMRES_MEDIUM, "Medium" }, - { DMRES_LOW, "Low" }, - { DMRES_DRAFT, "Draft" } - }; - unsigned int i; - const char *cp = "Unknown"; - - for (i = 0; i < sizeof(print_quality) / sizeof(struct PrinterQuality); i++) - { - if (print_quality[i].res == dm->dmPrintQuality) - { - cp = print_quality[i].desc; - break; - } - } - set_attribute(att, "resolution", cp); - } - } - - /* If the page size is provided by the paper size, use the page size to update - * the previous size from the HDC. - */ - if ((dm->dmFields & DM_PAPERLENGTH) && (dm->dmFields & DM_PAPERWIDTH)) - { - sprintf(tmpbuf, "%ld %ld", (long)TENTH_MM_TO_MINCH(dm->dmPaperWidth), - (long)TENTH_MM_TO_MINCH(dm->dmPaperLength)); - set_attribute(att, "page dimensions", tmpbuf); - } - else if (dm->dmFields & DM_PAPERSIZE) - { - /* If we are in this case, we must also check for landscape vs. portrait; - * unfortunately, Windows does not distinguish properly in this subcase - */ - unsigned int i; - for (i=0; i < sizeof(paper_sizes)/sizeof (struct paper_size); i++) - { - if (paper_sizes[i].size == dm->dmPaperSize) - { - if (dm->dmOrientation == DMORIENT_PORTRAIT) - { - sprintf(tmpbuf, "%ld %ld", paper_sizes[i].wid, paper_sizes[i].len); - set_attribute(att, "page dimensions", tmpbuf); - } - else if (dm->dmOrientation == DMORIENT_LANDSCAPE) - { - sprintf(tmpbuf, "%ld %ld", paper_sizes[i].len, paper_sizes[i].wid); - set_attribute(att, "page dimensions", tmpbuf); - } - } - } - } -} - -/* - *---------------------------------------------------------------------- - * - * SetDevNamesAttribs -- - * - * Converts dialog terms to attributes. - * - * Results: - * Sets attributes. - * - *---------------------------------------------------------------------- - */ - -static void SetDevNamesAttribs (Tcl_HashTable *att, struct printer_values *dn) +int +Winprint_Init( + Tcl_Interp * interp) { - /* Set the "device", "driver" and "port" attributes - (belt and suspenders). */ - if (dn->devnames_printername != NULL && strlen(dn->devnames_printername) > 0) - set_attribute(att,"device",dn->devnames_printername); - if (dn->devnames_filename != NULL && strlen(dn->devnames_filename)>0) - set_attribute(att,"driver",dn->devnames_filename); - if (dn->devnames_port != NULL && strlen(dn->devnames_port)>0) - set_attribute(att,"port",dn->devnames_port); -} - -/* - *---------------------------------------------------------------------- - * - * GetPageDlgAttribs -- - * - * Gets page dialog attributes. - * - * Results: - * Gets attributes. - * - *---------------------------------------------------------------------- - */ -static void GetPageDlgAttribs (Tcl_HashTable *att, PAGESETUPDLG *pgdlg) -{ - const char *cp; - - if (cp = get_attribute(att, "page margins")) { - RestorePageMargins(cp, pgdlg); - } - + Tcl_InitHashTable(&attribs, TCL_ONE_WORD_KEYS); + return TCL_OK; } /* - *---------------------------------------------------------------------- - * - * GetPrintDlgAttribs-- - * - * Gets print dialog attributes. - * - * Results: - * Gets attributes. - * - *---------------------------------------------------------------------- - */ - -static void GetPrintDlgAttribs (Tcl_HashTable *att, PRINTDLG *pdlg) -{ - const char *cp; - - if (cp = get_attribute(att, "copies")) - pdlg->nCopies = atoi(cp); - - /* Add minimum and maximum page numbers to enable print page selection. */ - if (cp = get_attribute(att, "minimum page")) - { - pdlg->nMinPage = atoi(cp); - if (pdlg->nMinPage <= 0) - pdlg->nMinPage = 1; - } - - if (cp = get_attribute(att, "maximum page")) - { - pdlg->nMaxPage = atoi(cp); - if (pdlg->nMaxPage < pdlg->nMinPage) - pdlg->nMaxPage = pdlg->nMinPage; - } - - if (cp = get_attribute(att, "first page")) - { - pdlg->nFromPage = atoi(cp); - if (pdlg->nFromPage > 0) - { - pdlg->Flags &= (~PD_ALLPAGES); - pdlg->Flags |= PD_PAGENUMS; - if (pdlg->nMinPage > pdlg->nFromPage) - pdlg->nMinPage = 1; - } - } - - if (cp = get_attribute(att, "last page")) - { - pdlg->nToPage = atoi(cp); - if (pdlg->nToPage > 0) - { - pdlg->Flags &= (~PD_ALLPAGES); - pdlg->Flags |= PD_PAGENUMS; - if (pdlg->nMaxPage < pdlg->nToPage) - pdlg->nMaxPage = pdlg->nToPage; - } - } - - /* Added to match the radiobuttons on the windows dialog. */ - if (cp = get_attribute(att, "print flag")) - { - if (lstrcmpi(cp, "all") == 0) - pdlg->Flags &= (~(PD_PAGENUMS|PD_SELECTION)); - else if (lstrcmpi(cp, "selection") == 0) - { - pdlg->Flags |= PD_SELECTION; - pdlg->Flags &= (~(PD_PAGENUMS|PD_NOSELECTION)); - } - else if (lstrcmpi(cp, "pagenums") == 0) - { - pdlg->Flags |= PD_PAGENUMS; - pdlg->Flags &= (~(PD_SELECTION|PD_NOPAGENUMS)); - } - } -} - -/* - *---------------------------------------------------------------------- - * - * SetPrintDlgAttribs-- - * - * Sets print dialog attributes. - * - * Results: - * Sets attributes. - * - *---------------------------------------------------------------------- - */ - -static void SetPrintDlgAttribs (Tcl_HashTable *att, PRINTDLG *pdlg) -{ - char tmpbuf[11+1]; - - /* - * This represents the number of copies the program is expected to spool - * (e.g., if collation is on) - . */ - sprintf(tmpbuf, "%d", pdlg->nCopies); - set_attribute(att, "copiesToSpool", tmpbuf); - - /* Set the to and from page if they are nonzero. */ - if (pdlg->nFromPage > 0) - { - sprintf(tmpbuf, "%d", pdlg->nFromPage); - set_attribute(att, "first page", tmpbuf); - } - - if (pdlg->nToPage > 0) - { - sprintf(tmpbuf, "%d", pdlg->nToPage); - set_attribute(att, "last page", tmpbuf); - } - - if (pdlg->Flags & PD_PAGENUMS) - set_attribute(att, "print flag", "pagenums"); - else if (pdlg->Flags & PD_SELECTION) - set_attribute(att, "print flag", "selection"); - else if ((pdlg->Flags & (PD_PAGENUMS | PD_SELECTION)) == 0) - set_attribute(att, "print flag", "all"); -} - -/* - *---------------------------------------------------------------------- - * - * SetPageSetupDlgAttribs-- - * - * Sets page setup dialog attributes. - * - * Results: - * Sets attributes. - * - *---------------------------------------------------------------------- - */ - -static void SetPageSetupDlgAttribs (Tcl_HashTable *att, PAGESETUPDLG *pgdlg) -{ - char tmpbuf[4*11 + 3 + 1]; - /* According to the PAGESETUPDLG page, the paper size and margins may be - * provided in locale-specific units. We want thousandths of inches - * for consistency at this point. Look for the flag: - . */ - int metric = (pgdlg->Flags & PSD_INHUNDREDTHSOFMILLIMETERS)?1:0; - double factor = 1.0; - - if (metric) - factor = 2.54; - - sprintf(tmpbuf, "%ld %ld", (long)(pgdlg->ptPaperSize.x / factor), - (long)(pgdlg->ptPaperSize.y / factor)); - set_attribute(att, "page dimensions", tmpbuf); - sprintf(tmpbuf, "%ld %ld %ld %ld", (long)(pgdlg->rtMargin.left / factor), - (long)(pgdlg->rtMargin.top / factor), - (long)(pgdlg->rtMargin.right / factor), - (long)(pgdlg->rtMargin.bottom / factor)); - set_attribute(att, "page margins", tmpbuf); - sprintf(tmpbuf, "%ld %ld %ld %ld", (long)(pgdlg->rtMinMargin.left / factor), - (long)(pgdlg->rtMinMargin.top / factor), - (long)(pgdlg->rtMinMargin.right / factor), - (long)(pgdlg->rtMinMargin.bottom / factor)); - set_attribute(att, "page minimum margins", tmpbuf); -} - -/* - *---------------------------------------------------------------------- - * - * SetHDCAttribs -- - * - * Sets HDC attributes. - * - * Results: - * Sets attributes. - * - *---------------------------------------------------------------------- - */ - -static void SetHDCAttribs (Tcl_HashTable *att, HDC hDC) -{ - char tmpbuf[2*11+2+1]; - int hsize, vsize, hscale, vscale, hoffset, voffset, hppi, vppi; - - sprintf(tmpbuf, "0x%lx", (long) hDC); - set_attribute(att, "hDC", tmpbuf); - - if (PrintPageAttr(hDC, &hsize, &vsize, - &hscale, &vscale, - &hoffset, &voffset, - &hppi, &vppi) == 0 && - hppi > 0 && vppi > 0) - { - sprintf(tmpbuf, "%d %d", (int)(hsize*1000L/hppi), (int)(vsize*1000L/vppi)); - set_attribute(att, "page dimensions", tmpbuf); - sprintf(tmpbuf, "%d %d", hppi, vppi); - set_attribute(att, "pixels per inch", tmpbuf); - - /* Perhaps what's below should only be done if not already set.... */ - sprintf(tmpbuf, "%d %d %d %d", (int)(hoffset*1000L/hppi), (int)(voffset*1000L/vppi), - (int)(hoffset*1000L/hppi), (int)(voffset*1000L/vppi)); - set_attribute(att, "page minimum margins", tmpbuf); - set_attribute(att, "page margins", "1000 1000 1000 1000"); - } -} - - -/* - *---------------------------------------------------------------------- - * - * StorePrintVals -- - * - * Stores the new DEVMODE and DEVNAMES structures - * if needed, and converts relevant portions of the structures - * to attribute/value pairs. - * - * Results: - * Sets attributes. - * - *---------------------------------------------------------------------- - */ - -static void StorePrintVals(struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg) -{ - - /* - * If pdlg or pgdlg are nonzero, attribute/value pairs are - * extracted from them as well. - * A companion function is intended to convert attribute/value - * pairs in the ppv->attribs hash table to set the appropriate - * dialog values. - * All values in the hash table are strings to simplify getting - * and setting by the user; the job of converting to and from - * the platform-specific notion is left to the conversion function. - */ - - /* First, take care of the hDC structure. */ - if (pdlg != NULL) - { - const char *cp; - if (ppv->hDC != NULL) - { - delete_dc (ppv->hDC); - DeleteDC(ppv->hDC); - } - if (ppv->hdcname[0] != '\0') - { - if (hdc_delete) - hdc_delete(0, ppv->hdcname); - ppv->hdcname[0] = '\0'; - } - ppv->hDC = pdlg->hDC; - /* Only need to do this if the hDC has changed. */ - if (ppv->hDC) - { - SetHDCAttribs(&ppv->attribs, ppv->hDC); - if (cp = make_printer_dc_name(0, ppv->hDC, ppv)) - { - strncpy(ppv->hdcname, cp, sizeof (current_printer_values->hdcname)); - set_attribute(&ppv->attribs, "hdcname", cp); - } - ppv->hdcname[sizeof (current_printer_values->hdcname) - 1] = '\0'; - } - } - - /* Next, get the DEVMODE out of the pdlg if present; - * if not, try the page dialog; if neither, skip this step. - */ - if (pdlg != NULL && pdlg->hDevMode != NULL) - { - MakeDevmode(ppv, pdlg->hDevMode); - GlobalFree(pdlg->hDevMode); - pdlg->hDevMode = NULL; - SetDevModeAttribs(&ppv->attribs, ppv->pdevmode); - } - else if (pgdlg != NULL && pgdlg->hDevMode != NULL) - { - MakeDevmode (ppv, pgdlg->hDevMode); - GlobalFree(pgdlg->hDevMode); - pgdlg->hDevMode = NULL; - SetDevModeAttribs(&ppv->attribs, ppv->pdevmode); - } - - /* Next, get the DEVNAMES out of the pdlg if present; - * if not, try the page dialog; if neither, skip this step - . */ - if (pdlg != NULL && pdlg->hDevNames != NULL) - { - CopyDevnames(ppv, pdlg->hDevNames); - GlobalFree(pdlg->hDevNames); - pdlg->hDevNames = NULL; - SetDevNamesAttribs(&ppv->attribs, ppv); - } - else if (pgdlg != NULL && pgdlg->hDevNames != NULL) - { - CopyDevnames(ppv, pgdlg->hDevNames); - GlobalFree(pgdlg->hDevNames); - pgdlg->hDevNames = NULL; - SetDevNamesAttribs(&ppv->attribs, ppv); - } - - /* Set attributes peculiar to the print dialog. */ - if (pdlg != NULL) - SetPrintDlgAttribs(&ppv->attribs, pdlg); - - /* Set attributes peculiar to the page setup dialog. */ - if (pgdlg != NULL) - SetPageSetupDlgAttribs(&ppv->attribs, pgdlg); -} - - -/* - *---------------------------------------------------------------------- - * - * RestorePageMargins -- - * - * Restores page margins. - * - * Results: - * Page margins are restored. - * - *---------------------------------------------------------------------- - */ - -static void RestorePageMargins (const char *attrib, PAGESETUPDLG *pgdlg) -{ - - /* - * This function is domain-specific (in the longer term, probably - * an attribute to determine read-only vs. read-write and which - * dialog it's relevant to and a function to do the conversion - * would be appropriate). - * Fix for metric measurements submitted by Michael Thomsen . - */ - RECT r; - double left, top, right, bottom; - - /* According to the PAGESETUPDLG page, the paper size and margins may be - * provided in locale-specific units. We want thousandths of inches - * for consistency at this point. Look for the flag: - . */ - int metric = (default_printer_values.pgdlg.Flags & PSD_INHUNDREDTHSOFMILLIMETERS)?1:0; - double factor = 1.0; - - if (metric) - factor = 2.54; - - if (sscanf(attrib, "%lf %lf %lf %lf", &left, &top, &right, &bottom) == 4) { - r.left = (long) (floor(left * factor + 0.5)); - r.top = (long) (floor(top * factor + 0.5)); - r.right = (long) (floor(right * factor + 0.5)); - r.bottom = (long) (floor(bottom * factor + 0.5)); - pgdlg->rtMargin = r; - pgdlg->Flags |= PSD_MARGINS|PSD_INTHOUSANDTHSOFINCHES; - } -} - -/* - *---------------------------------------------------------------------- - * - * RestorePrintVals -- - * - * Sets the attributes in ppv->attribs into the - * print dialog or page setup dialog as requested. - * - * Results: - * Sets attributes. - * - *---------------------------------------------------------------------- - */ - -static void RestorePrintVals (struct printer_values *ppv, PRINTDLG *pdlg, PAGESETUPDLG *pgdlg) -{ - if (pdlg) - { - /* - * Values to be restored: - * copies - * first page - * last page - . */ - GetPrintDlgAttribs(&ppv->attribs, pdlg); - - /* Note: if DEVMODE is not null, copies is taken from the DEVMODE structure. */ - if (ppv->pdevmode) - ppv->pdevmode->dmCopies = pdlg->nCopies; - - } - - if (pgdlg) - { - /* - * Values to be restored: - * page margins - . */ - GetPageDlgAttribs(&ppv->attribs, pgdlg); - } -} - -/* - * To make the print command easier to extend and administer, - * the subcommands are in a table. - * Since I may not make the correct assumptions about what is - * considered safe and unsafe, this is parameterized in the - * function table. - * For now the commands will be searched linearly (there are only - * a few), but keep them sorted, so a binary search could be used. - */ -typedef int (*tcl_prtcmd) (ClientData, Tcl_Interp *, int, const char *); -struct prt_cmd -{ - const char *name; - tcl_prtcmd func; - int safe; -}; - -static struct prt_cmd printer_commands[] = - { - { "attr", PrintAttr, 1 }, - { "close", PrintClose, 1 }, - { "dialog", PrintDialog, 1 }, - { "job", PrintJob, 1 }, - { "list", PrintList, 1 }, - { "open", PrintOpen, 1 }, - { "option", PrintOption, 0 }, - { "page", PrintPage, 1 }, - { "send", PrintSend, 1 }, - { "version", Version, 1 }, - }; - -/* - * We can also build the global usage message dynamically. - */ -static void top_usage_message(Tcl_Interp *interp, int argc, const char * argv, int safe) -{ - int i; - int last = sizeof printer_commands / sizeof (struct prt_cmd); - int first=1; - Tcl_AppendResult(interp, "printer [", 0); - for (i=0; i < last; i++) - { - if (printer_commands[i].safe >= safe) - { - if (first) - { - Tcl_AppendResult(interp, " ", printer_commands[i].name, 0); - first = 0; - } - else - Tcl_AppendResult(interp, " | ", printer_commands[i].name, 0); - } - if (i == (last - 1)) - Tcl_AppendResult(interp, " ]", 0); - } - if (argc) - { - Tcl_AppendResult(interp, "\n(Bad command: ", 0); - for (i=0; i= safe) { - const char *name = (char *)argv[0]; - const char *cmd = printer_commands[i].name; - if (strcmp(name, cmd) == 0) - return printer_commands[i].func(defaults, interp, argc-1, argv+1); - } - - top_usage_message(interp, argc+1, argv-1, safe); - return TCL_ERROR; -} - - -/* - *---------------------------------------------------------------------- - * - * printer -- - * - * Core command. - * - * Results: - * Executes print command/subcommand. - * - *---------------------------------------------------------------------- - */ - -static int printer (ClientData data, Tcl_Interp *interp, int argc, char * argv) -{ - if (argc > 1) - { - argv++; - argc--; - return Print(data, interp, argc, argv, 0); - } - - top_usage_message(interp, argc, argv, 0); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * Winprint_Init -- - * - * Initializes this command. - * - * Results: - * Command is initialized. - * - *---------------------------------------------------------------------- - */ - -int Winprint_Init(Tcl_Interp * interp) { - - Tcl_CreateObjCommand(interp, "::tk::print::_print", printer, - (ClientData)(& current_printer_values), 0); - - /* Initialize the attribute hash table. */ - init_printer_dc_contexts(interp); - - /* Initialize the attribute hash table. */ - Tcl_InitHashTable(& (current_printer_values -> attribs), TCL_STRING_KEYS); - - /* Initialize the list of HDCs hash table. */ - Tcl_InitHashTable(& printer_hdcs, TCL_ONE_WORD_KEYS); - - /* Initialize the default page settings. */ - current_printer_values -> pgdlg.lStructSize = sizeof(PAGESETUPDLG); - current_printer_values -> pgdlg.Flags |= PSD_RETURNDEFAULT; - - return TCL_OK; -} - - - -/* - *---------------------------------------------------------------------- - * - * SplitDevice -- - * - * Divide the default printing device into its component parts. - * - * Results: - * Device components are returned. - * - *---------------------------------------------------------------------- - */ - -static int SplitDevice(LPSTR device, LPSTR *dev, LPSTR *dvr, LPSTR *port) -{ - static char buffer[256]; - if (device == 0) - { - device = (LPSTR)"WINSPOOL,Postscript,"; - } - - *dev = strtok(device, ","); - *dvr = strtok(NULL, ","); - *port = strtok(NULL, ","); - - if (*dev) - while ( * dev == ' ') - (*dev)++; - if (*dvr) - while ( * dvr == ' ') - (*dvr)++; - if (*port) - while ( * port == ' ') - (*port)++; - - return 1; -} - -/* - *---------------------------------------------------------------------- - * - * GetPrinterDC -- - * - * Build a compatible printer DC for the default printer. - * - * Results: - * Returns DC. - * - *---------------------------------------------------------------------- - */ - - -static HDC GetPrinterDC (const char *printer) -{ - HDC hdcPrint; - - LPSTR lpPrintDevice = ""; - LPSTR lpPrintDriver = ""; - LPSTR lpPrintPort = ""; - - SplitDevice ((LPSTR)printer, &lpPrintDevice, &lpPrintDriver, &lpPrintPort); - - hdcPrint = CreateDC (lpPrintDriver, - lpPrintDevice, - NULL, - NULL); - - return hdcPrint; -} - -/* End of support for file printing. */ - - -/* - *---------------------------------------------------------------------- - * - * PrintStatusToStr -- - * - * Convert a status code to a string. - * Function created by Brian Griffin - * - * Results: - * Returns status code. - * - *---------------------------------------------------------------------- - */ - -static const char *PrintStatusToStr(DWORD status) -{ - switch (status) { - case PRINTER_STATUS_PAUSED: return "Paused"; - case PRINTER_STATUS_ERROR: return "Error"; - case PRINTER_STATUS_PENDING_DELETION: return "Pending Deletion"; - case PRINTER_STATUS_PAPER_JAM: return "Paper jam"; - case PRINTER_STATUS_PAPER_OUT: return "Paper out"; - case PRINTER_STATUS_MANUAL_FEED: return "Manual feed"; - case PRINTER_STATUS_PAPER_PROBLEM: return "Paper problem"; - case PRINTER_STATUS_OFFLINE: return "Offline"; - case PRINTER_STATUS_IO_ACTIVE: return "IO Active"; - case PRINTER_STATUS_BUSY: return "Busy"; - case PRINTER_STATUS_PRINTING: return "Printing"; - case PRINTER_STATUS_OUTPUT_BIN_FULL: return "Output bit full"; - case PRINTER_STATUS_NOT_AVAILABLE: return "Not available"; - case PRINTER_STATUS_WAITING: return "Waiting"; - case PRINTER_STATUS_PROCESSING: return "Processing"; - case PRINTER_STATUS_INITIALIZING: return "Initializing"; - case PRINTER_STATUS_WARMING_UP: return "Warming up"; - case PRINTER_STATUS_TONER_LOW: return "Toner low"; - case PRINTER_STATUS_NO_TONER: return "No toner"; - case PRINTER_STATUS_PAGE_PUNT: return "Page punt"; - case PRINTER_STATUS_USER_INTERVENTION: return "User intervention"; - case PRINTER_STATUS_OUT_OF_MEMORY: return "Out of memory"; - case PRINTER_STATUS_DOOR_OPEN: return "Door open"; - case PRINTER_STATUS_SERVER_UNKNOWN: return "Server unknown"; - case PRINTER_STATUS_POWER_SAVE: return "Power save"; - case 0: return "Ready"; - default: break; - } - return "Unknown"; -} - -/* - *---------------------------------------------------------------------- - * - * PrintList -- - * - * Returns the list of available printers in - * a format convenient for the print command. - * Brian Griffin suggested and implemented - * the -verbose flag, and the new Win32 implementation. - * - * Results: - * Returns printer list. - * - *---------------------------------------------------------------------- - */ - -static int PrintList (ClientData unused, Tcl_Interp *interp, int argc, const char * argv) -{ - char *usgmsg = "::tk::print::_print list [-match matchstring] [-verbose]"; - const char *match = 0; - const char *illegal = 0; - - /* The following 3 declarations are only needed for the Win32s case. */ - static char devices_buffer[256]; - static char value[256]; - char *cp; - - int i; - int verbose = 0; - - for (i=0; i, - * and replaces the older implementation which used PRINTER_INFO_4,5 - . */ - - DWORD bufsiz = 0; - DWORD needed = 0; - DWORD num_printers = 0; - PRINTER_INFO_2 *ary = 0; - DWORD _i; - - /* First, get the size of array needed to enumerate the printers. */ - if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, - NULL, - 2, (LPBYTE)ary, - bufsiz, &needed, - &num_printers) == FALSE) - { - /* Expected failure--we didn't allocate space. */ - DWORD err = GetLastError(); - /* If the error isn't insufficient space, we have a real problem.. */ - if (err != ERROR_INSUFFICIENT_BUFFER) - { - sprintf (msgbuf, "EnumPrinters: unexpected error code: %ld", (long)err); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - return TCL_ERROR; - } - } - - if (needed > 0) { - if ((ary = (PRINTER_INFO_2 *)Tcl_Alloc(needed)) != 0) - bufsiz = needed; - else - { - sprintf (msgbuf, "EnumPrinters: Out of memory in request for %ld bytes", (long)needed); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - return TCL_ERROR; - } - } else { /* No printers to report!. */ - return TCL_OK; - } - - /* Now that we know how much, allocate it -- if there is a printer!. */ - if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_FAVORITE, NULL, - 2, (LPBYTE)ary, - bufsiz, &needed, - &num_printers) == FALSE) - { - /* Now we have a real failure! */ - sprintf(msgbuf, "::tk::print::_print list: Cannot enumerate printers: %ld", (long)GetLastError()); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - return TCL_ERROR; - } - - /* Question for UTF: Do I need to convert all visible output? - * Or just the printer name and location? - . */ - - /* Question for Win95: Do I need to provide the port number?. */ - for (i=0; i 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) - { - const char *ostring; - Tcl_DString tds; - Tcl_DStringInit(&tds); - Tcl_UtfToExternalDString(NULL, ary[i].pPrinterName, -1, &tds); - ostring = Tcl_DStringValue(&tds); - Tcl_AppendElement(interp, ostring); - Tcl_DStringFree(&tds); - } -#else - Tcl_AppendElement(interp, ary[i].pPrinterName); -#endif - Tcl_AppendResult(interp, "} ", 0); - Tcl_AppendResult(interp, "{", 0); - Tcl_AppendElement(interp, "Status"); - Tcl_AppendElement(interp, PrintStatusToStr(ary[i].Status)); - Tcl_AppendResult(interp, "} ", 0); - if (ary[i].pDriverName && ary[i].pDriverName[0] != '\0') - { - Tcl_AppendResult(interp, "{", 0); - Tcl_AppendElement(interp, "Driver"); - Tcl_AppendElement(interp, ary[i].pDriverName); - Tcl_AppendResult(interp, "} ", 0); - } - if (ary[i].pServerName && ary[i].pServerName[0] != '\0') - { - Tcl_AppendResult(interp, "{", 0); - Tcl_AppendElement(interp, "Control"); - Tcl_AppendElement(interp, "Server"); - Tcl_AppendResult(interp, "} ", 0); - Tcl_AppendResult(interp, "{", 0); - Tcl_AppendElement(interp, "Server"); - Tcl_AppendElement(interp, ary[i].pServerName); - Tcl_AppendResult(interp, "} ", 0); - } - else - { - Tcl_AppendResult(interp, "{", 0); - Tcl_AppendElement(interp, "Control"); - Tcl_AppendElement(interp, "Local"); - Tcl_AppendResult(interp, "} ", 0); - Tcl_AppendResult(interp, "{", 0); - Tcl_AppendElement(interp, "Port"); - Tcl_AppendElement(interp, ary[i].pPortName); - Tcl_AppendResult(interp, "} ", 0); - } - if (ary[i].pLocation && ary[i].pLocation[0] != '\0') - { - Tcl_AppendResult(interp, "{", 0); - Tcl_AppendElement(interp, "Location"); -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) - { - const char *ostring; - Tcl_DString tds; - Tcl_DStringInit(&tds); - Tcl_UtfToExternalDString(NULL, ary[i].pLocation, -1, &tds); - ostring = Tcl_DStringValue(&tds); - Tcl_AppendElement(interp, ostring); - Tcl_DStringFree(&tds); - } -#else - Tcl_AppendElement(interp, ary[i].pLocation); -#endif - Tcl_AppendResult(interp, "} ", 0); - } - Tcl_AppendResult(interp, "{", 0); - Tcl_AppendElement(interp, "Queued Jobs"); - sprintf(msgbuf, "%ld", (long)ary[i].cJobs); - Tcl_AppendElement(interp, msgbuf); - Tcl_AppendResult(interp, "} ", 0); - /* End of this printer's list. */ - Tcl_AppendResult(interp, "}\n", 0); - } - else - Tcl_AppendElement(interp, ary[i].pPrinterName); - } - } - Tcl_Free((char *)ary); - return TCL_OK; -} - -#define PRINT_FROM_FILE 0 -#define PRINT_FROM_DATA 1 - -/* - *---------------------------------------------------------------------- - * - * PrintSend -- - * - * Main routine for sending data or files to a printer. - * - * Results: - * Sends data to printer. - * - *---------------------------------------------------------------------- - */ - -static int PrintSend (ClientData defaults, Tcl_Interp *interp, int argc, const char * argv) -{ - static char *usgmsg = - "::tk::print::_print send " - "[-postscript|-nopostscript] " - "[-binary|-ascii] " - "[-printer printer] " - "[-datalen nnnnnn] " - "[-file|-data] file_or_data ... "; - int ps = 0; /* The default is nopostscript. */ - int binary = 1; /* The default is binary. */ - long datalen = 0L; - - const char *printer = 0; - const char *hdcString = 0; - static char last_printer[255+1]; - int debug = 0; - int printtype = PRINT_FROM_FILE; - struct printer_values * ppv = *(struct printer_values *) defaults; - struct printer_values * oldppv = 0; - int self_created = 0; /* Remember if we specially created the DC. */ - int direct_to_port = 0; - HANDLE hdc = NULL; - - while (argc > 0) - { - if (argv[0][0] == '-') - { - /* Check for -postscript / -nopostscript flag. */ - if (strcmp(argv[0], "-postscript") == 0) - ps = 1; - else if (strcmp(argv[0], "-nopostscript") == 0) - ps = 0; - else if (strcmp(argv[0], "-ascii") == 0) - binary = 0; - else if (strcmp(argv[0], "-binary") == 0) - binary = 1; - else if (strcmp(argv[0], "-printer") == 0) - { - argc--; - argv++; - printer = argv[0]; - } - else if (strcmp(argv[0], "-file") == 0) - printtype = PRINT_FROM_FILE; - else if (strcmp(argv[0], "-data") == 0) { - printtype = PRINT_FROM_DATA; - } - else if (strcmp(argv[0], "-datalen") == 0) - { - argc--; - argv++; - datalen = atol(argv[0]); - } - else if (strcmp(argv[0], "-debug") == 0) - debug++; - else if (strcmp(argv[0], "-direct") == 0) - direct_to_port = 1; - } - else - break; - argc--; - argv++; - } - - if (argc <= 0) - { - Tcl_SetResult(interp,usgmsg, TCL_STATIC); - return TCL_ERROR; - } - - - /* - * Ensure we have a good HDC. If not, we'll have to abort. - * First, go by printer name, if provided. - * Next, use the last printer we opened, if any - * Finally, use the default printer. - * If we still don't have a good HDC, we've failed. - * - */ - if (hdc == NULL ) - { - if (printer) - OpenPrinter((char *)printer, &hdc, NULL); - else if (last_printer[0] != '\0') - OpenPrinter(last_printer, &hdc, NULL); - else if (current_printer_values != 0 && current_printer_values->devnames_printername[0] != '\0') - OpenPrinter(current_printer_values->devnames_printername, &hdc, NULL); - else - { - } - - if (hdc == NULL) /* STILL can't get a good printer DC. */ - { - Tcl_SetResult (interp, "Error: Can't get a valid printer context", TCL_STATIC); - return TCL_ERROR; - } - } - - /* Now save off a bit of information for the next call.... */ - if (printer) - strncpy (last_printer, printer, sizeof(last_printer) - 1); - else if (ppv && ppv->devnames_printername[0]) - strncpy (last_printer, ppv->devnames_printername, sizeof(last_printer) - 1); - - /* * - * Everything left is a file or data. Just print it. - * */ - while (argc > 0) - { - static const char init_postscript[] = "\r\nsave\r\ninitmatrix\r\n"; - static const char fini_postscript[] = "\r\nrestore\r\n"; - - const char *docname; - - if (argv[0][0] == '-') { - if (strcmp(argv[0], "-datalen") == 0) - { - argc--; - argv++; - datalen = atol(argv[0]); - continue; - } - else if (strcmp(argv[0], "-file") == 0) { - argc--; - argv++; - printtype = PRINT_FROM_FILE; - continue; - } - else if (strcmp(argv[0], "-data") == 0) { - argc--; - argv++; - printtype = PRINT_FROM_DATA; - continue; - } - } - - switch (printtype) { - case PRINT_FROM_FILE: - docname = argv[0]; - break; - case PRINT_FROM_DATA: - default: - docname = "Tcl Print Data"; - if (datalen == 0L) { - Tcl_AppendResult(interp, "Printer warning: ::tk::print::_print send ... -data requires a -datalen preceding argument. Using strlen as a poor substitute.\n", 0); - datalen = strlen(argv[0]); - } - break; - } - - if (PrintStart(hdc, interp, docname) == 1) { - if (ps) { - DWORD inCount = strlen(init_postscript); - DWORD outCount = 0; - if (WritePrinter(hdc,(LPVOID)init_postscript,inCount,&outCount) == 0 || - inCount != outCount) { - Tcl_AppendResult(interp,"Printer error: Postscript init failed\n", 0); - } - } - - switch (printtype) { - case PRINT_FROM_FILE: - if (PrintRawFileData(hdc,interp,argv[0],binary) == 0) { - Tcl_AppendResult(interp,"Printer error: Could not print file ", argv[0], "\n", 0); - } - break; - case PRINT_FROM_DATA: - default: - if (PrintRawData(hdc,interp,(LPBYTE)argv[0],datalen) == 0) { - Tcl_AppendResult(interp,"Printer error: Could not print raw data\n", 0); - } - datalen=0L; /* reset the data length, so it is not reused. */ - break; - } - - if (ps) { - DWORD inCount = strlen(fini_postscript); - DWORD outCount = 0; - if (WritePrinter(hdc,(LPVOID)fini_postscript,inCount,&outCount) == 0 || - inCount != outCount) { - Tcl_AppendResult(interp,"Printer error: Postscript finish failed\n", 0); - } - } - - PrintFinish(hdc, interp); - } - argv++; - argc--; - } - - ClosePrinter(hdc); - - return TCL_OK; -} - -/* - * Support for file printing - */ - -/* - *---------------------------------------------------------------------- - * - * PrintRawData -- - * - * Prints raw data to a printer. - * - * Results: - * Sends data to printer. - * - *---------------------------------------------------------------------- - */ - -static int PrintRawData (HANDLE printer, Tcl_Interp *interp, LPBYTE lpData, DWORD dwCount) -{ - int retval = 0; - DWORD dwBytesWritten = 0; - - /* Send the data. */ - if (WritePrinter(printer, lpData, dwCount, &dwBytesWritten) == 0) { - /* Error writing the data. */ - Tcl_AppendResult(interp, "Printer error: Cannot write data to printer"); - } else if (dwBytesWritten != dwCount) { - /* Wrong number of bytes were written.... */ - sprintf(msgbuf, "%ld written; %ld requested", dwBytesWritten, dwCount); - Tcl_AppendResult(interp, "Printer error: Wrong number of bytes were written", - msgbuf, "\n", 0); - } else - retval = 1; - - return retval; -} - -/* - *---------------------------------------------------------------------- - * - * PrintRawFileData -- - * - * Prints raw file data to a printer. - * - * Results: - * Sends file data to printer. - * - *---------------------------------------------------------------------- - */ - -static int PrintRawFileData (HANDLE printer, Tcl_Interp *interp, const char *filename, int binary) -{ - int retval = 0; - DWORD dwBytesWritten = 0; - DWORD dwBytesRequested = 0; - - Tcl_Channel channel; - - struct { - WORD len; /* Defined to be 16 bits..... */ - char buffer[128+1]; - } indata; - - if ((channel = Tcl_OpenFileChannel(interp, (char *)filename, "r", 0444)) == NULL) - { - /* Can't open the file!. */ - return 0; - } - - if (binary) - Tcl_SetChannelOption(interp, channel, "-translation", "binary"); - - /* Send the data. */ - while ((indata.len = Tcl_Read(channel, indata.buffer, sizeof(indata.buffer)-1)) > 0) - { - DWORD dwWritten = 0; - dwBytesRequested += indata.len; - indata.buffer[indata.len] = '\0'; - if (WritePrinter(printer, indata.buffer, indata.len, &dwWritten) == 0) - { - /* Error writing the data. */ - Tcl_AppendResult(interp, "Printer error: Can't write data to printer\n", 0); - Tcl_Close(interp, channel); - break; - } - dwBytesWritten += dwWritten; - if (dwWritten != indata.len) { - sprintf(msgbuf, "%ld requested; %ld written", (long)indata.len, dwWritten); - Tcl_AppendResult(interp, "Printer warning: Short write: ", msgbuf, "\n", 0); - } - } - - if (dwBytesWritten == dwBytesRequested) - retval = 1; - - Tcl_Close(interp, channel); - - return retval; -} - -/* - *---------------------------------------------------------------------- - * - * PrintStart -- - * - * Sets up the job and starts the DocPrinter and PagePrinter. - * - * Results: - * Returns 1 upon success, and 0 if anything goes wrong. - * - *---------------------------------------------------------------------- - */ - - -static int PrintStart (HDC printer, Tcl_Interp *interp, const char *docname) -{ - DOC_INFO_1 DocInfo; - DWORD dwJob; - - /* Fill in the document information with the details. */ - if (docname != 0) - DocInfo.pDocName = (LPTSTR)docname; - else - DocInfo.pDocName = (LPTSTR)"Tcl Document"; - DocInfo.pOutputFile = 0; - DocInfo.pDatatype = "RAW"; - - /* Start the job. */ - if ((dwJob = StartDocPrinter(printer, 1, (LPSTR)&DocInfo)) == 0) { - /* Error starting doc printer. */ - Tcl_AppendResult(interp, "Printer error: Cannot start document printing\n", 0); - return 0; - } - /* Start the first page. */ - if (StartPagePrinter(printer) == 0) { - /* Error starting the page. */ - Tcl_AppendResult(interp, "Printer error: Cannot start document page\n", 0); - EndDocPrinter(printer); - return 0; - } - return 1; -} - -/* - *---------------------------------------------------------------------- - * - * PrintFinish -- - * - * Finishes the print job. - * - * Results: - * Print job ends. - * - *---------------------------------------------------------------------- - */ - -static int PrintFinish (HDC printer, Tcl_Interp *interp) -{ - /* Finish the last page. */ - if (EndPagePrinter(printer) == 0) { - Tcl_AppendResult(interp, "Printer warning: Cannot end document page\n", 0); - /* Error ending the last page. */ - } - /* Conclude the document. */ - if (EndDocPrinter(printer) == 0) { - Tcl_AppendResult(interp, "Printer warning: Cannot end document printing\n", 0); - /* Error ending document. */ - } - - JobInfo(0,0,0); - - return 1; -} - -/* - *---------------------------------------------------------------------- - * - * PrintOpenDefault -- - * - * Opens the default printer. - * - * Results: - * Default printer opened. - * - *---------------------------------------------------------------------- - */ - -static int PrintOpenDefault (ClientData data, Tcl_Interp *interp, int argc, const char * argv) -{ - struct printer_values *ppv = *(struct printer_values *)data; - if (autoclose && ppv && ppv->hDC) - { - char tmpbuf[11+1+1]; - char *args[3]; - sprintf(tmpbuf, "0x%lx", ppv->hDC); - args[0] = "-hDC"; - args[1] = tmpbuf; - args[2] = 0; - PrintClose(data, interp, 2, args); - } - *(struct printer_values *)data = ppv - = make_printer_values(0); /* Get a default printer_values context. */ - - /* This version uses PrintDlg, and works under Win32s. */ - { - HWND tophwnd; - int retval; - - /* The following is an attempt to get the right owners notified of - * repaint requests from the dialog. It doesn't quite work. - * It does make the dialog box modal to the toplevel it's working with, though. - . */ - if ((ppv->pdlg.hwndOwner = GetActiveWindow()) != 0) - while ((tophwnd = GetParent(ppv->pdlg.hwndOwner)) != 0) - ppv->pdlg.hwndOwner = tophwnd; - - /* - * Since we are doing the "default" dialog, we must put NULL in the - * hDevNames and hDevMode members. - * Use '::tk::printer::_print dialog select' for selecting a printer from a list - . */ - ppv->pdlg.lStructSize = sizeof(PRINTDLG); - ppv->pdlg.Flags = PD_RETURNDEFAULT | PD_RETURNDC; - ppv->pdlg.hDevNames = 0; - ppv->pdlg.hDevMode = 0; - - retval = PrintDlg (&(ppv->pdlg)); - - if (retval == 1) - { - const char *name; - if (ppv->hdcname[0] && hdc_delete) - hdc_delete(interp, ppv->hdcname); - ppv->hdcname[0] = '\0'; - /* StorePrintVals creates and stores the hdcname as well. */ - StorePrintVals(ppv, &ppv->pdlg, 0); - if ((name = get_attribute (&ppv->attribs, "device")) != 0) - if (PrinterGetDefaults(ppv, name, 1) > 0) { /* Set default DEVMODE too. */ - current_printer_values = ppv; /* This is now the default printer. */ - } - } - else - { - /* Failed or cancelled. Leave everything else the same. */ - Tcl_Free((char *) ppv); - /* Per Steve Bold--restore the default printer values - In any case the current_printer_values shouldn't be left hanging - . */ - *(struct printer_values *)data = &default_printer_values; - } - } - - /* The status does not need to be supplied. either hDC is OK or it's NULL. */ - if (ppv->hdcname[0]) - Tcl_SetResult(interp, ppv->hdcname, TCL_VOLATILE); - else - { - sprintf(msgbuf, "0x%lx", ppv->hDC); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - } - - return TCL_OK; -} - - -/* - *---------------------------------------------------------------------- - * - * PrintOpen -- - * - * Open any named printer (or the default printer if no name - * is provided). - * - * Results: - * Printer opened. - * - *---------------------------------------------------------------------- - */ - -static int PrintOpen(ClientData data, Tcl_Interp *interp, int argc, const char * argv) -{ - /* The ClientData is the default printer--this may be overridden by the proc arguments. */ - struct printer_values *ppv = *(struct printer_values *)data; - const char *printer_name; - int use_printer_name = 0; - int use_default = 0; - int use_attrs = 0; - const char * attrs = 0; - int j; - int retval = TCL_OK; - static const char usage_message[] = "::tk::print::_print open [-name printername|-default]"; - - /* Command line should specify everything needed. Don't bring up dialog. */ - /* This should also SET the default to any overridden printer name. */ - for (j=0; jhDC) - { - char tmpbuf[11+1+1]; - char *args[3]; - sprintf(tmpbuf, "0x%lx", ppv->hDC); - args[0] = "-hDC"; - args[1] = tmpbuf; - args[2] = 0; - PrintClose(data, interp, 2, args); - } - - ppv = make_printer_values(0); /* Get a default printer_values context. */ - *(struct printer_values *)data = ppv; - /* - * Since this is a print open, a new HDC will be created--at this point, starting - * with the default attributes. - */ - if (ppv) { - int retval = 0; - - if ((retval = PrinterGetDefaults(ppv, printer_name, 1)) > 0) /* Set devmode if available. */ - { - const char *cp; - if ((cp = make_printer_dc_name(interp, ppv->hDC, ppv)) != 0) - { - strncpy(ppv->hdcname, cp, sizeof (current_printer_values->hdcname)); - set_attribute(&ppv->attribs, "hdcname", cp); - } - current_printer_values = ppv; /* This is now the default printer. */ - } else { - /* an error occurred - printer is not usable for some reason, so report that. */ - switch (retval) { - case GETDEFAULTS_UNSUPPORTED: /* Not supported. */ - Tcl_AppendResult(interp, "PrinterGetDefaults: Not supported for this OS\n", 0); - break; - case GETDEFAULTS_NOSUCHPRINTER: /* Can't find printer. */ - Tcl_AppendResult(interp, "PrinterGetDefaults: Can't find printer ", printer_name, "\n", 0); - break; - case GETDEFAULTS_CANTCREATEDC: /* Can't create DC. */ - Tcl_AppendResult(interp, "PrinterGetDefaults: Can't create DC: Insufficient printer information\n", 0); - break; - case GETDEFAULTS_CANTOPENPRINTER: /* Can't open printer. */ - Tcl_AppendResult(interp, "PrinterGetDefaults: Can't open printer ", printer_name, "\n", 0); - break; - case GETDEFAULTS_WINDOWSERROR: /* Windows error. */ - Tcl_AppendResult(interp, "PrinterGetDefaults: Windows error\n", 0); - break; - default: /* ???. */ - Tcl_AppendResult(interp, "PrinterGetDefaults: Unknown error\n", 0); - break; - } - - if (ppv->errorCode != 0) - ReportWindowsError(interp,ppv->errorCode); - - /* release the ppv. */ - delete_printer_values(ppv); - - return TCL_ERROR; - } - } - } - else /* It's a default. */ - { - retval = PrintOpenDefault(data, interp, argc, argv); /* argc, argv unused. */ - ppv = *(struct printer_values *)data; - } - - /* Get device names information. */ - { - char *dev, *dvr, *port; - /* - * retval test added by Jon Hilbert, 8/8/02. - * The printer name in this function should not be matched with wildcards. - */ - if (retval == TCL_OK && ppv && ppv->pdevmode && ppv->pdevmode->dmDeviceName && - GetPrinterWithName((char *)(ppv->pdevmode->dmDeviceName), &dev, &dvr, &port, 0) != 0) - { - strcpy(ppv->devnames_filename, dvr); - strcpy(ppv->devnames_port, port); - } - } - - /* Check for attribute modifications. */ - if (use_attrs != 0 && retval == TCL_OK) - { - char hdcbuffer[20]; - const char *args[5]; -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) - Tcl_SavedResult state; - Tcl_SaveResult(interp, &state); -#endif - args[0] = "-hDC"; - sprintf(hdcbuffer, "0x%lx", ppv->hDC); - args[1] = hdcbuffer; - args[2] = "-set"; - args[3] = attrs; - args[4] = 0; - PrintAttr(data, interp, 4, args); -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) - Tcl_RestoreResult(interp,&state); -#endif - } - - /* The status does not need to be supplied. either hDC is OK or it's NULL. */ - if (ppv->hdcname[0]) - Tcl_SetResult(interp, ppv->hdcname, TCL_VOLATILE); - else - { - sprintf(msgbuf, "0x%lx", ppv->hDC); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - } - - return retval; -} - -/* - *---------------------------------------------------------------------- - * - * PrintClose -- - * - * Frees the printer DC and releases it. - * - * Results: - * Printer closed. - * - *---------------------------------------------------------------------- - */ - -static int PrintClose(ClientData data, Tcl_Interp *interp, int argc, const char * argv) -{ - int j; - const char *hdcString = 0; - - /* Start with the default printer. */ - struct printer_values *ppv = *(struct printer_values *)data; - - /* See if there are any command line arguments. */ - for (j=0; jhDC, interp); - ppv->in_page = 0; - ppv->in_job = 0; - - /* Free the printer DC. */ - if (ppv->hDC) - { - delete_dc(ppv->hDC); - DeleteDC(ppv->hDC); - ppv->hDC = NULL; - } - - if (ppv->hdcname[0] != '\0' && hdc_delete != 0) - hdc_delete(interp, ppv->hdcname); - ppv->hdcname[0] = '\0'; - - /* We should also clean up the devmode and devname structures. */ - if (ppv && ppv != current_printer_values) - delete_printer_values(ppv); - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * PrintDialog-- - * - * Main dialog for selecting printer and page setup. - * - * Results: - * Printer or page setup selected. - * - *---------------------------------------------------------------------- - */ - - -static int PrintDialog(ClientData data, Tcl_Interp *interp, int argc, const char * argv) -{ - /* Which dialog is requested: one of select, page_setup. */ - static char usage_message[] = "::tk::print::_print dialog [-hDC hdc ] [select|page_setup] [-flags flagsnum]"; - struct printer_values *ppv = *(struct printer_values *)data; - int flags; - int oldMode; - int print_retcode; - HDC hdc = 0; - const char *hdcString = 0; - - int is_new_ppv = 0; - struct printer_values *old_ppv = ppv; - - static const int PRINT_ALLOWED_SET = PD_ALLPAGES|PD_SELECTION|PD_PAGENUMS| - PD_NOSELECTION|PD_NOPAGENUMS|PD_COLLATE| - PD_PRINTTOFILE|PD_PRINTSETUP|PD_NOWARNING| - PD_RETURNDC|PD_RETURNDEFAULT| - PD_DISABLEPRINTTOFILE|PD_HIDEPRINTTOFILE| - PD_NONETWORKBUTTON; - static const int PRINT_REQUIRED_SET = PD_NOWARNING|PD_RETURNDC; - - static const int PAGE_ALLOWED_SET = - PSD_MINMARGINS|PSD_MARGINS|PSD_NOWARNING| - PSD_DEFAULTMINMARGINS|PSD_DISABLEMARGINS| - PSD_DISABLEORIENTATION|PSD_DISABLEPAGEPAINTING| - PSD_DISABLEPAPER|PSD_DISABLEPRINTER| - PSD_INHUNDREDTHSOFMILLIMETERS|PSD_INTHOUSANDTHSOFINCHES| - PSD_RETURNDEFAULT; - static const int PAGE_REQUIRED_SET = - PSD_NOWARNING | PSD_DISABLEPRINTER; - - /* Create matching devmode and devnames to match the defaults. */ - HANDLE hDevMode = 0; - HANDLE hDevNames = 0; - DEVMODE *pdm = 0; - DEVNAMES *pdn = 0; - int dmsize = 0; - - int errors = 0; - const int alloc_devmode = 1; - const int lock_devmode = 2; - const int alloc_devname = 4; - const int lock_devname = 8; - const int change_devmode = 16; - int k; - int do_select= 0; - int do_page = 0; - int do_flags = 0; - int do_sync = 0; - - if (argc < 1) - { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - for (k = 0; k < argc; k++) - { - if (strcmp(argv[k], "select") == 0) - do_select = 1; - else if (strcmp(argv[k], "page_setup") == 0) - do_page = 1; - else if (strcmp(argv[k], "-hdc") == 0 || strcmp (argv[k], "-hDC") == 0) - { - k++; - hdcString = argv[k]; - } - else if (strcmp(argv[k], "-flags") == 0) - { - char *endstr; - if (argv[k+1]) - { - flags = strtol(argv[++k], &endstr, 0); /* Take any valid base. */ - if (endstr != argv[k]) /* if this was a valid numeric string. */ - do_flags = 1; - } - } - } - - if ((do_page + do_select) != 1) - { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - if (ppv == 0 || ppv == &default_printer_values || ppv->hDC == 0) - { - is_new_ppv = 1; - old_ppv = 0; - } - - if (hdcString) - { - hdc = get_printer_dc(interp,hdcString); - ppv = find_dc_by_hdc(hdc); - *(struct printer_values *)data = ppv; - if (hdc == 0) - { - is_new_ppv = 1; - } - if (ppv == 0) - { - is_new_ppv = 1; - } - } - - if (is_new_ppv == 1) - { - /* Open a brand new printer values structure. */ - old_ppv = ppv; - ppv = make_printer_values(0); - *(struct printer_values *)data = ppv; - } - - /* Copy the devmode and devnames into usable components. */ - if (ppv && ppv->pdevmode) - dmsize = ppv->pdevmode->dmSize+ppv->pdevmode->dmDriverExtra; - - if (dmsize <= 0) - ; /* Don't allocate a devmode structure. */ - else if ((hDevMode = GlobalAlloc(GMEM_MOVEABLE|GMEM_ZEROINIT, dmsize)) == NULL) - { - /* Failure!. */ - errors |= alloc_devmode; - pdm = 0; /* Use the default devmode. */ - } - else if ((pdm = (DEVMODE *)GlobalLock(hDevMode)) == NULL) - { - /* Failure!. */ - errors |= lock_devmode; - } - - /* If this is the first time we've got a ppv, just leave the names null. */ - if (ppv->devnames_filename[0] == 0 || - ppv->devnames_port[0] == 0 || - ppv->pdevmode == 0) - ; /* Don't allocate the devnames structure. */ - else if ((hDevNames = GlobalAlloc(GMEM_MOVEABLE|GMEM_ZEROINIT, - sizeof(DEVNAMES)+ - sizeof(ppv->devnames_filename) + - CCHDEVICENAME + - sizeof(ppv->devnames_port) + 2) - ) == NULL) - { - /* Failure!. */ - errors |= alloc_devname; - pdn = 0; - } - else if ((pdn = (DEVNAMES *)GlobalLock(hDevNames)) == NULL) - { - /* Failure!. */ - errors |= lock_devname; - } - - if (pdm) - memcpy (pdm, ppv->pdevmode, dmsize); - - if (pdn) - { - pdn->wDefault = 0; - pdn->wDriverOffset = 4*sizeof (WORD); - strcpy((char *)pdn + pdn->wDriverOffset, ppv->devnames_filename); - pdn->wDeviceOffset = pdn->wDriverOffset + strlen(ppv->devnames_filename) + 2; - strcpy ((char *)pdn + pdn->wDeviceOffset, ppv->pdevmode->dmDeviceName); - pdn->wOutputOffset = pdn->wDeviceOffset + strlen(ppv->pdevmode->dmDeviceName) + 2; - strcpy ((char *)pdn + pdn->wOutputOffset, ppv->devnames_port); - } - - if (hDevMode) - GlobalUnlock(hDevMode); - if (hDevNames) - GlobalUnlock(hDevNames); - - if (do_select) - { - /* - * Looking at the return value of PrintDlg, we want to - * save the values in the PAGEDIALOG for the next time. - * The tricky part is that PrintDlg and PageSetupDlg - * have the ability to move their hDevMode and hDevNames memory. - * This never seems to happen under NT, - * seems not to happen under Windows 3.1, - * but can be demonstrated under Windows 95 (and presumably Windows 98). - * - * As the handles are shared among the Print and Page dialogs, we must - * consistently establish and free the handles. - * Current thinking is to preserve them in the PageSetup structure ONLY, - * thus avoiding the problem here. - . */ - - HWND tophwnd; - - /* Assign the copied, moveable handles to the dialog structure. */ - ppv->pdlg.hDevMode = hDevMode; - ppv->pdlg.hDevNames = hDevNames; - - /* - * This loop make the dialog box modal to the toplevel it's working with. - * It also avoids any reliance on Tk code (for Tcl users). - . */ - if ((ppv->pdlg.hwndOwner = GetActiveWindow()) != 0) - while ((tophwnd = GetParent(ppv->pdlg.hwndOwner)) != 0) - ppv->pdlg.hwndOwner = tophwnd; - - /* Leaving the memory alone will preserve selections. */ - /* memset (&(ppv->pdlg), 0, sizeof(PRINTDLG));. */ - ppv->pdlg.lStructSize = sizeof(PRINTDLG); - ppv->pdlg.Flags |= PRINT_REQUIRED_SET; - - /* Vista (Win95) Fix Start. */ - /* Seems to be needed to print multiple copies. */ - ppv->pdlg.Flags |= PD_USEDEVMODECOPIES; - ppv->pdlg.nCopies = (WORD)PD_USEDEVMODECOPIES; /* Value shouldn't matter. */ - /* Vista Fix End. */ - - if (do_flags) - { - /* Enable requested flags, but disable the flags we don't want to support. */ - ppv->pdlg.Flags |= flags; - ppv->pdlg.Flags &= PRINT_ALLOWED_SET; - } - - /* One may not specify return default when devmode or devnames are present. */ - /* Since the copied flags in the ppv's pdevmode may have been created by - * the "PrintOpen" call, this flag _might_ be set - . */ - if (ppv->pdlg.hDevMode || ppv->pdlg.hDevNames) - ppv->pdlg.Flags &= (~PD_RETURNDEFAULT); - -#if TCL_MAJOR_VERSION > 7 - /* In Tcl versions 8 and later, a service call to the notifier is provided. */ - oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); -#endif - - print_retcode = PrintDlg(&(ppv->pdlg)); - -#if TCL_MAJOR_VERSION > 7 - /* Return the service mode to its original state. */ - Tcl_SetServiceMode(oldMode); -#endif - - if (print_retcode == 1) /* Not canceled. */ - { - const char *name; - StorePrintVals (ppv, &ppv->pdlg, 0); - - if ((name = get_attribute (&ppv->attribs, "device")) != 0) - PrinterGetDefaults(ppv, name, 0); /* Don't set default DEVMODE: - user may have already set it in properties. */ - - add_dc(ppv->hDC, ppv); - current_printer_values = ppv; - - hDevNames = NULL; - hDevMode = NULL; - } - else /* Canceled. */ - { - DWORD extError = CommDlgExtendedError(); - if (ppv->pdlg.hDevMode) - GlobalFree(ppv->pdlg.hDevMode); - else - GlobalFree(hDevMode); - hDevMode = ppv->pdlg.hDevMode = NULL; - - if (ppv->pdlg.hDevNames) - GlobalFree (ppv->pdlg.hDevNames); - else - GlobalFree (hDevNames); - hDevNames = ppv->pdlg.hDevNames = NULL; - - if (is_new_ppv) - { - Tcl_Free((char *)ppv); - ppv = old_ppv; - if (ppv == 0) - ppv = &default_printer_values; - *(struct printer_values *)data = ppv; - } - } - - /* Results are available through printer attr; HDC now returned. */ - /* This would be a good place for Tcl_SetObject, but for now, support - * older implementations by returning a Hex-encoded value. - * Note: Added a 2nd parameter to allow caller to note cancellation. - */ - { - const char *cp = ppv->hdcname; - if (cp && cp[0]) - sprintf(msgbuf, "%s %d", cp, print_retcode); - else - sprintf(msgbuf, "0x%lx %d", ppv->hDC, print_retcode); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - } - } - else if (do_page) - { - if (do_flags == 0) - flags = PSD_MARGINS|PSD_NOWARNING|PSD_DISABLEPRINTER|PSD_INTHOUSANDTHSOFINCHES; - - ppv->pgdlg.Flags = flags; - /* Restrict flags to those we wish to support. */ - ppv->pgdlg.Flags |= PAGE_REQUIRED_SET; - ppv->pgdlg.Flags &= PAGE_ALLOWED_SET; - - /* Set the devmode and devnames to match our structures. */ - ppv->pgdlg.hDevMode = hDevMode; - ppv->pgdlg.hDevNames = hDevNames; - - ppv->pgdlg.lStructSize = sizeof(PAGESETUPDLG); -#if TCL_MAJOR_VERSION > 7 - /* In Tcl versions 8 and later, a service call to the notifier is provided. */ - oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); -#endif - - print_retcode = PageSetupDlg(&(ppv->pgdlg)); - -#if TCL_MAJOR_VERSION > 7 - /* Return the service mode to its original state. */ - Tcl_SetServiceMode(oldMode); -#endif - - if (print_retcode == 1) /* Not cancelled. */ - { - StorePrintVals(ppv, 0, &ppv->pgdlg); - /* Modify the HDC using ResetDC. */ - ResetDC(ppv->hDC, ppv->pdevmode); - hDevNames = NULL; - hDevMode = NULL; - } - else /* Canceled. */ - { - if (ppv->pgdlg.hDevMode) - GlobalFree(ppv->pgdlg.hDevMode); - else - GlobalFree(hDevMode); - hDevMode = ppv->pgdlg.hDevMode = NULL; - - if (ppv->pgdlg.hDevNames) - GlobalFree (ppv->pgdlg.hDevNames); - else - GlobalFree (hDevNames); - hDevNames = ppv->pgdlg.hDevNames = NULL; - if (is_new_ppv) - { - Tcl_Free ((char *)ppv); - ppv = old_ppv; - if (ppv == 0) - ppv = &default_printer_values; - *(struct printer_values *)data = ppv; - } - } - - { - const char *cp = ppv->hdcname; - if (cp && cp[0]) - sprintf(msgbuf, "%s %d", cp, print_retcode); - else - sprintf(msgbuf, "0x%lx %d", ppv->hDC, print_retcode); - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - } - Tcl_SetResult(interp, msgbuf, TCL_VOLATILE); - } - else - { - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; - } - - if (errors) - { - if (errors & alloc_devmode) - Tcl_AppendResult(interp, "\nError allocating global DEVMODE structure", 0); - if (errors & lock_devmode) - Tcl_AppendResult(interp, "\nError locking global DEVMODE structure", 0); - if (errors & alloc_devname) - Tcl_AppendResult(interp, "\nError allocating global DEVNAMES structure", 0); - if (errors & lock_devname) - Tcl_AppendResult(interp, "\nError locking global DEVNAMES structure", 0); - } - - return TCL_OK; -} - -static int JobInfo(int state, const char *name, const char * outname) -{ - static int inJob = 0; - static char jobname[63+1]; - - switch (state) - { - case 0: - inJob = 0; - jobname[0] = '\0'; - break; - case 1: - inJob = 1; - if (name) - strncpy (jobname, name, sizeof(jobname) - 1); - break; - default: - break; - } - if (outname) - *outname = jobname; - return inJob; -} - -/* - *---------------------------------------------------------------------- - * - * PrintJob-- - * - * Manage print jobs. - * - * Results: - * Print job executed. - * - *---------------------------------------------------------------------- - */ - - -static int PrintJob(ClientData data, Tcl_Interp *interp, int argc, const char * argv) -{ - DOCINFO di; - struct printer_values * ppv = *(struct printer_values *) data; - - static char usage_message[] = "::tk::print::_print job [ -hDC hdc ] [ [start [-name docname] ] | end ]"; - HDC hdc = 0; - const char *hdcString = 0; - - /* Parameters for document name and output file (if any) should be supported. */ - if (argc > 0 && (strcmp(argv[0], "-hdc") == 0 || strcmp (argv[0], "-hDC") == 0)) - { - argc--; - argv++; - hdcString = argv[0]; - argc--; - argv++; - } - - if (hdcString) - { - hdc = get_printer_dc(interp,hdcString); - ppv = find_dc_by_hdc(hdc); - *(struct printer_values *)data = ppv; - - if (hdc == 0) - { - Tcl_AppendResult(interp, "printer job got unrecognized hdc ", hdcString, 0); - return TCL_ERROR; - } - if (ppv == 0) - { - } - } - - if (ppv && hdc == 0) - hdc = ppv->hDC; - - /* Should this command keep track of start/end state so two starts in a row - * automatically have an end inserted? - . */ - if (argc == 0) /* printer job by itself. */ - { - const char *jobname; - int status; - - status = JobInfo (-1, 0, &jobname); - if (status) - Tcl_SetResult(interp, (char *)jobname, TCL_VOLATILE); - return TCL_OK; - } - else if (argc >= 1) - { - if (strcmp (*argv, "start") == 0) - { - const char *docname = "Tcl Printer Document"; - int oldMode; - - argc--; - argv++; - /* handle -name argument if present. */ - if (argc >= 1 && strcmp(*argv, "-name") == 0) - { - argv++; - if (--argc > 0) - { - docname = *argv; - } - } - - /* Ensure the hDC is valid before continuing. */ - if (hdc == NULL) - { - Tcl_SetResult (interp, "Error starting print job: no printer context", TCL_STATIC); - return TCL_ERROR; - } - - /* Close off any other job if already in progress. */ - if (JobInfo(-1, 0, 0)) - { - EndDoc(ppv->hDC); - JobInfo(0, 0, 0); - } - - memset (&di, 0, sizeof(DOCINFO)); - di.cbSize = sizeof(DOCINFO); - di.lpszDocName = docname; - - /* * - * If print to file is selected, this causes a popup dialog. - * Therefore, in Tcl 8 and above, enable event handling - * */ -#if TCL_MAJOR_VERSION > 7 - /* In Tcl versions 8 and later, a service call to the notifier is provided. */ - oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); -#endif - StartDoc(hdc, &di); - JobInfo (1, docname, 0); -#if TCL_MAJOR_VERSION > 7 - /* Return the service mode to its original state. */ - Tcl_SetServiceMode(oldMode); -#endif - if (ppv) - ppv->in_job = 1; - - return TCL_OK; - } - else if (strcmp (*argv, "end") == 0) - { - EndDoc(hdc); - JobInfo (0, 0, 0); - if (ppv) - ppv->in_job = 0; - - return TCL_OK; - } - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * PrintPage-- - * - * Manage page by page printing. - * - * Results: - * Page printing executed. - * - *---------------------------------------------------------------------- - */ - - -static int PrintPage(ClientData data, Tcl_Interp *interp, int argc, const char * argv) -{ - struct printer_values * ppv = *(struct printer_values *) data; - static char usage_message[] = "::tk::print::_print [-hDC hdc] [start|end]"; - HDC hdc = 0; - const char *hdcString = 0; - - if (argv[0] && (strcmp(argv[0], "-hdc") == 0 || strcmp (argv[0], "-hDC") == 0)) - { - argc--; - argv++; - hdcString = argv[0]; - argc--; - argv++; - } - - if (hdcString) - { - hdc = get_printer_dc(interp,hdcString); - ppv = find_dc_by_hdc(hdc); - *(struct printer_values *)data = ppv; - - if (hdc == 0) - { - Tcl_AppendResult(interp, "printer page got unrecognized hdc ", hdcString, 0); - return TCL_ERROR; - } - if (ppv == 0) - { - Tcl_AppendResult(interp, "printer page got unrecognized hdc ", hdcString, 0); - return TCL_ERROR; - } - } - /* - * Should this command keep track of start/end state so two starts in a row - * automatically have an end inserted? - * Also, if no job has started, should it start a printer job? - . */ - if (argc >= 1) - { - if (strcmp (*argv, "start") == 0) - { - StartPage(ppv->hDC); - ppv->in_page = 1; - return TCL_OK; - } - else if (strcmp (*argv, "end") == 0) - { - EndPage(ppv->hDC); - ppv->in_page = 0; - return TCL_OK; - } - } - - Tcl_SetResult(interp, usage_message, TCL_STATIC); - return TCL_ERROR; -} - -/* - * This function gets physical page size in case the user hasn't - * performed any action to set it - */ -static int PrintPageAttr (HDC hdc, int *hsize, int *vsize, - int *hscale, int *vscale, - int *hoffset, int *voffset, - int *hppi, int *vppi) -{ - int status = 0; - if (hdc == 0) - { - return -1; /* A value indicating failure. */ - } - - *hsize = GetDeviceCaps(hdc, PHYSICALWIDTH); - *vsize = GetDeviceCaps(hdc, PHYSICALHEIGHT); - *hscale = GetDeviceCaps(hdc, SCALINGFACTORX); - *vscale = GetDeviceCaps(hdc, SCALINGFACTORY); - *hoffset = GetDeviceCaps (hdc, PHYSICALOFFSETX); - *voffset = GetDeviceCaps (hdc, PHYSICALOFFSETY); - *hppi = GetDeviceCaps (hdc, LOGPIXELSX); - *vppi = GetDeviceCaps (hdc, LOGPIXELSY); - - return status; -} - -/* - *---------------------------------------------------------------------- - * - * PrintAttr-- - * - * Report printer attributes. In some cases, this function should probably get the information - * if not already available from user action. - * - * Results: - * Returns printer attributes. - * - *---------------------------------------------------------------------- - */ - -static int PrintAttr(ClientData data, Tcl_Interp *interp, int argc, const char * argv) -{ - HDC hdc = 0; - const char *hdcString = 0; - /* - * Note: Currently, attributes are maintained ONCE per Tcl session. - * Later design may allow a set of attributes per hDC. - * In that case, the hDC is a component of this command. - * Meanwhile, the hDC is consulted as a means of ensuring initialization of - * the printer attributes only. - */ - static char usage_message[] = "::tk::print::_print attr " - "[-hDC hdc] " - "[ [-get keylist] | [-set key-value-pair list] | [-delete key-list] | [-prompt] ]"; - - struct printer_values * ppv = *(struct printer_values *) data; - - Tcl_HashEntry *ent; - Tcl_HashSearch srch; - - /* - * Get and set options? Depends on further arguments? Pattern matching?. - * Returns a collection of key/value pairs. Should it use a user-specified array name?. - * The attributes of interest are the ones buried in the dialog structures. - */ - - /* For the first implementation, more than 100 keys/pairs will be ignored. */ - char * keys=0; - int key_count = 0; - - int do_get = 0; - int do_set = 0; - int do_delete = 0; - int do_prompt = 0; - int i; - - /* - * This command should take an HDC as an optional parameter, otherwise using - * the one in the ppv structure? - . */ - for (i=0; i 1) - { - Tcl_AppendResult(interp, "\nCannot use two options from " - "-get, -set, -delete, and -prompt in same request.\n", - usage_message, - 0); - if (keys) - Tcl_Free((char *)keys); - return TCL_ERROR; - } - - if (hdcString) - { - hdc = get_printer_dc(interp,hdcString); - ppv = find_dc_by_hdc(hdc); - *(struct printer_values *)data = ppv; - - if (hdc == 0) - { - Tcl_AppendResult(interp, "::tk::print::_print attr got unrecognized hdc ", hdcString, 0); - return TCL_ERROR; - } - if (ppv == 0) - { - Tcl_AppendResult(interp, "::tk::print::_print attr got unrecognized hdc ", hdcString, 0); - return TCL_ERROR; - } - } - - /* - * Handle the case where we are asking for attributes on a non-opened printer - * The two choices are (a) to consider this a fatal error for the printer attr - * command; and (b) to open the default printer. For now, we use choice (b) - */ - if (ppv == 0 || ppv == &default_printer_values || ppv->hDC == NULL) - { - /* In these cases, open the default printer, if any. If none, return an error. */ - if (PrintOpen(data, interp, 0, 0) != TCL_OK) - { - Tcl_AppendResult(interp, "\nThere appears to be no default printer." - "\nUse '::tk::print::_print dialog select' before '::tk::print::_print attr'\n", - 0); - if (keys) - Tcl_Free((char *)keys); - return TCL_ERROR; - } - else - Tcl_ResetResult(interp); /* Remove the hDC from the result. */ - - /* This changes the ppv (via changing data in PrintOpen!. */ - ppv = *(struct printer_values *)data; - - } - - /* - * This command must support two switches: - * -get: the list following this switch represents a set of - * "wildcard-matchable" values to retrieve from the attribute list. - * When found, they are reported ONCE in alphabetical order. - * -set: the LIST OF PAIRS following this switch represents a set - * of LITERAL keys and values to be added or replaced into the - * attribute list. Values CAN be set in this list that are not - * recognized by the printer dialogs or structures. - */ - /* This is the "delete" part, used only by the -delete case. */ - if (do_delete) - { - int count_del = 0; - char count_str[12+1]; - - /* The only trick here is to ensure that only permitted - * items are deleted - . */ - static const char *illegal[] = { - "device", - "driver", - "hDC", - "hdcname", - "pixels per inch", - "port", - "resolution", - }; - for (ent = Tcl_FirstHashEntry(&ppv->attribs, &srch); - ent != 0; - ent = Tcl_NextHashEntry(&srch)) - { - const char *key; - if ((key = (const char *)Tcl_GetHashKey(&ppv->attribs, ent)) != 0 ) - { - /* Test here to see if a list is available, and if this element is on it. */ - int found=0; - int i; - for (i=0; iattribs, key); - count_del++; - } - - /* If the delete option is chosen, we're done. */ - if (keys) - Tcl_Free((char *)keys); - sprintf(count_str, "%d", count_del); - Tcl_SetResult(interp, count_str, TCL_VOLATILE); - return TCL_OK; - } - /* This is the "set" part, used only by the -set case. */ - else if (do_set) - { - int k; - /* Split each key, do the set, and then free the result. - * Also, replace keys[k] with just the key part. - . */ - for (k=0; k 1) - { - set_attribute (&ppv->attribs, slist[0], slist[1]); - strcpy(keys[k], slist[0]); /* Always shorter, so this should be OK. */ - } - if (slist) - Tcl_Free((char *)slist); - } - } - - /* Here we should "synchronize" the pairs with the devmode. */ - GetDevModeAttribs (&ppv->attribs, ppv->pdevmode); - RestorePrintVals (ppv, &ppv->pdlg, &ppv->pgdlg); - /* -------------- added 8/1/02 by Jon Hilbert. */ - /* tell the printer about the devmode changes - This is necessary to support paper size setting changes - . */ - DocumentProperties(GetActiveWindow(),ppv->hDC,ppv->pdevmode->dmDeviceName, - ppv->pdevmode,ppv->pdevmode,DM_IN_BUFFER|DM_OUT_BUFFER); - - /* Here we should modify the DEVMODE by calling ResetDC. */ - ResetDC(ppv->hDC, ppv->pdevmode); - } - else if (do_prompt) - { - DWORD dwRet; - HANDLE hPrinter; - PRINTER_DEFAULTS pd = {0, 0, 0}; - - pd.DesiredAccess = PRINTER_ALL_ACCESS; - pd.pDevMode = ppv->pdevmode; - - OpenPrinter (ppv->pdevmode->dmDeviceName, &hPrinter, &pd); - dwRet = DocumentProperties ( - GetActiveWindow(), hPrinter, ppv->pdevmode->dmDeviceName, - ppv->pdevmode, ppv->pdevmode, DM_PROMPT | DM_IN_BUFFER | DM_OUT_BUFFER); - if (dwRet == IDCANCEL) - { - /* The dialog was canceled. Don't do anything. */ - } - else - { - if (dwRet != IDOK) { - ppv->errorCode = GetLastError(); - sprintf(msgbuf, "::tk::print::_print attr -prompt: Cannot retrieve printer attributes: %ld (%ld)", (long) ppv->errorCode, dwRet); - Tcl_SetResult (interp, msgbuf, TCL_VOLATILE); - ClosePrinter(hPrinter); - return TCL_ERROR; - } - - ppv->pdevmode->dmFields |= DM_PAPERSIZE; - if (ppv->pdevmode->dmPaperLength && ppv->pdevmode->dmPaperWidth) { - ppv->pdevmode->dmFields |= DM_PAPERWIDTH | DM_PAPERLENGTH; - } - SetDevModeAttribs (&ppv->attribs, ppv->pdevmode); - - dwRet = DocumentProperties(GetActiveWindow(),hPrinter, ppv->pdevmode->dmDeviceName, - ppv->pdevmode,ppv->pdevmode,DM_IN_BUFFER | DM_OUT_BUFFER); - if (dwRet != IDOK) { - ppv->errorCode = GetLastError(); - sprintf(msgbuf, "::tk::print::_print attr -prompt: Cannot set printer attributes: %ld", (long) ppv->errorCode); - Tcl_SetResult (interp, msgbuf, TCL_VOLATILE); - ClosePrinter(hPrinter); - return TCL_ERROR; - } - ResetDC(hPrinter, ppv->pdevmode); - } - ClosePrinter(hPrinter); - } - - /* This is the "get" part, used for all cases of the command. */ - for (ent = Tcl_FirstHashEntry(&ppv->attribs, &srch); - ent != 0; - ent = Tcl_NextHashEntry(&srch)) - { - const char *key, *value; - if ((value = (const char *)Tcl_GetHashValue(ent)) != 0 && - (key = (const char *)Tcl_GetHashKey(&ppv->attribs, ent)) != 0 ) - { - /* Test here to see if a list is available, and if this element is on it. */ - if (do_set || do_get) - { - int found=0; - int i; - for (i=0; i 0) - Tcl_AppendResult(interp, "\n", usage, "\n", 0); - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * add_dc-- - * - * Adds device context. - * - * Results: - * Device context added. - * - *---------------------------------------------------------------------- - */ - -static void add_dc(HDC hdc, struct printer_values *pv) -{ - Tcl_HashEntry *data; - int status; - data = Tcl_CreateHashEntry(&printer_hdcs, (const char *)hdc, &status); - Tcl_SetHashValue(data,(const char *)pv); -} - -/* - *---------------------------------------------------------------------- - * - * delete_dc-- - * - * Deletes device context. - * - * Results: - * Device context deleted. - * - *---------------------------------------------------------------------- - */ - - -static struct printer_values *delete_dc (HDC hdc) -{ - Tcl_HashEntry *data; - struct printer_values *pv = 0; - if ((data = Tcl_FindHashEntry(&printer_hdcs, (const char *)hdc)) != 0) - { - pv = (struct printer_values *)Tcl_GetHashValue(data); - Tcl_DeleteHashEntry(data); - } - return pv; -} - -/* - *---------------------------------------------------------------------- - * - * find_dc_by_hdc -- - * - * Finds device context. - * - * Results: - * Device context found. - * - *---------------------------------------------------------------------- - */ - - -static struct printer_values *find_dc_by_hdc(HDC hdc) -{ - Tcl_HashEntry *data; - if ((data = Tcl_FindHashEntry(&printer_hdcs, (const char *)hdc)) != 0) - return (struct printer_values *)Tcl_GetHashValue(data); - return 0; -} - -#define PRINTER_dc_type 32 - -/* - *---------------------------------------------------------------------- - * - * init_printer_dc_contexts -- - * - * Initializes DC contexts. - * - * Results: - * Device contexts initialized. - * - *---------------------------------------------------------------------- - */ - - -static void init_printer_dc_contexts(Tcl_Interp *interp) -{ - if (hdc_prefixof) - hdc_prefixof(interp, PRINTER_dc_type, "printerDc"); -} - -/* - *---------------------------------------------------------------------- - * - * delete_printer_dc_contexts -- - * - * Deletes DC contexts. - * - * Results: - * Device contexts deleted. - * - *---------------------------------------------------------------------- - */ - - -static void delete_printer_dc_contexts(Tcl_Interp *interp) -{ - const char *contexts[1000]; - int outlen = sizeof(contexts) / sizeof(const char *); - int i; - HDC hdc; - - - /* Note: hdc_List, hdc_get, and hdc_delete do not use the interp argument. */ - hdc_list(interp, PRINTER_dc_type, contexts, &outlen); - for (i=0; i name) - { - if (is_valid_hdc((HDC)tmp) == 0) - { - tmp = 0; - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", - "need a printer drawing context, got non-context address: ", name, "\n", 0); - } - return (HDC)tmp; - } - else - { - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation: ", - "need a printer drawing context, got: ", name, "\n", 0); - return 0; - } - } - return (HDC)hdc_get(interp, name); - -} - - \0x0C -/* - * Local variables: + * Local Variables: * mode: c - * indent-tabs-mode: nil - * End: - */ + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ -- cgit v0.12 From 1f79e0ed001bc9b4012a6c366ce382a4176b0fc8 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 28 Apr 2021 02:15:03 +0000 Subject: Clean up function comment --- win/tkWinPrint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 66833d2..7e9059f 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -142,7 +142,7 @@ static int PrintSelectPrinter( Tcl_Interp *interp ) /* * ---------------------------------------------------------------------- * - * PrintInit -- + * WinprintInit -- * * Initialize this package and create script-level commands. * -- cgit v0.12 From 9d49d70fffa1bb163adf4cdb1468ea5e2a187df1 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 30 Apr 2021 02:03:08 +0000 Subject: Add page setup dialog --- win/tkWinPrint.c | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 96 insertions(+), 4 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 7e9059f..8c16b8a 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -27,9 +27,12 @@ /* Initialize variables for later use. */ Tcl_HashTable *attribs; static PRINTDLG pd; -static PAGESETUPDLG pgdlg; +static PAGESETUPDLG psd; static DOCINFO di; -static int PrintSelectPrinter( Tcl_Interp *interp ); +static int PrintSelectPrinter(Tcl_Interp *interp); +static int PrintPageSetup( Tcl_Interp *interp); +BOOL CALLBACK PaintHook(HWND hwndDlg, UINT uMsg, WPARAM wParam, LPARAM lParam); +int Winprint_Init(Tcl_Interp * interp); /*---------------------------------------------------------------------- * @@ -67,7 +70,7 @@ static int PrintSelectPrinter( Tcl_Interp *interp ) if (PrintDlg(&pd) == TRUE) { hDC = pd.hDC; - if (hDC == NULL) { + if (hDC = NULL) { Tcl_AppendResult(interp, "can't allocate printer DC", NULL); return TCL_ERROR; } @@ -85,7 +88,7 @@ static int PrintSelectPrinter( Tcl_Interp *interp ) HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); - if (NULL != localDevmode) + if (localDevmode !=NULL) { memcpy( (LPVOID)localDevmode, @@ -138,6 +141,95 @@ static int PrintSelectPrinter( Tcl_Interp *interp ) return TCL_OK; } +/* + * -------------------------------------------------------------------------- + * + * PrintPageSetup-- + * + * Show the page setup dialogue box. + * + * Results: + * Returns the complete page setup. + * + * ------------------------------------------------------------------------- + */ + +static int PrintPageSetup( Tcl_Interp *interp) +{ + + /* Initialize PAGESETUPDLG. */ + ZeroMemory(&psd, sizeof(psd)); + psd.lStructSize = sizeof(psd); + psd.hwndOwner = GetDesktopWindow(); + psd.Flags = PSD_DISABLEORIENTATION | PSD_DISABLEPAPER | PSD_DISABLEPRINTER | PSD_ENABLEPAGEPAINTHOOK | PSD_MARGINS; + + /*Set default margins.*/ + psd.rtMargin.top = 1000; + psd.rtMargin.left = 1250; + psd.rtMargin.right = 1250; + psd.rtMargin.bottom = 1000; + + /*Callback for displaying print preview.*/ + psd.lpfnPagePaintHook = PaintHook; + + if (PageSetupDlg(&psd)!=TRUE) + { + Tcl_AppendResult(interp, "can't display page setup dialog", NULL); + return TCL_ERROR; + } else { + return TCL_OK; + } +} + +/* + * -------------------------------------------------------------------------- + * + * PaintHook-- + * + * Callback for displaying page margins/print preview. + * + * Results: + * Returns visual thumbnail of page margins. + * + * ------------------------------------------------------------------------- + */ + + +BOOL CALLBACK PaintHook(HWND hwndDlg, UINT uMsg, WPARAM wParam, LPARAM lParam) +{ + LPRECT lprc; + COLORREF crMargRect; + HDC hdc, hdcOld; + + switch (uMsg) + { + /* Draw the margin rectangle. */ + case WM_PSD_MARGINRECT: + hdc = (HDC) wParam; + lprc = (LPRECT) lParam; + + /* Get the system highlight color. */ + crMargRect = GetSysColor(COLOR_HIGHLIGHT); + + /* + * Create a dash-dot pen of the system highlight color and + * select it into the DC of the sample page. + */ + hdcOld = SelectObject(hdc, CreatePen(PS_DASHDOT, .5, crMargRect)); + + /* Draw the margin rectangle. */ + Rectangle(hdc, lprc->left, lprc->top, lprc->right, lprc->bottom); + + /* Restore the previous pen to the DC. */ + SelectObject(hdc, hdcOld); + return TRUE; + + default: + return FALSE; + } + return TRUE; +} + /* * ---------------------------------------------------------------------- -- cgit v0.12 From 3ba257e59b404759bfde7f2b385c86017538661b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 30 Apr 2021 02:16:03 +0000 Subject: Silence a few compiler warnings --- win/tkWinPrint.c | 41 +++++++++++++++++++++++++++++++---------- 1 file changed, 31 insertions(+), 10 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 8c16b8a..004ec36 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -29,8 +29,10 @@ Tcl_HashTable *attribs; static PRINTDLG pd; static PAGESETUPDLG psd; static DOCINFO di; -static int PrintSelectPrinter(Tcl_Interp *interp); -static int PrintPageSetup( Tcl_Interp *interp); +static int PrintSelectPrinter( ClientData clientData,Tcl_Interp *interp, + int objc,Tcl_Obj *const objv[]); +static int PrintPageSetup( ClientData clientData, Tcl_Interp *interp, + int objc,Tcl_Obj *const objv[]); BOOL CALLBACK PaintHook(HWND hwndDlg, UINT uMsg, WPARAM wParam, LPARAM lParam); int Winprint_Init(Tcl_Interp * interp); @@ -46,20 +48,31 @@ int Winprint_Init(Tcl_Interp * interp); *---------------------------------------------------------------------- */ -static int PrintSelectPrinter( Tcl_Interp *interp ) +static int PrintSelectPrinter( ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[] ) { + (void) clientData; + (void) objc; + (void) objv; HDC hDC; PDEVMODE returnedDevmode; PDEVMODE localDevmode; - LPWSTR localPrinterName; int copies, paper_width, paper_height, dpi_x, dpi_y, new; Tcl_HashEntry *hPtr; + LPWSTR localPrinterName; returnedDevmode = NULL; localDevmode = NULL; localPrinterName = NULL; - copies, paper_width, paper_height, dpi_x, dpi_y, new = 0; + copies = 0; + paper_width = 0; + paper_height = 0; + dpi_x = 0; + dpi_y = 0; + new = 0; /* Set up print dialog and initalize property structure. */ @@ -154,9 +167,15 @@ static int PrintSelectPrinter( Tcl_Interp *interp ) * ------------------------------------------------------------------------- */ -static int PrintPageSetup( Tcl_Interp *interp) +static int PrintPageSetup( ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { - + + (void) clientData; + (void) objc; + (void) objv; /* Initialize PAGESETUPDLG. */ ZeroMemory(&psd, sizeof(psd)); psd.lStructSize = sizeof(psd); @@ -246,11 +265,13 @@ BOOL CALLBACK PaintHook(HWND hwndDlg, UINT uMsg, WPARAM wParam, LPARAM lParam) int -Winprint_Init( - Tcl_Interp * interp) +Winprint_Init(Tcl_Interp * interp) { - Tcl_InitHashTable(&attribs, TCL_ONE_WORD_KEYS); + Tcl_InitHashTable(attribs, TCL_ONE_WORD_KEYS); + Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_pagesetup", PrintPageSetup, + NULL, NULL); return TCL_OK; } -- cgit v0.12 From 41479dbccee1e09df3fc42b7c279849aa0cae36c Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 1 May 2021 02:18:27 +0000 Subject: Linked vars now working; still need to refine page setup --- library/print.tcl | 2 +- win/tkWinPrint.c | 77 ++++++++++++++++++++++++------------------------------- 2 files changed, 35 insertions(+), 44 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 69f6e59..4d7c69d 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -14,7 +14,7 @@ namespace eval ::tk::print { - if [tk windowingsystem] eq "win32" { + if {[tk windowingsystem] eq "win32"} { variable printargs set printargs "" diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 004ec36..e554aa7 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -25,10 +25,11 @@ /* Initialize variables for later use. */ -Tcl_HashTable *attribs; static PRINTDLG pd; static PAGESETUPDLG psd; static DOCINFO di; +int copies, paper_width, paper_height, dpi_x, dpi_y; +char *localPrinterName; static int PrintSelectPrinter( ClientData clientData,Tcl_Interp *interp, int objc,Tcl_Obj *const objv[]); static int PrintPageSetup( ClientData clientData, Tcl_Interp *interp, @@ -60,9 +61,6 @@ static int PrintSelectPrinter( ClientData clientData, HDC hDC; PDEVMODE returnedDevmode; PDEVMODE localDevmode; - int copies, paper_width, paper_height, dpi_x, dpi_y, new; - Tcl_HashEntry *hPtr; - LPWSTR localPrinterName; returnedDevmode = NULL; localDevmode = NULL; @@ -72,7 +70,6 @@ static int PrintSelectPrinter( ClientData clientData, paper_height = 0; dpi_x = 0; dpi_y = 0; - new = 0; /* Set up print dialog and initalize property structure. */ @@ -107,10 +104,14 @@ static int PrintSelectPrinter( ClientData clientData, (LPVOID)localDevmode, (LPVOID)returnedDevmode, returnedDevmode->dmSize); - /* Get printer name and number of copies set by user. */ - localPrinterName = localDevmode->dmDeviceName; + /* Get values from user-set and built-in properties. */ + localPrinterName = (char*) localDevmode->dmDeviceName; + dpi_y = localDevmode->dmYResolution; + dpi_x = localDevmode->dmPrintQuality; + paper_height = (int) localDevmode->dmPaperLength; + paper_width = (int) localDevmode->dmPaperWidth; copies = pd.nCopies; - } + } else { localDevmode = NULL; @@ -120,40 +121,28 @@ static int PrintSelectPrinter( ClientData clientData, GlobalFree(pd.hDevMode); } } - - /* - * Get printer resolution and paper size. - */ - dpi_x = GetDeviceCaps(hDC, LOGPIXELSX); - dpi_y = GetDeviceCaps(hDC, LOGPIXELSY); - paper_width = GetDeviceCaps(hDC, PHYSICALWIDTH); - paper_height = GetDeviceCaps(hDC, PHYSICALHEIGHT); - - /* - * Store print properties in hash table and link variables - * so they can be accessed from script level. - */ - hPtr = Tcl_CreateHashEntry (attribs, "hDC", &new); - Tcl_SetHashValue (hPtr, &hDC); - hPtr = Tcl_CreateHashEntry (attribs, "copies", &new); - Tcl_SetHashValue (hPtr, &copies); - Tcl_LinkVar(interp, "::tk::print::copies", &copies, TCL_LINK_INT); - hPtr = Tcl_CreateHashEntry (attribs, "dpi_x", &new); - Tcl_SetHashValue (hPtr, &dpi_x); - Tcl_LinkVar(interp, "::tk::print::dpi_x", &dpi_x, TCL_LINK_INT); - hPtr = Tcl_CreateHashEntry (attribs, "dpi_y", &new); - Tcl_SetHashValue (hPtr, &dpi_y); - Tcl_LinkVar(interp, "::tk::print::dpi_y", &dpi_y, TCL_LINK_INT); - hPtr = Tcl_CreateHashEntry (attribs, "paper_width", &new); - Tcl_SetHashValue (hPtr, &paper_width); - Tcl_LinkVar(interp, "::tk::print::paper_width", &paper_width, TCL_LINK_INT); - hPtr = Tcl_CreateHashEntry (attribs, "paper_height", &new); - Tcl_SetHashValue (hPtr, &paper_height); - Tcl_LinkVar(interp, "::tk::print::paper_height", &paper_height, TCL_LINK_INT); - - return TCL_OK; + /* + * Store print properties and link variables + * so they can be accessed from script level. + */ + + + char *varlink1 = Tcl_Alloc(100 * sizeof(char)); + char **varlink2 = (char **)Tcl_Alloc(sizeof(char *)); + *varlink2 = varlink1; + strcpy (varlink1, localPrinterName); + + Tcl_LinkVar(interp, "::tk::print::hDC", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::dpi_x", (char *)&dpi_x, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); + + return TCL_OK; } + /* * -------------------------------------------------------------------------- * @@ -180,16 +169,19 @@ static int PrintPageSetup( ClientData clientData, ZeroMemory(&psd, sizeof(psd)); psd.lStructSize = sizeof(psd); psd.hwndOwner = GetDesktopWindow(); - psd.Flags = PSD_DISABLEORIENTATION | PSD_DISABLEPAPER | PSD_DISABLEPRINTER | PSD_ENABLEPAGEPAINTHOOK | PSD_MARGINS; + psd.Flags = PSD_ENABLEPAGEPAINTHOOK | PSD_MARGINS; /*Set default margins.*/ psd.rtMargin.top = 1000; psd.rtMargin.left = 1250; psd.rtMargin.right = 1250; psd.rtMargin.bottom = 1000; + ////psd.ptPaperSize.x = 8500; +// psd.ptPaperSize.y = 1100; + //= (8500, 1100); /*Callback for displaying print preview.*/ - psd.lpfnPagePaintHook = PaintHook; + psd.lpfnPagePaintHook = (LPPAGEPAINTHOOK)PaintHook; if (PageSetupDlg(&psd)!=TRUE) { @@ -268,7 +260,6 @@ int Winprint_Init(Tcl_Interp * interp) { - Tcl_InitHashTable(attribs, TCL_ONE_WORD_KEYS); Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); Tcl_CreateObjCommand(interp, "::tk::print::_pagesetup", PrintPageSetup, NULL, NULL); -- cgit v0.12 From 3b7390b9cbed112df5fb9c9ceb44433a233120da Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 1 May 2021 14:28:05 +0000 Subject: Draft implementation of complete setup dialog --- win/tkWinPrint.c | 96 +++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 63 insertions(+), 33 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index e554aa7..e9e6369 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -49,10 +49,10 @@ int Winprint_Init(Tcl_Interp * interp); *---------------------------------------------------------------------- */ -static int PrintSelectPrinter( ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[] ) +static int PrintSelectPrinter(ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { (void) clientData; @@ -111,7 +111,7 @@ static int PrintSelectPrinter( ClientData clientData, paper_height = (int) localDevmode->dmPaperLength; paper_width = (int) localDevmode->dmPaperWidth; copies = pd.nCopies; - } + } else { localDevmode = NULL; @@ -121,25 +121,25 @@ static int PrintSelectPrinter( ClientData clientData, GlobalFree(pd.hDevMode); } } - /* - * Store print properties and link variables - * so they can be accessed from script level. - */ + + /* + * Store print properties and link variables + * so they can be accessed from script level. + */ - - char *varlink1 = Tcl_Alloc(100 * sizeof(char)); - char **varlink2 = (char **)Tcl_Alloc(sizeof(char *)); - *varlink2 = varlink1; - strcpy (varlink1, localPrinterName); + char *varlink1 = Tcl_Alloc(100 * sizeof(char)); + char **varlink2 = (char **)Tcl_Alloc(sizeof(char *)); + *varlink2 = varlink1; + strcpy (varlink1, localPrinterName); - Tcl_LinkVar(interp, "::tk::print::hDC", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::dpi_x", (char *)&dpi_x, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::hDC", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::dpi_x", (char *)&dpi_x, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); - return TCL_OK; + return TCL_OK; } @@ -157,18 +157,23 @@ static int PrintSelectPrinter( ClientData clientData, */ static int PrintPageSetup( ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { (void) clientData; (void) objc; (void) objv; + /* Initialize PAGESETUPDLG. */ ZeroMemory(&psd, sizeof(psd)); psd.lStructSize = sizeof(psd); psd.hwndOwner = GetDesktopWindow(); + returnedDevmode = NULL; + localDevmode = NULL; + + psd.Flags = PSD_ENABLEPAGEPAINTHOOK | PSD_MARGINS; /*Set default margins.*/ @@ -176,19 +181,45 @@ static int PrintPageSetup( ClientData clientData, psd.rtMargin.left = 1250; psd.rtMargin.right = 1250; psd.rtMargin.bottom = 1000; - ////psd.ptPaperSize.x = 8500; -// psd.ptPaperSize.y = 1100; - //= (8500, 1100); /*Callback for displaying print preview.*/ psd.lpfnPagePaintHook = (LPPAGEPAINTHOOK)PaintHook; - if (PageSetupDlg(&psd)!=TRUE) + if (PageSetupDlg(&psd)=TRUE) { - Tcl_AppendResult(interp, "can't display page setup dialog", NULL); - return TCL_ERROR; + /* Copy print attributes to local structure. */ + returnedDevmode = (PDEVMODE)GlobalLock(psd.hDevMode); + localDevmode = (LPDEVMODE)HeapAlloc( + GetProcessHeap(), + HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, + returnedDevmode->dmSize); + + if (localDevmode !=NULL) + { + memcpy( + (LPVOID)localDevmode, + (LPVOID)returnedDevmode, + returnedDevmode->dmSize); + /* Get values from user-set and built-in properties. */ + localPrinterName = (char*) localDevmode->dmDeviceName; + dpi_y = localDevmode->dmYResolution; + dpi_x = localDevmode->dmPrintQuality; + paper_height = (int) localDevmode->dmPaperLength; + paper_width = (int) localDevmode->dmPaperWidth; + } + else + { + localDevmode = NULL; + } + if (psd.hDevMode !=NULL) + { + GlobalFree(psd.hDevMode); + } + return TCL_OK; + } else { - return TCL_OK; + Tcl_AppendResult(interp, "can't display page setup dialog", NULL); + return TCL_ERROR; } } @@ -256,8 +287,7 @@ BOOL CALLBACK PaintHook(HWND hwndDlg, UINT uMsg, WPARAM wParam, LPARAM lParam) */ -int -Winprint_Init(Tcl_Interp * interp) +int Winprint_Init(Tcl_Interp * interp) { Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); -- cgit v0.12 From 8018d01dfc4e2570e16ba1733279bcfecc8dac33 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 1 May 2021 14:31:37 +0000 Subject: Fix compiler errors --- win/tkWinPrint.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index e9e6369..551a80d 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -30,6 +30,8 @@ static PAGESETUPDLG psd; static DOCINFO di; int copies, paper_width, paper_height, dpi_x, dpi_y; char *localPrinterName; +PDEVMODE returnedDevmode; +PDEVMODE localDevmode; static int PrintSelectPrinter( ClientData clientData,Tcl_Interp *interp, int objc,Tcl_Obj *const objv[]); static int PrintPageSetup( ClientData clientData, Tcl_Interp *interp, @@ -59,9 +61,7 @@ static int PrintSelectPrinter(ClientData clientData, (void) objc; (void) objv; HDC hDC; - PDEVMODE returnedDevmode; - PDEVMODE localDevmode; - + returnedDevmode = NULL; localDevmode = NULL; localPrinterName = NULL; @@ -185,7 +185,7 @@ static int PrintPageSetup( ClientData clientData, /*Callback for displaying print preview.*/ psd.lpfnPagePaintHook = (LPPAGEPAINTHOOK)PaintHook; - if (PageSetupDlg(&psd)=TRUE) + if (PageSetupDlg(&psd)==TRUE) { /* Copy print attributes to local structure. */ returnedDevmode = (PDEVMODE)GlobalLock(psd.hDevMode); -- cgit v0.12 From 21aaf963ae9be8fd3de49f1c39481ee1696ce9b3 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 1 May 2021 17:45:57 +0000 Subject: Remove page setup - print customizing can be done at the select printer dialog --- win/tkWinPrint.c | 137 +------------------------------------------------------ 1 file changed, 1 insertion(+), 136 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 551a80d..385a21d 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -34,9 +34,6 @@ PDEVMODE returnedDevmode; PDEVMODE localDevmode; static int PrintSelectPrinter( ClientData clientData,Tcl_Interp *interp, int objc,Tcl_Obj *const objv[]); -static int PrintPageSetup( ClientData clientData, Tcl_Interp *interp, - int objc,Tcl_Obj *const objv[]); -BOOL CALLBACK PaintHook(HWND hwndDlg, UINT uMsg, WPARAM wParam, LPARAM lParam); int Winprint_Init(Tcl_Interp * interp); /*---------------------------------------------------------------------- @@ -142,137 +139,6 @@ static int PrintSelectPrinter(ClientData clientData, return TCL_OK; } - -/* - * -------------------------------------------------------------------------- - * - * PrintPageSetup-- - * - * Show the page setup dialogue box. - * - * Results: - * Returns the complete page setup. - * - * ------------------------------------------------------------------------- - */ - -static int PrintPageSetup( ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - - (void) clientData; - (void) objc; - (void) objv; - - /* Initialize PAGESETUPDLG. */ - ZeroMemory(&psd, sizeof(psd)); - psd.lStructSize = sizeof(psd); - psd.hwndOwner = GetDesktopWindow(); - returnedDevmode = NULL; - localDevmode = NULL; - - - psd.Flags = PSD_ENABLEPAGEPAINTHOOK | PSD_MARGINS; - - /*Set default margins.*/ - psd.rtMargin.top = 1000; - psd.rtMargin.left = 1250; - psd.rtMargin.right = 1250; - psd.rtMargin.bottom = 1000; - - /*Callback for displaying print preview.*/ - psd.lpfnPagePaintHook = (LPPAGEPAINTHOOK)PaintHook; - - if (PageSetupDlg(&psd)==TRUE) - { - /* Copy print attributes to local structure. */ - returnedDevmode = (PDEVMODE)GlobalLock(psd.hDevMode); - localDevmode = (LPDEVMODE)HeapAlloc( - GetProcessHeap(), - HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, - returnedDevmode->dmSize); - - if (localDevmode !=NULL) - { - memcpy( - (LPVOID)localDevmode, - (LPVOID)returnedDevmode, - returnedDevmode->dmSize); - /* Get values from user-set and built-in properties. */ - localPrinterName = (char*) localDevmode->dmDeviceName; - dpi_y = localDevmode->dmYResolution; - dpi_x = localDevmode->dmPrintQuality; - paper_height = (int) localDevmode->dmPaperLength; - paper_width = (int) localDevmode->dmPaperWidth; - } - else - { - localDevmode = NULL; - } - if (psd.hDevMode !=NULL) - { - GlobalFree(psd.hDevMode); - } - return TCL_OK; - - } else { - Tcl_AppendResult(interp, "can't display page setup dialog", NULL); - return TCL_ERROR; - } -} - -/* - * -------------------------------------------------------------------------- - * - * PaintHook-- - * - * Callback for displaying page margins/print preview. - * - * Results: - * Returns visual thumbnail of page margins. - * - * ------------------------------------------------------------------------- - */ - - -BOOL CALLBACK PaintHook(HWND hwndDlg, UINT uMsg, WPARAM wParam, LPARAM lParam) -{ - LPRECT lprc; - COLORREF crMargRect; - HDC hdc, hdcOld; - - switch (uMsg) - { - /* Draw the margin rectangle. */ - case WM_PSD_MARGINRECT: - hdc = (HDC) wParam; - lprc = (LPRECT) lParam; - - /* Get the system highlight color. */ - crMargRect = GetSysColor(COLOR_HIGHLIGHT); - - /* - * Create a dash-dot pen of the system highlight color and - * select it into the DC of the sample page. - */ - hdcOld = SelectObject(hdc, CreatePen(PS_DASHDOT, .5, crMargRect)); - - /* Draw the margin rectangle. */ - Rectangle(hdc, lprc->left, lprc->top, lprc->right, lprc->bottom); - - /* Restore the previous pen to the DC. */ - SelectObject(hdc, hdcOld); - return TRUE; - - default: - return FALSE; - } - return TRUE; -} - - /* * ---------------------------------------------------------------------- * @@ -291,8 +157,7 @@ int Winprint_Init(Tcl_Interp * interp) { Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_pagesetup", PrintPageSetup, - NULL, NULL); + return TCL_OK; } -- cgit v0.12 From 2a68d36c72614dce510f0e4eec0f8d86ff63f9d9 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 3 May 2021 03:41:22 +0000 Subject: Add more functions --- win/tkWinPrint.c | 84 +++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 65 insertions(+), 19 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 385a21d..4d3895c 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -26,14 +26,16 @@ /* Initialize variables for later use. */ static PRINTDLG pd; -static PAGESETUPDLG psd; static DOCINFO di; int copies, paper_width, paper_height, dpi_x, dpi_y; char *localPrinterName; PDEVMODE returnedDevmode; PDEVMODE localDevmode; -static int PrintSelectPrinter( ClientData clientData,Tcl_Interp *interp, - int objc,Tcl_Obj *const objv[]); +static HDC hDC; + +static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); int Winprint_Init(Tcl_Interp * interp); /*---------------------------------------------------------------------- @@ -48,17 +50,13 @@ int Winprint_Init(Tcl_Interp * interp); *---------------------------------------------------------------------- */ -static int PrintSelectPrinter(ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) +static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) { (void) clientData; - (void) objc; + (void) argc; (void) objv; - HDC hDC; - + returnedDevmode = NULL; localDevmode = NULL; localPrinterName = NULL; @@ -129,35 +127,83 @@ static int PrintSelectPrinter(ClientData clientData, *varlink2 = varlink1; strcpy (varlink1, localPrinterName); - Tcl_LinkVar(interp, "::tk::print::hDC", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, TCL_LINK_INT | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::dpi_x", (char *)&dpi_x, TCL_LINK_INT | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, TCL_LINK_INT | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); return TCL_OK; } /* - * ---------------------------------------------------------------------- + * -------------------------------------------------------------------------- * - * WinprintInit -- + * PrintOpenPrinter-- * - * Initialize this package and create script-level commands. + * Open the given printer. * * Results: - * Initialization of code. + * Opens the selected printer. * - * ---------------------------------------------------------------------- + * ------------------------------------------------------------------------- */ +int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +{ + (void) clientData; + + if (argc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "printer"); + return TCL_ERROR; + } -int Winprint_Init(Tcl_Interp * interp) + char *printer = Tcl_GetString(objv[2]); + OpenPrinter(printer, &hDC, NULL); + return TCL_OK; +} + +/* + * -------------------------------------------------------------------------- + * + * PrintClosePrinter-- + * + * Closes the given printer. + * + * Results: + * Printer closed. + * + * ------------------------------------------------------------------------- + */ + +int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) { + (void) clientData; + (void) argc; + (void) objv; + + ClosePrinter(hDC); + return TCL_OK; +} +/* + * -------------------------------------------------------------------------- + * + * Winprint_Init-- + * + * Initializes printing module on Windows.. + * + * Results: + * Module initialized. + * + * ------------------------------------------------------------------------- + */ +int Winprint_Init(Tcl_Interp * interp) +{ Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); - + Tcl_CreateObjCommand(interp, "::tk::print::_openprinter", PrintOpenPrinter, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_closeprinter", PrintClosePrinter, NULL, NULL); return TCL_OK; } -- cgit v0.12 From d01c97fa3c188bf8584e1a65de0c6a28211399e7 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 5 May 2021 01:54:02 +0000 Subject: Complete draft implementation of printing API --- win/tkWinPrint.c | 149 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 142 insertions(+), 7 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 4d3895c..0548c27 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -33,9 +33,17 @@ PDEVMODE returnedDevmode; PDEVMODE localDevmode; static HDC hDC; +/* + * Prototypes for functions used only in this file. + */ + static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +static int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +static int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +static int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +static int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); int Winprint_Init(Tcl_Interp * interp); /*---------------------------------------------------------------------- @@ -45,7 +53,7 @@ int Winprint_Init(Tcl_Interp * interp); * Main dialog for selecting printer and initializing data for print job. * * Results: - * Printer selected. + * Printer selected. * *---------------------------------------------------------------------- */ @@ -83,22 +91,21 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg /*Get document info.*/ ZeroMemory( &di, sizeof(di)); di.cbSize = sizeof(di); - di.lpszDocName = "Tk Output"; + di.lpszDocName = "Tk Print Output"; /* Copy print attributes to local structure. */ returnedDevmode = (PDEVMODE)GlobalLock(pd.hDevMode); - localDevmode = (LPDEVMODE)HeapAlloc( - GetProcessHeap(), + localDevmode = (LPDEVMODE)HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); if (localDevmode !=NULL) { - memcpy( - (LPVOID)localDevmode, + memcpy((LPVOID)localDevmode, (LPVOID)returnedDevmode, returnedDevmode->dmSize); + /* Get values from user-set and built-in properties. */ localPrinterName = (char*) localDevmode->dmDeviceName; dpi_y = localDevmode->dmYResolution; @@ -160,6 +167,9 @@ int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Ob } char *printer = Tcl_GetString(objv[2]); + if (hDC == NULL) { + return TCL_ERROR; + } OpenPrinter(printer, &hDC, NULL); return TCL_OK; } @@ -190,6 +200,127 @@ int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_O /* * -------------------------------------------------------------------------- * + * PrintOpenDoc-- + * + * Opens the document for printing. + * + * Results: + * Opens the print document. + * + * ------------------------------------------------------------------------- + */ + +int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +{ + + (void) clientData; + (void) argc; + (void) objv; + + int output = 0; + + if (hDC == NULL) { + return TCL_ERROR; + } + + /* + * Start printing. + */ + output = StartDoc(hDC, &di); + if (output <= 0) { + Tcl_AppendResult(interp, "unable to start document", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + * -------------------------------------------------------------------------- + * + * PrintCloseDoc-- + * + * Closes the document for printing. + * + * Results: + * Closes the print document. + * + * ------------------------------------------------------------------------- + */ + + +int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +{ + + (void) clientData; + (void) argc; + (void) objv; + + if ( EndDoc(hDC) <= 0) { + return TCL_ERROR; + } + return TCL_OK; +} + +/* + * -------------------------------------------------------------------------- + * + * PrintOpenPage-- + * + * Opens a page for printing. + * + * Results: + * Opens the print page. + * + * ------------------------------------------------------------------------- + */ + +int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +{ + + (void) clientData; + (void) argc; + (void) objv; + + /*Start an individual page.*/ + if ( StartPage(hDC) <= 0) { + Tcl_AppendResult(interp, "unable to start page", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + * -------------------------------------------------------------------------- + * + * PrintClosePage-- + * + * Closes the printed page. + * + * Results: + * Closes the page. + * + * ------------------------------------------------------------------------- + */ + +int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +{ + + (void) clientData; + (void) argc; + (void) objv; + + if ( EndPage(hDC) <= 0) { + return TCL_ERROR; + } + return TCL_OK; +} + + +/* + * -------------------------------------------------------------------------- + * * Winprint_Init-- * * Initializes printing module on Windows.. @@ -203,7 +334,11 @@ int Winprint_Init(Tcl_Interp * interp) { Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); Tcl_CreateObjCommand(interp, "::tk::print::_openprinter", PrintOpenPrinter, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_closeprinter", PrintClosePrinter, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_closeprinter", PrintClosePrinter, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_opendoc", PrintOpenDoc, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_closedoc", PrintCloseDoc, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_openpage", PrintOpenPage, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_closepage", PrintClosePage, NULL, NULL); return TCL_OK; } -- cgit v0.12 From 65bc1e389b534a02b21605d2585a51df5bfb1b59 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 5 May 2021 01:57:20 +0000 Subject: Fix typo --- win/tkWinPrint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 0548c27..cfa2c20 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -323,7 +323,7 @@ int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * * Winprint_Init-- * - * Initializes printing module on Windows.. + * Initializes printing module on Windows. * * Results: * Module initialized. -- cgit v0.12 From df19bd86f4307eebad863249fdff6ce451fc909b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 6 May 2021 02:07:38 +0000 Subject: Begin integration of C printing at script level, still needs testing --- library/print.tcl | 139 +++++++++++++++++------------------------------------- win/tkWinPrint.c | 10 +++- 2 files changed, 51 insertions(+), 98 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 4d7c69d..4a08231 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -16,6 +16,14 @@ namespace eval ::tk::print { if {[tk windowingsystem] eq "win32"} { + variable ::tk::print::printer_name + variable ::tk::print::copies + variable ::tk::print::dpi_x + variable ::tk::print::dpi_y + variable ::tk::print::paper_width + variable ::tk::print::paper_height + variable ::tk::print::margin_left + variable ::tk::print::margin_top variable printargs set printargs "" @@ -30,57 +38,29 @@ namespace eval ::tk::print { proc _page_args { array } { upvar #0 $array ary - # First we check whether we have a valid hDC - # (perhaps we can later make this also an optional argument, defaulting to - # the default printer) - set attr [ ::tk::print::_print attr ] - foreach attrpair $attr { - set key [lindex $attrpair 0] - set val [lindex $attrpair 1] - switch -exact $key { - "hDC" { set ary(hDC) $val } - "copies" { if { $val >= 0 } { set ary(copies) $val } } - "page dimensions" { - set wid [lindex $val 0] - set hgt [lindex $val 1] - if { $wid > 0 } { set ary(pw) $wid } - if { $hgt > 0 } { set ary(pl) $hgt } - } - "page margins" { - if { [scan [lindex $val 0] %d tmp] > 0 } { - set ary(lm) [ lindex $val 0 ] - set ary(tm) [ lindex $val 1 ] - set ary(rm) [ lindex $val 2 ] - set ary(bm) [ lindex $val 3 ] - } - } - "resolution" { - if { [scan [lindex $val 0] %d tmp] > 0 } { - set ary(resx) [ lindex $val 0 ] - set ary(resy) [ lindex $val 1 ] - } else { - set ary(resx) 200 ;# Set some defaults for this... - set ary(resy) 200 - } - } - } + #First, we select the printer. + ::tk::print::_selectprinter + + if {$::tk::print::printer_name == ""} { + #they pressed cancel + return } + #Next, set values. + set ary(hDC) $::tk::print::printer_name + set ary(pw) $::tk::print::paper_width + set ary(pl) $::tk::print::paper_height + set ary(lm) $::tk::print::margin_left + set ary(tm) $::tk::print::margin_top + set ary(rm) [list expr $ary(pw) - $ary(lm)] + set ary(bm) [list expr $ary(pl) - $ary(tm)] + set ary(resx) $::tk::print::dpi_x + set ary(resy) $::tk::print::dpi_y + set ary(copies) $::tk::print::copies + if { ( [ info exist ary(hDC) ] == 0 ) || ($ary(hDC) == 0x0) } { error "Can't get printer attributes" - } - - # Now, set "reasonable" defaults if some values were unavailable - if { [ info exist ary(resx) ] == 0 } { set ary(resx) 200 } - if { [ info exist ary(resy) ] == 0 } { set ary(resy) 200 } - if { [ info exist ary(tm) ] == 0 } { set ary(tm) 1000 } - if { [ info exist ary(bm) ] == 0 } { set ary(bm) 1000 } - if { [ info exist ary(lm) ] == 0 } { set ary(lm) 1000 } - if { [ info exist ary(rm) ] == 0 } { set ary(rm) 1000 } - if { [ info exist ary(pw) ] == 0 } { set ary(pw) 8500 } - if { [ info exist ary(pl) ] == 0 } { set ary(pl) 11000 } - if { [ info exist ary(copies) ] == 0 } { set ary(copies) 1 } - + } } # _ print_page_data @@ -96,22 +76,18 @@ namespace eval ::tk::print { variable printargs _page_args printargs - if { ! [info exist printargs(hDC)] } { - printer open - _page_args printargs - } set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] set pw [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] - ::tk::print::_print job start - ::tk::print::_print page start + ::tk::print::_opendoc + ::tk::print::_openpage eval gdi text $printargs(hDC) $lm $tm \ -anchor nw -text [list $data] \ -width $pw \ $fontargs - ::tk::print::_print page end - ::tk::print::_print job end + ::tk::print::_closepage + ::tk::print::_closedoc } @@ -147,15 +123,7 @@ namespace eval ::tk::print { variable printargs _page_args printargs - if { ! [info exist printargs(hDC)] } { - ::tk::print::_print open - _page_args printargs - } - if { $printargs(hDC) == "?" || $printargs(hDC) == 0 } { - ::tk::print::_print open - _page_args printargs - } - + if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid } else { @@ -168,8 +136,8 @@ namespace eval ::tk::print { set curlen 0 set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] - ::tk::print::_print job start -name "Tk Print Job" - ::tk::print::_print page start + ::tk::print::_opendoc + ::tk::print::_openpage while { $curlen < $totallen } { set linestring [ string range $data $curlen end ] if { $breaklines } { @@ -188,13 +156,13 @@ namespace eval ::tk::print { incr curlen [lindex $result 0] incr curhgt [lindex $result 1] if { [expr $curhgt + [lindex $result 1] ] > $pagehgt } { - ::tk::print::_print page end - ::tk::print::_print page start + ::tk::print::_closepage + ::tk::print::_openpage set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] } } - ::tk::print::_print page end - ::tk::print::_print job end + ::tk::print::_print_closepage + ::tk::print::_print_closedoc } @@ -311,33 +279,12 @@ namespace eval ::tk::print { proc _print_widget { wid {printer default} {name "Tk Print Job"} } { - # start printing process ------ - if {[string match "default" $printer]} { - set hdc [::tk::print::_print open] - } else { - set hdc [::tk::print::_print dialog select] - if { [lindex $hdc 1] == 0 } { - # User has canceled printing - return - } - set hdc [ lindex $hdc 0 ] - } - variable p set p(0) 0 ; unset p(0) _page_args p - if {![info exist p(hDC)]} { - set hdc [::tk::print::_print open] - _page_args p - } - if {[string match "?" $hdc] || [string match 0x0 $hdc]} { - catch {::tk::print::_print close} - error "Problem opening printer: printer context cannot be established" - } - - ::tk::print::_print job start -name "$name" - ::tk::print::_print page start + ::tk::print::_opendoc + ::tk::print::_openpage # Here is where any scaling/gdi mapping should take place # For now, scale so the dimensions of the window are sized to the @@ -404,9 +351,9 @@ namespace eval ::tk::print { } # end printing process ------ - ::tk::print::_print page end - ::tk::print::_printj job end - ::tk::print::_print close + ::tk::print::_closepage + ::tk::print::_closedoc + ::tk::print::_closeprinter } diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index cfa2c20..2926d76 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -27,7 +27,7 @@ /* Initialize variables for later use. */ static PRINTDLG pd; static DOCINFO di; -int copies, paper_width, paper_height, dpi_x, dpi_y; +int copies, paper_width, paper_height, dpi_x, dpi_y, margin_left, margin_top; char *localPrinterName; PDEVMODE returnedDevmode; PDEVMODE localDevmode; @@ -73,6 +73,8 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_height = 0; dpi_x = 0; dpi_y = 0; + margin_left = 0; + margin_top = 0; /* Set up print dialog and initalize property structure. */ @@ -112,7 +114,9 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg dpi_x = localDevmode->dmPrintQuality; paper_height = (int) localDevmode->dmPaperLength; paper_width = (int) localDevmode->dmPaperWidth; - copies = pd.nCopies; + copies = pd.nCopies; + margin_left = GetDeviceCaps(hDC, PHYSICALOFFSETX); + margin_top = GetDeviceCaps(hDC, PHYSICALOFFSETY); } else { @@ -140,6 +144,8 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, TCL_LINK_INT | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, TCL_LINK_INT | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::margin_left", (char *)&margin_left, TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::margin_top", (char *)&margin_top, TCL_LINK_INT | TCL_LINK_READ_ONLY); return TCL_OK; } -- cgit v0.12 From 1e7d79df7dfdb25ac911ca112fc891e4f6bb68d9 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 6 May 2021 03:48:08 +0000 Subject: More work on gdi needed to expose commands --- library/print.tcl | 52 +++++++++++++++++++++++++--------------------------- win/tkWinGDI.c | 36 ++++++++++++++++++------------------ 2 files changed, 43 insertions(+), 45 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 4a08231..54d775d 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -25,7 +25,7 @@ namespace eval ::tk::print { variable ::tk::print::margin_left variable ::tk::print::margin_top variable printargs - set printargs "" + array set printargs {} # Multiple utility procedures for printing text based on the C printer # primitives. @@ -33,10 +33,9 @@ namespace eval ::tk::print { # _page_args: # Parse common arguments for text processing in the other commands. # - # Arguments: - # array - name of an array in which to store the various pieces needed for text processing. - proc _page_args { array } { - upvar #0 $array ary + # + proc _page_args {} { + variable printargs #First, we select the printer. ::tk::print::_selectprinter @@ -47,20 +46,22 @@ namespace eval ::tk::print { } #Next, set values. - set ary(hDC) $::tk::print::printer_name - set ary(pw) $::tk::print::paper_width - set ary(pl) $::tk::print::paper_height - set ary(lm) $::tk::print::margin_left - set ary(tm) $::tk::print::margin_top - set ary(rm) [list expr $ary(pw) - $ary(lm)] - set ary(bm) [list expr $ary(pl) - $ary(tm)] - set ary(resx) $::tk::print::dpi_x - set ary(resy) $::tk::print::dpi_y - set ary(copies) $::tk::print::copies - - if { ( [ info exist ary(hDC) ] == 0 ) || ($ary(hDC) == 0x0) } { + set printargs(hDC) $::tk::print::printer_name + set printargs(pw) $::tk::print::paper_width + set printargs(pl) $::tk::print::paper_height + set printargs(lm) 100 ;#$::tk::print::margin_left + set printargs(tm) 100 ;#$::tk::print::margin_top + set printargs(rm) [expr $printargs(pw) - $printargs(lm)] + set printargs(bm) [expr $printargs(pl) - $printargs(tm)] + set printargs(resx) $::tk::print::dpi_x + set printargs(resy) $::tk::print::dpi_y + set printargs(copies) $::tk::print::copies + + if { ( [ info exist printargs(hDC) ] == 0 ) || ($printargs(hDC) == 0x0) } { error "Can't get printer attributes" } + + return printargs } # _ print_page_data @@ -75,7 +76,8 @@ namespace eval ::tk::print { proc _print_page_data { data {fontargs {}} } { variable printargs - _page_args printargs + + _page_args set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] @@ -122,7 +124,7 @@ namespace eval ::tk::print { proc _print_data { data {breaklines 1 } {font {}} } { variable printargs - _page_args printargs + _page_args if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid @@ -278,10 +280,8 @@ namespace eval ::tk::print { # name - App name to pass to printer. proc _print_widget { wid {printer default} {name "Tk Print Job"} } { - - variable p - set p(0) 0 ; unset p(0) - _page_args p + + _page_args ::tk::print::_opendoc ::tk::print::_openpage @@ -568,10 +568,8 @@ namespace eval ::tk::print { proc _print_canvas.text {hdc cw id} { variable vtgPrint - variable p - - set p(0) 1 ; unset p(0) - _page_args p + + _page_args set color [_print_canvas.TransColor [$cw itemcget $id -fill]] # if {[string match white [string tolower $color]]} {return} diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index aae31f5..4bd205c 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -26,25 +26,25 @@ #include "tkWinHDC.h" /* Main dispatcher for commands. */ -static int TkWinGDI (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* Main dispatcher for subcommands. */ -static int TkWinGDISubcmd (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int TkWinGDISubcmd (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* Real functions. */ -static int GdiArc (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiBitmap (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiCharWidths (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiImage (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiPhoto (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiLine (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiOval (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiPolygon (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiRectangle(ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiText (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiMap (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); -static int GdiCopyBits (ClientData unused, Tcl_Interp *interp, int argc, const char **argv); +static int GdiArc (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiBitmap (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiCharWidths (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiImage (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiPhoto (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiLine (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiOval (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiPolygon (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiRectangle(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiText (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiMap (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiCopyBits (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* Local copies of similar routines elsewhere in Tcl/Tk. */ static int GdiParseColor (const char *name, unsigned long *color); @@ -107,13 +107,13 @@ static HDC get_dc(Tcl_Interp *interp, const char *name); *---------------------------------------------------------------------- */ -static int TkWinGDI (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) { if ( argc > 1 && strcmp(*argv, "::tk::print::_gdi") == 0 ) { argc--; argv++; - return TkWinGDISubcmd(unused, interp, argc, argv); + return TkWinGDISubcmd(clientData, interp, argc, argv); } Tcl_AppendResult(interp, gdi_usage_message, NULL); @@ -160,13 +160,13 @@ struct gdi_command *---------------------------------------------------------------------- */ -static int TkWinGDISubcmd (ClientData unused, Tcl_Interp *interp, int argc, const char **argv) +static int TkWinGDISubcmd (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) { size_t i; for (i=0; i Date: Thu, 6 May 2021 12:42:03 +0000 Subject: Gdi commands now active; next step: work out printing details at script level --- win/tkWinGDI.c | 20 ++++++++++++++++---- win/tkWinInit.c | 2 +- win/tkWinInt.h | 2 +- 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 4bd205c..82c48e8 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -51,8 +51,6 @@ static int GdiParseColor (const char *name, unsigned long *color); static int GdiGetColor (const char *name, unsigned long *color); static int TkGdiMakeBezierCurve(Tk_Canvas, double *, int, int, XPoint[], double[]); - - /* * Helper functions. */ @@ -109,6 +107,7 @@ static HDC get_dc(Tcl_Interp *interp, const char *name); static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) { + if ( argc > 1 && strcmp(*argv, "::tk::print::_gdi") == 0 ) { argc--; @@ -4649,11 +4648,24 @@ static HDC get_dc(Tcl_Interp *interp, const char *name) } } - +/* + *-------------------------------------------------------------- + * + * Gdi_Init -- + * + * Initializes the Gdi package. + * + * Results: + * Gdi commands initialized. + * + *-------------------------------------------------------------- + */ + int Gdi_Init(Tcl_Interp *interp) { - Tcl_CreateCommand(interp, ":tk::print::_gdi", TkWinGDI, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); + Tcl_CreateCommand(interp, "::tk::print::_gdi", TkWinGDI, + (ClientData)0, (Tcl_CmdDeleteProc *)0); return TCL_OK; } diff --git a/win/tkWinInit.c b/win/tkWinInit.c index d7e1dce..7060d0f 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -44,7 +44,7 @@ TkpInit( WinIcoInit(interp); Winprint_Init(interp); - Gdi_Init(interp); + Gdi_Init(interp); TkWinXInit(Tk_GetHINSTANCE()); return TCL_OK; } diff --git a/win/tkWinInt.h b/win/tkWinInt.h index 69617c2..702a574 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.h @@ -232,7 +232,7 @@ MODULE_SCOPE int Winprint_Init(Tcl_Interp* interp); */ -MODULE_SCOPE int Gdi_Init(Tcl_Interp *interp); +MODULE_SCOPE int Gdi_Init(Tcl_Interp* interp); /* * Common routines used in Windows implementation -- cgit v0.12 From d56d5577a75d2a367728e7f2fd9ff68ba98bed20 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 6 May 2021 15:51:40 +0000 Subject: Try to obtain printer HDC at script level for printing --- library/print.tcl | 2 +- win/Makefile.in | 1 - win/makefile.vc | 1 - win/tkWinHDC.c | 295 ------------------------------------------------------ win/tkWinHDC.h | 29 ------ win/tkWinPrint.c | 54 +++++++++- 6 files changed, 54 insertions(+), 328 deletions(-) delete mode 100644 win/tkWinHDC.c delete mode 100644 win/tkWinHDC.h diff --git a/library/print.tcl b/library/print.tcl index 54d775d..c6fb1d8 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -46,7 +46,7 @@ namespace eval ::tk::print { } #Next, set values. - set printargs(hDC) $::tk::print::printer_name + set printargs(hDC) ::tk::print::_gethdc set printargs(pw) $::tk::print::paper_width set printargs(pl) $::tk::print::paper_height set printargs(lm) 100 ;#$::tk::print::margin_left diff --git a/win/Makefile.in b/win/Makefile.in index d46ce74..849e79c 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -309,7 +309,6 @@ TK_OBJS = \ tkWinEmbed.$(OBJEXT) \ tkWinFont.$(OBJEXT) \ tkWinGDI.$(OBJEXT) \ - tkWinHDC.$(OBJEXT) \ tkWinIco.$(OBJEXT) \ tkWinImage.$(OBJEXT) \ tkWinInit.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index ee42f1e..4624265 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -189,7 +189,6 @@ TKOBJS = \ $(TMP_DIR)\tkWinEmbed.obj \ $(TMP_DIR)\tkWinFont.obj \ $(TMP_DIR)\tkWinGDI.obj \ - $(TMP_DIR)\tkWinHDC.obj \ $(TMP_DIR)\tkWinIco.obj \ $(TMP_DIR)\tkWinImage.obj \ $(TMP_DIR)\tkWinInit.obj \ diff --git a/win/tkWinHDC.c b/win/tkWinHDC.c deleted file mode 100644 index daca149..0000000 --- a/win/tkWinHDC.c +++ /dev/null @@ -1,295 +0,0 @@ -/* - * tkWinHDC.c -- - * - * This module implements utility functions for accessing hardware device contexts - * for graphics rendering in Windows. - * - * Copyright © 2009 Michael I. Schwartz. - * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - - -#include "tkWinHDC.h" - -/* - *---------------------------------------------------------------------- - * - * Hdc_build_name -- - * - * Creates HDC name. - * - * Results: - * HDC name created. - * - *---------------------------------------------------------------------- - */ - -static const char *Hdc_build_name(int type) -{ - const char *prefix; - Tcl_HashEntry *data; - int status; - - if ( (data = Tcl_FindHashEntry(&hdcprefixes, (char *)type)) != 0 ) - prefix = (const char *)Tcl_GetHashValue(data); - else - { - char *cp; - prefix = "hdc"; - if ( (cp = (char *)Tcl_Alloc(4)) != 0 ) - { - strcpy (cp, prefix); - if ( (data = Tcl_CreateHashEntry(&hdcprefixes, (char *)type, &status)) != 0 ) - Tcl_SetHashValue(data, (ClientData)cp); - } - } - - sprintf(hdc_name, "%s%ld", prefix, ++hdc_count); - return hdc_name; -} - - -/* - *---------------------------------------------------------------------- - * - * hdc_create -- - * - * Creates device context. - * - * Results: - * HDC created. - * - *---------------------------------------------------------------------- - */ - -const char * hdc_create (Tcl_Interp *interp, void *ptr, int type) -{ - struct hdc_value *pval; - const char *name; - Tcl_HashEntry *entry; - int status; - - pval = (struct hdc_value *)Tcl_Alloc(sizeof(struct hdc_value)); - if (pval == 0) - { - return 0; - } - pval->addr = ptr; - pval->type = type; - - name = Hdc_build_name(type); - if ( ( entry = Tcl_CreateHashEntry(&hdcs, name, &status)) != 0 ) - Tcl_SetHashValue(entry, (ClientData)pval); - return name; -} - - -/* - *---------------------------------------------------------------------- - * - * hdc_valid -- - * - * Tests validity of HDC. - * - * Results: - * HDC tested. - * - *---------------------------------------------------------------------- - */ - -int hdc_valid (Tcl_Interp *interp, const char *hdcname, int type) -{ - struct hdc_value *val; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) - { - val = (struct hdc_value *)Tcl_GetHashValue(data); - - if ( type <= 0 || val->type == type ) - return 1; - } - return 0; -} - - -/* - *---------------------------------------------------------------------- - * - * hdc_delete -- - * - * Dletes device context. - * - * Results: - * HDC created. - * - *---------------------------------------------------------------------- - */ - -int hdc_delete (Tcl_Interp *interp, const char *hdcname) -{ - struct hdc_value *val; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) - { - val = (struct hdc_value *)Tcl_GetHashValue(data); - - Tcl_DeleteHashEntry(data); - Tcl_Free((void *)val); - return 1; - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * - * hdc_get -- - * - * Gets device context. - * - * Results: - * HDC returned. - * - *---------------------------------------------------------------------- - */ - -void * hdc_get (Tcl_Interp *interp, const char *hdcname) -{ - struct hdc_value *val; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) - val = (struct hdc_value *)Tcl_GetHashValue(data); - else - return 0; - - return val->addr; -} - -/* - *---------------------------------------------------------------------- - * - * hdc_typeof -- - * - * Gets HDC type. - * - * Results: - * Type returned. - * - *---------------------------------------------------------------------- - */ - - -int hdc_typeof (Tcl_Interp *interp, const char *hdcname) -{ - struct hdc_value *val; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) - val = (struct hdc_value *)Tcl_GetHashValue(data); - - return val->type; -} - -/* - *---------------------------------------------------------------------- - * - * hdc_prefixof -- - * - * Gets HDC prefix. - * - * Results: - * Prefix returned. - * - *---------------------------------------------------------------------- - */ - -const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix) -{ - const char *prefix; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcprefixes, (char *)type)) != 0 ) - prefix = (const char *)Tcl_GetHashValue(data); - - if ( newprefix ) - { - char *cp; - size_t siz, len; - - siz = strlen(newprefix); - len = siz > 32 ? 32 : siz; - - if ( (cp = (char *)Tcl_Alloc(len+1)) != 0 ) - { - int newptr = 0; - - strncpy (cp, newprefix, len); - cp[len] = '\0'; - if ( data == 0 ) - data = Tcl_CreateHashEntry(&hdcprefixes,(char *)type,&newptr); - Tcl_SetHashValue(data, (ClientData)cp); - prefix = cp; - } - } - - return prefix; -} - -/* - *---------------------------------------------------------------------- - * - * hdc_list -- - * - * Lists all device contexts. - * - * Results: - * List of device contexts returned. - * - *---------------------------------------------------------------------- - */ - -int hdc_list (Tcl_Interp *interp, int type, const char *out[], int *poutlen) -{ - Tcl_HashEntry *ent; - Tcl_HashSearch srch; - int i=0; - const char *cp; - int retval = 0; - struct hdc_value *val; - - for ( ent = Tcl_FirstHashEntry(&hdcs, &srch); ent !=0; ent=Tcl_NextHashEntry(&srch)) - { - if ( (cp = Tcl_GetHashKey(&hdcs, ent)) != 0 ) - { - if ( i < *poutlen ) - { - if ( (val = (struct hdc_value *)Tcl_GetHashValue(ent) ) != 0 ) - { - if ( type <= 0 || type == val->type ) - { - out[i++] = cp; - retval++; - } - } - } - } - } - *poutlen = i; - return retval; -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ - - diff --git a/win/tkWinHDC.h b/win/tkWinHDC.h deleted file mode 100644 index c83c894..0000000 --- a/win/tkWinHDC.h +++ /dev/null @@ -1,29 +0,0 @@ -#include -#include -#include -#include - - -/* - * Static data and function prototypes. - */ - -struct hdc_value -{ - void *addr; - int type; -}; - -static unsigned long hdc_count = 0L; -static Tcl_HashTable hdcs; -static Tcl_HashTable hdcprefixes; -static char hdc_name [32+12+1]; - - -const char * hdc_create (Tcl_Interp *interp, void *ptr, int type); -int hdc_valid (Tcl_Interp *interp, const char *hdcname, int type); -int hdc_delete (Tcl_Interp *interp, const char *hdcname); -const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix); -int hdc_typeof (Tcl_Interp *interp, const char *hdcname); -void * hdc_get (Tcl_Interp *interp, const char *hdcname); -static const char *Hdc_build_name(int type); \ No newline at end of file diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 2926d76..f698bb7 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -44,6 +44,8 @@ static int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl static int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); static int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); static int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +HDC get_hdc(void); int Winprint_Init(Tcl_Interp * interp); /*---------------------------------------------------------------------- @@ -327,6 +329,54 @@ int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj /* * -------------------------------------------------------------------------- * + * PrintGetHDC-- + * + * Gets the device context for the printer. + * + * Results: + * Returns HDC. + * + * ------------------------------------------------------------------------- + */ + +int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +{ + + (void) clientData; + (void) argc; + (void) objv; + + if ( hDC == NULL) { + return TCL_ERROR; + } + + get_hdc(); + return TCL_OK; +} + +/* + * -------------------------------------------------------------------------- + * + * PrintGetHDC-- + * + * Gets the device context for the printer. + * + * Results: + * Returns HDC. + * + * ------------------------------------------------------------------------- + */ + + +HDC get_hdc(void) { + + return hDC; + +} + +/* + * -------------------------------------------------------------------------- + * * Winprint_Init-- * * Initializes printing module on Windows. @@ -336,6 +386,7 @@ int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * * ------------------------------------------------------------------------- */ + int Winprint_Init(Tcl_Interp * interp) { Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); @@ -344,7 +395,8 @@ int Winprint_Init(Tcl_Interp * interp) Tcl_CreateObjCommand(interp, "::tk::print::_opendoc", PrintOpenDoc, NULL, NULL); Tcl_CreateObjCommand(interp, "::tk::print::_closedoc", PrintCloseDoc, NULL, NULL); Tcl_CreateObjCommand(interp, "::tk::print::_openpage", PrintOpenPage, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_closepage", PrintClosePage, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_closepage", PrintClosePage, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_gethdc", PrintGetHDC, NULL, NULL); return TCL_OK; } -- cgit v0.12 From fae050f86b29acf35534ce93dbd7646f2e947fc7 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 6 May 2021 15:52:15 +0000 Subject: Further adjustments --- library/print.tcl | 6 +++--- win/tkWinPrint.c | 10 ++-------- 2 files changed, 5 insertions(+), 11 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index c6fb1d8..0cd4c12 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -46,11 +46,11 @@ namespace eval ::tk::print { } #Next, set values. - set printargs(hDC) ::tk::print::_gethdc + set printargs(hDC) [::tk::print::_gethdc] set printargs(pw) $::tk::print::paper_width set printargs(pl) $::tk::print::paper_height - set printargs(lm) 100 ;#$::tk::print::margin_left - set printargs(tm) 100 ;#$::tk::print::margin_top + set printargs(lm) 100 + set printargs(tm) 100 set printargs(rm) [expr $printargs(pw) - $printargs(lm)] set printargs(bm) [expr $printargs(pl) - $printargs(tm)] set printargs(resx) $::tk::print::dpi_x diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index f698bb7..2157287 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -27,7 +27,7 @@ /* Initialize variables for later use. */ static PRINTDLG pd; static DOCINFO di; -int copies, paper_width, paper_height, dpi_x, dpi_y, margin_left, margin_top; +int copies, paper_width, paper_height, dpi_x, dpi_y; char *localPrinterName; PDEVMODE returnedDevmode; PDEVMODE localDevmode; @@ -75,8 +75,6 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_height = 0; dpi_x = 0; dpi_y = 0; - margin_left = 0; - margin_top = 0; /* Set up print dialog and initalize property structure. */ @@ -117,8 +115,6 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_height = (int) localDevmode->dmPaperLength; paper_width = (int) localDevmode->dmPaperWidth; copies = pd.nCopies; - margin_left = GetDeviceCaps(hDC, PHYSICALOFFSETX); - margin_top = GetDeviceCaps(hDC, PHYSICALOFFSETY); } else { @@ -146,9 +142,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, TCL_LINK_INT | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, TCL_LINK_INT | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::margin_left", (char *)&margin_left, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::margin_top", (char *)&margin_top, TCL_LINK_INT | TCL_LINK_READ_ONLY); - + return TCL_OK; } -- cgit v0.12 From 8c12b56e5d09af1b345f0d91a8b8f59e3bad5404 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 7 May 2021 10:43:08 +0000 Subject: Restore HDC management code - seems to be key to linking gdi and printing API's --- win/Makefile.in | 1 + win/makefile.vc | 1 + win/tkWinHDC.c | 295 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ win/tkWinHDC.h | 29 ++++++ 4 files changed, 326 insertions(+) create mode 100644 win/tkWinHDC.c create mode 100644 win/tkWinHDC.h diff --git a/win/Makefile.in b/win/Makefile.in index 849e79c..d46ce74 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -309,6 +309,7 @@ TK_OBJS = \ tkWinEmbed.$(OBJEXT) \ tkWinFont.$(OBJEXT) \ tkWinGDI.$(OBJEXT) \ + tkWinHDC.$(OBJEXT) \ tkWinIco.$(OBJEXT) \ tkWinImage.$(OBJEXT) \ tkWinInit.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index 4624265..ee42f1e 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -189,6 +189,7 @@ TKOBJS = \ $(TMP_DIR)\tkWinEmbed.obj \ $(TMP_DIR)\tkWinFont.obj \ $(TMP_DIR)\tkWinGDI.obj \ + $(TMP_DIR)\tkWinHDC.obj \ $(TMP_DIR)\tkWinIco.obj \ $(TMP_DIR)\tkWinImage.obj \ $(TMP_DIR)\tkWinInit.obj \ diff --git a/win/tkWinHDC.c b/win/tkWinHDC.c new file mode 100644 index 0000000..daca149 --- /dev/null +++ b/win/tkWinHDC.c @@ -0,0 +1,295 @@ +/* + * tkWinHDC.c -- + * + * This module implements utility functions for accessing hardware device contexts + * for graphics rendering in Windows. + * + * Copyright © 2009 Michael I. Schwartz. + * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + + +#include "tkWinHDC.h" + +/* + *---------------------------------------------------------------------- + * + * Hdc_build_name -- + * + * Creates HDC name. + * + * Results: + * HDC name created. + * + *---------------------------------------------------------------------- + */ + +static const char *Hdc_build_name(int type) +{ + const char *prefix; + Tcl_HashEntry *data; + int status; + + if ( (data = Tcl_FindHashEntry(&hdcprefixes, (char *)type)) != 0 ) + prefix = (const char *)Tcl_GetHashValue(data); + else + { + char *cp; + prefix = "hdc"; + if ( (cp = (char *)Tcl_Alloc(4)) != 0 ) + { + strcpy (cp, prefix); + if ( (data = Tcl_CreateHashEntry(&hdcprefixes, (char *)type, &status)) != 0 ) + Tcl_SetHashValue(data, (ClientData)cp); + } + } + + sprintf(hdc_name, "%s%ld", prefix, ++hdc_count); + return hdc_name; +} + + +/* + *---------------------------------------------------------------------- + * + * hdc_create -- + * + * Creates device context. + * + * Results: + * HDC created. + * + *---------------------------------------------------------------------- + */ + +const char * hdc_create (Tcl_Interp *interp, void *ptr, int type) +{ + struct hdc_value *pval; + const char *name; + Tcl_HashEntry *entry; + int status; + + pval = (struct hdc_value *)Tcl_Alloc(sizeof(struct hdc_value)); + if (pval == 0) + { + return 0; + } + pval->addr = ptr; + pval->type = type; + + name = Hdc_build_name(type); + if ( ( entry = Tcl_CreateHashEntry(&hdcs, name, &status)) != 0 ) + Tcl_SetHashValue(entry, (ClientData)pval); + return name; +} + + +/* + *---------------------------------------------------------------------- + * + * hdc_valid -- + * + * Tests validity of HDC. + * + * Results: + * HDC tested. + * + *---------------------------------------------------------------------- + */ + +int hdc_valid (Tcl_Interp *interp, const char *hdcname, int type) +{ + struct hdc_value *val; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) + { + val = (struct hdc_value *)Tcl_GetHashValue(data); + + if ( type <= 0 || val->type == type ) + return 1; + } + return 0; +} + + +/* + *---------------------------------------------------------------------- + * + * hdc_delete -- + * + * Dletes device context. + * + * Results: + * HDC created. + * + *---------------------------------------------------------------------- + */ + +int hdc_delete (Tcl_Interp *interp, const char *hdcname) +{ + struct hdc_value *val; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) + { + val = (struct hdc_value *)Tcl_GetHashValue(data); + + Tcl_DeleteHashEntry(data); + Tcl_Free((void *)val); + return 1; + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * hdc_get -- + * + * Gets device context. + * + * Results: + * HDC returned. + * + *---------------------------------------------------------------------- + */ + +void * hdc_get (Tcl_Interp *interp, const char *hdcname) +{ + struct hdc_value *val; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) + val = (struct hdc_value *)Tcl_GetHashValue(data); + else + return 0; + + return val->addr; +} + +/* + *---------------------------------------------------------------------- + * + * hdc_typeof -- + * + * Gets HDC type. + * + * Results: + * Type returned. + * + *---------------------------------------------------------------------- + */ + + +int hdc_typeof (Tcl_Interp *interp, const char *hdcname) +{ + struct hdc_value *val; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) + val = (struct hdc_value *)Tcl_GetHashValue(data); + + return val->type; +} + +/* + *---------------------------------------------------------------------- + * + * hdc_prefixof -- + * + * Gets HDC prefix. + * + * Results: + * Prefix returned. + * + *---------------------------------------------------------------------- + */ + +const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix) +{ + const char *prefix; + Tcl_HashEntry *data; + + if ( (data = Tcl_FindHashEntry(&hdcprefixes, (char *)type)) != 0 ) + prefix = (const char *)Tcl_GetHashValue(data); + + if ( newprefix ) + { + char *cp; + size_t siz, len; + + siz = strlen(newprefix); + len = siz > 32 ? 32 : siz; + + if ( (cp = (char *)Tcl_Alloc(len+1)) != 0 ) + { + int newptr = 0; + + strncpy (cp, newprefix, len); + cp[len] = '\0'; + if ( data == 0 ) + data = Tcl_CreateHashEntry(&hdcprefixes,(char *)type,&newptr); + Tcl_SetHashValue(data, (ClientData)cp); + prefix = cp; + } + } + + return prefix; +} + +/* + *---------------------------------------------------------------------- + * + * hdc_list -- + * + * Lists all device contexts. + * + * Results: + * List of device contexts returned. + * + *---------------------------------------------------------------------- + */ + +int hdc_list (Tcl_Interp *interp, int type, const char *out[], int *poutlen) +{ + Tcl_HashEntry *ent; + Tcl_HashSearch srch; + int i=0; + const char *cp; + int retval = 0; + struct hdc_value *val; + + for ( ent = Tcl_FirstHashEntry(&hdcs, &srch); ent !=0; ent=Tcl_NextHashEntry(&srch)) + { + if ( (cp = Tcl_GetHashKey(&hdcs, ent)) != 0 ) + { + if ( i < *poutlen ) + { + if ( (val = (struct hdc_value *)Tcl_GetHashValue(ent) ) != 0 ) + { + if ( type <= 0 || type == val->type ) + { + out[i++] = cp; + retval++; + } + } + } + } + } + *poutlen = i; + return retval; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ + + diff --git a/win/tkWinHDC.h b/win/tkWinHDC.h new file mode 100644 index 0000000..c83c894 --- /dev/null +++ b/win/tkWinHDC.h @@ -0,0 +1,29 @@ +#include +#include +#include +#include + + +/* + * Static data and function prototypes. + */ + +struct hdc_value +{ + void *addr; + int type; +}; + +static unsigned long hdc_count = 0L; +static Tcl_HashTable hdcs; +static Tcl_HashTable hdcprefixes; +static char hdc_name [32+12+1]; + + +const char * hdc_create (Tcl_Interp *interp, void *ptr, int type); +int hdc_valid (Tcl_Interp *interp, const char *hdcname, int type); +int hdc_delete (Tcl_Interp *interp, const char *hdcname); +const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix); +int hdc_typeof (Tcl_Interp *interp, const char *hdcname); +void * hdc_get (Tcl_Interp *interp, const char *hdcname); +static const char *Hdc_build_name(int type); \ No newline at end of file -- cgit v0.12 From 2df69ce47b11d6fb46cd983002825ee006254975 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 7 May 2021 20:58:09 +0000 Subject: Minor tweaks --- win/tkWinHDC.c | 6 +++--- win/tkWinHDC.h | 2 +- win/tkWinPrint.c | 4 +++- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/win/tkWinHDC.c b/win/tkWinHDC.c index daca149..9464f07 100644 --- a/win/tkWinHDC.c +++ b/win/tkWinHDC.c @@ -17,7 +17,7 @@ /* *---------------------------------------------------------------------- * - * Hdc_build_name -- + * hdc_build_name -- * * Creates HDC name. * @@ -27,7 +27,7 @@ *---------------------------------------------------------------------- */ -static const char *Hdc_build_name(int type) +static const char * hdc_build_name(int type) { const char *prefix; Tcl_HashEntry *data; @@ -80,7 +80,7 @@ const char * hdc_create (Tcl_Interp *interp, void *ptr, int type) pval->addr = ptr; pval->type = type; - name = Hdc_build_name(type); + name = hdc_build_name(type); if ( ( entry = Tcl_CreateHashEntry(&hdcs, name, &status)) != 0 ) Tcl_SetHashValue(entry, (ClientData)pval); return name; diff --git a/win/tkWinHDC.h b/win/tkWinHDC.h index c83c894..e9d4c1b 100644 --- a/win/tkWinHDC.h +++ b/win/tkWinHDC.h @@ -26,4 +26,4 @@ int hdc_delete (Tcl_Interp *interp, const char *hdcname); const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix); int hdc_typeof (Tcl_Interp *interp, const char *hdcname); void * hdc_get (Tcl_Interp *interp, const char *hdcname); -static const char *Hdc_build_name(int type); \ No newline at end of file +static const char *hdc_build_name(int type); diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 2157287..d6a6ea5 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -22,7 +22,7 @@ #include #include #include - +#include "tkWinHDC.h" /* Initialize variables for later use. */ static PRINTDLG pd; @@ -345,6 +345,8 @@ int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *co } get_hdc(); + char hdcbuffer[20]; + sprintf(hdcbuffer, "the hdc is 0x%lx", hDC); return TCL_OK; } -- cgit v0.12 From 8e6d6481d28a0d922380c5c24cdf4e58085f07c3 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 7 May 2021 20:59:33 +0000 Subject: Compiler error --- win/tkWinPrint.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index d6a6ea5..4328e1b 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -345,8 +345,6 @@ int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *co } get_hdc(); - char hdcbuffer[20]; - sprintf(hdcbuffer, "the hdc is 0x%lx", hDC); return TCL_OK; } -- cgit v0.12 From 5de5d89154de7b662db91a75e8f9453c07b42300 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 7 May 2021 21:03:14 +0000 Subject: Fix [https://core.tcl-lang.org/tcl/tktview?name=bb937366b4|bb937366b4] --- generic/tkUtil.c | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 8595144..321b7ac 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -1298,13 +1298,15 @@ TkUtfAtIndex( Tcl_UniChar ch = 0; size_t len = 0; - while (index-- > 0) { - len = Tcl_UtfToUniChar(src, &ch); - src += len; - } - if ((ch >= 0xD800) && (len < 3)) { - /* Index points at character following high Surrogate */ - src += Tcl_UtfToUniChar(src, &ch); + if (index != (size_t)-1) { + while (index-- > 0) { + len = Tcl_UtfToUniChar(src, &ch); + src += len; + } + if ((ch >= 0xD800) && (len < 3)) { + /* Index points at character following high Surrogate */ + src += Tcl_UtfToUniChar(src, &ch); + } } return src; } -- cgit v0.12 From 840a31c2cb9adc4fd9bf623f96d9c13c6f770b58 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 8 May 2021 00:30:44 +0000 Subject: More changes --- win/Makefile.in | 1 - win/makefile.vc | 1 - win/tkWinHDC.c | 295 ------------------------------------------------------- win/tkWinHDC.h | 29 ------ win/tkWinPrint.c | 7 +- 5 files changed, 5 insertions(+), 328 deletions(-) delete mode 100644 win/tkWinHDC.c delete mode 100644 win/tkWinHDC.h diff --git a/win/Makefile.in b/win/Makefile.in index d46ce74..849e79c 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -309,7 +309,6 @@ TK_OBJS = \ tkWinEmbed.$(OBJEXT) \ tkWinFont.$(OBJEXT) \ tkWinGDI.$(OBJEXT) \ - tkWinHDC.$(OBJEXT) \ tkWinIco.$(OBJEXT) \ tkWinImage.$(OBJEXT) \ tkWinInit.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index ee42f1e..4624265 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -189,7 +189,6 @@ TKOBJS = \ $(TMP_DIR)\tkWinEmbed.obj \ $(TMP_DIR)\tkWinFont.obj \ $(TMP_DIR)\tkWinGDI.obj \ - $(TMP_DIR)\tkWinHDC.obj \ $(TMP_DIR)\tkWinIco.obj \ $(TMP_DIR)\tkWinImage.obj \ $(TMP_DIR)\tkWinInit.obj \ diff --git a/win/tkWinHDC.c b/win/tkWinHDC.c deleted file mode 100644 index 9464f07..0000000 --- a/win/tkWinHDC.c +++ /dev/null @@ -1,295 +0,0 @@ -/* - * tkWinHDC.c -- - * - * This module implements utility functions for accessing hardware device contexts - * for graphics rendering in Windows. - * - * Copyright © 2009 Michael I. Schwartz. - * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - - -#include "tkWinHDC.h" - -/* - *---------------------------------------------------------------------- - * - * hdc_build_name -- - * - * Creates HDC name. - * - * Results: - * HDC name created. - * - *---------------------------------------------------------------------- - */ - -static const char * hdc_build_name(int type) -{ - const char *prefix; - Tcl_HashEntry *data; - int status; - - if ( (data = Tcl_FindHashEntry(&hdcprefixes, (char *)type)) != 0 ) - prefix = (const char *)Tcl_GetHashValue(data); - else - { - char *cp; - prefix = "hdc"; - if ( (cp = (char *)Tcl_Alloc(4)) != 0 ) - { - strcpy (cp, prefix); - if ( (data = Tcl_CreateHashEntry(&hdcprefixes, (char *)type, &status)) != 0 ) - Tcl_SetHashValue(data, (ClientData)cp); - } - } - - sprintf(hdc_name, "%s%ld", prefix, ++hdc_count); - return hdc_name; -} - - -/* - *---------------------------------------------------------------------- - * - * hdc_create -- - * - * Creates device context. - * - * Results: - * HDC created. - * - *---------------------------------------------------------------------- - */ - -const char * hdc_create (Tcl_Interp *interp, void *ptr, int type) -{ - struct hdc_value *pval; - const char *name; - Tcl_HashEntry *entry; - int status; - - pval = (struct hdc_value *)Tcl_Alloc(sizeof(struct hdc_value)); - if (pval == 0) - { - return 0; - } - pval->addr = ptr; - pval->type = type; - - name = hdc_build_name(type); - if ( ( entry = Tcl_CreateHashEntry(&hdcs, name, &status)) != 0 ) - Tcl_SetHashValue(entry, (ClientData)pval); - return name; -} - - -/* - *---------------------------------------------------------------------- - * - * hdc_valid -- - * - * Tests validity of HDC. - * - * Results: - * HDC tested. - * - *---------------------------------------------------------------------- - */ - -int hdc_valid (Tcl_Interp *interp, const char *hdcname, int type) -{ - struct hdc_value *val; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) - { - val = (struct hdc_value *)Tcl_GetHashValue(data); - - if ( type <= 0 || val->type == type ) - return 1; - } - return 0; -} - - -/* - *---------------------------------------------------------------------- - * - * hdc_delete -- - * - * Dletes device context. - * - * Results: - * HDC created. - * - *---------------------------------------------------------------------- - */ - -int hdc_delete (Tcl_Interp *interp, const char *hdcname) -{ - struct hdc_value *val; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) - { - val = (struct hdc_value *)Tcl_GetHashValue(data); - - Tcl_DeleteHashEntry(data); - Tcl_Free((void *)val); - return 1; - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * - * hdc_get -- - * - * Gets device context. - * - * Results: - * HDC returned. - * - *---------------------------------------------------------------------- - */ - -void * hdc_get (Tcl_Interp *interp, const char *hdcname) -{ - struct hdc_value *val; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) - val = (struct hdc_value *)Tcl_GetHashValue(data); - else - return 0; - - return val->addr; -} - -/* - *---------------------------------------------------------------------- - * - * hdc_typeof -- - * - * Gets HDC type. - * - * Results: - * Type returned. - * - *---------------------------------------------------------------------- - */ - - -int hdc_typeof (Tcl_Interp *interp, const char *hdcname) -{ - struct hdc_value *val; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcs, hdcname)) != 0 ) - val = (struct hdc_value *)Tcl_GetHashValue(data); - - return val->type; -} - -/* - *---------------------------------------------------------------------- - * - * hdc_prefixof -- - * - * Gets HDC prefix. - * - * Results: - * Prefix returned. - * - *---------------------------------------------------------------------- - */ - -const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix) -{ - const char *prefix; - Tcl_HashEntry *data; - - if ( (data = Tcl_FindHashEntry(&hdcprefixes, (char *)type)) != 0 ) - prefix = (const char *)Tcl_GetHashValue(data); - - if ( newprefix ) - { - char *cp; - size_t siz, len; - - siz = strlen(newprefix); - len = siz > 32 ? 32 : siz; - - if ( (cp = (char *)Tcl_Alloc(len+1)) != 0 ) - { - int newptr = 0; - - strncpy (cp, newprefix, len); - cp[len] = '\0'; - if ( data == 0 ) - data = Tcl_CreateHashEntry(&hdcprefixes,(char *)type,&newptr); - Tcl_SetHashValue(data, (ClientData)cp); - prefix = cp; - } - } - - return prefix; -} - -/* - *---------------------------------------------------------------------- - * - * hdc_list -- - * - * Lists all device contexts. - * - * Results: - * List of device contexts returned. - * - *---------------------------------------------------------------------- - */ - -int hdc_list (Tcl_Interp *interp, int type, const char *out[], int *poutlen) -{ - Tcl_HashEntry *ent; - Tcl_HashSearch srch; - int i=0; - const char *cp; - int retval = 0; - struct hdc_value *val; - - for ( ent = Tcl_FirstHashEntry(&hdcs, &srch); ent !=0; ent=Tcl_NextHashEntry(&srch)) - { - if ( (cp = Tcl_GetHashKey(&hdcs, ent)) != 0 ) - { - if ( i < *poutlen ) - { - if ( (val = (struct hdc_value *)Tcl_GetHashValue(ent) ) != 0 ) - { - if ( type <= 0 || type == val->type ) - { - out[i++] = cp; - retval++; - } - } - } - } - } - *poutlen = i; - return retval; -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ - - diff --git a/win/tkWinHDC.h b/win/tkWinHDC.h deleted file mode 100644 index e9d4c1b..0000000 --- a/win/tkWinHDC.h +++ /dev/null @@ -1,29 +0,0 @@ -#include -#include -#include -#include - - -/* - * Static data and function prototypes. - */ - -struct hdc_value -{ - void *addr; - int type; -}; - -static unsigned long hdc_count = 0L; -static Tcl_HashTable hdcs; -static Tcl_HashTable hdcprefixes; -static char hdc_name [32+12+1]; - - -const char * hdc_create (Tcl_Interp *interp, void *ptr, int type); -int hdc_valid (Tcl_Interp *interp, const char *hdcname, int type); -int hdc_delete (Tcl_Interp *interp, const char *hdcname); -const char * hdc_prefixof (Tcl_Interp *interp, int type, const char *newprefix); -int hdc_typeof (Tcl_Interp *interp, const char *hdcname); -void * hdc_get (Tcl_Interp *interp, const char *hdcname); -static const char *hdc_build_name(int type); diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 4328e1b..3b3cc12 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -125,7 +125,8 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg GlobalFree(pd.hDevMode); } } - + + /* * Store print properties and link variables * so they can be accessed from script level. @@ -339,12 +340,14 @@ int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *co (void) clientData; (void) argc; (void) objv; + + hDC = CreateDC( L"WINSPOOL", localPrinterName, NULL, NULL); if ( hDC == NULL) { return TCL_ERROR; } - get_hdc(); + // get_hdc(); return TCL_OK; } -- cgit v0.12 From 5ec5b413155ce154aad7d777092d510a717ed390 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 8 May 2021 01:27:53 +0000 Subject: Minor adjustments --- library/print.tcl | 12 ++++++------ win/tkWinGDI.c | 1 - win/tkWinPrint.c | 8 +++----- 3 files changed, 9 insertions(+), 12 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 0cd4c12..1abfa63 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -46,7 +46,7 @@ namespace eval ::tk::print { } #Next, set values. - set printargs(hDC) [::tk::print::_gethdc] + set printargs(hDC) [::tk::print::_gethdc] set printargs(pw) $::tk::print::paper_width set printargs(pl) $::tk::print::paper_height set printargs(lm) 100 @@ -57,9 +57,9 @@ namespace eval ::tk::print { set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - if { ( [ info exist printargs(hDC) ] == 0 ) || ($printargs(hDC) == 0x0) } { - error "Can't get printer attributes" - } + # if { ( [ info exist printargs(hDC) ] == 0 ) || ($printargs(hDC) == 0x0) } { + # error "Can't get printer attributes" + # } return printargs } @@ -84,7 +84,7 @@ namespace eval ::tk::print { set pw [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] ::tk::print::_opendoc ::tk::print::_openpage - eval gdi text $printargs(hDC) $lm $tm \ + eval ::tk::print::_gdi text $printargs(hDC) $lm $tm \ -anchor nw -text [list $data] \ -width $pw \ $fontargs @@ -127,7 +127,7 @@ namespace eval ::tk::print { _page_args if { [string length $font] == 0 } { - eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid + eval ::tk::print::_gdi characters -array printcharwid } else { eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 82c48e8..55a363d 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -23,7 +23,6 @@ #include #include "tkWinInt.h" -#include "tkWinHDC.h" /* Main dispatcher for commands. */ static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c index 3b3cc12..4c35233 100644 --- a/win/tkWinPrint.c +++ b/win/tkWinPrint.c @@ -22,7 +22,6 @@ #include #include #include -#include "tkWinHDC.h" /* Initialize variables for later use. */ static PRINTDLG pd; @@ -341,20 +340,19 @@ int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *co (void) argc; (void) objv; - hDC = CreateDC( L"WINSPOOL", localPrinterName, NULL, NULL); if ( hDC == NULL) { return TCL_ERROR; } - // get_hdc(); + get_hdc(); return TCL_OK; } /* * -------------------------------------------------------------------------- * - * PrintGetHDC-- + * get_hdc-- * * Gets the device context for the printer. * @@ -366,7 +364,7 @@ int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *co HDC get_hdc(void) { - + return hDC; } -- cgit v0.12 -- cgit v0.12 From ec9816bbeaaaa5016f108d999f84d88660823f56 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 8 May 2021 13:55:37 +0000 Subject: Minor progress --- library/print.tcl | 12 ++++-------- win/tkWinGDI.c | 8 +++++--- 2 files changed, 9 insertions(+), 11 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 8df1173..af539eb 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -56,10 +56,6 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - - if { ( [ info exist printargs(hDC) ] == 0 ) || ($printargs(hDC) == 0x0) } { - error "Can't get printer attributes" - } return printargs } @@ -84,7 +80,7 @@ namespace eval ::tk::print { set pw [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] ::tk::print::_opendoc ::tk::print::_openpage - eval ::tk::print::_gdi text $printargs(hDC) $lm $tm \ + eval ::tk::print::_gdi text $::tk::print::printer_name $lm $tm \ -anchor nw -text [list $data] \ -width $pw \ $fontargs @@ -129,7 +125,7 @@ namespace eval ::tk::print { if { [string length $font] == 0 } { eval ::tk::print::_gdi characters -array printcharwid } else { - eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid + eval ::tk::print::_gdi characters $::tk::print::printer_name -font $font -array printcharwid } set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] @@ -237,12 +233,12 @@ namespace eval ::tk::print { } if { [string length $font] > 0 } { - set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ + set result [ ::tk::print::_gdi text $::tk::print::printer_name $lm $y \ -anchor nw -justify left \ -text [ string trim [ string range $string 0 $endindex ] "\r\n" ] \ -font $font ] } else { - set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ + set result [ ::tk::print::_gdi text $::tk::print::printer_name $lm $y \ -anchor nw -justify left \ -text [string trim [ string range $string 0 $endindex ] "\r\n" ] ] } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 5e8c57b..fff10b7 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -3,8 +3,9 @@ * * This module implements access to the Win32 GDI API. * - * Copyright © 1991-1996 Microsoft Corp. + * Copyright © 1991-2018 Microsoft Corp. * Copyright © 2009, Michael I. Schwartz. + * Copyright © 1998-2019 Harald Oehlmann, Elmicron GmbH * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of @@ -110,8 +111,6 @@ PDEVMODE returnedDevmode; PDEVMODE localDevmode; static HDC printDC; - - /* *---------------------------------------------------------------------- * @@ -4639,6 +4638,8 @@ static HDC get_dc(Tcl_Interp *interp) /* ANY type of DC should be ok here. */ unsigned long tmp; + tmp = 0; + RestoreDC(printDC, -1); DWORD objtype = GetObjectType(printDC); switch (objtype) { @@ -5023,6 +5024,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg Tcl_AppendResult(interp, "can't allocate printer DC", NULL); return TCL_ERROR; } + SaveDC(printDC); /*Get document info.*/ ZeroMemory( &di, sizeof(di)); -- cgit v0.12 From 8df3383c775fa89566f9c5d97218fe46299cf784 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 8 May 2021 21:29:35 +0000 Subject: Trying to identify why DC is not passed / retained --- win/tkWinGDI.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index fff10b7..cf9948d 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4639,7 +4639,8 @@ static HDC get_dc(Tcl_Interp *interp) unsigned long tmp; tmp = 0; - RestoreDC(printDC, -1); + + RestoreDC(printDC, -1); DWORD objtype = GetObjectType(printDC); switch (objtype) { @@ -5025,7 +5026,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg return TCL_ERROR; } SaveDC(printDC); - + /*Get document info.*/ ZeroMemory( &di, sizeof(di)); di.cbSize = sizeof(di); @@ -5051,7 +5052,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_height = (int) localDevmode->dmPaperLength; paper_width = (int) localDevmode->dmPaperWidth; copies = pd.nCopies; - } + DWORD objtype2 = GetObjectType(printDC); else { localDevmode = NULL; -- cgit v0.12 From 4df2c67e3b928bf159d2b8e64b706f4941f7d573 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 9 May 2021 20:12:38 +0000 Subject: Test new approach for getting DC --- win/tkWinGDI.c | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index cf9948d..f050dd8 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -107,6 +107,8 @@ static PRINTDLG pd; static DOCINFO di; int copies, paper_width, paper_height, dpi_x, dpi_y; char *localPrinterName; +LPCTSTR printerName; +const LPDEVNAMES devnames; PDEVMODE returnedDevmode; PDEVMODE localDevmode; static HDC printDC; @@ -4635,12 +4637,18 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { + printDC = CreateDC((LPCTSTR)pDevNames + pDevNames->wDriverOffset, + (LPCTSTR)pDevNames + pDevNames->wDeviceOffset, + (LPCTSTR)pDevNames + pDevNames->wOutputOffset, + pDevMode); + GlobalUnlock(pd.hDevNames); + /* ANY type of DC should be ok here. */ unsigned long tmp; tmp = 0; - RestoreDC(printDC, -1); + // RestoreDC(printDC, -1); DWORD objtype = GetObjectType(printDC); switch (objtype) { @@ -5006,6 +5014,8 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg returnedDevmode = NULL; localDevmode = NULL; localPrinterName = NULL; + devnames = NULL; + printerName = NULL; copies = 0; paper_width = 0; paper_height = 0; @@ -5017,7 +5027,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg ZeroMemory( &pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); - pd.Flags = PD_RETURNDC | PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; + pd.Flags = /*PD_RETURNDC*/ | PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; if (PrintDlg(&pd) == TRUE) { printDC = pd.hDC; @@ -5034,7 +5044,8 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg /* Copy print attributes to local structure. */ - returnedDevmode = (PDEVMODE)GlobalLock(pd.hDevMode); + returnedDevmode = (PDEVMODE)GlobalLock(pd.hDevMode); + devname = (LPDEVNAMES)GlobalLock(pd.hDevNames); localDevmode = (LPDEVMODE)HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); -- cgit v0.12 From d1da25d8f4d0359a4c787e0ceda817764e014fb3 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 9 May 2021 20:36:13 +0000 Subject: Tweaks --- win/tkWinGDI.c | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index f050dd8..911eac0 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -108,7 +108,6 @@ static DOCINFO di; int copies, paper_width, paper_height, dpi_x, dpi_y; char *localPrinterName; LPCTSTR printerName; -const LPDEVNAMES devnames; PDEVMODE returnedDevmode; PDEVMODE localDevmode; static HDC printDC; @@ -4637,11 +4636,8 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { - printDC = CreateDC((LPCTSTR)pDevNames + pDevNames->wDriverOffset, - (LPCTSTR)pDevNames + pDevNames->wDeviceOffset, - (LPCTSTR)pDevNames + pDevNames->wOutputOffset, - pDevMode); - GlobalUnlock(pd.hDevNames); + printDC = CreateDC("WINSPOOL", printerName, NULL, NULL); + /* ANY type of DC should be ok here. */ @@ -5014,7 +5010,6 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg returnedDevmode = NULL; localDevmode = NULL; localPrinterName = NULL; - devnames = NULL; printerName = NULL; copies = 0; paper_width = 0; @@ -5027,7 +5022,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg ZeroMemory( &pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); - pd.Flags = /*PD_RETURNDC*/ | PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; + pd.Flags = /*PD_RETURNDC |*/ PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; if (PrintDlg(&pd) == TRUE) { printDC = pd.hDC; @@ -5045,7 +5040,8 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg /* Copy print attributes to local structure. */ returnedDevmode = (PDEVMODE)GlobalLock(pd.hDevMode); - devname = (LPDEVNAMES)GlobalLock(pd.hDevNames); + const LPDEVNAMES devnames = (LPDEVNAMES)GlobalLock(pd.hDevNames); + printerName = (LPCTSTR) devnames + devnames->wDeviceOffset; localDevmode = (LPDEVMODE)HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); @@ -5063,17 +5059,20 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_height = (int) localDevmode->dmPaperLength; paper_width = (int) localDevmode->dmPaperWidth; copies = pd.nCopies; - DWORD objtype2 = GetObjectType(printDC); + } else { localDevmode = NULL; } - if (pd.hDevMode !=NULL) - { - GlobalFree(pd.hDevMode); - } } - + if (pd.hDevMode !=NULL) + { + GlobalFree(pd.hDevMode); + } + if (pd.hDevNames != NULL) + { + GlobalUnlock(pd.hDevNames); + } /* * Store print properties and link variables -- cgit v0.12 From a4629f9ba9c6eea1dcc6cb1226364ef683f15cce Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 9 May 2021 21:18:24 +0000 Subject: Further revision --- library/print.tcl | 28 ++++++++++++++-------------- win/tkWinGDI.c | 27 +++++++++++++++++---------- 2 files changed, 31 insertions(+), 24 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index af539eb..efe3d18 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -46,7 +46,7 @@ namespace eval ::tk::print { } #Next, set values. - set printargs(hDC) $::tk::print::printer_name + set printargs(hDC) {} set printargs(pw) $::tk::print::paper_width set printargs(pl) $::tk::print::paper_height set printargs(lm) 100 @@ -328,14 +328,14 @@ namespace eval ::tk::print { set ph $printer_x } - ::tk::print::_gdi map $hdc -logical $lo -physical $ph -offset $p(resolution) + ::tk::print::_gdi map $::tk::print::printer_name -logical $lo -physical $ph -offset $p(resolution) # handling of canvas widgets # additional procs can be added for other widget types switch [winfo class $wid] { Canvas { # if {[catch { - _print_canvas [lindex $hdc 0] $wid + _print_canvas [lindex $::tk::print::printer_name 0] $wid # } msg]} { # debug_puts "print_widget: $msg" # error "Windows Printing Problem: $msg" @@ -372,7 +372,7 @@ namespace eval ::tk::print { foreach id [$cw find all] { set type [$cw type $id] if { [ info commands _print_canvas.$type ] == "_print_canvas.$type" } { - _print_canvas.[$cw type $id] $hdc $cw $id + _print_canvas.[$cw type $id] $::tk::print::printer_name $cw $id } else { puts "Omitting canvas item of type $type since there is no handler registered for it" } @@ -406,7 +406,7 @@ namespace eval ::tk::print { set smooth [$cw itemcget $id -smooth ] set splinesteps [ $cw itemcget $id -splinesteps ] - set cmmd "::tk::print::_gdi line $hdc $coords -fill $color -arrow $arrow -arrowshape [list $arwshp]" + set cmmd "::tk::print::_gdi line $::tk::print::printer_name $coords -fill $color -arrow $arrow -arrowshape [list $arwshp]" if { $wdth > 1 } { set cmmd "$cmmd -width $wdth" @@ -454,7 +454,7 @@ namespace eval ::tk::print { set extent [ $cw itemcget $id -extent ] set fill [ $cw itemcget $id -fill ] - set cmmd "::tk::print::_gdi arc $hdc $coords -outline $color -style $style -start $start -extent $extent" + set cmmd "::tk::print::_gdi arc $::tk::print::printer_name $coords -outline $color -style $style -start $start -extent $extent" if { $wdth > 1 } { set cmmd "$cmmd -width $wdth" } @@ -491,7 +491,7 @@ namespace eval ::tk::print { set splinesteps [ $cw itemcget $id -splinesteps ] - set cmmd "::tk::print::_gdi polygon $hdc $coords -width $wdth \ + set cmmd "::tk::print::_gdi polygon $::tk::print::printer_name $coords -width $wdth \ -fill $fcolor -outline $ocolor" if { $smooth != "" } { set cmmd "$cmmd -smooth $smooth" @@ -523,7 +523,7 @@ namespace eval ::tk::print { set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - set cmmd "::tk::print::_gdi oval $hdc $coords -width $wdth \ + set cmmd "::tk::print::_gdi oval $::tk::print::printer_name $coords -width $wdth \ -fill $fcolor -outline $ocolor" eval $cmmd @@ -548,7 +548,7 @@ namespace eval ::tk::print { set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - set cmmd "::tk::print::_gdi rectangle $hdc $coords -width $wdth \ + set cmmd "::tk::print::_gdi rectangle $::tk::print::printer_name $coords -width $wdth \ -fill $fcolor -outline $ocolor" eval $cmmd @@ -590,7 +590,7 @@ namespace eval ::tk::print { # Improve this as GDI improves set font [list [font configure $font -family] -[font configure $font -size] ] - set cmmd "::tk::print::_gdi text $hdc $coords -fill $color -text [list $txt] \ + set cmmd "::tk::print::_gdi text $::tk::print::printer_name $coords -fill $color -text [list $txt] \ -anchor $anchr -font [ list $font ] \ -width $wdth -justify $just" eval $cmmd @@ -641,11 +641,11 @@ namespace eval ::tk::print { #set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] set srccoords [ list "0 0 $wid $hgt" ] set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] $wid $hgt" ] - set cmmd "::tk::print::_gdi copybits $hdc -window $tl -client -source $srccoords -destination $dstcoords " + set cmmd "::tk::print::_gdi copybits $::tk::print::printer_name -window $tl -client -source $srccoords -destination $dstcoords " eval $cmmd destroy $tl } else { - set cmmd "::tk::print::_gdi image $hdc $coords -anchor $anchor -image $imagename " + set cmmd "::tk::print::_gdi image $::tk::print::printer_name $coords -anchor $anchor -image $imagename " eval $cmmd } } @@ -690,11 +690,11 @@ namespace eval ::tk::print { update set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] - set cmmd "::tk::print::_gdi copybits $hdc -window $tl -client -source $srccoords -destination $dstcoords " + set cmmd "::tk::print::_gdi copybits $::tk::print::printer_name -window $tl -client -source $srccoords -destination $dstcoords " eval $cmmd destroy $tl } else { - set cmmd "::tk::print::_gdi bitmap $hdc $coords -anchor $anchor -bitmap $imagename" + set cmmd "::tk::print::_gdi bitmap $::tk::print::printer_name $coords -anchor $anchor -bitmap $imagename" eval $cmmd } } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 911eac0..246e846 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -108,8 +108,11 @@ static DOCINFO di; int copies, paper_width, paper_height, dpi_x, dpi_y; char *localPrinterName; LPCTSTR printerName; +LPCTSTR driver; +LPCTSTR output; PDEVMODE returnedDevmode; PDEVMODE localDevmode; +LPDEVNAMES devnames; static HDC printDC; /* @@ -4636,15 +4639,15 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { - printDC = CreateDC("WINSPOOL", printerName, NULL, NULL); + // printDC = CreateDC("WINSPOOL", printerName, NULL, NULL); + printDC = CreateDC (driver, printerName, output, returnedDevmode); /* ANY type of DC should be ok here. */ unsigned long tmp; - tmp = 0; - - // RestoreDC(printDC, -1); + tmp = 0; + DWORD objtype = GetObjectType(printDC); switch (objtype) { @@ -4659,6 +4662,11 @@ static HDC get_dc(Tcl_Interp *interp) return 0; break; } + + if (devnames != NULL) + { + GlobalUnlock(devnames); + } return (HDC)tmp; } @@ -5040,8 +5048,10 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg /* Copy print attributes to local structure. */ returnedDevmode = (PDEVMODE)GlobalLock(pd.hDevMode); - const LPDEVNAMES devnames = (LPDEVNAMES)GlobalLock(pd.hDevNames); - printerName = (LPCTSTR) devnames + devnames->wDeviceOffset; + devnames = (LPDEVNAMES)GlobalLock(pd.hDevNames); + printerName = (LPCTSTR)devnames + devnames->wDeviceOffset; + driver = (LPCTSTR)devnames + devnames->wDriverOffset; + output = (LPCTSTR)devnames + devnames->wOutputOffset; localDevmode = (LPDEVMODE)HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); @@ -5069,10 +5079,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg { GlobalFree(pd.hDevMode); } - if (pd.hDevNames != NULL) - { - GlobalUnlock(pd.hDevNames); - } + /* * Store print properties and link variables -- cgit v0.12 From 2a9831106905e7b3e8f53eb7002664961bd0eb8d Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 9 May 2021 22:06:07 +0000 Subject: DC seems to work for text printing; now to debug script parameters --- library/print.tcl | 54 +++++++++++++++++++++++++++++++++++------------------- win/tkWinGDI.c | 6 +++++- 2 files changed, 40 insertions(+), 20 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index efe3d18..a712ab2 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -56,7 +56,7 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - + return printargs } @@ -74,13 +74,16 @@ namespace eval ::tk::print { variable printargs _page_args + + + #parray printargs set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] - set pw [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] + set pw [ expr ($printargs(pw) - $printargs(rm)) / 1000 * $printargs(resx) ] ::tk::print::_opendoc ::tk::print::_openpage - eval ::tk::print::_gdi text $::tk::print::printer_name $lm $tm \ + eval ::tk::print::_gdi text $printargs(hDC) $lm $tm \ -anchor nw -text [list $data] \ -width $pw \ $fontargs @@ -98,6 +101,9 @@ namespace eval ::tk::print { # fontargs - Optional arguments to supply to the text command proc _print_page_file { filename {fontargs {}} } { + + variable printargs + set fn [open $filename r] set data [ read $fn ] @@ -125,7 +131,7 @@ namespace eval ::tk::print { if { [string length $font] == 0 } { eval ::tk::print::_gdi characters -array printcharwid } else { - eval ::tk::print::_gdi characters $::tk::print::printer_name -font $font -array printcharwid + eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid } set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] @@ -176,6 +182,9 @@ namespace eval ::tk::print { # font - Optional arguments to supply to the text command proc _print_file { filename {breaklines 1 } { font {}} } { + + variable printargs + set fn [open $filename r] set data [ read $fn ] @@ -197,6 +206,9 @@ namespace eval ::tk::print { # font - if non-empty specifies a font to draw the line in proc _print_page_nextline { string carray parray y font } { + + variable printargs + upvar #0 $carray charwidths upvar #0 $parray printargs @@ -233,12 +245,12 @@ namespace eval ::tk::print { } if { [string length $font] > 0 } { - set result [ ::tk::print::_gdi text $::tk::print::printer_name $lm $y \ + set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ -anchor nw -justify left \ -text [ string trim [ string range $string 0 $endindex ] "\r\n" ] \ -font $font ] } else { - set result [ ::tk::print::_gdi text $::tk::print::printer_name $lm $y \ + set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ -anchor nw -justify left \ -text [string trim [ string range $string 0 $endindex ] "\r\n" ] ] } @@ -257,12 +269,14 @@ namespace eval ::tk::print { proc _init_print_canvas { } { variable option variable vtgPrint + variable printargs set option(use_copybits) 1 set vtgPrint(printer.bg) white } proc _is_win {} { + variable printargs return [ info exist tk_patchLevel ] } @@ -277,6 +291,8 @@ namespace eval ::tk::print { proc _print_widget { wid {printer default} {name "Tk Print Job"} } { + variable printargs + _page_args ::tk::print::_opendoc @@ -328,14 +344,14 @@ namespace eval ::tk::print { set ph $printer_x } - ::tk::print::_gdi map $::tk::print::printer_name -logical $lo -physical $ph -offset $p(resolution) + ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph -offset $p(resolution) # handling of canvas widgets # additional procs can be added for other widget types switch [winfo class $wid] { Canvas { # if {[catch { - _print_canvas [lindex $::tk::print::printer_name 0] $wid + _print_canvas [lindex $printargs(hDC) 0] $wid # } msg]} { # debug_puts "print_widget: $msg" # error "Windows Printing Problem: $msg" @@ -372,7 +388,7 @@ namespace eval ::tk::print { foreach id [$cw find all] { set type [$cw type $id] if { [ info commands _print_canvas.$type ] == "_print_canvas.$type" } { - _print_canvas.[$cw type $id] $::tk::print::printer_name $cw $id + _print_canvas.[$cw type $id] $printargs(hDC) $cw $id } else { puts "Omitting canvas item of type $type since there is no handler registered for it" } @@ -406,7 +422,7 @@ namespace eval ::tk::print { set smooth [$cw itemcget $id -smooth ] set splinesteps [ $cw itemcget $id -splinesteps ] - set cmmd "::tk::print::_gdi line $::tk::print::printer_name $coords -fill $color -arrow $arrow -arrowshape [list $arwshp]" + set cmmd "::tk::print::_gdi line $printargs(hDC) $coords -fill $color -arrow $arrow -arrowshape [list $arwshp]" if { $wdth > 1 } { set cmmd "$cmmd -width $wdth" @@ -454,7 +470,7 @@ namespace eval ::tk::print { set extent [ $cw itemcget $id -extent ] set fill [ $cw itemcget $id -fill ] - set cmmd "::tk::print::_gdi arc $::tk::print::printer_name $coords -outline $color -style $style -start $start -extent $extent" + set cmmd "::tk::print::_gdi arc $printargs(hDC) $coords -outline $color -style $style -start $start -extent $extent" if { $wdth > 1 } { set cmmd "$cmmd -width $wdth" } @@ -491,7 +507,7 @@ namespace eval ::tk::print { set splinesteps [ $cw itemcget $id -splinesteps ] - set cmmd "::tk::print::_gdi polygon $::tk::print::printer_name $coords -width $wdth \ + set cmmd "::tk::print::_gdi polygon $printargs(hDC) $coords -width $wdth \ -fill $fcolor -outline $ocolor" if { $smooth != "" } { set cmmd "$cmmd -smooth $smooth" @@ -523,7 +539,7 @@ namespace eval ::tk::print { set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - set cmmd "::tk::print::_gdi oval $::tk::print::printer_name $coords -width $wdth \ + set cmmd "::tk::print::_gdi oval $printargs(hDC) $coords -width $wdth \ -fill $fcolor -outline $ocolor" eval $cmmd @@ -548,7 +564,7 @@ namespace eval ::tk::print { set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - set cmmd "::tk::print::_gdi rectangle $::tk::print::printer_name $coords -width $wdth \ + set cmmd "::tk::print::_gdi rectangle $printargs(hDC) $coords -width $wdth \ -fill $fcolor -outline $ocolor" eval $cmmd @@ -590,7 +606,7 @@ namespace eval ::tk::print { # Improve this as GDI improves set font [list [font configure $font -family] -[font configure $font -size] ] - set cmmd "::tk::print::_gdi text $::tk::print::printer_name $coords -fill $color -text [list $txt] \ + set cmmd "::tk::print::_gdi text $printargs(hDC) $coords -fill $color -text [list $txt] \ -anchor $anchr -font [ list $font ] \ -width $wdth -justify $just" eval $cmmd @@ -641,11 +657,11 @@ namespace eval ::tk::print { #set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] set srccoords [ list "0 0 $wid $hgt" ] set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] $wid $hgt" ] - set cmmd "::tk::print::_gdi copybits $::tk::print::printer_name -window $tl -client -source $srccoords -destination $dstcoords " + set cmmd "::tk::print::_gdi copybits $printargs(hDC) -window $tl -client -source $srccoords -destination $dstcoords " eval $cmmd destroy $tl } else { - set cmmd "::tk::print::_gdi image $::tk::print::printer_name $coords -anchor $anchor -image $imagename " + set cmmd "::tk::print::_gdi image $printargs(hDC) $coords -anchor $anchor -image $imagename " eval $cmmd } } @@ -690,11 +706,11 @@ namespace eval ::tk::print { update set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] - set cmmd "::tk::print::_gdi copybits $::tk::print::printer_name -window $tl -client -source $srccoords -destination $dstcoords " + set cmmd "::tk::print::_gdi copybits $printargs(hDC) -window $tl -client -source $srccoords -destination $dstcoords " eval $cmmd destroy $tl } else { - set cmmd "::tk::print::_gdi bitmap $::tk::print::printer_name $coords -anchor $anchor -bitmap $imagename" + set cmmd "::tk::print::_gdi bitmap $printargs(hDC) $coords -anchor $anchor -bitmap $imagename" eval $cmmd } } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 246e846..4f082d6 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4641,14 +4641,17 @@ static HDC get_dc(Tcl_Interp *interp) { // printDC = CreateDC("WINSPOOL", printerName, NULL, NULL); printDC = CreateDC (driver, printerName, output, returnedDevmode); - + return printDC; + #if 0 /* ANY type of DC should be ok here. */ unsigned long tmp; tmp = 0; DWORD objtype = GetObjectType(printDC); + if (objtype = "OBJ_DC") + printf("yes!"); switch (objtype) { /* Any of the DC types are OK. */ @@ -4669,6 +4672,7 @@ static HDC get_dc(Tcl_Interp *interp) } return (HDC)tmp; + #endif } /* -- cgit v0.12 From 63a788480db31895ab9542adccddc3097f77909e Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 10 May 2021 02:11:18 +0000 Subject: More refinement, getting a little bit closer to text printing on Windows --- library/print.tcl | 103 +++++++++++++++++++++++++++++++++++++++--------------- win/tkWinGDI.c | 36 ++----------------- 2 files changed, 78 insertions(+), 61 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index a712ab2..fe8fead 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -56,8 +56,8 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - - return printargs + + return printargs } # _ print_page_data @@ -74,10 +74,9 @@ namespace eval ::tk::print { variable printargs _page_args - - #parray printargs - + array get printargs + set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] set pw [ expr ($printargs(pw) - $printargs(rm)) / 1000 * $printargs(resx) ] @@ -101,9 +100,10 @@ namespace eval ::tk::print { # fontargs - Optional arguments to supply to the text command proc _print_page_file { filename {fontargs {}} } { - - variable printargs - + + variable printargs + array get printargs + set fn [open $filename r] set data [ read $fn ] @@ -124,12 +124,15 @@ namespace eval ::tk::print { # font - Font for printing proc _print_data { data {breaklines 1 } {font {}} } { - variable printargs + + variable printargs _page_args - + + array get printargs + if { [string length $font] == 0 } { - eval ::tk::print::_gdi characters -array printcharwid + eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid } else { eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid } @@ -182,9 +185,11 @@ namespace eval ::tk::print { # font - Optional arguments to supply to the text command proc _print_file { filename {breaklines 1 } { font {}} } { - - variable printargs - + + variable printargs + + array get printargs + set fn [open $filename r] set data [ read $fn ] @@ -200,18 +205,23 @@ namespace eval ::tk::print { # and y is the height of the line printed # Arguments: # string - Data to print - # parray - Array of values for printer characteristics - # carray - Array of values for character widths + # pdata - Array of values for printer characteristics + # cdata - Array of values for character widths # y - Y value to begin printing at # font - if non-empty specifies a font to draw the line in - proc _print_page_nextline { string carray parray y font } { + proc _print_page_nextline { string cdata pdata y font } { - variable printargs - - upvar #0 $carray charwidths - upvar #0 $parray printargs - + variable printargs + array get printargs + + upvar #0 $cdata charwidths + upvar #0 $pdata printargs + + puts "yup" + + parray pdata + set endindex 0 set totwidth 0 set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] @@ -269,14 +279,19 @@ namespace eval ::tk::print { proc _init_print_canvas { } { variable option variable vtgPrint - variable printargs + variable printargs + + array get printargs set option(use_copybits) 1 set vtgPrint(printer.bg) white } proc _is_win {} { - variable printargs + variable printargs + + array get printargs + return [ info exist tk_patchLevel ] } @@ -290,10 +305,12 @@ namespace eval ::tk::print { # name - App name to pass to printer. proc _print_widget { wid {printer default} {name "Tk Print Job"} } { - - variable printargs - + + variable printargs + _page_args + + array get printargs ::tk::print::_opendoc ::tk::print::_openpage @@ -379,6 +396,9 @@ namespace eval ::tk::print { proc _print_canvas {hdc cw} { variable vtgPrint + + variable printargs + array get printargs # get information about page being printed to # print_canvas.CalcSizing $cw @@ -410,6 +430,9 @@ namespace eval ::tk::print { proc _print_canvas.line {hdc cw id} { variable vtgPrint + + variable printargs + array get printargs set color [_print_canvas.TransColor [$cw itemcget $id -fill]] if {[string match $vtgPrint(printer.bg) $color]} {return} @@ -458,6 +481,9 @@ namespace eval ::tk::print { proc _print_canvas.arc {hdc cw id} { variable vtgPrint + + variable printargs + array get printargs set color [print_canvas.TransColor [$cw itemcget $id -outline]] if { [string match $vtgPrint(printer.bg) $color] } { @@ -492,6 +518,9 @@ namespace eval ::tk::print { proc _print_canvas.polygon {hdc cw id} { variable vtgPrint + + variable printargs + array get printargs set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] if { ![string length $fcolor] } { @@ -531,6 +560,9 @@ namespace eval ::tk::print { proc _print_canvas.oval { hdc cw id } { variable vtgPrint + + variable printargs + array get printargs set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} @@ -556,6 +588,9 @@ namespace eval ::tk::print { proc _print_canvas.rectangle {hdc cw id} { variable vtgPrint + + variable printargs + array get printargs set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} @@ -580,9 +615,12 @@ namespace eval ::tk::print { proc _print_canvas.text {hdc cw id} { variable vtgPrint - + _page_args + variable printargs + array get printargs + set color [_print_canvas.TransColor [$cw itemcget $id -fill]] # if {[string match white [string tolower $color]]} {return} # set color black @@ -625,6 +663,9 @@ namespace eval ::tk::print { variable vtgPrint variable option + + variable printargs + array get printargs # First, we have to get the image name set imagename [ $cw itemcget $id -image] @@ -678,6 +719,9 @@ namespace eval ::tk::print { proc _print_canvas.bitmap {hdc cw id} { variable option variable vtgPrint + + variable printargs + array get printargs # First, we have to get the bitmap name set imagename [ $cw itemcget $id -image] @@ -728,6 +772,9 @@ namespace eval ::tk::print { proc _print_canvas.TransColor {color} { variable vtgPrint + + variable printargs + array get printargs switch [string toupper $color] { $vtgPrint(canvas.bg) {return $vtgPrint(printer.bg)} diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 4f082d6..663793b 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4639,40 +4639,10 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { - // printDC = CreateDC("WINSPOOL", printerName, NULL, NULL); + printDC = CreateDC (driver, printerName, output, returnedDevmode); - return printDC; - - #if 0 - /* ANY type of DC should be ok here. */ - - unsigned long tmp; - tmp = 0; - - DWORD objtype = GetObjectType(printDC); - if (objtype = "OBJ_DC") - printf("yes!"); - switch (objtype) - { - /* Any of the DC types are OK. */ - case OBJ_DC: case OBJ_MEMDC: case OBJ_METADC: case OBJ_ENHMETADC: - break; - /* Anything else is invalid */ - case 0: /* Function failed */ - default: - tmp = 0; - Tcl_AppendResult(interp, "Error: Wrong type of handle for this operation\n", 0); - return 0; - break; - } - - if (devnames != NULL) - { - GlobalUnlock(devnames); - } - - return (HDC)tmp; - #endif + return printDC; + } /* -- cgit v0.12 From 94f587d3560c4a171a7fa0af8f98f354833ea9f8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 10 May 2021 09:15:53 +0000 Subject: More test-cases --- tests/cluster.test | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 74 insertions(+), 5 deletions(-) diff --git a/tests/cluster.test b/tests/cluster.test index 59b94d0..32e4c63 100644 --- a/tests/cluster.test +++ b/tests/cluster.test @@ -157,21 +157,90 @@ test cluster-5.9 {::tk::startOfNextWord} -body { ::tk::startOfNextWord "ab cd" end-1 } -result {} -test cluster-6.0 {::tk::startOfCluster} -body { +test cluster-6.0 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" -1 +} -result {} +test cluster-6.1 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" 0 +} -result {} +test cluster-6.2 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" 1 +} -result {} +test cluster-6.3 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" 2 +} -result 2 +test cluster-6.4 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" 3 +} -result 3 +test cluster-6.5 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" 4 +} -result 3 +test cluster-6.6 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" 5 +} -result 3 +test cluster-6.7 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" end +} -result 3 +test cluster-6.8 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore "ab cd" {} +} -result {} +test cluster-6.9 {::tk::wordBreakBefore} -body { + ::tk::startOfNextWord "ab cd" end-1 +} -result {} + +test cluster-7.0 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" -1 +} -result 2 +test cluster-7.1 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" 0 +} -result 2 +test cluster-7.2 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" 1 +} -result 2 +test cluster-7.3 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" 2 +} -result 3 +test cluster-7.4 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" 3 +} -result {} +test cluster-7.5 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" 4 +} -result {} +test cluster-7.6 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" 5 +} -result {} +test cluster-7.7 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" end +} -result {} +test cluster-7.8 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" {} +} -result 2 +test cluster-7.9 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter "ab cd" end-1 +} -result {} + + +test cluster-8.0 {::tk::startOfCluster} -body { ::tk::startOfCluster a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::startOfCluster str start ?locale?"} -test cluster-6.1 {::tk::endOfCluster} -body { +test cluster-8.1 {::tk::endOfCluster} -body { ::tk::endOfCluster a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::endOfCluster str start ?locale?"} -test cluster-6.2 {::tk::startOfPreviousWord} -body { +test cluster-8.2 {::tk::startOfPreviousWord} -body { ::tk::startOfPreviousWord a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::startOfPreviousWord str start ?locale?"} -test cluster-6.3 {::tk::startOfNextWord} -body { +test cluster-8.3 {::tk::startOfNextWord} -body { ::tk::startOfNextWord a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::startOfNextWord str start ?locale?"} -test cluster-6.4 {::tk::endOfWord} -body { +test cluster-8.4 {::tk::endOfWord} -body { ::tk::endOfWord a b c d } -returnCodes 1 -result {wrong # args: should be "::tk::endOfWord str start ?locale?"} +test cluster-8.5 {::tk::wordBreakBefore} -body { + ::tk::wordBreakBefore a b c d +} -returnCodes 1 -result {wrong # args: should be "::tk::wordBreakBefore str start ?locale?"} +test cluster-8.6 {::tk::wordBreakAfter} -body { + ::tk::wordBreakAfter a b c d +} -returnCodes 1 -result {wrong # args: should be "::tk::wordBreakAfter str start ?locale?"} cleanupTests return -- cgit v0.12 From 739ffaf094dd4c237141d4fa10e9b56ea9d49472 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 11 May 2021 12:35:21 +0000 Subject: Finally have device context working - text printing requires deeper debugging --- library/print.tcl | 32 ++++++++++++++++++++------------ win/tkWinGDI.c | 24 +++++++++++++++++++----- 2 files changed, 39 insertions(+), 17 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index fe8fead..71ef3f4 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -46,7 +46,7 @@ namespace eval ::tk::print { } #Next, set values. - set printargs(hDC) {} + set printargs(hDC) [list $::tk::print::printer_name] set printargs(pw) $::tk::print::paper_width set printargs(pl) $::tk::print::paper_height set printargs(lm) 100 @@ -56,6 +56,8 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies + + parray printargs return printargs } @@ -76,6 +78,8 @@ namespace eval ::tk::print { _page_args array get printargs + + puts "_print_page_data" set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] @@ -125,11 +129,13 @@ namespace eval ::tk::print { proc _print_data { data {breaklines 1 } {font {}} } { - variable printargs + variable printargs _page_args array get printargs + + puts "_print_data" if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid @@ -157,9 +163,15 @@ namespace eval ::tk::print { } } } + + set plist [array get printargs] + set clist [array get printcharwid] + + puts "plist is $plist" + puts "clist is $clist" set result [_print_page_nextline $linestring \ - printcharwid printargs $curhgt $font] + $clist $plist $curhgt $font] incr curlen [lindex $result 0] incr curhgt [lindex $result 1] if { [expr $curhgt + [lindex $result 1] ] > $pagehgt } { @@ -210,17 +222,13 @@ namespace eval ::tk::print { # y - Y value to begin printing at # font - if non-empty specifies a font to draw the line in - proc _print_page_nextline { string cdata pdata y font } { + proc _print_page_nextline { string clist plist y font } { - variable printargs - array get printargs - - upvar #0 $cdata charwidths - upvar #0 $pdata printargs - - puts "yup" + + array set charwidths $clist + array set printargs $plist - parray pdata + puts "_print_page_nextline" set endindex 0 set totwidth 0 diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 663793b..e3f56a8 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -101,6 +101,7 @@ static int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, T static const char gdi_usage_message[] = "::tk::print::_gdi [arc|characters|copybits|line|map|oval|" "photo|polygon|rectangle|text|version]\n" "\thdc parameters can be generated by the printer extension"; + static char msgbuf[1024]; static HDC get_dc(Tcl_Interp *interp); static PRINTDLG pd; @@ -4639,10 +4640,22 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { - + /* + * Check for valid DC, create or restore as needed. + */ + if (printDC == NULL) { printDC = CreateDC (driver, printerName, output, returnedDevmode); - return printDC; - + SaveDC(printDC); + } else { + RestoreDC(printDC, -1); + } + + DWORD objtype = GetObjectType((HGDIOBJ)printDC); + if (objtype = OBJ_DC) { + return (HDC) 1; + } else { + return (HDC) 0; + } } /* @@ -5004,7 +5017,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg ZeroMemory( &pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); - pd.Flags = /*PD_RETURNDC |*/ PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; + pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; if (PrintDlg(&pd) == TRUE) { printDC = pd.hDC; @@ -5012,7 +5025,6 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg Tcl_AppendResult(interp, "can't allocate printer DC", NULL); return TCL_ERROR; } - SaveDC(printDC); /*Get document info.*/ ZeroMemory( &di, sizeof(di)); @@ -5125,6 +5137,7 @@ int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_O (void) objv; ClosePrinter(printDC); + DeleteDC(printDC); return TCL_OK; } @@ -5149,6 +5162,7 @@ int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *c (void) objv; int output = 0; + RestoreDC(printDC, -1); if (printDC == NULL) { return TCL_ERROR; -- cgit v0.12 From 4d2e4273e51d1a02da4f636ccd14a741f722b5d8 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 11 May 2021 12:52:56 +0000 Subject: Minor cleanup --- win/tkWinGDI.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index e3f56a8..d9c2702 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4640,22 +4640,22 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { - /* - * Check for valid DC, create or restore as needed. - */ - if (printDC == NULL) { - printDC = CreateDC (driver, printerName, output, returnedDevmode); + /* + * Check for valid DC, create or restore as needed. + */ + if (printDC == NULL) { + printDC = CreateDC (driver, printerName, output, returnedDevmode); SaveDC(printDC); - } else { + } else { RestoreDC(printDC, -1); - } + } - DWORD objtype = GetObjectType((HGDIOBJ)printDC); - if (objtype = OBJ_DC) { - return (HDC) 1; - } else { - return (HDC) 0; - } + DWORD objtype = GetObjectType((HGDIOBJ)printDC); + if (objtype = OBJ_DC) { + return (HDC) 1; + } else { + return (HDC) 0; + } } /* -- cgit v0.12 From eb310d37135b849847f7f7e28b9fa68dc25ca0da Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 11 May 2021 14:02:10 +0000 Subject: More tweaks --- win/tkWinGDI.c | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index d9c2702..deec192 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1551,19 +1551,18 @@ static int GdiCharWidths( argc--; } - /* Now, get the widths using the correct function for this Windows version. */ -#ifdef WIN32 + + /* Now, get the widths using the correct function for font type. */ + /* - * Try the correct function. If it fails (as has been reported on some - * versions of Windows 95), try the "old" function. + * Try the correct function for non-TrueType fonts first. */ if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) { - retval = GetCharWidth (hDC, 0, 255, widths ); + /*Try TrueType fonts next.*/ + retval = GetCharABCWidths (hDC, 0, 255, (LPABC) widths ); } -#else - retval = GetCharWidth (hDC, 0, 255, widths); -#endif + /* * Retval should be 1 (TRUE) if the function succeeded. If the function fails, * get the "extended" error code and return. Be sure to deallocate the font if @@ -4640,15 +4639,13 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { - /* + /* * Check for valid DC, create or restore as needed. */ if (printDC == NULL) { printDC = CreateDC (driver, printerName, output, returnedDevmode); - SaveDC(printDC); - } else { - RestoreDC(printDC, -1); - } + + } DWORD objtype = GetObjectType((HGDIOBJ)printDC); if (objtype = OBJ_DC) { @@ -4658,6 +4655,7 @@ static HDC get_dc(Tcl_Interp *interp) } } + /* *-------------------------------------------------------------- * -- cgit v0.12 From fd1203830ab296fbe4f8418f64c49a0fd84f3c0d Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 11 May 2021 14:23:39 +0000 Subject: Make sure printDC is set throughout this file --- win/tkWinGDI.c | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index deec192..d394dad 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -255,6 +255,8 @@ static int GdiArc( return TCL_ERROR; } + hDC = printDC; + x1 = atoi(argv[1]); y1 = atoi(argv[2]); x2 = atoi(argv[3]); @@ -483,6 +485,8 @@ static int GdiPhoto( return TCL_ERROR; } + dst = printDC; + /* * Next, check to see if 'dst' can support BitBlt. * If not, raise an error. @@ -753,6 +757,8 @@ static int GdiLine( return TCL_ERROR; } + hDC = printDC; + if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) { Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); @@ -1075,6 +1081,8 @@ static int GdiOval( return TCL_ERROR; } + hDC = printDC; + x1 = atol(argv[1]); y1 = atol(argv[2]); x2 = atol(argv[3]); @@ -1208,6 +1216,8 @@ static int GdiPolygon( return TCL_ERROR; } + hDC = printDC; + if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) { Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); @@ -1390,6 +1400,8 @@ static int GdiRectangle( return TCL_ERROR; } + hDC = printDC; + x1 = atol(argv[1]); y1 = atol(argv[2]); x2 = atol(argv[3]); @@ -1521,6 +1533,8 @@ static int GdiCharWidths( return TCL_ERROR; } + hDC = printDC; + argc--; argv++; @@ -1670,6 +1684,8 @@ int GdiText( return TCL_ERROR; } + hDC = printDC; + x = atol(argv[1]); y = atol(argv[2]); argc -= 3; @@ -2099,6 +2115,8 @@ static int GdiMap( return TCL_ERROR; } + hDC = printDC; + if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) { /* Failed!. */ @@ -2346,6 +2364,8 @@ static int GdiCopyBits ( return TCL_ERROR; } + dst = printDC; + /* * Next, check to see if 'dst' can support BitBlt. * If not, raise an error. @@ -4639,13 +4659,12 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { - /* + /* * Check for valid DC, create or restore as needed. */ if (printDC == NULL) { printDC = CreateDC (driver, printerName, output, returnedDevmode); - - } + } DWORD objtype = GetObjectType((HGDIOBJ)printDC); if (objtype = OBJ_DC) { -- cgit v0.12 From 98185ee7751c8539c00c682740a2746037de7371 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 12 May 2021 01:18:12 +0000 Subject: Minor tweaks --- win/tkWinGDI.c | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index d394dad..af7044e 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -73,7 +73,7 @@ static int GdiMakePen(Tcl_Interp *interp, int width, static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen); static int GdiMakeBrush (Tcl_Interp *interp, unsigned int style, unsigned long color, long hatch, LOGBRUSH *lb, HDC hDC, HGDIOBJ *oldBrush); -static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBrush); +static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBcrush); static int GdiGetHdcInfo( HDC hdc, LPPOINT worigin, LPSIZE wextent, LPPOINT vorigin, LPSIZE vextent); @@ -114,7 +114,7 @@ LPCTSTR output; PDEVMODE returnedDevmode; PDEVMODE localDevmode; LPDEVNAMES devnames; -static HDC printDC; +HDC printDC; /* *---------------------------------------------------------------------- @@ -248,6 +248,7 @@ static int GdiArc( if (argc >= 5) { hDC = get_dc(interp); + /* Check hDC. */ if (hDC == (HDC)0 ) { @@ -750,6 +751,7 @@ static int GdiLine( if (argc >= 5) { hDC = get_dc(interp); + /* Check hDC. */ if (hDC == (HDC)0 ) { @@ -1074,6 +1076,7 @@ static int GdiOval( if (argc >= 5) { hDC = get_dc(interp); + /* Check hDC. */ if (hDC == (HDC)0 ) { @@ -1209,6 +1212,7 @@ static int GdiPolygon( if (argc >= 5) { hDC = get_dc(interp); + /* Check hDC. */ if (hDC == (HDC)0 ) { @@ -1525,9 +1529,11 @@ static int GdiCharWidths( return TCL_ERROR; } + hDC = get_dc(interp); + /* Check hDC. */ - if (hDC == (HDC)0 ) + if (hDC = (HDC)0 ) { Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); return TCL_ERROR; @@ -1677,6 +1683,7 @@ int GdiText( { /* Parse the command. */ hDC = get_dc(interp); + /* Check hDC. */ if (hDC == (HDC)0 ) { @@ -2108,6 +2115,7 @@ static int GdiMap( if ( argc >= 1 ) { hdc = get_dc(interp); + /* Check hDC. */ if (hdc == (HDC)0 ) { @@ -2115,7 +2123,7 @@ static int GdiMap( return TCL_ERROR; } - hDC = printDC; + hdc = printDC; if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) { @@ -4660,16 +4668,19 @@ static int PalEntriesOnDevice(HDC hDC) static HDC get_dc(Tcl_Interp *interp) { /* - * Check for valid DC, create or restore as needed. + * Create DC. */ - if (printDC == NULL) { + if (printDC != NULL) { printDC = CreateDC (driver, printerName, output, returnedDevmode); - } + } + DWORD objtype = GetObjectType((HGDIOBJ)printDC); if (objtype = OBJ_DC) { - return (HDC) 1; + printf("HDC here!\n"); + return printDC; } else { + printf("ya got nuttin!\n"); return (HDC) 0; } } @@ -5221,6 +5232,7 @@ int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * if ( EndDoc(printDC) <= 0) { return TCL_ERROR; } + DeleteDC(printDC); return TCL_OK; } -- cgit v0.12 From ea088e48fc36b551ad5b0a00b272a0611fd3a8b8 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 12 May 2021 01:32:08 +0000 Subject: Simplify management of device contexts --- win/tkWinGDI.c | 129 +++------------------------------------------------------ 1 file changed, 6 insertions(+), 123 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index af7044e..2e04cea 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -103,7 +103,6 @@ static const char gdi_usage_message[] = "::tk::print::_gdi [arc|characters|copyb "\thdc parameters can be generated by the printer extension"; static char msgbuf[1024]; -static HDC get_dc(Tcl_Interp *interp); static PRINTDLG pd; static DOCINFO di; int copies, paper_width, paper_height, dpi_x, dpi_y; @@ -247,14 +246,6 @@ static int GdiArc( /* Verrrrrry simple for now.... */ if (argc >= 5) { - hDC = get_dc(interp); - - /* Check hDC. */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } hDC = printDC; @@ -477,15 +468,6 @@ static int GdiPhoto( return TCL_ERROR; } - dst = get_dc(interp); - - /* Check hDC. */ - if (dst == (HDC) 0) { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI photo\n", NULL); - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - dst = printDC; /* @@ -752,13 +734,6 @@ static int GdiLine( { hDC = get_dc(interp); - /* Check hDC. */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } - hDC = printDC; if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) @@ -1075,15 +1050,7 @@ static int GdiOval( /* Verrrrrry simple for now.... */ if (argc >= 5) { - hDC = get_dc(interp); - - /* Check hDC. */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } - + hDC = printDC; x1 = atol(argv[1]); @@ -1211,15 +1178,7 @@ static int GdiPolygon( /* Verrrrrry simple for now.... */ if (argc >= 5) { - hDC = get_dc(interp); - - /* Check hDC. */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } - + hDC = printDC; if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) @@ -1396,14 +1355,7 @@ static int GdiRectangle( /* Verrrrrry simple for now.... */ if (argc >= 5) { - hDC = get_dc(interp); - /* Check hDC. */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } - + hDC = printDC; x1 = atol(argv[1]); @@ -1529,16 +1481,6 @@ static int GdiCharWidths( return TCL_ERROR; } - - hDC = get_dc(interp); - - /* Check hDC. */ - if (hDC = (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } - hDC = printDC; argc--; @@ -1682,15 +1624,7 @@ int GdiText( if ( argc >= 4 ) { /* Parse the command. */ - hDC = get_dc(interp); - - /* Check hDC. */ - if (hDC == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } - + hDC = printDC; x = atol(argv[1]); @@ -2114,15 +2048,7 @@ static int GdiMap( /* Required parameter: HDC for printer. */ if ( argc >= 1 ) { - hdc = get_dc(interp); - - /* Check hDC. */ - if (hdc == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for GDI", NULL); - return TCL_ERROR; - } - + hdc = printDC; if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) @@ -2363,15 +2289,6 @@ static int GdiCopyBits ( return TCL_ERROR; } - dst = get_dc(interp); - - /* Check hDC. */ - if (dst == (HDC)0 ) - { - Tcl_AppendResult(interp, "Device context ", argv[0], " is invalid for BitBlt destination", NULL); - return TCL_ERROR; - } - dst = printDC; /* @@ -4653,40 +4570,6 @@ static int PalEntriesOnDevice(HDC hDC) /* - *---------------------------------------------------------------------- - * - * get_dc -- - * - * Utility function to obtain device context. - * - * Results: - * Returns DC. - * - *---------------------------------------------------------------------- - */ - -static HDC get_dc(Tcl_Interp *interp) -{ - /* - * Create DC. - */ - if (printDC != NULL) { - printDC = CreateDC (driver, printerName, output, returnedDevmode); - } - - - DWORD objtype = GetObjectType((HGDIOBJ)printDC); - if (objtype = OBJ_DC) { - printf("HDC here!\n"); - return printDC; - } else { - printf("ya got nuttin!\n"); - return (HDC) 0; - } -} - - -/* *-------------------------------------------------------------- * * Gdi_Init -- @@ -5045,7 +4928,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg ZeroMemory( &pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); - pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; + pd.Flags = PD_RETURNDC |PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; if (PrintDlg(&pd) == TRUE) { printDC = pd.hDC; -- cgit v0.12 From c95137e11834a65c1d884c594f8ad8643969aee4 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 12 May 2021 10:50:46 +0000 Subject: Needs more work on simplifying --- library/print.tcl | 4 +++- win/tkWinGDI.c | 33 +++++++++++++++++++++------------ 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 71ef3f4..fb2668e 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -133,7 +133,7 @@ namespace eval ::tk::print { _page_args - array get printargs + # array get printargs puts "_print_data" @@ -148,9 +148,11 @@ namespace eval ::tk::print { set totallen [ string length $data ] set curlen 0 set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] + puts "fuck" ::tk::print::_opendoc ::tk::print::_openpage + puts "yup" while { $curlen < $totallen } { set linestring [ string range $data $curlen end ] if { $breaklines } { diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 2e04cea..61a2dd8 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -247,7 +247,8 @@ static int GdiArc( if (argc >= 5) { - hDC = printDC; + // hDC = printDC; + hDC = CreateDC (driver, printerName, output, returnedDevmode); x1 = atoi(argv[1]); y1 = atoi(argv[2]); @@ -468,7 +469,8 @@ static int GdiPhoto( return TCL_ERROR; } - dst = printDC; + //dst = printDC; + dst = CreateDC (driver, printerName, output, returnedDevmode); /* * Next, check to see if 'dst' can support BitBlt. @@ -732,9 +734,10 @@ static int GdiLine( /* Verrrrrry simple for now.... */ if (argc >= 5) { - hDC = get_dc(interp); + + // hDC = printDC; + hDC = CreateDC (driver, printerName, output, returnedDevmode); - hDC = printDC; if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) { @@ -1051,7 +1054,8 @@ static int GdiOval( if (argc >= 5) { - hDC = printDC; + // hDC = printDC; + hDC = CreateDC (driver, printerName, output, returnedDevmode); x1 = atol(argv[1]); y1 = atol(argv[2]); @@ -1179,7 +1183,8 @@ static int GdiPolygon( if (argc >= 5) { - hDC = printDC; + // hDC = printDC; + hDC = CreateDC (driver, printerName, output, returnedDevmode); if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) { @@ -1356,7 +1361,8 @@ static int GdiRectangle( if (argc >= 5) { - hDC = printDC; + //hDC = printDC; + hDC = CreateDC (driver, printerName, output, returnedDevmode); x1 = atol(argv[1]); y1 = atol(argv[2]); @@ -1481,7 +1487,8 @@ static int GdiCharWidths( return TCL_ERROR; } - hDC = printDC; + // hDC = printDC; + hDC = CreateDC (driver, printerName, output, returnedDevmode); argc--; argv++; @@ -1625,7 +1632,8 @@ int GdiText( { /* Parse the command. */ - hDC = printDC; + // hDC = printDC; + hDC = CreateDC (driver, printerName, output, returnedDevmode); x = atol(argv[1]); y = atol(argv[2]); @@ -2049,7 +2057,8 @@ static int GdiMap( if ( argc >= 1 ) { - hdc = printDC; + // hdc = printDC; + hdc = CreateDC (driver, printerName, output, returnedDevmode); if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) { @@ -2289,8 +2298,8 @@ static int GdiCopyBits ( return TCL_ERROR; } - dst = printDC; - + //dst = printDC; +dst = CreateDC (driver, printerName, output, returnedDevmode); /* * Next, check to see if 'dst' can support BitBlt. * If not, raise an error. -- cgit v0.12 From f8c95a12a18a52a2bf843434a321ff1adc436823 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 12 May 2021 10:53:32 +0000 Subject: Minor tweak --- library/print.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/print.tcl b/library/print.tcl index fb2668e..6b08c56 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -148,7 +148,7 @@ namespace eval ::tk::print { set totallen [ string length $data ] set curlen 0 set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] - puts "fuck" + puts "flick" ::tk::print::_opendoc ::tk::print::_openpage -- cgit v0.12 From f809d505cd3b3f51bcec3afcdc93fe9a84999910 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 12 May 2021 11:02:31 +0000 Subject: Commit refinements for testing --- library/print.tcl | 105 +- win/tkWinGDI.c | 5134 ++++++++++++++++++++++++++--------------------------- 2 files changed, 2586 insertions(+), 2653 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 6b08c56..5f04b20 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -30,11 +30,11 @@ namespace eval ::tk::print { # Multiple utility procedures for printing text based on the C printer # primitives. - # _page_args: - # Parse common arguments for text processing in the other commands. - # + # _set_dc: + # Select printer and set device context and other parameters + # for print job. # - proc _page_args {} { + proc _set_dc {} { variable printargs #First, we select the printer. @@ -56,86 +56,29 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - - parray printargs - - return printargs - } - - # _ print_page_data - # This proc is the simplest way to print a small amount of - # text on a page. The text is formatted in a box the size of the - # selected page and margins. - # - # Arguments: - # data - Text data for printing - # fontargs - Optional arguments to supply to the text command - - proc _print_page_data { data {fontargs {}} } { - - variable printargs - - _page_args - - array get printargs - - puts "_print_page_data" - - set tm [ expr $printargs(tm) * $printargs(resy) / 1000 ] - set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] - set pw [ expr ($printargs(pw) - $printargs(rm)) / 1000 * $printargs(resx) ] - ::tk::print::_opendoc - ::tk::print::_openpage - eval ::tk::print::_gdi text $printargs(hDC) $lm $tm \ - -anchor nw -text [list $data] \ - -width $pw \ - $fontargs - ::tk::print::_closepage - ::tk::print::_closedoc - } - - - # _print_page_file - # This is the simplest way to print a small file - # on a page. The text is formatted in a box the size of the - # selected page and margins. - # Arguments: - # data - Text data for printing - # fontargs - Optional arguments to supply to the text command - - proc _print_page_file { filename {fontargs {}} } { - variable printargs - array get printargs + parray printargs - set fn [open $filename r] - - set data [ read $fn ] - - close $fn - - _print_page_data $data $fontargs + return printargs } - # _print_data # This function prints multiple-page files, using a line-oriented # function, taking advantage of knowing the character widths. # Arguments: - # data - Text data for printing + # data - Text data for printing # breaklines - If non-zero, keep newlines in the string as # newlines in the output. # font - Font for printing proc _print_data { data {breaklines 1 } {font {}} } { - variable printargs + variable printargs - _page_args - - # array get printargs - - puts "_print_data" + _set_dc + + puts "_print_data" + ::tk::print::_opendoc if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid @@ -148,11 +91,11 @@ namespace eval ::tk::print { set totallen [ string length $data ] set curlen 0 set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] - puts "flick" + puts "flick" + - ::tk::print::_opendoc ::tk::print::_openpage - puts "yup" + puts "yup" while { $curlen < $totallen } { set linestring [ string range $data $curlen end ] if { $breaklines } { @@ -225,13 +168,13 @@ namespace eval ::tk::print { # font - if non-empty specifies a font to draw the line in proc _print_page_nextline { string clist plist y font } { - - - array set charwidths $clist - array set printargs $plist - - puts "_print_page_nextline" - + + + array set charwidths $clist + array set printargs $plist + + puts "_print_page_nextline" + set endindex 0 set totwidth 0 set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] @@ -318,7 +261,7 @@ namespace eval ::tk::print { variable printargs - _page_args + _set_dc array get printargs @@ -626,7 +569,7 @@ namespace eval ::tk::print { proc _print_canvas.text {hdc cw id} { variable vtgPrint - _page_args + _set_dc variable printargs array get printargs diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 61a2dd8..ca2fe8d 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -99,8 +99,8 @@ static int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tc static int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); static const char gdi_usage_message[] = "::tk::print::_gdi [arc|characters|copybits|line|map|oval|" - "photo|polygon|rectangle|text|version]\n" - "\thdc parameters can be generated by the printer extension"; + "photo|polygon|rectangle|text|version]\n" + "\thdc parameters can be generated by the printer extension"; static char msgbuf[1024]; static PRINTDLG pd; @@ -132,15 +132,15 @@ HDC printDC; static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) { - if ( argc > 1 && strcmp(*argv, "::tk::print::_gdi") == 0 ) - { - argc--; - argv++; - return TkWinGDISubcmd(clientData, interp, argc, argv); - } + if ( argc > 1 && strcmp(*argv, "::tk::print::_gdi") == 0 ) + { + argc--; + argv++; + return TkWinGDISubcmd(clientData, interp, argc, argv); + } - Tcl_AppendResult(interp, gdi_usage_message, NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, gdi_usage_message, NULL); + return TCL_ERROR; } /* @@ -150,24 +150,24 @@ static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const */ struct gdi_command { - const char *command_string; - int (*command) (ClientData, Tcl_Interp *, int, const char **); + const char *command_string; + int (*command) (ClientData, Tcl_Interp *, int, const char **); } gdi_commands[] = -{ - { "arc", GdiArc }, - { "bitmap", GdiBitmap }, - { "characters", GdiCharWidths }, - { "image", GdiImage }, - { "line", GdiLine }, - { "map", GdiMap }, - { "oval", GdiOval }, - { "photo", GdiPhoto }, - { "polygon", GdiPolygon }, - { "rectangle", GdiRectangle }, - { "text", GdiText }, - { "copybits", GdiCopyBits }, - -}; + { + { "arc", GdiArc }, + { "bitmap", GdiBitmap }, + { "characters", GdiCharWidths }, + { "image", GdiImage }, + { "line", GdiLine }, + { "map", GdiMap }, + { "oval", GdiOval }, + { "photo", GdiPhoto }, + { "polygon", GdiPolygon }, + { "rectangle", GdiRectangle }, + { "text", GdiText }, + { "copybits", GdiCopyBits }, + + }; /* @@ -185,14 +185,14 @@ struct gdi_command static int TkWinGDISubcmd (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) { - size_t i; + size_t i; - for (i=0; i= 5) - { - - // hDC = printDC; - hDC = CreateDC (driver, printerName, output, returnedDevmode); - - x1 = atoi(argv[1]); - y1 = atoi(argv[2]); - x2 = atoi(argv[3]); - y2 = atoi(argv[4]); - - argc -= 5; - argv += 5; - while ( argc >= 2 ) - { - if ( strcmp (argv[0], "-extent") == 0 ) - extent = atof(argv[1]); - else if ( strcmp (argv[0], "-start") == 0 ) - start = atof(argv[1]); - else if ( strcmp (argv[0], "-style") == 0 ) - { - if ( strcmp (argv[1], "pieslice") == 0 ) - drawfunc = Pie; - else if ( strcmp(argv[1], "arc") == 0 ) - drawfunc = Arc; - else if ( strcmp(argv[1], "chord") == 0 ) - drawfunc = Chord; - } - /* Handle all args, even if we don't use them yet. */ - else if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( GdiGetColor(argv[1], &fillcolor) ) - dofillcolor=1; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor=1; - } - else if (strcmp(argv[0], "-outlinestipple") == 0 ) - { - } - else if (strcmp(argv[0], "-stipple") == 0 ) - { - } - else if (strcmp(argv[0], "-width") == 0 ) - { - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } - argc -= 2; - argv += 2; - } - xr0 = xr1 = ( x1 + x2 ) / 2; - yr0 = yr1 = ( y1 + y2 ) / 2; - - - /* - * The angle used by the arc must be "warped" by the eccentricity of the ellipse. - * Thanks to Nigel Dodd for bringing a nice example. - */ - xr0 += (int)(100.0 * (x2 - x1) * cos( (start * 2.0 * 3.14159265) / 360.0 ) ); - yr0 -= (int)(100.0 * (y2 - y1) * sin( (start * 2.0 * 3.14159265) / 360.0 ) ); - xr1 += (int)(100.0 * (x2 - x1) * cos( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); - yr1 -= (int)(100.0 * (y2 - y1) * sin( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); - - /* Under Win95, SetArcDirection isn't implemented--so we have to - * assume that arcs are drawn counterclockwise (e.g., positive extent) - * So if it's negative, switch the coordinates! - */ - if ( extent < 0 ) - { - int xr2 = xr0; - int yr2 = yr0; - xr0 = xr1; - xr1 = xr2; - yr0 = yr1; - yr1 = yr2; - } - - if ( dofillcolor ) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH) ); - - if ( width || dolinecolor ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - - (*drawfunc)(hDC, x1, y1, x2, y2, xr0, yr0, xr1, yr1); - - if ( width || dolinecolor ) - GdiFreePen(interp, hDC, hPen); - if ( dofillcolor ) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject(hDC, oldobj); + int x1, y1, x2, y2; + int xr0, yr0, xr1, yr1; + HDC hDC; + double extent = 0.0 , start = 0.0 ; + DrawFunc drawfunc; + int width = 0; + HPEN hPen; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + HBRUSH hBrush; + LOGBRUSH lbrush; + HGDIOBJ oldobj; + int dodash = 0; + const char *dashdata = 0; + + drawfunc = Pie; + + /* Verrrrrry simple for now.... */ + if (argc >= 5) + { - return TCL_OK; - } + hDC = printDC; + + x1 = atoi(argv[1]); + y1 = atoi(argv[2]); + x2 = atoi(argv[3]); + y2 = atoi(argv[4]); + + argc -= 5; + argv += 5; + while ( argc >= 2 ) + { + if ( strcmp (argv[0], "-extent") == 0 ) + extent = atof(argv[1]); + else if ( strcmp (argv[0], "-start") == 0 ) + start = atof(argv[1]); + else if ( strcmp (argv[0], "-style") == 0 ) + { + if ( strcmp (argv[1], "pieslice") == 0 ) + drawfunc = Pie; + else if ( strcmp(argv[1], "arc") == 0 ) + drawfunc = Arc; + else if ( strcmp(argv[1], "chord") == 0 ) + drawfunc = Chord; + } + /* Handle all args, even if we don't use them yet. */ + else if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( GdiGetColor(argv[1], &fillcolor) ) + dofillcolor=1; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor=1; + } + else if (strcmp(argv[0], "-outlinestipple") == 0 ) + { + } + else if (strcmp(argv[0], "-stipple") == 0 ) + { + } + else if (strcmp(argv[0], "-width") == 0 ) + { + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + argc -= 2; + argv += 2; + } + xr0 = xr1 = ( x1 + x2 ) / 2; + yr0 = yr1 = ( y1 + y2 ) / 2; + + + /* + * The angle used by the arc must be "warped" by the eccentricity of the ellipse. + * Thanks to Nigel Dodd for bringing a nice example. + */ + xr0 += (int)(100.0 * (x2 - x1) * cos( (start * 2.0 * 3.14159265) / 360.0 ) ); + yr0 -= (int)(100.0 * (y2 - y1) * sin( (start * 2.0 * 3.14159265) / 360.0 ) ); + xr1 += (int)(100.0 * (x2 - x1) * cos( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); + yr1 -= (int)(100.0 * (y2 - y1) * sin( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); + + /* Under Win95, SetArcDirection isn't implemented--so we have to + * assume that arcs are drawn counterclockwise (e.g., positive extent) + * So if it's negative, switch the coordinates! + */ + if ( extent < 0 ) + { + int xr2 = xr0; + int yr2 = yr0; + xr0 = xr1; + xr1 = xr2; + yr0 = yr1; + yr1 = yr2; + } + + if ( dofillcolor ) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH) ); + + if ( width || dolinecolor ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + + (*drawfunc)(hDC, x1, y1, x2, y2, xr0, yr0, xr1, yr1); + + if ( width || dolinecolor ) + GdiFreePen(interp, hDC, hPen); + if ( dofillcolor ) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject(hDC, oldobj); + + return TCL_OK; + } - Tcl_AppendResult(interp, "::tk::print::_gdi", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, "::tk::print::_gdi", NULL); + return TCL_ERROR; } /* @@ -371,23 +370,23 @@ static int GdiArc( */ static int GdiBitmap( - TCL_UNUSED(void *), - Tcl_Interp *interp, - TCL_UNUSED(int), - TCL_UNUSED(const char **)) + TCL_UNUSED(void *), + Tcl_Interp *interp, + TCL_UNUSED(int), + TCL_UNUSED(const char **)) { - static const char usage_message[] = "::tk::print::_gdi bitmap hdc x y " - "-anchor [center|n|e|s|w] -background color " - "-bitmap bitmap -foreground color\n" - "Not implemented yet. Sorry!"; - - /* - * Skip this for now. Should be based on common - * code with the copybits command. - */ - - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; + static const char usage_message[] = "::tk::print::_gdi bitmap hdc x y " + "-anchor [center|n|e|s|w] -background color " + "-bitmap bitmap -foreground color\n" + "Not implemented yet. Sorry!"; + + /* + * Skip this for now. Should be based on common + * code with the copybits command. + */ + + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; } @@ -406,20 +405,20 @@ static int GdiBitmap( */ static int GdiImage( - TCL_UNUSED(void *), - Tcl_Interp *interp, - TCL_UNUSED(int), - TCL_UNUSED(const char **)) + TCL_UNUSED(void *), + Tcl_Interp *interp, + TCL_UNUSED(int), + TCL_UNUSED(const char **)) { - static const char usage_message[] = "::tk::print::_gdi image hdc x y -anchor [center|n|e|s|w] -image name\n" - "Not implemented yet. Sorry!"; + static const char usage_message[] = "::tk::print::_gdi image hdc x y -anchor [center|n|e|s|w] -image name\n" + "Not implemented yet. Sorry!"; - /* Skip this for now..... */ - /* Should be based on common code with the copybits command. */ + /* Skip this for now..... */ + /* Should be based on common code with the copybits command. */ - Tcl_AppendResult(interp, usage_message, NULL); - /* Normally, usage results in TCL_ERROR--but wait til' it's implemented. */ - return TCL_OK; + Tcl_AppendResult(interp, usage_message, NULL); + /* Normally, usage results in TCL_ERROR--but wait til' it's implemented. */ + return TCL_OK; } /* @@ -430,7 +429,7 @@ static int GdiImage( * Contributed by Lukas Rosenthaler * Note: The canvas doesn't directly support photos (only as images), * so this is the first ::tk::print::_gdi command without an equivalent canvas command. -* This code may be modified to support photo images on the canvas. + * This code may be modified to support photo images on the canvas. * * Results: * Renders a photo. @@ -439,183 +438,182 @@ static int GdiImage( */ static int GdiPhoto( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi photo hdc [-destination x y [w [h]]] -photo name\n"; - HDC dst; - int dst_x = 0, dst_y = 0, dst_w = 0, dst_h = 0; - int nx, ny, sll; - const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char *. */ - Tk_PhotoHandle photo_handle; - Tk_PhotoImageBlock img_block; - BITMAPINFO bitmapinfo; /* Since we don't need the bmiColors table, - there is no need for dynamic allocation. */ - int oldmode; /* For saving the old stretch mode. */ - POINT pt; /* For saving the brush org. */ - char *pbuf = NULL; - int i, j, k; - int retval = TCL_OK; - - /* - * Parse the arguments. - */ - - /* HDC is required. */ - if ( argc < 1 ) { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } + static const char usage_message[] = "::tk::print::_gdi photo hdc [-destination x y [w [h]]] -photo name\n"; + HDC dst; + int dst_x = 0, dst_y = 0, dst_w = 0, dst_h = 0; + int nx, ny, sll; + const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char *. */ + Tk_PhotoHandle photo_handle; + Tk_PhotoImageBlock img_block; + BITMAPINFO bitmapinfo; /* Since we don't need the bmiColors table, + there is no need for dynamic allocation. */ + int oldmode; /* For saving the old stretch mode. */ + POINT pt; /* For saving the brush org. */ + char *pbuf = NULL; + int i, j, k; + int retval = TCL_OK; - //dst = printDC; - dst = CreateDC (driver, printerName, output, returnedDevmode); - - /* - * Next, check to see if 'dst' can support BitBlt. - * If not, raise an error. - */ - if ( (GetDeviceCaps (dst, RASTERCAPS) & RC_STRETCHDIB) == 0 ) { - sprintf(msgbuf, "::tk::print::_gdi photo not supported on device context (0x%s)", argv[0]); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_ERROR; - } + /* + * Parse the arguments. + */ - /* Parse the command line arguments. */ - for (j = 1; j < argc; j++) - { - if (strcmp (argv[j], "-destination") == 0) - { - double x, y, w, h; - int count = 0; + /* HDC is required. */ + if ( argc < 1 ) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - if ( j < argc ) - count = sscanf(argv[++j], "%lf%lf%lf%lf", &x, &y, &w, &h); + dst = printDC; - if ( count < 2 ) /* Destination must provide at least 2 arguments. */ - { - Tcl_AppendResult(interp, "-destination requires a list of at least 2 numbers\n", - usage_message, NULL); + /* + * Next, check to see if 'dst' can support BitBlt. + * If not, raise an error. + */ + if ( (GetDeviceCaps (dst, RASTERCAPS) & RC_STRETCHDIB) == 0 ) { + sprintf(msgbuf, "::tk::print::_gdi photo not supported on device context (0x%s)", argv[0]); + Tcl_AppendResult(interp, msgbuf, NULL); return TCL_ERROR; - } - else - { - dst_x = (int) x; - dst_y = (int) y; - if ( count == 3 ) - { - dst_w = (int) w; - dst_h = -1; - } - else if ( count == 4 ) - { - dst_w = (int) w; - dst_h = (int) h; - } - } } - else if (strcmp (argv[j], "-photo") == 0) - photoname = argv[++j]; - } - if ( photoname == 0 ) /* No photo provided. */ - { - Tcl_AppendResult(interp, "No photo name provided to ::tk::print::_gdi photo\n", usage_message, NULL); - return TCL_ERROR; - } + /* Parse the command line arguments. */ + for (j = 1; j < argc; j++) + { + if (strcmp (argv[j], "-destination") == 0) + { + double x, y, w, h; + int count = 0; + + if ( j < argc ) + count = sscanf(argv[++j], "%lf%lf%lf%lf", &x, &y, &w, &h); + + if ( count < 2 ) /* Destination must provide at least 2 arguments. */ + { + Tcl_AppendResult(interp, "-destination requires a list of at least 2 numbers\n", + usage_message, NULL); + return TCL_ERROR; + } + else + { + dst_x = (int) x; + dst_y = (int) y; + if ( count == 3 ) + { + dst_w = (int) w; + dst_h = -1; + } + else if ( count == 4 ) + { + dst_w = (int) w; + dst_h = (int) h; + } + } + } + else if (strcmp (argv[j], "-photo") == 0) + photoname = argv[++j]; + } - photo_handle = Tk_FindPhoto (interp, photoname); - if ( photo_handle == 0 ) - { - Tcl_AppendResult(interp, "::tk::print::_gdi photo: Photo name ", photoname, " can't be located\n", + if ( photoname == 0 ) /* No photo provided. */ + { + Tcl_AppendResult(interp, "No photo name provided to ::tk::print::_gdi photo\n", usage_message, NULL); + return TCL_ERROR; + } + + photo_handle = Tk_FindPhoto (interp, photoname); + if ( photo_handle == 0 ) + { + Tcl_AppendResult(interp, "::tk::print::_gdi photo: Photo name ", photoname, " can't be located\n", usage_message, NULL); - return TCL_ERROR; - } - Tk_PhotoGetImage (photo_handle, &img_block); + return TCL_ERROR; + } + Tk_PhotoGetImage (photo_handle, &img_block); - nx = img_block.width; - ny = img_block.height; - sll = ((3*nx + 3) / 4)*4; /* Must be multiple of 4. */ + nx = img_block.width; + ny = img_block.height; + sll = ((3*nx + 3) / 4)*4; /* Must be multiple of 4. */ - pbuf = (char *) Tcl_Alloc (sll*ny*sizeof (char)); - if ( pbuf == 0 ) /* Memory allocation failure. */ - { - Tcl_AppendResult(interp, "::tk::print::_gdi photo failed--out of memory", NULL); - return TCL_ERROR; - } + pbuf = (char *) Tcl_Alloc (sll*ny*sizeof (char)); + if ( pbuf == 0 ) /* Memory allocation failure. */ + { + Tcl_AppendResult(interp, "::tk::print::_gdi photo failed--out of memory", NULL); + return TCL_ERROR; + } - /* After this, all returns must go through retval. */ + /* After this, all returns must go through retval. */ - /* BITMAP expects BGR; photo provides RGB. */ - for (k = 0; k < ny; k++) - { - for (i = 0; i < nx; i++) - { - pbuf[k*sll + 3*i] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[2]]; - pbuf[k*sll + 3*i + 1] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[1]]; - pbuf[k*sll + 3*i + 2] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[0]]; + /* BITMAP expects BGR; photo provides RGB. */ + for (k = 0; k < ny; k++) + { + for (i = 0; i < nx; i++) + { + pbuf[k*sll + 3*i] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[2]]; + pbuf[k*sll + 3*i + 1] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[1]]; + pbuf[k*sll + 3*i + 2] = + img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[0]]; + } + } + + memset (&bitmapinfo, 0L, sizeof (BITMAPINFO)); + + bitmapinfo.bmiHeader.biSize = sizeof (BITMAPINFOHEADER); + bitmapinfo.bmiHeader.biWidth = nx; + bitmapinfo.bmiHeader.biHeight = -ny; + bitmapinfo.bmiHeader.biPlanes = 1; + bitmapinfo.bmiHeader.biBitCount = 24; + bitmapinfo.bmiHeader.biCompression = BI_RGB; + bitmapinfo.bmiHeader.biSizeImage = 0; /* sll*ny;. */ + bitmapinfo.bmiHeader.biXPelsPerMeter = 0; + bitmapinfo.bmiHeader.biYPelsPerMeter = 0; + bitmapinfo.bmiHeader.biClrUsed = 0; + bitmapinfo.bmiHeader.biClrImportant = 0; + + oldmode = SetStretchBltMode (dst, HALFTONE); + /* According to the Win32 Programmer's Manual, we have to set the brush org, now. */ + SetBrushOrgEx(dst, 0, 0, &pt); + + if (dst_w <= 0) + { + dst_w = nx; + dst_h = ny; + } + else if (dst_h <= 0) + { + dst_h = ny*dst_w / nx; + } + + if (StretchDIBits(dst, dst_x, dst_y, dst_w, dst_h, 0, 0, nx, ny, + pbuf, &bitmapinfo, DIB_RGB_COLORS, SRCCOPY) == (int)GDI_ERROR) { + int errcode; + + errcode = GetLastError(); + sprintf(msgbuf, "::tk::print::_gdi photo internal failure: StretchDIBits error code %d", errcode); + Tcl_AppendResult(interp, msgbuf, NULL); + retval = TCL_ERROR; } - } - - memset (&bitmapinfo, 0L, sizeof (BITMAPINFO)); - - bitmapinfo.bmiHeader.biSize = sizeof (BITMAPINFOHEADER); - bitmapinfo.bmiHeader.biWidth = nx; - bitmapinfo.bmiHeader.biHeight = -ny; - bitmapinfo.bmiHeader.biPlanes = 1; - bitmapinfo.bmiHeader.biBitCount = 24; - bitmapinfo.bmiHeader.biCompression = BI_RGB; - bitmapinfo.bmiHeader.biSizeImage = 0; /* sll*ny;. */ - bitmapinfo.bmiHeader.biXPelsPerMeter = 0; - bitmapinfo.bmiHeader.biYPelsPerMeter = 0; - bitmapinfo.bmiHeader.biClrUsed = 0; - bitmapinfo.bmiHeader.biClrImportant = 0; - - oldmode = SetStretchBltMode (dst, HALFTONE); - /* According to the Win32 Programmer's Manual, we have to set the brush org, now. */ - SetBrushOrgEx(dst, 0, 0, &pt); - - if (dst_w <= 0) - { - dst_w = nx; - dst_h = ny; - } - else if (dst_h <= 0) - { - dst_h = ny*dst_w / nx; - } - - if (StretchDIBits(dst, dst_x, dst_y, dst_w, dst_h, 0, 0, nx, ny, - pbuf, &bitmapinfo, DIB_RGB_COLORS, SRCCOPY) == (int)GDI_ERROR) { - int errcode; - - errcode = GetLastError(); - sprintf(msgbuf, "::tk::print::_gdi photo internal failure: StretchDIBits error code %d", errcode); - Tcl_AppendResult(interp, msgbuf, NULL); - retval = TCL_ERROR; - } - /* Clean up the hDC. */ - if (oldmode != 0 ) - { - SetStretchBltMode(dst, oldmode); - SetBrushOrgEx(dst, pt.x, pt.y, &pt); - } + /* Clean up the hDC. */ + if (oldmode != 0 ) + { + SetStretchBltMode(dst, oldmode); + SetBrushOrgEx(dst, pt.x, pt.y, &pt); + } - Tcl_Free (pbuf); + Tcl_Free (pbuf); - if ( retval == TCL_OK ) - { - sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); - Tcl_AppendResult(interp, msgbuf, NULL); - } + if ( retval == TCL_OK ) + { + sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); + Tcl_AppendResult(interp, msgbuf, NULL); + } - return retval; + return retval; } @@ -661,7 +659,7 @@ int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { nbpoints = TkGdiMakeBezierCurve(NULL, inPointList, npoly, nStep, - NULL, outPointList); + NULL, outPointList); Tcl_Free((void *)inPointList); @@ -676,7 +674,7 @@ int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { bpoints[n].y = (long)outPointList[2*n+1]; } Tcl_Free((void *)outPointList); - *bpointptr = *bpoints; + *bpointptr = *bpoints; return nbpoints; } @@ -694,326 +692,324 @@ int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { */ static int GdiLine( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi line hdc x1 y1 ... xn yn " - "-arrow [first|last|both|none] -arrowshape {d1 d2 d3} " - "-dash dashlist " - "-capstyle [butt|projecting|round] -fill color " - "-joinstyle [bevel|miter|round] -smooth [true|false|bezier] " - "-splinesteps number -stipple bitmap -width linewid"; - char *strend; - POINT *polypoints; - int npoly; - int x, y; - HDC hDC; - HPEN hPen; - - LOGBRUSH lbrush; - HBRUSH hBrush; - - int width = 0; - COLORREF linecolor = 0; - int dolinecolor = 0; - int dosmooth = 0; - int doarrow = 0; /* 0=none; 1=end; 2=start; 3=both. */ - int arrowshape[3]; - - int nStep = 12; - - int dodash = 0; - const char *dashdata = 0; - - arrowshape[0] = 8; - arrowshape[1] = 10; - arrowshape[2] = 3; - - /* Verrrrrry simple for now.... */ - if (argc >= 5) - { - - // hDC = printDC; - hDC = CreateDC (driver, printerName, output, returnedDevmode); - - - if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) - { - Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); - return TCL_ERROR; - } - polypoints[0].x = atol(argv[1]); - polypoints[0].y = atol(argv[2]); - polypoints[1].x = atol(argv[3]); - polypoints[1].y = atol(argv[4]); - argc -= 5; - argv += 5; - npoly = 2; - - while ( argc >= 2 ) - { - /* Check for a number. */ - x = strtoul(argv[0], &strend, 0); - if ( strend > argv[0] ) - { - /* One number.... */ - y = strtoul (argv[1], &strend, 0); - if ( strend > argv[1] ) - { - /* TWO numbers!. */ - polypoints[npoly].x = x; - polypoints[npoly].y = y; - npoly++; - argc-=2; - argv+=2; - } - else - { - /* Only one number... Assume a usage error. */ - Tcl_Free((void *)polypoints); - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - } - else - { - if ( strcmp(*argv, "-arrow") == 0 ) - { - if ( strcmp(argv[1], "none") == 0 ) - doarrow = 0; - else if ( strcmp(argv[1], "both") == 0 ) - doarrow = 3; - else if ( strcmp(argv[1], "first") == 0 ) - doarrow = 2; - else if ( strcmp(argv[1], "last") == 0 ) - doarrow = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-arrowshape") == 0 ) - { - /* List of 3 numbers--set arrowshape array. */ - int a1, a2, a3; - - if ( sscanf(argv[1], "%d%d%d", &a1, &a2, &a3) == 3 ) - { - if (a1 > 0 && a2 > 0 && a3 > 0 ) - { - arrowshape[0] = a1; - arrowshape[1] = a2; - arrowshape[2] = a3; - } - /* Else the numbers are bad. */ - } - /* Else the argument was bad. */ - - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-capstyle") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-fill") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-joinstyle") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-smooth") == 0 ) - { - /* Argument is true/false or 1/0 or bezier. */ - if ( argv[1] ) { - switch ( argv[1][0] ) { - case 't': case 'T': - case '1': - case 'b': case 'B': /* bezier. */ - dosmooth = 1; - break; - default: - dosmooth = 0; - break; - } - argv+=2; - argc-=2; - } - } - else if ( strcmp(*argv, "-splinesteps") == 0 ) - { - nStep = atoi(argv[1]); - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-dash" ) == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - argv += 2; - argc -= 2; - } - else if ( strcmp(*argv, "-dashoffset" ) == 0 ) - { - argv += 2; - argc -= 2; - } - else if ( strcmp(*argv, "-stipple") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-width") == 0 ) - { - width = atoi(argv[1]); - argv+=2; - argc-=2; - } - else /* It's an unknown argument!. */ - { - argc--; - argv++; - } - /* Check for arguments - * Most of the arguments affect the "Pen" - */ - } - } - - if (width || dolinecolor || dodash ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - if ( doarrow != 0 ) - GdiMakeBrush(interp, 0, linecolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - - if (dosmooth) /* Use PolyBezier. */ - { - int nbpoints; - POINT *bpoints = 0; - nbpoints = Bezierize(polypoints,npoly,nStep,bpoints); - if (nbpoints > 0 ) - Polyline(hDC, bpoints, nbpoints); - else - Polyline(hDC, polypoints, npoly); /* Out of memory? Just draw a regular line. */ - if ( bpoints != 0 ) - Tcl_Free((void *)bpoints); - } - else - Polyline(hDC, polypoints, npoly); + static const char usage_message[] = "::tk::print::_gdi line hdc x1 y1 ... xn yn " + "-arrow [first|last|both|none] -arrowshape {d1 d2 d3} " + "-dash dashlist " + "-capstyle [butt|projecting|round] -fill color " + "-joinstyle [bevel|miter|round] -smooth [true|false|bezier] " + "-splinesteps number -stipple bitmap -width linewid"; + char *strend; + POINT *polypoints; + int npoly; + int x, y; + HDC hDC; + HPEN hPen; - if ( dodash && doarrow ) /* Don't use dashed or thick pen for the arrows! */ - { - GdiFreePen(interp, hDC, hPen); - GdiMakePen(interp, width, - 0, 0, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - } + LOGBRUSH lbrush; + HBRUSH hBrush; - /* Now the arrowheads, if any. */ - if ( doarrow & 1 ) - { - /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y. */ - POINT ahead[6]; - double dx, dy, length; - double backup, sinTheta, cosTheta; - double vertX, vertY, temp; - double fracHeight; - - fracHeight = 2.0 / arrowshape[2]; - backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; - - ahead[0].x = ahead[5].x = polypoints[npoly-1].x; - ahead[0].y = ahead[5].y = polypoints[npoly-1].y; - dx = ahead[0].x - polypoints[npoly-2].x; - dy = ahead[0].y - polypoints[npoly-2].y; - if ( (length = hypot(dx, dy)) == 0 ) - sinTheta = cosTheta = 0.0; - else - { - sinTheta = dy / length; - cosTheta = dx / length; - } - vertX = ahead[0].x - arrowshape[0]*cosTheta; - vertY = ahead[0].y - arrowshape[0]*sinTheta; - temp = arrowshape[2]*sinTheta; - ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); - ahead[4].x = (long)(ahead[1].x - 2 * temp); - temp = arrowshape[2]*cosTheta; - ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); - ahead[4].y = (long)(ahead[1].y + 2 * temp); - ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); - ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); - - Polygon(hDC, ahead, 6); + int width = 0; + COLORREF linecolor = 0; + int dolinecolor = 0; + int dosmooth = 0; + int doarrow = 0; /* 0=none; 1=end; 2=start; 3=both. */ + int arrowshape[3]; - } + int nStep = 12; - if ( doarrow & 2 ) - { - /* Arrowhead at end = polypoints[0].x, polypoints[0].y. */ - POINT ahead[6]; - double dx, dy, length; - double backup, sinTheta, cosTheta; - double vertX, vertY, temp; - double fracHeight; - - fracHeight = 2.0 / arrowshape[2]; - backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; - - ahead[0].x = ahead[5].x = polypoints[0].x; - ahead[0].y = ahead[5].y = polypoints[0].y; - dx = ahead[0].x - polypoints[1].x; - dy = ahead[0].y - polypoints[1].y; - if ( (length = hypot(dx, dy)) == 0 ) - sinTheta = cosTheta = 0.0; - else - { - sinTheta = dy / length; - cosTheta = dx / length; - } - vertX = ahead[0].x - arrowshape[0]*cosTheta; - vertY = ahead[0].y - arrowshape[0]*sinTheta; - temp = arrowshape[2]*sinTheta; - ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); - ahead[4].x = (long)(ahead[1].x - 2 * temp); - temp = arrowshape[2]*cosTheta; - ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); - ahead[4].y = (long)(ahead[1].y + 2 * temp); - ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); - ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); - - Polygon(hDC, ahead, 6); - } + int dodash = 0; + const char *dashdata = 0; + arrowshape[0] = 8; + arrowshape[1] = 10; + arrowshape[2] = 3; - if (width || dolinecolor || dodash ) - GdiFreePen(interp, hDC, hPen); - if ( doarrow ) - GdiFreeBrush(interp, hDC, hBrush); - - Tcl_Free((void *)polypoints); - - return TCL_OK; - } + /* Verrrrrry simple for now.... */ + if (argc >= 5) + { + + hDC = printDC; + + if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) + { + Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); + return TCL_ERROR; + } + polypoints[0].x = atol(argv[1]); + polypoints[0].y = atol(argv[2]); + polypoints[1].x = atol(argv[3]); + polypoints[1].y = atol(argv[4]); + argc -= 5; + argv += 5; + npoly = 2; + + while ( argc >= 2 ) + { + /* Check for a number. */ + x = strtoul(argv[0], &strend, 0); + if ( strend > argv[0] ) + { + /* One number.... */ + y = strtoul (argv[1], &strend, 0); + if ( strend > argv[1] ) + { + /* TWO numbers!. */ + polypoints[npoly].x = x; + polypoints[npoly].y = y; + npoly++; + argc-=2; + argv+=2; + } + else + { + /* Only one number... Assume a usage error. */ + Tcl_Free((void *)polypoints); + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } + } + else + { + if ( strcmp(*argv, "-arrow") == 0 ) + { + if ( strcmp(argv[1], "none") == 0 ) + doarrow = 0; + else if ( strcmp(argv[1], "both") == 0 ) + doarrow = 3; + else if ( strcmp(argv[1], "first") == 0 ) + doarrow = 2; + else if ( strcmp(argv[1], "last") == 0 ) + doarrow = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-arrowshape") == 0 ) + { + /* List of 3 numbers--set arrowshape array. */ + int a1, a2, a3; + + if ( sscanf(argv[1], "%d%d%d", &a1, &a2, &a3) == 3 ) + { + if (a1 > 0 && a2 > 0 && a3 > 0 ) + { + arrowshape[0] = a1; + arrowshape[1] = a2; + arrowshape[2] = a3; + } + /* Else the numbers are bad. */ + } + /* Else the argument was bad. */ + + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-capstyle") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-fill") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-joinstyle") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-smooth") == 0 ) + { + /* Argument is true/false or 1/0 or bezier. */ + if ( argv[1] ) { + switch ( argv[1][0] ) { + case 't': case 'T': + case '1': + case 'b': case 'B': /* bezier. */ + dosmooth = 1; + break; + default: + dosmooth = 0; + break; + } + argv+=2; + argc-=2; + } + } + else if ( strcmp(*argv, "-splinesteps") == 0 ) + { + nStep = atoi(argv[1]); + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-dash" ) == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + argv += 2; + argc -= 2; + } + else if ( strcmp(*argv, "-dashoffset" ) == 0 ) + { + argv += 2; + argc -= 2; + } + else if ( strcmp(*argv, "-stipple") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(*argv, "-width") == 0 ) + { + width = atoi(argv[1]); + argv+=2; + argc-=2; + } + else /* It's an unknown argument!. */ + { + argc--; + argv++; + } + /* Check for arguments + * Most of the arguments affect the "Pen" + */ + } + } + + if (width || dolinecolor || dodash ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + if ( doarrow != 0 ) + GdiMakeBrush(interp, 0, linecolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + + if (dosmooth) /* Use PolyBezier. */ + { + int nbpoints; + POINT *bpoints = 0; + nbpoints = Bezierize(polypoints,npoly,nStep,bpoints); + if (nbpoints > 0 ) + Polyline(hDC, bpoints, nbpoints); + else + Polyline(hDC, polypoints, npoly); /* Out of memory? Just draw a regular line. */ + if ( bpoints != 0 ) + Tcl_Free((void *)bpoints); + } + else + Polyline(hDC, polypoints, npoly); + + if ( dodash && doarrow ) /* Don't use dashed or thick pen for the arrows! */ + { + GdiFreePen(interp, hDC, hPen); + GdiMakePen(interp, width, + 0, 0, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + } + + /* Now the arrowheads, if any. */ + if ( doarrow & 1 ) + { + /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y. */ + POINT ahead[6]; + double dx, dy, length; + double backup, sinTheta, cosTheta; + double vertX, vertY, temp; + double fracHeight; + + fracHeight = 2.0 / arrowshape[2]; + backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; + + ahead[0].x = ahead[5].x = polypoints[npoly-1].x; + ahead[0].y = ahead[5].y = polypoints[npoly-1].y; + dx = ahead[0].x - polypoints[npoly-2].x; + dy = ahead[0].y - polypoints[npoly-2].y; + if ( (length = hypot(dx, dy)) == 0 ) + sinTheta = cosTheta = 0.0; + else + { + sinTheta = dy / length; + cosTheta = dx / length; + } + vertX = ahead[0].x - arrowshape[0]*cosTheta; + vertY = ahead[0].y - arrowshape[0]*sinTheta; + temp = arrowshape[2]*sinTheta; + ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); + ahead[4].x = (long)(ahead[1].x - 2 * temp); + temp = arrowshape[2]*cosTheta; + ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); + ahead[4].y = (long)(ahead[1].y + 2 * temp); + ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); + ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); + + Polygon(hDC, ahead, 6); + + } + + if ( doarrow & 2 ) + { + /* Arrowhead at end = polypoints[0].x, polypoints[0].y. */ + POINT ahead[6]; + double dx, dy, length; + double backup, sinTheta, cosTheta; + double vertX, vertY, temp; + double fracHeight; + + fracHeight = 2.0 / arrowshape[2]; + backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; + + ahead[0].x = ahead[5].x = polypoints[0].x; + ahead[0].y = ahead[5].y = polypoints[0].y; + dx = ahead[0].x - polypoints[1].x; + dy = ahead[0].y - polypoints[1].y; + if ( (length = hypot(dx, dy)) == 0 ) + sinTheta = cosTheta = 0.0; + else + { + sinTheta = dy / length; + cosTheta = dx / length; + } + vertX = ahead[0].x - arrowshape[0]*cosTheta; + vertY = ahead[0].y - arrowshape[0]*sinTheta; + temp = arrowshape[2]*sinTheta; + ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); + ahead[4].x = (long)(ahead[1].x - 2 * temp); + temp = arrowshape[2]*cosTheta; + ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); + ahead[4].y = (long)(ahead[1].y + 2 * temp); + ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); + ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); + + Polygon(hDC, ahead, 6); + } + + + if (width || dolinecolor || dodash ) + GdiFreePen(interp, hDC, hPen); + if ( doarrow ) + GdiFreeBrush(interp, hDC, hBrush); + + Tcl_Free((void *)polypoints); + + return TCL_OK; + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; } /* @@ -1030,112 +1026,112 @@ static int GdiLine( */ static int GdiOval( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi oval hdc x1 y1 x2 y2 -fill color -outline color " - "-stipple bitmap -width linewid"; - int x1, y1, x2, y2; - HDC hDC; - HPEN hPen; - int width=0; - COLORREF linecolor = 0, fillcolor = 0; - int dolinecolor = 0, dofillcolor = 0; - HBRUSH hBrush; - LOGBRUSH lbrush; - HGDIOBJ oldobj; - - int dodash = 0; - const char *dashdata = 0; - - /* Verrrrrry simple for now.... */ - if (argc >= 5) - { + static const char usage_message[] = "::tk::print::_gdi oval hdc x1 y1 x2 y2 -fill color -outline color " + "-stipple bitmap -width linewid"; + int x1, y1, x2, y2; + HDC hDC; + HPEN hPen; + int width=0; + COLORREF linecolor = 0, fillcolor = 0; + int dolinecolor = 0, dofillcolor = 0; + HBRUSH hBrush; + LOGBRUSH lbrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now.... */ + if (argc >= 5) + { - // hDC = printDC; - hDC = CreateDC (driver, printerName, output, returnedDevmode); - - x1 = atol(argv[1]); - y1 = atol(argv[2]); - x2 = atol(argv[3]); - y2 = atol(argv[4]); - if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } - if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } - argc -= 5; - argv += 5; - - while ( argc > 0 ) - { - /* Now handle any other arguments that occur. */ - if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( argv[1] ) - if ( GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( argv[1] ) - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-stipple") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-width") == 0 ) - { - if (argv[1]) - width = atoi(argv[1]); - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - argv+=2; - argc-=2; - } - } - - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject( hDC, GetStockObject(HOLLOW_BRUSH) ); - - if (width || dolinecolor) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - /* - * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and - * earlier documentation, canvas rectangle does not. Thus, add 1 to - * right and lower bounds to get appropriate behavior. - */ - Ellipse (hDC, x1, y1, x2+1, y2+1); - if (width || dolinecolor) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject (hDC, oldobj ); - - return TCL_OK; - } + hDC = printDC; + + + x1 = atol(argv[1]); + y1 = atol(argv[2]); + x2 = atol(argv[3]); + y2 = atol(argv[4]); + if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } + if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } + argc -= 5; + argv += 5; + + while ( argc > 0 ) + { + /* Now handle any other arguments that occur. */ + if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( argv[1] ) + if ( GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( argv[1] ) + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-stipple") == 0 ) + { + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-width") == 0 ) + { + if (argv[1]) + width = atoi(argv[1]); + argv+=2; + argc-=2; + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + argv+=2; + argc-=2; + } + } + + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject( hDC, GetStockObject(HOLLOW_BRUSH) ); + + if (width || dolinecolor) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ + Ellipse (hDC, x1, y1, x2+1, y2+1); + if (width || dolinecolor) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject (hDC, oldobj ); + + return TCL_OK; + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; } /* @@ -1152,173 +1148,171 @@ static int GdiOval( */ static int GdiPolygon( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi polygon hdc x1 y1 ... xn yn " - "-fill color -outline color -smooth [true|false|bezier] " - "-splinesteps number -stipple bitmap -width linewid"; - - char *strend; - POINT *polypoints; - int npoly; - int dosmooth = 0; - int nStep = 12; - int x, y; - HDC hDC; - HPEN hPen; - int width = 0; - COLORREF linecolor=0, fillcolor=BS_NULL; - int dolinecolor=0, dofillcolor=0; - LOGBRUSH lbrush; - HBRUSH hBrush; - HGDIOBJ oldobj; - - int dodash = 0; - const char *dashdata = 0; - - /* Verrrrrry simple for now.... */ - if (argc >= 5) - { - - // hDC = printDC; - hDC = CreateDC (driver, printerName, output, returnedDevmode); - - if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) - { - Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); - return TCL_ERROR; - } - polypoints[0].x = atol(argv[1]); - polypoints[0].y = atol(argv[2]); - polypoints[1].x = atol(argv[3]); - polypoints[1].y = atol(argv[4]); - argc -= 5; - argv += 5; - npoly = 2; - - while ( argc >= 2 ) - { - /* Check for a number */ - x = strtoul(argv[0], &strend, 0); - if ( strend > argv[0] ) - { - /* One number.... */ - y = strtoul (argv[1], &strend, 0); - if ( strend > argv[1] ) - { - /* TWO numbers!. */ - polypoints[npoly].x = x; - polypoints[npoly].y = y; - npoly++; - argc-=2; - argv+=2; - } - else - { - /* Only one number... Assume a usage error. */ - Tcl_Free((void *)polypoints); - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - } - else - { - if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( argv[1] && GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 0; - } - else if ( strcmp(argv[0], "-smooth") == 0 ) { - if ( argv[1] ) { - switch ( argv[1][0] ) { - case 't': case 'T': - case '1': - case 'b': case 'B': /* bezier. */ - dosmooth = 1; - break; - default: - dosmooth = 0; - break; - } - } - } - else if ( strcmp(argv[0], "-splinesteps") == 0 ) - { - if ( argv[1] ) - nStep = atoi(argv[1]); - } - else if (strcmp(argv[0], "-stipple") == 0 ) - { - } - else if (strcmp(argv[0], "-width") == 0 ) - { - if (argv[1]) - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } - argc -= 2; - argv += 2; - /* - * Check for arguments. - * Most of the arguments affect the "Pen" and "Brush". - */ - } - } - - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); - - if (width || dolinecolor) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - - if ( dosmooth) - { - int nbpoints; - POINT *bpoints = 0; - nbpoints = Bezierize(polypoints,npoly,nStep,bpoints); - if ( nbpoints > 0 ) - Polygon(hDC, bpoints, nbpoints); - else - Polygon(hDC, polypoints, npoly); - if ( bpoints != 0 ) - Tcl_Free((void *)bpoints); - } - else - Polygon(hDC, polypoints, npoly); + static const char usage_message[] = "::tk::print::_gdi polygon hdc x1 y1 ... xn yn " + "-fill color -outline color -smooth [true|false|bezier] " + "-splinesteps number -stipple bitmap -width linewid"; - if (width || dolinecolor) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject (hDC, oldobj); - - Tcl_Free((void *)polypoints); - - return TCL_OK; - } + char *strend; + POINT *polypoints; + int npoly; + int dosmooth = 0; + int nStep = 12; + int x, y; + HDC hDC; + HPEN hPen; + int width = 0; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + LOGBRUSH lbrush; + HBRUSH hBrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now.... */ + if (argc >= 5) + { + hDC = printDC; + + if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) + { + Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); + return TCL_ERROR; + } + polypoints[0].x = atol(argv[1]); + polypoints[0].y = atol(argv[2]); + polypoints[1].x = atol(argv[3]); + polypoints[1].y = atol(argv[4]); + argc -= 5; + argv += 5; + npoly = 2; + + while ( argc >= 2 ) + { + /* Check for a number */ + x = strtoul(argv[0], &strend, 0); + if ( strend > argv[0] ) + { + /* One number.... */ + y = strtoul (argv[1], &strend, 0); + if ( strend > argv[1] ) + { + /* TWO numbers!. */ + polypoints[npoly].x = x; + polypoints[npoly].y = y; + npoly++; + argc-=2; + argv+=2; + } + else + { + /* Only one number... Assume a usage error. */ + Tcl_Free((void *)polypoints); + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } + } + else + { + if ( strcmp(argv[0], "-fill") == 0 ) + { + if ( argv[1] && GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + } + else if ( strcmp(argv[0], "-outline") == 0 ) + { + if ( GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 0; + } + else if ( strcmp(argv[0], "-smooth") == 0 ) { + if ( argv[1] ) { + switch ( argv[1][0] ) { + case 't': case 'T': + case '1': + case 'b': case 'B': /* bezier. */ + dosmooth = 1; + break; + default: + dosmooth = 0; + break; + } + } + } + else if ( strcmp(argv[0], "-splinesteps") == 0 ) + { + if ( argv[1] ) + nStep = atoi(argv[1]); + } + else if (strcmp(argv[0], "-stipple") == 0 ) + { + } + else if (strcmp(argv[0], "-width") == 0 ) + { + if (argv[1]) + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + argc -= 2; + argv += 2; + /* + * Check for arguments. + * Most of the arguments affect the "Pen" and "Brush". + */ + } + } + + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); + + if (width || dolinecolor) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + + if ( dosmooth) + { + int nbpoints; + POINT *bpoints = 0; + nbpoints = Bezierize(polypoints,npoly,nStep,bpoints); + if ( nbpoints > 0 ) + Polygon(hDC, bpoints, nbpoints); + else + Polygon(hDC, polypoints, npoly); + if ( bpoints != 0 ) + Tcl_Free((void *)bpoints); + } + else + Polygon(hDC, polypoints, npoly); + + if (width || dolinecolor) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject (hDC, oldobj); + + Tcl_Free((void *)polypoints); + + return TCL_OK; + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; } /* @@ -1335,113 +1329,112 @@ static int GdiPolygon( */ static int GdiRectangle( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi rectangle hdc x1 y1 x2 y2 " - "-fill color -outline color " - "-stipple bitmap -width linewid"; - - int x1, y1, x2, y2; - HDC hDC; - HPEN hPen; - int width = 0; - COLORREF linecolor=0, fillcolor=BS_NULL; - int dolinecolor=0, dofillcolor=0; - LOGBRUSH lbrush; - HBRUSH hBrush; - HGDIOBJ oldobj; - - int dodash = 0; - const char *dashdata = 0; - - /* Verrrrrry simple for now.... */ - if (argc >= 5) - { + static const char usage_message[] = "::tk::print::_gdi rectangle hdc x1 y1 x2 y2 " + "-fill color -outline color " + "-stipple bitmap -width linewid"; + + int x1, y1, x2, y2; + HDC hDC; + HPEN hPen; + int width = 0; + COLORREF linecolor=0, fillcolor=BS_NULL; + int dolinecolor=0, dofillcolor=0; + LOGBRUSH lbrush; + HBRUSH hBrush; + HGDIOBJ oldobj; + + int dodash = 0; + const char *dashdata = 0; + + /* Verrrrrry simple for now.... */ + if (argc >= 5) + { - //hDC = printDC; - hDC = CreateDC (driver, printerName, output, returnedDevmode); - - x1 = atol(argv[1]); - y1 = atol(argv[2]); - x2 = atol(argv[3]); - y2 = atol(argv[4]); - if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } - if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } - argc -= 5; - argv += 5; - - /* Now handle any other arguments that occur. */ - while (argc > 1) - { - if ( strcmp(argv[0], "-fill") == 0 ) - { - if (argv[1]) - if (GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - } - else if ( strcmp(argv[0], "-outline") == 0) - { - if (argv[1]) - if (GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - } - else if ( strcmp(argv[0], "-stipple") == 0) - { - } - else if ( strcmp(argv[0], "-width") == 0) - { - if (argv[1] ) - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } - - argc -= 2; - argv += 2; - } - - /* - * Note: If any fill is specified, the function must create a brush and - * put the coordinates in a RECTANGLE structure, and call FillRect. - * FillRect requires a BRUSH / color. - * If not, the function Rectangle must be called. - */ - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); - - if ( width || dolinecolor ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - /* - * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and - * earlier documentation, canvas rectangle does not. Thus, add 1 to - * right and lower bounds to get appropriate behavior. - */ - Rectangle (hDC, x1, y1, x2+1, y2+1); - if ( width || dolinecolor ) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject(hDC, oldobj); - - return TCL_OK; - } + hDC = printDC; + + x1 = atol(argv[1]); + y1 = atol(argv[2]); + x2 = atol(argv[3]); + y2 = atol(argv[4]); + if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } + if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } + argc -= 5; + argv += 5; + + /* Now handle any other arguments that occur. */ + while (argc > 1) + { + if ( strcmp(argv[0], "-fill") == 0 ) + { + if (argv[1]) + if (GdiGetColor(argv[1], &fillcolor) ) + dofillcolor = 1; + } + else if ( strcmp(argv[0], "-outline") == 0) + { + if (argv[1]) + if (GdiGetColor(argv[1], &linecolor) ) + dolinecolor = 1; + } + else if ( strcmp(argv[0], "-stipple") == 0) + { + } + else if ( strcmp(argv[0], "-width") == 0) + { + if (argv[1] ) + width = atoi(argv[1]); + } + else if ( strcmp(argv[0], "-dash") == 0 ) + { + if ( argv[1] ) { + dodash = 1; + dashdata = argv[1]; + } + } + + argc -= 2; + argv += 2; + } + + /* + * Note: If any fill is specified, the function must create a brush and + * put the coordinates in a RECTANGLE structure, and call FillRect. + * FillRect requires a BRUSH / color. + * If not, the function Rectangle must be called. + */ + if (dofillcolor) + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + else + oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); + + if ( width || dolinecolor ) + GdiMakePen(interp, width, + dodash, dashdata, + 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ + Rectangle (hDC, x1, y1, x2+1, y2+1); + if ( width || dolinecolor ) + GdiFreePen(interp, hDC, hPen); + if (dofillcolor) + GdiFreeBrush(interp, hDC, hBrush); + else + SelectObject(hDC, oldobj); + + return TCL_OK; + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; } /* @@ -1450,7 +1443,7 @@ static int GdiRectangle( * GdiCharWidths -- * * Computes /character widths. This is completely inadequate for typesetting, - but should work for simple text manipulation. + but should work for simple text manipulation. * * Results: * Returns character width. @@ -1460,121 +1453,120 @@ static int GdiRectangle( static int GdiCharWidths( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi characters hdc [-font fontname] [-array ary]"; - /* - * Returns widths of characters from font in an associative array. - * Font is currently selected font for HDC if not specified. - * Array name is GdiCharWidths if not specified. - * Widths should be in the same measures as all other values (1/1000 inch). - */ - HDC hDC; - LOGFONT lf; - HFONT hfont, oldfont; - int made_font = 0; - const char *aryvarname = "GdiCharWidths"; - /* For now, assume 256 characters in the font.... */ - int widths[256]; - int retval; - - if ( argc < 1 ) - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - - // hDC = printDC; - hDC = CreateDC (driver, printerName, output, returnedDevmode); + static const char usage_message[] = "::tk::print::_gdi characters hdc [-font fontname] [-array ary]"; + /* + * Returns widths of characters from font in an associative array. + * Font is currently selected font for HDC if not specified. + * Array name is GdiCharWidths if not specified. + * Widths should be in the same measures as all other values (1/1000 inch). + */ + HDC hDC; + LOGFONT lf; + HFONT hfont, oldfont; + int made_font = 0; + const char *aryvarname = "GdiCharWidths"; + /* For now, assume 256 characters in the font.... */ + int widths[256]; + int retval; + + if ( argc < 1 ) + { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - argc--; - argv++; + hDC = printDC; - while ( argc > 0 ) - { - if ( strcmp(argv[0], "-font") == 0 ) - { - argc--; - argv++; - if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) - if ( (hfont = CreateFontIndirect(&lf)) != NULL ) - { - made_font = 1; - oldfont = SelectObject(hDC, hfont); - } - /* Else leave the font alone!. */ - } - else if ( strcmp(argv[0], "-array") == 0 ) - { - argv++; - argc--; - if ( argc > 0 ) - { - aryvarname=argv[0]; - } - } - argv++; argc--; - } + argv++; + + while ( argc > 0 ) + { + if ( strcmp(argv[0], "-font") == 0 ) + { + argc--; + argv++; + if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) + if ( (hfont = CreateFontIndirect(&lf)) != NULL ) + { + made_font = 1; + oldfont = SelectObject(hDC, hfont); + } + /* Else leave the font alone!. */ + } + else if ( strcmp(argv[0], "-array") == 0 ) + { + argv++; + argc--; + if ( argc > 0 ) + { + aryvarname=argv[0]; + } + } + argv++; + argc--; + } - /* Now, get the widths using the correct function for font type. */ + /* Now, get the widths using the correct function for font type. */ - /* - * Try the correct function for non-TrueType fonts first. - */ - if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) - { - /*Try TrueType fonts next.*/ - retval = GetCharABCWidths (hDC, 0, 255, (LPABC) widths ); - } - - /* - * Retval should be 1 (TRUE) if the function succeeded. If the function fails, - * get the "extended" error code and return. Be sure to deallocate the font if - * necessary. - */ - if (retval == FALSE) - { - DWORD val = GetLastError(); - char intstr[12+1]; - sprintf (intstr, "%ld", val ); - Tcl_AppendResult (interp, "::tk::print::_gdi character failed with code ", intstr, NULL); - if ( made_font ) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } - return TCL_ERROR; - } + /* + * Try the correct function for non-TrueType fonts first. + */ + if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) + { + /*Try TrueType fonts next.*/ + retval = GetCharABCWidths (hDC, 0, 255, (LPABC) widths ); + } - { - int i; - char numbuf[11+1]; - char ind[2]; - ind[1] = '\0'; + /* + * Retval should be 1 (TRUE) if the function succeeded. If the function fails, + * get the "extended" error code and return. Be sure to deallocate the font if + * necessary. + */ + if (retval == FALSE) + { + DWORD val = GetLastError(); + char intstr[12+1]; + sprintf (intstr, "%ld", val ); + Tcl_AppendResult (interp, "::tk::print::_gdi character failed with code ", intstr, NULL); + if ( made_font ) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + return TCL_ERROR; + } - for (i = 0; i < 255; i++ ) { - /* May need to convert the widths here(?). */ - sprintf(numbuf, "%d", widths[i]); - ind[0] = i; - Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); + int i; + char numbuf[11+1]; + char ind[2]; + ind[1] = '\0'; + + for (i = 0; i < 255; i++ ) + { + /* May need to convert the widths here(?). */ + sprintf(numbuf, "%d", widths[i]); + ind[0] = i; + Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); + } } - } - /* Now, remove the font if we created it only for this function. */ - if ( made_font ) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } - - /* The return value should be the array name(?). */ - Tcl_AppendResult(interp, (char *)aryvarname, NULL); - return TCL_OK; + /* Now, remove the font if we created it only for this function. */ + if ( made_font ) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + + /* The return value should be the array name(?). */ + Tcl_AppendResult(interp, (char *)aryvarname, NULL); + return TCL_OK; } /* @@ -1591,287 +1583,286 @@ static int GdiCharWidths( */ int GdiText( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi text hdc x y -anchor [center|n|e|s|w] " - "-fill color -font fontname " - "-justify [left|right|center] " - "-stipple bitmap -text string -width linelen " - "-single -backfill" - "-encoding [input encoding] -unicode"; - - HDC hDC; - int x, y; - const char *string = 0; - RECT sizerect; - UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas. */ - Tk_Anchor anchor = 0; - LOGFONT lf; - HFONT hfont, oldfont; - int made_font = 0; - int retval; - int dotextcolor=0; - int dobgmode=0; - int dounicodeoutput=0; /* If non-zero, output will be drawn in Unicode. */ - int bgmode; - COLORREF textcolor = 0; - int usesingle = 0; - const char *encoding_name = 0; + static const char usage_message[] = "::tk::print::_gdi text hdc x y -anchor [center|n|e|s|w] " + "-fill color -font fontname " + "-justify [left|right|center] " + "-stipple bitmap -text string -width linelen " + "-single -backfill" + "-encoding [input encoding] -unicode"; + + HDC hDC; + int x, y; + const char *string = 0; + RECT sizerect; + UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas. */ + Tk_Anchor anchor = 0; + LOGFONT lf; + HFONT hfont, oldfont; + int made_font = 0; + int retval; + int dotextcolor=0; + int dobgmode=0; + int dounicodeoutput=0; /* If non-zero, output will be drawn in Unicode. */ + int bgmode; + COLORREF textcolor = 0; + int usesingle = 0; + const char *encoding_name = 0; #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - TCHAR *ostring; - Tcl_DString tds; - Tcl_Encoding encoding = NULL; - int tds_len; + TCHAR *ostring; + Tcl_DString tds; + Tcl_Encoding encoding = NULL; + int tds_len; #endif - if ( argc >= 4 ) - { - /* Parse the command. */ + if ( argc >= 4 ) + { + /* Parse the command. */ - // hDC = printDC; - hDC = CreateDC (driver, printerName, output, returnedDevmode); - - x = atol(argv[1]); - y = atol(argv[2]); - argc -= 3; - argv += 3; - - sizerect.left = sizerect.right = x; - sizerect.top = sizerect.bottom = y; - - while ( argc > 0 ) - { - if ( strcmp(argv[0], "-anchor") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - Tk_GetAnchor(interp, argv[0], &anchor); - } - else if ( strcmp(argv[0], "-justify") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - { - if ( strcmp(argv[0], "left") == 0 ) - format_flags |= DT_LEFT; - else if ( strcmp(argv[0], "center") == 0 ) - format_flags |= DT_CENTER; - else if ( strcmp(argv[0], "right") == 0 ) - format_flags |= DT_RIGHT; - } - } - else if ( strcmp(argv[0], "-text") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - string = argv[0]; - } - else if ( strcmp(argv[0], "-font") == 0 ) - { - argc--; - argv++; - if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) - if ( (hfont = CreateFontIndirect(&lf)) != NULL ) - { - made_font = 1; - oldfont = SelectObject(hDC, hfont); - } - /* Else leave the font alone! */ - } - else if ( strcmp(argv[0], "-stipple") == 0 ) - { - argc--; - argv++; - /* Not implemented yet. */ - } - else if ( strcmp(argv[0], "-fill") == 0 ) - { - argc--; - argv++; - /* Get text color. */ - if ( GdiGetColor(argv[0], &textcolor) ) - dotextcolor = 1; - } - else if ( strcmp(argv[0], "-width") == 0 ) - { - argc--; - argv++; - if ( argc > 0 ) - sizerect.right += atol(argv[0]); - /* If a width is specified, break at words.. */ - format_flags |= DT_WORDBREAK; - } - else if ( strcmp(argv[0], "-single") == 0 ) - { - usesingle = 1; - } - else if ( strcmp(argv[0], "-backfill") == 0 ) - dobgmode = 1; - else if ( strcmp(argv[0], "-unicode") == 0 ) - { - dounicodeoutput = 1; - /* Set the encoding name to utf-8, but can be overridden. */ - if ( encoding_name == 0 ) - encoding_name = "utf-8"; - } - else if ( strcmp(argv[0], "-encoding") == 0 ) { - argc--; - argv++; - if ( argc > 0 ) { - encoding_name = argv[0]; - } - } - - argc--; - argv++; - } + hDC = printDC; + + x = atol(argv[1]); + y = atol(argv[2]); + argc -= 3; + argv += 3; + + sizerect.left = sizerect.right = x; + sizerect.top = sizerect.bottom = y; + + while ( argc > 0 ) + { + if ( strcmp(argv[0], "-anchor") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + Tk_GetAnchor(interp, argv[0], &anchor); + } + else if ( strcmp(argv[0], "-justify") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + { + if ( strcmp(argv[0], "left") == 0 ) + format_flags |= DT_LEFT; + else if ( strcmp(argv[0], "center") == 0 ) + format_flags |= DT_CENTER; + else if ( strcmp(argv[0], "right") == 0 ) + format_flags |= DT_RIGHT; + } + } + else if ( strcmp(argv[0], "-text") == 0 ) + { + argc--; + argv++; + if (argc > 0 ) + string = argv[0]; + } + else if ( strcmp(argv[0], "-font") == 0 ) + { + argc--; + argv++; + if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) + if ( (hfont = CreateFontIndirect(&lf)) != NULL ) + { + made_font = 1; + oldfont = SelectObject(hDC, hfont); + } + /* Else leave the font alone! */ + } + else if ( strcmp(argv[0], "-stipple") == 0 ) + { + argc--; + argv++; + /* Not implemented yet. */ + } + else if ( strcmp(argv[0], "-fill") == 0 ) + { + argc--; + argv++; + /* Get text color. */ + if ( GdiGetColor(argv[0], &textcolor) ) + dotextcolor = 1; + } + else if ( strcmp(argv[0], "-width") == 0 ) + { + argc--; + argv++; + if ( argc > 0 ) + sizerect.right += atol(argv[0]); + /* If a width is specified, break at words.. */ + format_flags |= DT_WORDBREAK; + } + else if ( strcmp(argv[0], "-single") == 0 ) + { + usesingle = 1; + } + else if ( strcmp(argv[0], "-backfill") == 0 ) + dobgmode = 1; + else if ( strcmp(argv[0], "-unicode") == 0 ) + { + dounicodeoutput = 1; + /* Set the encoding name to utf-8, but can be overridden. */ + if ( encoding_name == 0 ) + encoding_name = "utf-8"; + } + else if ( strcmp(argv[0], "-encoding") == 0 ) { + argc--; + argv++; + if ( argc > 0 ) { + encoding_name = argv[0]; + } + } + + argc--; + argv++; + } #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - /* Handle the encoding, if present. */ - if ( encoding_name != 0 ) - { - Tcl_Encoding tmp_encoding; - tmp_encoding = Tcl_GetEncoding(interp,encoding_name); - if (tmp_encoding != NULL) - encoding = tmp_encoding; - } + /* Handle the encoding, if present. */ + if ( encoding_name != 0 ) + { + Tcl_Encoding tmp_encoding; + tmp_encoding = Tcl_GetEncoding(interp,encoding_name); + if (tmp_encoding != NULL) + encoding = tmp_encoding; + } #endif - if (string == 0 ) - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - - /* Set the format flags for -single: Overrides -width. */ - if ( usesingle == 1 ) - { - format_flags |= DT_SINGLELINE; - format_flags |= DT_NOCLIP; - format_flags &= ~DT_WORDBREAK; - } - - /* Calculate the rectangle. */ + if (string == 0 ) + { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } + + /* Set the format flags for -single: Overrides -width. */ + if ( usesingle == 1 ) + { + format_flags |= DT_SINGLELINE; + format_flags |= DT_NOCLIP; + format_flags &= ~DT_WORDBREAK; + } + + /* Calculate the rectangle. */ #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - Tcl_DStringInit(&tds); - Tcl_UtfToExternalDString(encoding, string, -1, &tds); - ostring = Tcl_DStringValue(&tds); - tds_len = Tcl_DStringLength(&tds); - /* Just for fun, let's try translating ostring to Unicode. */ - if (dounicodeoutput) /* Convert UTF-8 to unicode. */ - { - Tcl_UniChar *ustring; - Tcl_DString tds2; - Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); - Tcl_DStringFree(&tds2); - } else /* Use UTF-8/local code page output. */ - { - DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); - } + Tcl_DStringInit(&tds); + Tcl_UtfToExternalDString(encoding, string, -1, &tds); + ostring = Tcl_DStringValue(&tds); + tds_len = Tcl_DStringLength(&tds); + /* Just for fun, let's try translating ostring to Unicode. */ + if (dounicodeoutput) /* Convert UTF-8 to unicode. */ + { + Tcl_UniChar *ustring; + Tcl_DString tds2; + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); + DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); + Tcl_DStringFree(&tds2); + } else /* Use UTF-8/local code page output. */ + { + DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); + } #else - DrawText (hDC, string, -1, &sizerect, format_flags | DT_CALCRECT); + DrawText (hDC, string, -1, &sizerect, format_flags | DT_CALCRECT); #endif - /* Adjust the rectangle according to the anchor. */ - x = y = 0; - switch ( anchor ) - { - case TK_ANCHOR_N: - x = ( sizerect.right - sizerect.left ) / 2; - break; - case TK_ANCHOR_S: - x = ( sizerect.right - sizerect.left ) / 2; - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_E: - x = ( sizerect.right - sizerect.left ); - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - case TK_ANCHOR_W: - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - case TK_ANCHOR_NE: - x = ( sizerect.right - sizerect.left ); - break; - case TK_ANCHOR_NW: - break; - case TK_ANCHOR_SE: - x = ( sizerect.right - sizerect.left ); - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_SW: - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_CENTER: - x = ( sizerect.right - sizerect.left ) / 2; - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - } - sizerect.right -= x; - sizerect.left -= x; - sizerect.top -= y; - sizerect.bottom -= y; - - /* Get the color right. */ - if ( dotextcolor ) - textcolor = SetTextColor(hDC, textcolor); - - if ( dobgmode ) - bgmode = SetBkMode(hDC, OPAQUE); - else - bgmode = SetBkMode(hDC, TRANSPARENT); - - - /* Print the text. */ + /* Adjust the rectangle according to the anchor. */ + x = y = 0; + switch ( anchor ) + { + case TK_ANCHOR_N: + x = ( sizerect.right - sizerect.left ) / 2; + break; + case TK_ANCHOR_S: + x = ( sizerect.right - sizerect.left ) / 2; + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_E: + x = ( sizerect.right - sizerect.left ); + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + case TK_ANCHOR_W: + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + case TK_ANCHOR_NE: + x = ( sizerect.right - sizerect.left ); + break; + case TK_ANCHOR_NW: + break; + case TK_ANCHOR_SE: + x = ( sizerect.right - sizerect.left ); + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_SW: + y = ( sizerect.bottom - sizerect.top ); + break; + case TK_ANCHOR_CENTER: + x = ( sizerect.right - sizerect.left ) / 2; + y = ( sizerect.bottom - sizerect.top ) / 2; + break; + } + sizerect.right -= x; + sizerect.left -= x; + sizerect.top -= y; + sizerect.bottom -= y; + + /* Get the color right. */ + if ( dotextcolor ) + textcolor = SetTextColor(hDC, textcolor); + + if ( dobgmode ) + bgmode = SetBkMode(hDC, OPAQUE); + else + bgmode = SetBkMode(hDC, TRANSPARENT); + + + /* Print the text. */ #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - if (dounicodeoutput) /* Convert UTF-8 to unicode. */ - { - Tcl_UniChar *ustring; - Tcl_DString tds2; - Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); - Tcl_DStringFree(&tds2); - } - else - { - retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); - } - Tcl_DStringFree(&tds); + if (dounicodeoutput) /* Convert UTF-8 to unicode. */ + { + Tcl_UniChar *ustring; + Tcl_DString tds2; + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); + retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); + Tcl_DStringFree(&tds2); + } + else + { + retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); + } + Tcl_DStringFree(&tds); #else - retval = DrawText (hDC, string, -1, &sizerect, format_flags); + retval = DrawText (hDC, string, -1, &sizerect, format_flags); #endif - /* Get the color set back. */ - if ( dotextcolor ) - textcolor = SetTextColor(hDC, textcolor); + /* Get the color set back. */ + if ( dotextcolor ) + textcolor = SetTextColor(hDC, textcolor); - SetBkMode(hDC, bgmode); + SetBkMode(hDC, bgmode); - if (made_font) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } + if (made_font) + { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } - /* In this case, the return value is the height of the text. */ - sprintf(msgbuf, "%d", retval); - Tcl_AppendResult(interp, msgbuf, NULL); + /* In this case, the return value is the height of the text. */ + sprintf(msgbuf, "%d", retval); + Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_OK; - } + return TCL_OK; + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; } /* @@ -1894,44 +1885,44 @@ static int GdiGetHdcInfo( HDC hdc, LPPOINT worigin, LPSIZE wextent, LPPOINT vorigin, LPSIZE vextent) { - int mapmode; - int retval; - - memset (worigin, 0, sizeof(POINT)); - memset (vorigin, 0, sizeof(POINT)); - memset (wextent, 0, sizeof(SIZE)); - memset (vextent, 0, sizeof(SIZE)); - - if ( (mapmode = GetMapMode(hdc)) == 0 ) - { - /* Failed! */ - retval=0; - } - else - retval = mapmode; - - if ( GetWindowExtEx(hdc, wextent) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetViewportExtEx (hdc, vextent) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetWindowOrgEx(hdc, worigin) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetViewportOrgEx(hdc, vorigin) == FALSE ) - { - /* Failed! */ - retval = 0; - } - - return retval; + int mapmode; + int retval; + + memset (worigin, 0, sizeof(POINT)); + memset (vorigin, 0, sizeof(POINT)); + memset (wextent, 0, sizeof(SIZE)); + memset (vextent, 0, sizeof(SIZE)); + + if ( (mapmode = GetMapMode(hdc)) == 0 ) + { + /* Failed! */ + retval=0; + } + else + retval = mapmode; + + if ( GetWindowExtEx(hdc, wextent) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetViewportExtEx (hdc, vextent) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetWindowOrgEx(hdc, worigin) == FALSE ) + { + /* Failed! */ + retval = 0; + } + if ( GetViewportOrgEx(hdc, vorigin) == FALSE ) + { + /* Failed! */ + retval = 0; + } + + return retval; } @@ -1951,27 +1942,27 @@ static int GdiGetHdcInfo( HDC hdc, static int GdiNameToMode(const char *name) { - static struct gdimodes { - int mode; - const char *name; - } modes[] = { - { MM_ANISOTROPIC, "MM_ANISOTROPIC" }, - { MM_HIENGLISH, "MM_HIENGLISH" }, - { MM_HIMETRIC, "MM_HIMETRIC" }, - { MM_ISOTROPIC, "MM_ISOTROPIC" }, - { MM_LOENGLISH, "MM_LOENGLISH" }, - { MM_LOMETRIC, "MM_LOMETRIC" }, - { MM_TEXT, "MM_TEXT" }, - { MM_TWIPS, "MM_TWIPS" } - }; - - size_t i; - for (i=0; i < sizeof(modes) / sizeof(struct gdimodes); i++) - { - if ( strcmp(modes[i].name, name) == 0 ) - return modes[i].mode; - } - return atoi(name); + static struct gdimodes { + int mode; + const char *name; + } modes[] = { + { MM_ANISOTROPIC, "MM_ANISOTROPIC" }, + { MM_HIENGLISH, "MM_HIENGLISH" }, + { MM_HIMETRIC, "MM_HIMETRIC" }, + { MM_ISOTROPIC, "MM_ISOTROPIC" }, + { MM_LOENGLISH, "MM_LOENGLISH" }, + { MM_LOMETRIC, "MM_LOMETRIC" }, + { MM_TEXT, "MM_TEXT" }, + { MM_TWIPS, "MM_TWIPS" } + }; + + size_t i; + for (i=0; i < sizeof(modes) / sizeof(struct gdimodes); i++) + { + if ( strcmp(modes[i].name, name) == 0 ) + return modes[i].mode; + } + return atoi(name); } /* @@ -1990,27 +1981,27 @@ static int GdiNameToMode(const char *name) static const char *GdiModeToName(int mode) { - static struct gdi_modes { - int mode; - const char *name; - } modes[] = { - { MM_ANISOTROPIC, "Anisotropic" }, - { MM_HIENGLISH, "1/1000 inch" }, - { MM_HIMETRIC, "1/100 mm" }, - { MM_ISOTROPIC, "Isotropic" }, - { MM_LOENGLISH, "1/100 inch" }, - { MM_LOMETRIC, "1/10 mm" }, - { MM_TEXT, "1 to 1" }, - { MM_TWIPS, "1/1440 inch" } - }; - - size_t i; - for (i=0; i < sizeof(modes) / sizeof(struct gdi_modes); i++) - { - if ( modes[i].mode == mode ) - return modes[i].name; - } - return "Unknown"; + static struct gdi_modes { + int mode; + const char *name; + } modes[] = { + { MM_ANISOTROPIC, "Anisotropic" }, + { MM_HIENGLISH, "1/1000 inch" }, + { MM_HIMETRIC, "1/100 mm" }, + { MM_ISOTROPIC, "Isotropic" }, + { MM_LOENGLISH, "1/100 inch" }, + { MM_LOMETRIC, "1/10 mm" }, + { MM_TEXT, "1 to 1" }, + { MM_TWIPS, "1/1440 inch" } + }; + + size_t i; + for (i=0; i < sizeof(modes) / sizeof(struct gdi_modes); i++) + { + if ( modes[i].mode == mode ) + return modes[i].name; + } + return "Unknown"; } /* @@ -2028,192 +2019,191 @@ static const char *GdiModeToName(int mode) */ static int GdiMap( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi map hdc " - "[-logical x[y]] [-physical x[y]] " - "[-offset {x y} ] [-default] [-mode mode]" - ; - HDC hdc; - int mapmode; /* Mapping mode. */ - SIZE wextent; /* Device extent. */ - SIZE vextent; /* Viewport extent. */ - POINT worigin; /* Device origin. */ - POINT vorigin; /* Viewport origin. */ - int argno; - - /* Keep track of what parts of the function need to be executed. */ - int need_usage = 0; - int use_logical = 0; - int use_physical = 0; - int use_offset = 0; - int use_default = 0; - int use_mode = 0; - - /* Required parameter: HDC for printer. */ - if ( argc >= 1 ) - { + static const char usage_message[] = "::tk::print::_gdi map hdc " + "[-logical x[y]] [-physical x[y]] " + "[-offset {x y} ] [-default] [-mode mode]" + ; + HDC hdc; + int mapmode; /* Mapping mode. */ + SIZE wextent; /* Device extent. */ + SIZE vextent; /* Viewport extent. */ + POINT worigin; /* Device origin. */ + POINT vorigin; /* Viewport origin. */ + int argno; + + /* Keep track of what parts of the function need to be executed. */ + int need_usage = 0; + int use_logical = 0; + int use_physical = 0; + int use_offset = 0; + int use_default = 0; + int use_mode = 0; + + /* Required parameter: HDC for printer. */ + if ( argc >= 1 ) + { - // hdc = printDC; - hdc = CreateDC (driver, printerName, output, returnedDevmode); - - if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) - { - /* Failed!. */ - Tcl_AppendResult(interp, "Cannot get current HDC info", NULL); - return TCL_ERROR; - } - - /* Parse remaining arguments. */ - for (argno = 1; argno < argc; argno++) - { - if ( strcmp(argv[argno], "-default") == 0 ) - { - vextent.cx = vextent.cy = wextent.cx = wextent.cy = 1; - vorigin.x = vorigin.y = worigin.x = worigin.y = 0; - mapmode = MM_TEXT; - use_default = 1; - } - else if ( strcmp (argv[argno], "-mode" ) == 0 ) - { - if ( argno + 1 >= argc ) - need_usage = 1; - else - { - mapmode = GdiNameToMode(argv[argno+1]); - use_mode = 1; - argno++; - } - } - else if ( strcmp (argv[argno], "-offset") == 0 ) - { - if (argno + 1 >= argc) - need_usage = 1; - else - { - /* It would be nice if this parsed units as well.... */ - if ( sscanf(argv[argno+1], "%ld%ld", &vorigin.x, &vorigin.y) == 2 ) - use_offset = 1; - else - need_usage = 1; - argno ++; - } - } - else if ( strcmp (argv[argno], "-logical") == 0 ) - { - if ( argno+1 >= argc) - need_usage = 1; - else - { - int count; - argno++; - /* In "real-life", this should parse units as well.. */ - if ( (count = sscanf(argv[argno], "%ld%ld", &wextent.cx, &wextent.cy)) != 2 ) - { - if ( count == 1 ) - { - mapmode = MM_ISOTROPIC; - use_logical = 1; - wextent.cy = wextent.cx; /* Make them the same. */ - } - else - need_usage = 1; - } - else - { - mapmode = MM_ANISOTROPIC; - use_logical = 2; - } - } - } - else if ( strcmp (argv[argno], "-physical") == 0 ) - { - if ( argno+1 >= argc) - need_usage = 1; - else - { - int count; - - argno++; - /* In "real-life", this should parse units as well.. */ - if ( (count = sscanf(argv[argno], "%ld%ld", &vextent.cx, &vextent.cy)) != 2 ) - { - if ( count == 1 ) - { - mapmode = MM_ISOTROPIC; - use_physical = 1; - vextent.cy = vextent.cx; /* Make them the same. */ - } - else - need_usage = 1; - } - else - { - mapmode = MM_ANISOTROPIC; - use_physical = 2; - } - } - } - } - - /* Check for any impossible combinations. */ - if ( use_logical != use_physical ) - need_usage = 1; - if ( use_default && (use_logical || use_offset || use_mode ) ) - need_usage = 1; - if ( use_mode && use_logical && - (mapmode != MM_ISOTROPIC && mapmode != MM_ANISOTROPIC) - ) - need_usage = 1; - - if ( need_usage == 0 ) - { - /* Call Windows CTM functions. */ - if ( use_logical || use_default || use_mode ) /* Don't call for offset only. */ - { - SetMapMode(hdc, mapmode); - } - - if ( use_offset || use_default ) - { - POINT oldorg; - SetViewportOrgEx (hdc, vorigin.x, vorigin.y, &oldorg); - SetWindowOrgEx (hdc, worigin.x, worigin.y, &oldorg); - } - - if ( use_logical ) /* Same as use_physical. */ - { - SIZE oldsiz; - SetWindowExtEx (hdc, wextent.cx, wextent.cy, &oldsiz); - SetViewportExtEx (hdc, vextent.cx, vextent.cy, &oldsiz); - } - - /* - * Since we may not have set up every parameter, get them again for - * the report. - */ - mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent); - - /* - * Output current CTM info. - * Note: This should really be in terms that can be used in a ::tk::print::_gdi map command! - */ - sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " - "Origin: \"(%ld, %ld)\" " - "MappingMode: \"%s\"", - vextent.cx, vextent.cy, wextent.cx, wextent.cy, - vorigin.x, vorigin.y, - GdiModeToName(mapmode)); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_OK; - } - } + hdc = printDC; + + if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) + { + /* Failed!. */ + Tcl_AppendResult(interp, "Cannot get current HDC info", NULL); + return TCL_ERROR; + } + + /* Parse remaining arguments. */ + for (argno = 1; argno < argc; argno++) + { + if ( strcmp(argv[argno], "-default") == 0 ) + { + vextent.cx = vextent.cy = wextent.cx = wextent.cy = 1; + vorigin.x = vorigin.y = worigin.x = worigin.y = 0; + mapmode = MM_TEXT; + use_default = 1; + } + else if ( strcmp (argv[argno], "-mode" ) == 0 ) + { + if ( argno + 1 >= argc ) + need_usage = 1; + else + { + mapmode = GdiNameToMode(argv[argno+1]); + use_mode = 1; + argno++; + } + } + else if ( strcmp (argv[argno], "-offset") == 0 ) + { + if (argno + 1 >= argc) + need_usage = 1; + else + { + /* It would be nice if this parsed units as well.... */ + if ( sscanf(argv[argno+1], "%ld%ld", &vorigin.x, &vorigin.y) == 2 ) + use_offset = 1; + else + need_usage = 1; + argno ++; + } + } + else if ( strcmp (argv[argno], "-logical") == 0 ) + { + if ( argno+1 >= argc) + need_usage = 1; + else + { + int count; + argno++; + /* In "real-life", this should parse units as well.. */ + if ( (count = sscanf(argv[argno], "%ld%ld", &wextent.cx, &wextent.cy)) != 2 ) + { + if ( count == 1 ) + { + mapmode = MM_ISOTROPIC; + use_logical = 1; + wextent.cy = wextent.cx; /* Make them the same. */ + } + else + need_usage = 1; + } + else + { + mapmode = MM_ANISOTROPIC; + use_logical = 2; + } + } + } + else if ( strcmp (argv[argno], "-physical") == 0 ) + { + if ( argno+1 >= argc) + need_usage = 1; + else + { + int count; + + argno++; + /* In "real-life", this should parse units as well.. */ + if ( (count = sscanf(argv[argno], "%ld%ld", &vextent.cx, &vextent.cy)) != 2 ) + { + if ( count == 1 ) + { + mapmode = MM_ISOTROPIC; + use_physical = 1; + vextent.cy = vextent.cx; /* Make them the same. */ + } + else + need_usage = 1; + } + else + { + mapmode = MM_ANISOTROPIC; + use_physical = 2; + } + } + } + } + + /* Check for any impossible combinations. */ + if ( use_logical != use_physical ) + need_usage = 1; + if ( use_default && (use_logical || use_offset || use_mode ) ) + need_usage = 1; + if ( use_mode && use_logical && + (mapmode != MM_ISOTROPIC && mapmode != MM_ANISOTROPIC) + ) + need_usage = 1; + + if ( need_usage == 0 ) + { + /* Call Windows CTM functions. */ + if ( use_logical || use_default || use_mode ) /* Don't call for offset only. */ + { + SetMapMode(hdc, mapmode); + } + + if ( use_offset || use_default ) + { + POINT oldorg; + SetViewportOrgEx (hdc, vorigin.x, vorigin.y, &oldorg); + SetWindowOrgEx (hdc, worigin.x, worigin.y, &oldorg); + } + + if ( use_logical ) /* Same as use_physical. */ + { + SIZE oldsiz; + SetWindowExtEx (hdc, wextent.cx, wextent.cy, &oldsiz); + SetViewportExtEx (hdc, vextent.cx, vextent.cy, &oldsiz); + } + + /* + * Since we may not have set up every parameter, get them again for + * the report. + */ + mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent); + + /* + * Output current CTM info. + * Note: This should really be in terms that can be used in a ::tk::print::_gdi map command! + */ + sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " + "Origin: \"(%ld, %ld)\" " + "MappingMode: \"%s\"", + vextent.cx, vextent.cy, wextent.cx, wextent.cy, + vorigin.x, vorigin.y, + GdiModeToName(mapmode)); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_OK; + } + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; } /* @@ -2231,384 +2221,384 @@ static int GdiMap( */ static int GdiCopyBits ( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - /* Goal: get the Tk_Window from the top-level - * convert it to an HWND - * get the HDC - * Do a bitblt to the given hdc - * Use an optional parameter to point to an arbitrary window instead of the main - * Use optional parameters to map to the width and height required for the dest. - */ - static const char usage_message[] = "::tk::print::_gdi copybits hdc [-window w|-screen] [-client] " - "[-source \"a b c d\"] " - "[-destination \"a b c d\"] [-scale number] [-calc]"; - - Tk_Window mainWin; - Tk_Window workwin; - Window w; - HDC src; - HDC dst; - HWND wnd = 0; - - HANDLE hDib; /* Handle for device-independent bitmap. */ - LPBITMAPINFOHEADER lpDIBHdr; - LPSTR lpBits; - enum PrintType wintype = PTWindow; - - int hgt, wid; - char *strend; - long errcode; - - /* Variables to remember what we saw in the arguments. */ - int do_window=0; - int do_screen=0; - int do_scale=0; - int do_print=1; - - /* Variables to remember the values in the arguments. */ - const char *window_spec; - double scale=1.0; - int src_x=0, src_y=0, src_w=0, src_h=0; - int dst_x=0, dst_y=0, dst_w=0, dst_h=0; - int is_toplevel = 0; - - /* - * The following steps are peculiar to the top level window. - * There is likely a clever way to do the mapping of a - * widget pathname to the proper window, to support the idea of - * using a parameter for this purpose. - */ - if ( (workwin = mainWin = Tk_MainWindow(interp)) == 0 ) - { - Tcl_AppendResult(interp, "Can't find main Tk window", NULL); - return TCL_ERROR; - } - - /* - * Parse the arguments. - */ - /* HDC is required. */ - if ( argc < 1 ) - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - - //dst = printDC; -dst = CreateDC (driver, printerName, output, returnedDevmode); - /* - * Next, check to see if 'dst' can support BitBlt. - * If not, raise an error. - */ - if ( ( GetDeviceCaps (dst, RASTERCAPS) & RC_BITBLT ) == 0 ) - { - printf(msgbuf, "Can't do bitmap operations on device context\n"); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_ERROR; - } + /* Goal: get the Tk_Window from the top-level + * convert it to an HWND + * get the HDC + * Do a bitblt to the given hdc + * Use an optional parameter to point to an arbitrary window instead of the main + * Use optional parameters to map to the width and height required for the dest. + */ + static const char usage_message[] = "::tk::print::_gdi copybits hdc [-window w|-screen] [-client] " + "[-source \"a b c d\"] " + "[-destination \"a b c d\"] [-scale number] [-calc]"; + + Tk_Window mainWin; + Tk_Window workwin; + Window w; + HDC src; + HDC dst; + HWND wnd = 0; + + HANDLE hDib; /* Handle for device-independent bitmap. */ + LPBITMAPINFOHEADER lpDIBHdr; + LPSTR lpBits; + enum PrintType wintype = PTWindow; + + int hgt, wid; + char *strend; + long errcode; - /* Loop through the remaining arguments. */ - { - int k; - for (k=1; k= 100.0 ) - { - sprintf(msgbuf, "Unreasonable scale specification %s", argv[k]); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_ERROR; - } - do_scale = 1; - } - } - else if ( strcmp(argv[k], "-noprint") == 0 || strncmp(argv[k], "-calc", 5) == 0 ) - { - /* This option suggested by Pascal Bouvier to get sizes without printing. */ - do_print = 0; - } - } - } + /* Variables to remember what we saw in the arguments. */ + int do_window=0; + int do_screen=0; + int do_scale=0; + int do_print=1; - /* - * Check to ensure no incompatible arguments were used. - */ - if ( do_window && do_screen ) - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - - /* - * Get the MS Window we want to copy. - * Given the HDC, we can get the "Window". - */ - if (wnd == 0 ) - { - if ( Tk_IsTopLevel(workwin) ) - is_toplevel = 1; - - if ( (w = Tk_WindowId(workwin)) == 0 ) - { - Tcl_AppendResult(interp, "Can't get id for Tk window", NULL); - return TCL_ERROR; - } + /* Variables to remember the values in the arguments. */ + const char *window_spec; + double scale=1.0; + int src_x=0, src_y=0, src_w=0, src_h=0; + int dst_x=0, dst_y=0, dst_w=0, dst_h=0; + int is_toplevel = 0; - /* Given the "Window" we can get a Microsoft Windows HWND. */ + /* + * The following steps are peculiar to the top level window. + * There is likely a clever way to do the mapping of a + * widget pathname to the proper window, to support the idea of + * using a parameter for this purpose. + */ + if ( (workwin = mainWin = Tk_MainWindow(interp)) == 0 ) + { + Tcl_AppendResult(interp, "Can't find main Tk window", NULL); + return TCL_ERROR; + } - if ( (wnd = Tk_GetHWND(w)) == 0 ) - { - Tcl_AppendResult(interp, "Can't get Windows handle for Tk window", NULL); - return TCL_ERROR; - } + /* + * Parse the arguments. + */ + /* HDC is required. */ + if ( argc < 1 ) + { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - /* - * If it's a toplevel, give it special treatment: Get the top-level window instead. - * If the user only wanted the client, the -client flag will take care of it. - * This uses "windows" tricks rather than Tk since the obvious method of - * getting the wrapper window didn't seem to work. - */ - if ( is_toplevel ) - { - HWND tmpWnd = wnd; - while ( (tmpWnd = GetParent( tmpWnd ) ) != 0 ) - wnd = tmpWnd; - } - } + dst = printDC; - /* Given the HWND, we can get the window's device context. */ - if ( (src = GetWindowDC(wnd)) == 0 ) - { - Tcl_AppendResult(interp, "Can't get device context for Tk window", NULL); - return TCL_ERROR; - } - - if ( do_screen ) - { - LONG w, h; - GetDisplaySize(&w, &h); - wid = w; - hgt = h; - } - else if ( is_toplevel ) - { - RECT tl; - GetWindowRect(wnd, &tl); - wid = tl.right - tl.left; - hgt = tl.bottom - tl.top; - } - else - { - if ( (hgt = Tk_Height(workwin)) <= 0 ) - { - Tcl_AppendResult(interp, "Can't get height of Tk window", NULL); - ReleaseDC(wnd,src); - return TCL_ERROR; - } + /* + * Next, check to see if 'dst' can support BitBlt. + * If not, raise an error. + */ + if ( ( GetDeviceCaps (dst, RASTERCAPS) & RC_BITBLT ) == 0 ) + { + printf(msgbuf, "Can't do bitmap operations on device context\n"); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_ERROR; + } - if ( (wid = Tk_Width(workwin)) <= 0 ) + /* Loop through the remaining arguments. */ { - Tcl_AppendResult(interp, "Can't get width of Tk window", NULL); - ReleaseDC(wnd,src); - return TCL_ERROR; - } - } - - /* - * Ensure all the widths and heights are set up right - * A: No dimensions are negative - * B: No dimensions exceed the maximums - * C: The dimensions don't lead to a 0 width or height image. - */ - if ( src_x < 0 ) - src_x = 0; - if ( src_y < 0 ) - src_y = 0; - if ( dst_x < 0 ) - dst_x = 0; - if ( dst_y < 0 ) - dst_y = 0; - - if ( src_w > wid || src_w <= 0 ) - src_w = wid; - - if ( src_h > hgt || src_h <= 0 ) - src_h = hgt; - - if ( do_scale && dst_w == 0 ) - { - /* Calculate destination width and height based on scale. */ - dst_w = (int)(scale * src_w); - dst_h = (int)(scale * src_h); - } - - if ( dst_h == -1 ) - dst_h = (int) (((long)src_h * dst_w) / (src_w + 1)) + 1; - - if ( dst_h == 0 || dst_w == 0 ) - { - dst_h = src_h; - dst_w = src_w; - } - - if ( do_print ) - { - /* - * Based on notes from Heiko Schock and Arndt Roger Schneider, - * create this as a DIBitmap, to allow output to a greater range of - * devices. This approach will also allow selection of - * a) Whole screen - * b) Whole window - * c) Client window only - * for the "grab" - */ - hDib = CopyToDIB( wnd, wintype ); - - /* GdiFlush();. */ - - if (!hDib) { - Tcl_AppendResult(interp, "Can't create DIB", NULL); - ReleaseDC(wnd,src); - return TCL_ERROR; + int k; + for (k=1; k= 100.0 ) + { + sprintf(msgbuf, "Unreasonable scale specification %s", argv[k]); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_ERROR; + } + do_scale = 1; + } + } + else if ( strcmp(argv[k], "-noprint") == 0 || strncmp(argv[k], "-calc", 5) == 0 ) + { + /* This option suggested by Pascal Bouvier to get sizes without printing. */ + do_print = 0; + } + } } - lpDIBHdr = (LPBITMAPINFOHEADER)GlobalLock(hDib); - if (!lpDIBHdr) { - Tcl_AppendResult(interp, "Can't get DIB header", NULL); - ReleaseDC(wnd,src); - return TCL_ERROR; - } + /* + * Check to ensure no incompatible arguments were used. + */ + if ( do_window && do_screen ) + { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - lpBits = (LPSTR)lpDIBHdr + lpDIBHdr->biSize + DIBNumColors(lpDIBHdr) * sizeof(RGBQUAD); + /* + * Get the MS Window we want to copy. + * Given the HDC, we can get the "Window". + */ + if (wnd == 0 ) + { + if ( Tk_IsTopLevel(workwin) ) + is_toplevel = 1; + + if ( (w = Tk_WindowId(workwin)) == 0 ) + { + Tcl_AppendResult(interp, "Can't get id for Tk window", NULL); + return TCL_ERROR; + } + + /* Given the "Window" we can get a Microsoft Windows HWND. */ + + if ( (wnd = Tk_GetHWND(w)) == 0 ) + { + Tcl_AppendResult(interp, "Can't get Windows handle for Tk window", NULL); + return TCL_ERROR; + } + + /* + * If it's a toplevel, give it special treatment: Get the top-level window instead. + * If the user only wanted the client, the -client flag will take care of it. + * This uses "windows" tricks rather than Tk since the obvious method of + * getting the wrapper window didn't seem to work. + */ + if ( is_toplevel ) + { + HWND tmpWnd = wnd; + while ( (tmpWnd = GetParent( tmpWnd ) ) != 0 ) + wnd = tmpWnd; + } + } - /* stretch the DIBbitmap directly in the target device. */ + /* Given the HWND, we can get the window's device context. */ + if ( (src = GetWindowDC(wnd)) == 0 ) + { + Tcl_AppendResult(interp, "Can't get device context for Tk window", NULL); + return TCL_ERROR; + } - if (StretchDIBits(dst, - dst_x, dst_y, dst_w, dst_h, - src_x, src_y, src_w, src_h, - lpBits, (LPBITMAPINFO)lpDIBHdr, DIB_RGB_COLORS, - SRCCOPY) == (int)GDI_ERROR) - { - errcode = GetLastError(); - GlobalUnlock(hDib); - GlobalFree(hDib); - ReleaseDC(wnd,src); - sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_ERROR; - } + if ( do_screen ) + { + LONG w, h; + GetDisplaySize(&w, &h); + wid = w; + hgt = h; + } + else if ( is_toplevel ) + { + RECT tl; + GetWindowRect(wnd, &tl); + wid = tl.right - tl.left; + hgt = tl.bottom - tl.top; + } + else + { + if ( (hgt = Tk_Height(workwin)) <= 0 ) + { + Tcl_AppendResult(interp, "Can't get height of Tk window", NULL); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + if ( (wid = Tk_Width(workwin)) <= 0 ) + { + Tcl_AppendResult(interp, "Can't get width of Tk window", NULL); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + } - /* free allocated memory. */ - GlobalUnlock(hDib); - GlobalFree(hDib); - } + /* + * Ensure all the widths and heights are set up right + * A: No dimensions are negative + * B: No dimensions exceed the maximums + * C: The dimensions don't lead to a 0 width or height image. + */ + if ( src_x < 0 ) + src_x = 0; + if ( src_y < 0 ) + src_y = 0; + if ( dst_x < 0 ) + dst_x = 0; + if ( dst_y < 0 ) + dst_y = 0; + + if ( src_w > wid || src_w <= 0 ) + src_w = wid; + + if ( src_h > hgt || src_h <= 0 ) + src_h = hgt; + + if ( do_scale && dst_w == 0 ) + { + /* Calculate destination width and height based on scale. */ + dst_w = (int)(scale * src_w); + dst_h = (int)(scale * src_h); + } - ReleaseDC(wnd,src); + if ( dst_h == -1 ) + dst_h = (int) (((long)src_h * dst_w) / (src_w + 1)) + 1; - /* - * The return value should relate to the size in the destination space. - * At least the height should be returned (for page layout purposes). - */ - sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); - Tcl_AppendResult(interp, msgbuf, NULL); + if ( dst_h == 0 || dst_w == 0 ) + { + dst_h = src_h; + dst_w = src_w; + } - return TCL_OK; + if ( do_print ) + { + /* + * Based on notes from Heiko Schock and Arndt Roger Schneider, + * create this as a DIBitmap, to allow output to a greater range of + * devices. This approach will also allow selection of + * a) Whole screen + * b) Whole window + * c) Client window only + * for the "grab" + */ + hDib = CopyToDIB( wnd, wintype ); + + /* GdiFlush();. */ + + if (!hDib) { + Tcl_AppendResult(interp, "Can't create DIB", NULL); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + lpDIBHdr = (LPBITMAPINFOHEADER)GlobalLock(hDib); + if (!lpDIBHdr) { + Tcl_AppendResult(interp, "Can't get DIB header", NULL); + ReleaseDC(wnd,src); + return TCL_ERROR; + } + + lpBits = (LPSTR)lpDIBHdr + lpDIBHdr->biSize + DIBNumColors(lpDIBHdr) * sizeof(RGBQUAD); + + /* stretch the DIBbitmap directly in the target device. */ + + if (StretchDIBits(dst, + dst_x, dst_y, dst_w, dst_h, + src_x, src_y, src_w, src_h, + lpBits, (LPBITMAPINFO)lpDIBHdr, DIB_RGB_COLORS, + SRCCOPY) == (int)GDI_ERROR) + { + errcode = GetLastError(); + GlobalUnlock(hDib); + GlobalFree(hDib); + ReleaseDC(wnd,src); + sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_ERROR; + } + + /* free allocated memory. */ + GlobalUnlock(hDib); + GlobalFree(hDib); + } + + ReleaseDC(wnd,src); + + /* + * The return value should relate to the size in the destination space. + * At least the height should be returned (for page layout purposes). + */ + sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); + Tcl_AppendResult(interp, msgbuf, NULL); + + return TCL_OK; } /* @@ -2640,7 +2630,7 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) dwClrUsed = (lpDIB)->biClrUsed; if (dwClrUsed) - return (WORD)dwClrUsed; + return (WORD)dwClrUsed; /* * Calculate the number of colors in the color table based on. @@ -2652,7 +2642,7 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) /* Return number of colors based on bits per pixel. */ switch (wBitCount) - { + { case 1: return 2; @@ -2664,19 +2654,19 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) default: return 0; - } + } } /* -* Helper functions -*/ + * Helper functions + */ /* -* ParseFontWords converts various keywords to modifyers of a -* font specification. -* For all words, later occurrences override earlier occurrences. -* Overstrike and underline cannot be "undone" by other words -*/ + * ParseFontWords converts various keywords to modifyers of a + * font specification. + * For all words, later occurrences override earlier occurrences. + * Overstrike and underline cannot be "undone" by other words + */ /* *---------------------------------------------------------------------- @@ -2694,33 +2684,33 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) */ static int GdiParseFontWords( - TCL_UNUSED(Tcl_Interp *), - LOGFONT *lf, - const char *str[], - int numargs) + TCL_UNUSED(Tcl_Interp *), + LOGFONT *lf, + const char *str[], + int numargs) { - int i; - int retval = 0; /* Number of words that could not be parsed. */ - for (i=0; ilfWeight = wt; - else if ( strcmp(str[i], "roman") == 0 ) - lf->lfItalic = FALSE; - else if ( strcmp(str[i], "italic") == 0 ) - lf->lfItalic = TRUE; - else if ( strcmp(str[i], "underline") == 0 ) - lf->lfUnderline = TRUE; - else if ( strcmp(str[i], "overstrike") == 0 ) - lf->lfStrikeOut = TRUE; - else - retval++; - } - } - return retval; + int i; + int retval = 0; /* Number of words that could not be parsed. */ + for (i=0; ilfWeight = wt; + else if ( strcmp(str[i], "roman") == 0 ) + lf->lfItalic = FALSE; + else if ( strcmp(str[i], "italic") == 0 ) + lf->lfItalic = TRUE; + else if ( strcmp(str[i], "underline") == 0 ) + lf->lfUnderline = TRUE; + else if ( strcmp(str[i], "overstrike") == 0 ) + lf->lfStrikeOut = TRUE; + else + retval++; + } + } + return retval; } @@ -2739,43 +2729,43 @@ static int GdiParseFontWords( static int GdiWordToWeight(const char *str) { - int retval = -1; - size_t i; - static struct font_weight - { - const char *name; - int weight; - } font_weights[] = - { - { "thin", FW_THIN }, - { "extralight", FW_EXTRALIGHT }, - { "ultralight", FW_EXTRALIGHT }, - { "light", FW_LIGHT }, - { "normal", FW_NORMAL }, - { "regular", FW_NORMAL }, - { "medium", FW_MEDIUM }, - { "semibold", FW_SEMIBOLD }, - { "demibold", FW_SEMIBOLD }, - { "bold", FW_BOLD }, - { "extrabold", FW_EXTRABOLD }, - { "ultrabold", FW_EXTRABOLD }, - { "heavy", FW_HEAVY }, - { "black", FW_HEAVY }, - }; - - if ( str == 0 ) - return -1; - - for (i=0; ilfWeight = FW_NORMAL; - lf->lfCharSet = DEFAULT_CHARSET; - lf->lfOutPrecision = OUT_DEFAULT_PRECIS; - lf->lfClipPrecision = CLIP_DEFAULT_PRECIS; - lf->lfQuality = DEFAULT_QUALITY; - lf->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; - - /* The cast to (char *) is silly, based on prototype of Tcl_SplitList. */ - if ( Tcl_SplitList(interp, str, &count, &list) != TCL_OK ) - return 0; - - /* Now we have the font structure broken into name, size, weight. */ - if ( count >= 1 ) - strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); - else - return 0; - - if ( count >= 2 ) - { - int siz; - char *strend; - siz = strtol(list[1], &strend, 0); - - /* - * Assumptions: - * 1) Like canvas, if a positive number is specified, it's in points. - * 2) Like canvas, if a negative number is specified, it's in pixels. - */ - if ( strend > list[1] ) /* If it looks like a number, it is a number.... */ - { - if ( siz > 0 ) /* Size is in points. */ - { - SIZE wextent, vextent; - POINT worigin, vorigin; - double factor; - - switch ( GdiGetHdcInfo(hDC, &worigin, &wextent, &vorigin, &vextent) ) - { - case MM_ISOTROPIC: - if ( vextent.cy < -1 || vextent.cy > 1 ) - { - factor = (double)wextent.cy / vextent.cy; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else if ( vextent.cx < -1 || vextent.cx > 1 ) - { - factor = (double)wextent.cx / vextent.cx; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else - lf->lfHeight = -siz; /* This is bad news.... */ - break; - case MM_ANISOTROPIC: - if ( vextent.cy != 0 ) - { - factor = (double)wextent.cy / vextent.cy; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else - lf->lfHeight = -siz; /* This is bad news.... */ - break; - case MM_TEXT: - default: - /* If mapping mode is MM_TEXT, use the documented formula. */ - lf->lfHeight = -MulDiv(siz, GetDeviceCaps(hDC, LOGPIXELSY), 72); - break; - case MM_HIENGLISH: - lf->lfHeight = -MulDiv(siz, 1000, 72); - break; - case MM_LOENGLISH: - lf->lfHeight = -MulDiv(siz, 100, 72); - break; - case MM_HIMETRIC: - lf->lfHeight = -MulDiv(siz, (int)(1000*2.54), 72); - break; - case MM_LOMETRIC: - lf->lfHeight = -MulDiv(siz, (int)(100*2.54), 72); - break; - case MM_TWIPS: - lf->lfHeight = -MulDiv(siz, 1440, 72); - break; - } - } - else if ( siz == 0 ) /* Use default size of 12 points. */ - lf->lfHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72); - else /* Use pixel size. */ - { - lf->lfHeight = siz; /* Leave this negative. */ - } - } + const char **list; + int count; + + /* Set up defaults for logical font. */ + memset (lf,0, sizeof(*lf)); + lf->lfWeight = FW_NORMAL; + lf->lfCharSet = DEFAULT_CHARSET; + lf->lfOutPrecision = OUT_DEFAULT_PRECIS; + lf->lfClipPrecision = CLIP_DEFAULT_PRECIS; + lf->lfQuality = DEFAULT_QUALITY; + lf->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; + + /* The cast to (char *) is silly, based on prototype of Tcl_SplitList. */ + if ( Tcl_SplitList(interp, str, &count, &list) != TCL_OK ) + return 0; + + /* Now we have the font structure broken into name, size, weight. */ + if ( count >= 1 ) + strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); else - GdiParseFontWords(interp, lf, list+1, count-1); - } + return 0; - if ( count >= 3 ) - GdiParseFontWords(interp, lf, list+2, count-2); + if ( count >= 2 ) + { + int siz; + char *strend; + siz = strtol(list[1], &strend, 0); + + /* + * Assumptions: + * 1) Like canvas, if a positive number is specified, it's in points. + * 2) Like canvas, if a negative number is specified, it's in pixels. + */ + if ( strend > list[1] ) /* If it looks like a number, it is a number.... */ + { + if ( siz > 0 ) /* Size is in points. */ + { + SIZE wextent, vextent; + POINT worigin, vorigin; + double factor; + + switch ( GdiGetHdcInfo(hDC, &worigin, &wextent, &vorigin, &vextent) ) + { + case MM_ISOTROPIC: + if ( vextent.cy < -1 || vextent.cy > 1 ) + { + factor = (double)wextent.cy / vextent.cy; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else if ( vextent.cx < -1 || vextent.cx > 1 ) + { + factor = (double)wextent.cx / vextent.cx; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else + lf->lfHeight = -siz; /* This is bad news.... */ + break; + case MM_ANISOTROPIC: + if ( vextent.cy != 0 ) + { + factor = (double)wextent.cy / vextent.cy; + if ( factor < 0.0 ) + factor = - factor; + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } + else + lf->lfHeight = -siz; /* This is bad news.... */ + break; + case MM_TEXT: + default: + /* If mapping mode is MM_TEXT, use the documented formula. */ + lf->lfHeight = -MulDiv(siz, GetDeviceCaps(hDC, LOGPIXELSY), 72); + break; + case MM_HIENGLISH: + lf->lfHeight = -MulDiv(siz, 1000, 72); + break; + case MM_LOENGLISH: + lf->lfHeight = -MulDiv(siz, 100, 72); + break; + case MM_HIMETRIC: + lf->lfHeight = -MulDiv(siz, (int)(1000*2.54), 72); + break; + case MM_LOMETRIC: + lf->lfHeight = -MulDiv(siz, (int)(100*2.54), 72); + break; + case MM_TWIPS: + lf->lfHeight = -MulDiv(siz, 1440, 72); + break; + } + } + else if ( siz == 0 ) /* Use default size of 12 points. */ + lf->lfHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72); + else /* Use pixel size. */ + { + lf->lfHeight = siz; /* Leave this negative. */ + } + } + else + GdiParseFontWords(interp, lf, list+1, count-1); + } - Tcl_Free((char *)list); - return 1; + if ( count >= 3 ) + GdiParseFontWords(interp, lf, list+2, count-2); + + Tcl_Free((char *)list); + return 1; } /* @@ -2919,125 +2909,125 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC */ static int GdiMakePen( - Tcl_Interp *interp, - int width, - int dashstyle, - const char *dashstyledata, - TCL_UNUSED(int), /* Ignored for now. */ - TCL_UNUSED(int), /* Ignored for now. */ - TCL_UNUSED(int), - TCL_UNUSED(const char *), /* Ignored for now. */ - unsigned long color, - HDC hDC, - HGDIOBJ *oldPen) + Tcl_Interp *interp, + int width, + int dashstyle, + const char *dashstyledata, + TCL_UNUSED(int), /* Ignored for now. */ + TCL_UNUSED(int), /* Ignored for now. */ + TCL_UNUSED(int), + TCL_UNUSED(const char *), /* Ignored for now. */ + unsigned long color, + HDC hDC, + HGDIOBJ *oldPen) { -/* - * The LOGPEN structure takes the following dash options: - * PS_SOLID: a solid pen - * PS_DASH: a dashed pen - * PS_DOT: a dotted pen - * PS_DASHDOT: a pen with a dash followed by a dot - * PS_DASHDOTDOT: a pen with a dash followed by 2 dots - * - * It seems that converting to ExtCreatePen may be more advantageous, as it matches - * the Tk canvas pens much better--but not for Win95, which does not support PS_USERSTYLE - * An explicit test (or storage in a static after first failure) may suffice for working - * around this. The ExtCreatePen is not supported at all under Win32. -*/ - - HPEN hPen; - LOGBRUSH lBrush; - DWORD pStyle = PS_SOLID; /* -dash should override*/ - DWORD endStyle = PS_ENDCAP_ROUND; /* -capstyle should override. */ - DWORD joinStyle = PS_JOIN_ROUND; /* -joinstyle should override. */ - DWORD styleCount = 0; - DWORD *styleArray = 0; - - /* - * To limit the propagation of allocated memory, the dashes will have a maximum here. - * If one wishes to remove the static allocation, please be sure to update GdiFreePen - * and ensure that the array is NOT freed if the LOGPEN option is used. - */ - static DWORD pStyleData[24]; - if ( dashstyle != 0 && dashstyledata != 0 ) - { - const char *cp; - size_t i; - char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); - if (dup) - strcpy(dup, dashstyledata); - /* DEBUG. */ - Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", dashstyledata, "|\n", NULL); - - /* Parse the dash spec. */ - if ( isdigit(dashstyledata[0]) ) { - cp = strtok(dup, " \t,;"); - for ( i = 0; cp && i < sizeof(pStyleData) / sizeof (DWORD); i++ ) { - pStyleData[styleCount++] = atoi(cp); - cp = strtok(NULL, " \t,;"); - } - } else { - for (i=0; dashstyledata[i] != '\0' && i< sizeof(pStyleData) / sizeof(DWORD); i++ ) { - switch ( dashstyledata[i] ) { - case ' ': - pStyleData[styleCount++] = 8; - break; - case ',': - pStyleData[styleCount++] = 4; - break; - case '_': - pStyleData[styleCount++] = 6; - break; - case '-': - pStyleData[styleCount++] = 4; - break; - case '.': - pStyleData[styleCount++] = 2; - break; - default: - break; - } - } - } - if ( styleCount > 0 ) - styleArray = pStyleData; - else - dashstyle = 0; - if (dup) - Tcl_Free(dup); - } - - if ( dashstyle != 0 ) - pStyle = PS_USERSTYLE; - - /* -stipple could affect this.... */ - lBrush.lbStyle = BS_SOLID; - lBrush.lbColor = color; - lBrush.lbHatch = 0; - - /* We only use geometric pens, even for 1-pixel drawing. */ - hPen = ExtCreatePen ( PS_GEOMETRIC|pStyle|endStyle|joinStyle, - width, - &lBrush, - styleCount, - styleArray); - - if ( hPen == 0 ) { /* Failed for some reason...Fall back on CreatePenIndirect. */ - LOGPEN lf; - lf.lopnWidth.x = width; - lf.lopnWidth.y = 0; /* Unused in LOGPEN. */ - if ( dashstyle == 0 ) - lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future. */ - else - lf.lopnStyle = PS_DASH; /* REALLLLY simple for now. */ - lf.lopnColor = color; /* Assume we're getting a COLORREF. */ - /* Now we have a logical pen. Create the "real" pen and put it in the hDC. */ - hPen = CreatePenIndirect(&lf); - } - - *oldPen = SelectObject(hDC, hPen); - return 1; + /* + * The LOGPEN structure takes the following dash options: + * PS_SOLID: a solid pen + * PS_DASH: a dashed pen + * PS_DOT: a dotted pen + * PS_DASHDOT: a pen with a dash followed by a dot + * PS_DASHDOTDOT: a pen with a dash followed by 2 dots + * + * It seems that converting to ExtCreatePen may be more advantageous, as it matches + * the Tk canvas pens much better--but not for Win95, which does not support PS_USERSTYLE + * An explicit test (or storage in a static after first failure) may suffice for working + * around this. The ExtCreatePen is not supported at all under Win32. + */ + + HPEN hPen; + LOGBRUSH lBrush; + DWORD pStyle = PS_SOLID; /* -dash should override*/ + DWORD endStyle = PS_ENDCAP_ROUND; /* -capstyle should override. */ + DWORD joinStyle = PS_JOIN_ROUND; /* -joinstyle should override. */ + DWORD styleCount = 0; + DWORD *styleArray = 0; + + /* + * To limit the propagation of allocated memory, the dashes will have a maximum here. + * If one wishes to remove the static allocation, please be sure to update GdiFreePen + * and ensure that the array is NOT freed if the LOGPEN option is used. + */ + static DWORD pStyleData[24]; + if ( dashstyle != 0 && dashstyledata != 0 ) + { + const char *cp; + size_t i; + char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); + if (dup) + strcpy(dup, dashstyledata); + /* DEBUG. */ + Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", dashstyledata, "|\n", NULL); + + /* Parse the dash spec. */ + if ( isdigit(dashstyledata[0]) ) { + cp = strtok(dup, " \t,;"); + for ( i = 0; cp && i < sizeof(pStyleData) / sizeof (DWORD); i++ ) { + pStyleData[styleCount++] = atoi(cp); + cp = strtok(NULL, " \t,;"); + } + } else { + for (i=0; dashstyledata[i] != '\0' && i< sizeof(pStyleData) / sizeof(DWORD); i++ ) { + switch ( dashstyledata[i] ) { + case ' ': + pStyleData[styleCount++] = 8; + break; + case ',': + pStyleData[styleCount++] = 4; + break; + case '_': + pStyleData[styleCount++] = 6; + break; + case '-': + pStyleData[styleCount++] = 4; + break; + case '.': + pStyleData[styleCount++] = 2; + break; + default: + break; + } + } + } + if ( styleCount > 0 ) + styleArray = pStyleData; + else + dashstyle = 0; + if (dup) + Tcl_Free(dup); + } + + if ( dashstyle != 0 ) + pStyle = PS_USERSTYLE; + + /* -stipple could affect this.... */ + lBrush.lbStyle = BS_SOLID; + lBrush.lbColor = color; + lBrush.lbHatch = 0; + + /* We only use geometric pens, even for 1-pixel drawing. */ + hPen = ExtCreatePen ( PS_GEOMETRIC|pStyle|endStyle|joinStyle, + width, + &lBrush, + styleCount, + styleArray); + + if ( hPen == 0 ) { /* Failed for some reason...Fall back on CreatePenIndirect. */ + LOGPEN lf; + lf.lopnWidth.x = width; + lf.lopnWidth.y = 0; /* Unused in LOGPEN. */ + if ( dashstyle == 0 ) + lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future. */ + else + lf.lopnStyle = PS_DASH; /* REALLLLY simple for now. */ + lf.lopnColor = color; /* Assume we're getting a COLORREF. */ + /* Now we have a logical pen. Create the "real" pen and put it in the hDC. */ + hPen = CreatePenIndirect(&lf); + } + + *oldPen = SelectObject(hDC, hPen); + return 1; } /* @@ -3054,14 +3044,14 @@ static int GdiMakePen( */ static int GdiFreePen( - TCL_UNUSED(Tcl_Interp *), - HDC hDC, - HGDIOBJ oldPen) + TCL_UNUSED(Tcl_Interp *), + HDC hDC, + HGDIOBJ oldPen) { - HGDIOBJ gonePen; - gonePen = SelectObject (hDC, oldPen); - DeleteObject (gonePen); - return 1; + HGDIOBJ gonePen; + gonePen = SelectObject (hDC, oldPen); + DeleteObject (gonePen); + return 1; } @@ -3080,22 +3070,22 @@ static int GdiFreePen( */ static int GdiMakeBrush( - TCL_UNUSED(Tcl_Interp *), - TCL_UNUSED(unsigned int), - unsigned long color, - long hatch, - LOGBRUSH *lb, - HDC hDC, - HGDIOBJ *oldBrush) + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(unsigned int), + unsigned long color, + long hatch, + LOGBRUSH *lb, + HDC hDC, + HGDIOBJ *oldBrush) { - HBRUSH hBrush; - lb->lbStyle = BS_SOLID; /* Support other styles later. */ - lb->lbColor = color; /* Assume this is a COLORREF. */ - lb->lbHatch = hatch; /* Ignored for now, given BS_SOLID in the Style. */ - /* Now we have the logical brush. Create the "real" brush and put it in the hDC. */ - hBrush = CreateBrushIndirect(lb); - *oldBrush = SelectObject(hDC, hBrush); - return 1; + HBRUSH hBrush; + lb->lbStyle = BS_SOLID; /* Support other styles later. */ + lb->lbColor = color; /* Assume this is a COLORREF. */ + lb->lbHatch = hatch; /* Ignored for now, given BS_SOLID in the Style. */ + /* Now we have the logical brush. Create the "real" brush and put it in the hDC. */ + hBrush = CreateBrushIndirect(lb); + *oldBrush = SelectObject(hDC, hBrush); + return 1; } /* @@ -3111,14 +3101,14 @@ static int GdiMakeBrush( *---------------------------------------------------------------------- */ static int GdiFreeBrush( - TCL_UNUSED(Tcl_Interp *), - HDC hDC, - HGDIOBJ oldBrush) + TCL_UNUSED(Tcl_Interp *), + HDC hDC, + HGDIOBJ oldBrush) { - HGDIOBJ goneBrush; - goneBrush = SelectObject (hDC, oldBrush); - DeleteObject(goneBrush); - return 1; + HGDIOBJ goneBrush; + goneBrush = SelectObject (hDC, oldBrush); + DeleteObject(goneBrush); + return 1; } /* @@ -3126,8 +3116,8 @@ static int GdiFreeBrush( * Functions have removed reliance on X and Tk libraries, * as well as removing the need for TkWindows. * GdiGetColor is a copy of a TkpGetColor from tkWinColor.c -* GdiParseColor is a copy of XParseColor from xcolors.c -*/ + * GdiParseColor is a copy of XParseColor from xcolors.c + */ typedef struct { const char *name; int index; @@ -3930,30 +3920,30 @@ static int numxcolors=0; static int GdiGetColor(const char *name, unsigned long *color) { - if ( numsyscolors == 0 ) - numsyscolors = sizeof ( sysColors ) / sizeof (SystemColorEntry); - if ( _strnicmp(name, "system", 6) == 0 ) - { - int i, l, u, r; - l = 0; - u = numsyscolors; - while ( l <= u ) - { - i = (l + u) / 2; - if ( (r = _strcmpi(name+6, sysColors[i].name)) == 0 ) - break; - if ( r < 0 ) - u = i - 1; - else - l = i + 1; - } - if ( l > u ) - return 0; - *color = GetSysColor(sysColors[i].index); - return 1; - } - else - return GdiParseColor(name, color); + if ( numsyscolors == 0 ) + numsyscolors = sizeof ( sysColors ) / sizeof (SystemColorEntry); + if ( _strnicmp(name, "system", 6) == 0 ) + { + int i, l, u, r; + l = 0; + u = numsyscolors; + while ( l <= u ) + { + i = (l + u) / 2; + if ( (r = _strcmpi(name+6, sysColors[i].name)) == 0 ) + break; + if ( r < 0 ) + u = i - 1; + else + l = i + 1; + } + if ( l > u ) + return 0; + *color = GetSysColor(sysColors[i].index); + return 1; + } + else + return GdiParseColor(name, color); } /* @@ -3973,66 +3963,66 @@ static int GdiGetColor(const char *name, unsigned long *color) static int GdiParseColor (const char *name, unsigned long *color) { - if ( name[0] == '#' ) - { - char fmt[40]; - int i; - unsigned red, green, blue; - - if ( (i = strlen(name+1))%3 != 0 || i > 12 || i < 3) - return 0; - i /= 3; - sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i); - if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { - return 0; - } - /* Now this is Windows-specific -- each component is at most 8 bits. */ - switch ( i ) - { - case 1: - red <<= 4; - green <<= 4; - blue <<= 4; - break; - case 2: - break; - case 3: - red >>= 4; - green >>= 4; - blue >>= 4; - break; - case 4: - red >>= 8; - green >>= 8; - blue >>= 8; - break; - } - *color = RGB(red, green, blue); - return 1; - } - else - { - int i, u, r, l; - if ( numxcolors == 0 ) - numxcolors = sizeof(xColors) / sizeof(XColorEntry); - l = 0; - u = numxcolors; - - while ( l <= u) - { - i = (l + u) / 2; - if ( (r = _strcmpi(name, xColors[i].name)) == 0 ) - break; - if ( r < 0 ) - u = i-1; - else - l = i+1; - } - if ( l > u ) - return 0; - *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); - return 1; - } + if ( name[0] == '#' ) + { + char fmt[40]; + int i; + unsigned red, green, blue; + + if ( (i = strlen(name+1))%3 != 0 || i > 12 || i < 3) + return 0; + i /= 3; + sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i); + if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { + return 0; + } + /* Now this is Windows-specific -- each component is at most 8 bits. */ + switch ( i ) + { + case 1: + red <<= 4; + green <<= 4; + blue <<= 4; + break; + case 2: + break; + case 3: + red >>= 4; + green >>= 4; + blue >>= 4; + break; + case 4: + red >>= 8; + green >>= 8; + blue >>= 8; + break; + } + *color = RGB(red, green, blue); + return 1; + } + else + { + int i, u, r, l; + if ( numxcolors == 0 ) + numxcolors = sizeof(xColors) / sizeof(XColorEntry); + l = 0; + u = numxcolors; + + while ( l <= u) + { + i = (l + u) / 2; + if ( (r = _strcmpi(name, xColors[i].name)) == 0 ) + break; + if ( r < 0 ) + u = i-1; + else + l = i+1; + } + if ( l > u ) + return 0; + *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); + return 1; + } } /* @@ -4058,105 +4048,105 @@ static int GdiParseColor (const char *name, unsigned long *color) static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) { - HANDLE hDIB; - HBITMAP hBitmap; - HPALETTE hPalette; + HANDLE hDIB; + HBITMAP hBitmap; + HPALETTE hPalette; - /* Check for a valid window handle. */ + /* Check for a valid window handle. */ if (!hWnd) return NULL; switch (type) - { + { case PTWindow: /* Copy entire window. */ - { - RECT rectWnd; + { + RECT rectWnd; - /* Get the window rectangle. */ + /* Get the window rectangle. */ - GetWindowRect(hWnd, &rectWnd); + GetWindowRect(hWnd, &rectWnd); - /* - * Get the DIB of the window by calling - * CopyScreenToDIB and passing it the window rect. - */ + /* + * Get the DIB of the window by calling + * CopyScreenToDIB and passing it the window rect. + */ - hDIB = CopyScreenToDIB(&rectWnd); - break; - } + hDIB = CopyScreenToDIB(&rectWnd); + break; + } case PTClient: /* Copy client area. */ - { - RECT rectClient; - POINT pt1, pt2; + { + RECT rectClient; + POINT pt1, pt2; - /* Get the client area dimensions. */ + /* Get the client area dimensions. */ - GetClientRect(hWnd, &rectClient); + GetClientRect(hWnd, &rectClient); - /* Convert client coords to screen coords. */ + /* Convert client coords to screen coords. */ - pt1.x = rectClient.left; - pt1.y = rectClient.top; - pt2.x = rectClient.right; - pt2.y = rectClient.bottom; - ClientToScreen(hWnd, &pt1); - ClientToScreen(hWnd, &pt2); - rectClient.left = pt1.x; - rectClient.top = pt1.y; - rectClient.right = pt2.x; - rectClient.bottom = pt2.y; + pt1.x = rectClient.left; + pt1.y = rectClient.top; + pt2.x = rectClient.right; + pt2.y = rectClient.bottom; + ClientToScreen(hWnd, &pt1); + ClientToScreen(hWnd, &pt2); + rectClient.left = pt1.x; + rectClient.top = pt1.y; + rectClient.right = pt2.x; + rectClient.bottom = pt2.y; - /* - * Get the DIB of the client area by calling - * CopyScreenToDIB and passing it the client rect. - */ + /* + * Get the DIB of the client area by calling + * CopyScreenToDIB and passing it the client rect. + */ - hDIB = CopyScreenToDIB(&rectClient); - break; - } + hDIB = CopyScreenToDIB(&rectClient); + break; + } case PTScreen: /* Entire screen. */ - { - RECT Rect; + { + RECT Rect; - /* - * Get the device-dependent bitmap in lpRect by calling - * CopyScreenToBitmap and passing it the rectangle to grab. - */ - Rect.top = Rect.left = 0; - GetDisplaySize(&Rect.right, &Rect.bottom); + /* + * Get the device-dependent bitmap in lpRect by calling + * CopyScreenToBitmap and passing it the rectangle to grab. + */ + Rect.top = Rect.left = 0; + GetDisplaySize(&Rect.right, &Rect.bottom); - hBitmap = CopyScreenToBitmap(&Rect); + hBitmap = CopyScreenToBitmap(&Rect); - /* Check for a valid bitmap handle. */ + /* Check for a valid bitmap handle. */ - if (!hBitmap) - return NULL; + if (!hBitmap) + return NULL; - /* Get the current palette. */ + /* Get the current palette. */ - hPalette = GetSystemPalette(); + hPalette = GetSystemPalette(); - /* Convert the bitmap to a DIB. */ + /* Convert the bitmap to a DIB. */ - hDIB = BitmapToDIB(hBitmap, hPalette); + hDIB = BitmapToDIB(hBitmap, hPalette); - /* Clean up. */ + /* Clean up. */ - DeleteObject(hPalette); - DeleteObject(hBitmap); + DeleteObject(hPalette); + DeleteObject(hBitmap); - /* Return handle to the packed-DIB. */ - } - break; - default: /* Invalid print area. */ - return NULL; - } + /* Return handle to the packed-DIB. */ + } + break; + default: /* Invalid print area. */ + return NULL; + } - /* Return the handle to the DIB. */ - return hDIB; + /* Return the handle to the DIB. */ + return hDIB; } /* @@ -4175,12 +4165,12 @@ static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) static void GetDisplaySize (LONG *width, LONG *height) { - HDC hDC; + HDC hDC; - hDC = CreateDC("DISPLAY", 0, 0, 0); - *width = GetDeviceCaps (hDC, HORZRES); - *height = GetDeviceCaps (hDC, VERTRES); - DeleteDC(hDC); + hDC = CreateDC("DISPLAY", 0, 0, 0); + *width = GetDeviceCaps (hDC, HORZRES); + *height = GetDeviceCaps (hDC, VERTRES); + DeleteDC(hDC); } @@ -4208,7 +4198,7 @@ static HBITMAP CopyScreenToBitmap(LPRECT lpRect) /* Check for an empty rectangle. */ if (IsRectEmpty(lpRect)) - return NULL; + return NULL; /* * Create a DC for the screen and create @@ -4358,14 +4348,14 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) /* If we couldn't get memory block. */ if (!hDIB) - { - /* clean up and return NULL. */ + { + /* clean up and return NULL. */ - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } /* Lock memory and get pointer to it. */ @@ -4373,14 +4363,14 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) /* Use our bitmap info. to fill BITMAPINFOHEADER. */ - *lpbi = bi; + *lpbi = bi; /* Call GetDIBits with a NULL lpBits param, so it will calculate the * biSizeImage field for us */ GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, NULL, (LPBITMAPINFO)lpbi, - DIB_RGB_COLORS); + DIB_RGB_COLORS); /* get the info. returned by GetDIBits and unlock memory block. */ @@ -4398,15 +4388,15 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) if ((h = GlobalReAlloc(hDIB, dwLen, 0)) != 0) hDIB = h; else - { - /* Clean up and return NULL. */ + { + /* Clean up and return NULL. */ - GlobalFree(hDIB); - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } + GlobalFree(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } /* Lock memory block and get pointer to it. */ @@ -4417,17 +4407,17 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) */ if (GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, (LPSTR)lpbi + - (WORD)lpbi->biSize + DIBNumColors(lpbi) * sizeof(RGBQUAD), (LPBITMAPINFO)lpbi, - DIB_RGB_COLORS) == 0) - { - /* Clean up and return NULL. */ + (WORD)lpbi->biSize + DIBNumColors(lpbi) * sizeof(RGBQUAD), (LPBITMAPINFO)lpbi, + DIB_RGB_COLORS) == 0) + { + /* Clean up and return NULL. */ - GlobalUnlock(hDIB); - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } + GlobalUnlock(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } bi = *lpbi; @@ -4470,7 +4460,7 @@ static HANDLE CopyScreenToDIB(LPRECT lpRect) /* Check for a valid bitmap handle. */ if (!hBitmap) - return NULL; + return NULL; /* Get the current palette. */ @@ -4522,7 +4512,7 @@ static HPALETTE GetSystemPalette(void) /* Allocate room for the palette and lock it.. */ hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + nColors * - sizeof(PALETTEENTRY)); + sizeof(PALETTEENTRY)); /* If we didn't get a logical palette, return NULL. */ @@ -4541,7 +4531,7 @@ static HPALETTE GetSystemPalette(void) /* Copy the current system palette into our logical palette. */ GetSystemPaletteEntries(hDC, 0, nColors, - (LPPALETTEENTRY)(lpLogPal->palPalEntry)); + (LPPALETTEENTRY)(lpLogPal->palPalEntry)); /* * Go ahead and create the palette. Once it's created, @@ -4574,7 +4564,7 @@ static HPALETTE GetSystemPalette(void) static int PalEntriesOnDevice(HDC hDC) { - return (1 << (GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES))); + return (1 << (GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES))); } @@ -4594,9 +4584,9 @@ static int PalEntriesOnDevice(HDC hDC) int Gdi_Init(Tcl_Interp *interp) { - Tcl_CreateCommand(interp, "::tk::print::_gdi", TkWinGDI, - (ClientData)0, (Tcl_CmdDeleteProc *)0); - return TCL_OK; + Tcl_CreateCommand(interp, "::tk::print::_gdi", TkWinGDI, + (ClientData)0, (Tcl_CmdDeleteProc *)0); + return TCL_OK; } /* @@ -4626,8 +4616,8 @@ int Winprint_Init(Tcl_Interp * interp) /* -* The following functions are adapted from tkTrig.c. -*/ + * The following functions are adapted from tkTrig.c. + */ /* *-------------------------------------------------------------- @@ -4652,14 +4642,14 @@ int Winprint_Init(Tcl_Interp * interp) static void TkGdiBezierScreenPoints(canvas, control, numSteps, xPointPtr) - Tk_Canvas canvas; /* Canvas in which curve is to be + Tk_Canvas canvas; /* Canvas in which curve is to be * drawn.. */ - double control[]; /* Array of coordinates for four + double control[]; /* Array of coordinates for four * control points: x0, y0, x1, y1, * ... x3 y3.. */ - int numSteps; /* Number of curve points to + int numSteps; /* Number of curve points to * generate. */ - register XPoint *xPointPtr; /* Where to put new points.. */ + register XPoint *xPointPtr; /* Where to put new points.. */ { int i; double u, u2, u3, t, t2, t3; @@ -4672,11 +4662,11 @@ TkGdiBezierScreenPoints(canvas, control, numSteps, xPointPtr) u2 = u*u; u3 = u2*u; Tk_CanvasDrawableCoords(canvas, - (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) - + control[6]*t3), - (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) - + control[7]*t3), - &xPointPtr->x, &xPointPtr->y); + (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + + control[6]*t3), + (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + + control[7]*t3), + &xPointPtr->x, &xPointPtr->y); } } @@ -4703,12 +4693,12 @@ TkGdiBezierScreenPoints(canvas, control, numSteps, xPointPtr) static void TkGdiBezierPoints(control, numSteps, coordPtr) - double control[]; /* Array of coordinates for four + double control[]; /* Array of coordinates for four * control points: x0, y0, x1, y1, * ... x3 y3.. */ - int numSteps; /* Number of curve points to + int numSteps; /* Number of curve points to * generate. */ - register double *coordPtr; /* Where to put new points.. */ + register double *coordPtr; /* Where to put new points.. */ { int i; double u, u2, u3, t, t2, t3; @@ -4721,9 +4711,9 @@ TkGdiBezierPoints(control, numSteps, coordPtr) u2 = u*u; u3 = u2*u; coordPtr[0] = control[0]*u3 - + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; + + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; coordPtr[1] = control[1]*u3 - + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; + + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; } } @@ -4754,12 +4744,12 @@ TkGdiBezierPoints(control, numSteps, coordPtr) */ static int TkGdiMakeBezierCurve( - Tk_Canvas canvas, /* Canvas in which curve is to be drawn.*/ - double *pointPtr, /* Array of input coordinates: x0, y0, x1, y1, etc... */ - int numPoints, /* Number of points at pointPtr.. */ - int numSteps, /* Number of steps to use for each spline segments. */ - XPoint xPoints[], /* Array of XPoints to fill in. */ - double dblPoints[]) /* Array of points to fill in as doubles, in the form x0, y0, x1, y1. */ + Tk_Canvas canvas, /* Canvas in which curve is to be drawn.*/ + double *pointPtr, /* Array of input coordinates: x0, y0, x1, y1, etc... */ + int numPoints, /* Number of points at pointPtr.. */ + int numSteps, /* Number of steps to use for each spline segments. */ + XPoint xPoints[], /* Array of XPoints to fill in. */ + double dblPoints[]) /* Array of points to fill in as doubles, in the form x0, y0, x1, y1. */ { int closed, outputPoints, i; @@ -4767,10 +4757,10 @@ TkGdiMakeBezierCurve( double control[8]; /* - * If the curve is a closed one then generate a special spline - * that spans the last points and the first ones. Otherwise - * just put the first point into the output. - */ + * If the curve is a closed one then generate a special spline + * that spans the last points and the first ones. Otherwise + * just put the first point into the output. + */ if (!pointPtr) { /* @@ -4784,7 +4774,7 @@ TkGdiMakeBezierCurve( outputPoints = 0; if ((pointPtr[0] == pointPtr[numCoords-2]) - && (pointPtr[1] == pointPtr[numCoords-1])) { + && (pointPtr[1] == pointPtr[numCoords-1])) { closed = 1; control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0]; control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1]; @@ -4796,7 +4786,7 @@ TkGdiMakeBezierCurve( control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; if (xPoints != NULL) { Tk_CanvasDrawableCoords(canvas, control[0], control[1], - &xPoints->x, &xPoints->y); + &xPoints->x, &xPoints->y); TkGdiBezierScreenPoints(canvas, control, numSteps, xPoints+1); xPoints += numSteps+1; } @@ -4811,7 +4801,7 @@ TkGdiMakeBezierCurve( closed = 0; if (xPoints != NULL) { Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1], - &xPoints->x, &xPoints->y); + &xPoints->x, &xPoints->y); xPoints += 1; } if (dblPoints != NULL) { @@ -4845,7 +4835,7 @@ TkGdiMakeBezierCurve( * Set up the last two control points. This is done * differently for the last spline of an open curve * than for other cases. - . */ + . */ if ((i == (numPoints-1)) && !closed) { control[4] = .667*pointPtr[2] + .333*pointPtr[4]; @@ -4864,14 +4854,14 @@ TkGdiMakeBezierCurve( * two points coincide, then generate a single * straight-line segment by outputting the last control * point. - . */ + . */ if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3])) - || ((pointPtr[2] == pointPtr[4]) + || ((pointPtr[2] == pointPtr[4]) && (pointPtr[3] == pointPtr[5]))) { if (xPoints != NULL) { Tk_CanvasDrawableCoords(canvas, control[6], control[7], - &xPoints[0].x, &xPoints[0].y); + &xPoints[0].x, &xPoints[0].y); xPoints++; } if (dblPoints != NULL) { @@ -4940,6 +4930,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg pd.Flags = PD_RETURNDC |PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; if (PrintDlg(&pd) == TRUE) { + /*Set device context here for all GDI printing operations.*/ printDC = pd.hDC; if (printDC = NULL) { Tcl_AppendResult(interp, "can't allocate printer DC", NULL); @@ -5057,7 +5048,6 @@ int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_O (void) objv; ClosePrinter(printDC); - DeleteDC(printDC); return TCL_OK; } @@ -5082,7 +5072,7 @@ int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *c (void) objv; int output = 0; - RestoreDC(printDC, -1); + RestoreDC(printDC, -1); if (printDC == NULL) { return TCL_ERROR; @@ -5124,7 +5114,7 @@ int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * if ( EndDoc(printDC) <= 0) { return TCL_ERROR; } - DeleteDC(printDC); + DeleteDC(printDC); return TCL_OK; } -- cgit v0.12 From e11dceb7b6ad79f9b3dbf8d1a9fef214df0e3308 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 15 May 2021 12:59:58 +0000 Subject: Add error checking --- library/print.tcl | 25 ++++++++++--------- win/tkWinGDI.c | 75 ++++++++++++++++++++++++++++++++++++++++++------------- 2 files changed, 71 insertions(+), 29 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 5f04b20..716fb18 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -13,7 +13,6 @@ namespace eval ::tk::print { - if {[tk windowingsystem] eq "win32"} { variable ::tk::print::printer_name @@ -56,10 +55,9 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - - parray printargs - - return printargs + + ::tk::print::_closeprinter + } # _print_data @@ -78,24 +76,26 @@ namespace eval ::tk::print { _set_dc puts "_print_data" - ::tk::print::_opendoc - + puts "opening printer" + + # ::tk::print::_openprinter [list $printargs(hDC)] + if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid } else { eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid } - + set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] set pagehgt [ expr ( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) ] set totallen [ string length $data ] set curlen 0 set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] - puts "flick" - - ::tk::print::_openpage - puts "yup" + puts "opening doc" + ::tk::print::_opendoc + puts "opening page" + ::tk::print::_openpage while { $curlen < $totallen } { set linestring [ string range $data $curlen end ] if { $breaklines } { @@ -127,6 +127,7 @@ namespace eval ::tk::print { } ::tk::print::_print_closepage ::tk::print::_print_closedoc + ::tk::print::_closeprinter } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index ca2fe8d..efb0aca 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1460,11 +1460,12 @@ static int GdiCharWidths( { static const char usage_message[] = "::tk::print::_gdi characters hdc [-font fontname] [-array ary]"; /* - * Returns widths of characters from font in an associative array. + * Returns widths of characters from font in an associative array. * Font is currently selected font for HDC if not specified. * Array name is GdiCharWidths if not specified. * Widths should be in the same measures as all other values (1/1000 inch). */ + HDC hDC; LOGFONT lf; HFONT hfont, oldfont; @@ -1481,7 +1482,7 @@ static int GdiCharWidths( } hDC = printDC; - + argc--; argv++; @@ -1518,12 +1519,13 @@ static int GdiCharWidths( /* * Try the correct function for non-TrueType fonts first. */ - if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) - { - /*Try TrueType fonts next.*/ - retval = GetCharABCWidths (hDC, 0, 255, (LPABC) widths ); - } - + + if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) + { + /*Try TrueType fonts next.*/ + retval = GetCharABCWidths (hDC, 0, 255, (LPABC) widths ); + } + /* * Retval should be 1 (TRUE) if the function succeeded. If the function fails, * get the "extended" error code and return. Be sure to deallocate the font if @@ -4976,8 +4978,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg { GlobalFree(pd.hDevMode); } - - + /* * Store print properties and link variables * so they can be accessed from script level. @@ -5019,12 +5020,27 @@ int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Ob Tcl_WrongNumArgs(interp, 1, objv, "printer"); return TCL_ERROR; } + + int len = 0; + + /*Start an individual page.*/ + if ( StartPage(printDC) <= 0) { + + return TCL_ERROR; + } - char *printer = Tcl_GetString(objv[2]); - if (printDC== NULL) { + char *printer = Tcl_GetStringFromObj(objv[1], &len); + + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } - OpenPrinter(printer, &printDC, NULL); + +if ((OpenPrinter(printer, &printDC, NULL)) == FALSE) { + Tcl_AppendResult(interp, "unable to open printer", NULL); + return TCL_ERROR; + } + return TCL_OK; } @@ -5046,7 +5062,12 @@ int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_O (void) clientData; (void) argc; (void) objv; - + + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); + return TCL_ERROR; + } + ClosePrinter(printDC); return TCL_OK; } @@ -5072,12 +5093,12 @@ int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *c (void) objv; int output = 0; - RestoreDC(printDC, -1); - if (printDC == NULL) { + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } - + /* * Start printing. */ @@ -5110,8 +5131,15 @@ int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * (void) clientData; (void) argc; (void) objv; + + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); + return TCL_ERROR; + } + if ( EndDoc(printDC) <= 0) { + Tcl_AppendResult(interp, "unable to establish close document", NULL); return TCL_ERROR; } DeleteDC(printDC); @@ -5137,6 +5165,12 @@ int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * (void) clientData; (void) argc; (void) objv; + + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); + return TCL_ERROR; + } + /*Start an individual page.*/ if ( StartPage(printDC) <= 0) { @@ -5167,7 +5201,14 @@ int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj (void) argc; (void) objv; + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); + return TCL_ERROR; + } + + if ( EndPage(printDC) <= 0) { + Tcl_AppendResult(interp, "unable to close page", NULL); return TCL_ERROR; } return TCL_OK; -- cgit v0.12 From 18516f2627b74e4f16ec4e411bf8eff1d79fadeb Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 15 May 2021 13:09:39 +0000 Subject: Formatting cleanup --- library/print.tcl | 30 ++++++++++-------------------- 1 file changed, 10 insertions(+), 20 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 716fb18..f87d1c7 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -55,9 +55,9 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - - ::tk::print::_closeprinter - + + ::tk::print::_closeprinter + } # _print_data @@ -74,28 +74,23 @@ namespace eval ::tk::print { variable printargs _set_dc - - puts "_print_data" - puts "opening printer" - - # ::tk::print::_openprinter [list $printargs(hDC)] - + + if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid } else { eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid } - + set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] set pagehgt [ expr ( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) ] set totallen [ string length $data ] set curlen 0 set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] - puts "opening doc" - ::tk::print::_opendoc - puts "opening page" - ::tk::print::_openpage + ::tk::print::_opendoc + ::tk::print::_openpage + while { $curlen < $totallen } { set linestring [ string range $data $curlen end ] if { $breaklines } { @@ -111,9 +106,6 @@ namespace eval ::tk::print { set plist [array get printargs] set clist [array get printcharwid] - - puts "plist is $plist" - puts "clist is $clist" set result [_print_page_nextline $linestring \ $clist $plist $curhgt $font] @@ -127,7 +119,7 @@ namespace eval ::tk::print { } ::tk::print::_print_closepage ::tk::print::_print_closedoc - ::tk::print::_closeprinter + ::tk::print::_closeprinter } @@ -174,8 +166,6 @@ namespace eval ::tk::print { array set charwidths $clist array set printargs $plist - puts "_print_page_nextline" - set endindex 0 set totwidth 0 set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] -- cgit v0.12 From ed3be9373daa68ad396971dd74591fabf4471d13 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 15 May 2021 13:27:47 +0000 Subject: Printer context seems to persist, finally; still not completing printing but progress made --- library/print.tcl | 16 ++++++++++------ win/tkWinGDI.c | 7 ++++++- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index f87d1c7..b0e24e8 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -55,10 +55,8 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - - ::tk::print::_closeprinter - - } + +} # _print_data # This function prints multiple-page files, using a line-oriented @@ -75,7 +73,8 @@ namespace eval ::tk::print { _set_dc - + puts "print_data" + if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid } else { @@ -88,7 +87,10 @@ namespace eval ::tk::print { set curlen 0 set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] + puts "open doc" ::tk::print::_opendoc + + puts "open page" ::tk::print::_openpage while { $curlen < $totallen } { @@ -117,9 +119,11 @@ namespace eval ::tk::print { set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] } } + + puts "closing down" ::tk::print::_print_closepage ::tk::print::_print_closedoc - ::tk::print::_closeprinter + #::tk::print::_closeprinter } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index efb0aca..dfb5145 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4929,7 +4929,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg ZeroMemory( &pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); - pd.Flags = PD_RETURNDC |PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; + pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; if (PrintDlg(&pd) == TRUE) { /*Set device context here for all GDI printing operations.*/ @@ -4968,6 +4968,11 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_height = (int) localDevmode->dmPaperLength; paper_width = (int) localDevmode->dmPaperWidth; copies = pd.nCopies; + printDC = CreateDC( + "WINSPOOL", + printerName, + NULL, + localDevmode); } else { -- cgit v0.12 From 58691a73130c3367d27b1cfae00fdf3178e7e9d3 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 17 May 2021 13:16:09 +0000 Subject: Cleanup of API --- library/print.tcl | 54 +++++++++++++++++++----------------------------------- win/tkWinGDI.c | 12 +++--------- 2 files changed, 22 insertions(+), 44 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index b0e24e8..19c5397 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -72,28 +72,23 @@ namespace eval ::tk::print { variable printargs _set_dc - - puts "print_data" if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid } else { eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid } - + set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] set pagehgt [ expr ( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) ] set totallen [ string length $data ] set curlen 0 set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] - puts "open doc" ::tk::print::_opendoc - - puts "open page" ::tk::print::_openpage - while { $curlen < $totallen } { + while { $curlen < $totallen } { set linestring [ string range $data $curlen end ] if { $breaklines } { set endind [ string first "\n" $linestring ] @@ -105,12 +100,9 @@ namespace eval ::tk::print { } } } - - set plist [array get printargs] - set clist [array get printcharwid] set result [_print_page_nextline $linestring \ - $clist $plist $curhgt $font] + printcharwid printargs $curhgt $font] incr curlen [lindex $result 0] incr curhgt [lindex $result 1] if { [expr $curhgt + [lindex $result 1] ] > $pagehgt } { @@ -119,11 +111,9 @@ namespace eval ::tk::print { set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] } } - - puts "closing down" + ::tk::print::_print_closepage ::tk::print::_print_closedoc - #::tk::print::_closeprinter } @@ -145,11 +135,8 @@ namespace eval ::tk::print { array get printargs set fn [open $filename r] - set data [ read $fn ] - close $fn - _print_data $data $breaklines $font } @@ -164,27 +151,24 @@ namespace eval ::tk::print { # y - Y value to begin printing at # font - if non-empty specifies a font to draw the line in - proc _print_page_nextline { string clist plist y font } { - + proc _print_page_nextline { string carray parray y font } { - array set charwidths $clist - array set printargs $plist - set endindex 0 - set totwidth 0 - set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] - set maxstring [ string length $string ] - set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] + upvar #0 $carray charwidths + upvar #0 $parray printargs + + variable printargs - for { set i 0 } { ( $i < $maxstring ) && ( $totwidth < $maxwidth ) } { incr i } { - set ch [ string index $string $i ] - if [ info exist charwidths($ch) ] { - incr totwidth $charwidths([string index $string $i]) - } else { - incr totwidth $charwidths(n) + set endindex 0 + set totwidth 0 + set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] + set maxstring [ string length $string ] + set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] + + for { set i 0 } { ( $i < $maxstring ) && ( $totwidth < $maxwidth ) } { incr i } { + incr totwidth $charwidths([string index $string $i]) + # set width($i) $totwidth } - # set width($i) $totwidth - } set endindex $i set startindex $endindex @@ -212,8 +196,8 @@ namespace eval ::tk::print { -anchor nw -justify left \ -text [string trim [ string range $string 0 $endindex ] "\r\n" ] ] } - return "$startindex $result" + } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index dfb5145..af447ea 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1515,16 +1515,10 @@ static int GdiCharWidths( /* Now, get the widths using the correct function for font type. */ - - /* - * Try the correct function for non-TrueType fonts first. - */ - if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) - { - /*Try TrueType fonts next.*/ - retval = GetCharABCWidths (hDC, 0, 255, (LPABC) widths ); - } + { + retval = GetCharWidth (hDC, 0, 255, widths ); + } /* * Retval should be 1 (TRUE) if the function succeeded. If the function fails, -- cgit v0.12 From 507661f2c95831d414455b26bc1aa263bb7e15d8 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 17 May 2021 17:56:57 +0000 Subject: Text printing on Windows now works! --- library/print.tcl | 23 +++++++++++------------ win/tkWinGDI.c | 4 ++-- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 19c5397..918dacf 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -44,14 +44,16 @@ namespace eval ::tk::print { return } - #Next, set values. + #Next, set values. Some are taken from the printer, + #some are sane defaults. + set printargs(hDC) [list $::tk::print::printer_name] set printargs(pw) $::tk::print::paper_width set printargs(pl) $::tk::print::paper_height - set printargs(lm) 100 - set printargs(tm) 100 - set printargs(rm) [expr $printargs(pw) - $printargs(lm)] - set printargs(bm) [expr $printargs(pl) - $printargs(tm)] + set printargs(lm) 1000 + set printargs(tm) 1000 + set printargs(rm) 1000 + set printargs(bm) 1000 set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies @@ -78,7 +80,6 @@ namespace eval ::tk::print { } else { eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid } - set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] set pagehgt [ expr ( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) ] set totallen [ string length $data ] @@ -112,15 +113,15 @@ namespace eval ::tk::print { } } - ::tk::print::_print_closepage - ::tk::print::_print_closedoc + ::tk::print::_closepage + ::tk::print::_closedoc } # _print_file # This function prints multiple-page files # It will either break lines or just let them run over the - # margins (and thus truncate). + # margins (and thus truncate). # The font argument is JUST the font name, not any additional # arguments. # Arguments: @@ -131,7 +132,6 @@ namespace eval ::tk::print { proc _print_file { filename {breaklines 1 } { font {}} } { variable printargs - array get printargs set fn [open $filename r] @@ -169,7 +169,7 @@ namespace eval ::tk::print { incr totwidth $charwidths([string index $string $i]) # set width($i) $totwidth } - + set endindex $i set startindex $endindex @@ -197,7 +197,6 @@ namespace eval ::tk::print { -text [string trim [ string range $string 0 $endindex ] "\r\n" ] ] } return "$startindex $result" - } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index af447ea..5467292 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4959,8 +4959,8 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg localPrinterName = (char*) localDevmode->dmDeviceName; dpi_y = localDevmode->dmYResolution; dpi_x = localDevmode->dmPrintQuality; - paper_height = (int) localDevmode->dmPaperLength; - paper_width = (int) localDevmode->dmPaperWidth; + paper_height = (int) localDevmode->dmPaperLength / 0.254; /*Convert to logical points.*/ + paper_width = (int) localDevmode->dmPaperWidth / 0.254; /* Convert to logical points.*/ copies = pd.nCopies; printDC = CreateDC( "WINSPOOL", -- cgit v0.12 From 20d699373384ffe7d1d810f8c9c8a6e03a33a326 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 17 May 2021 18:05:16 +0000 Subject: Minor tweak --- library/print.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/print.tcl b/library/print.tcl index 918dacf..b9bc96e 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -235,7 +235,7 @@ namespace eval ::tk::print { # printer - Flag whether to use the default printer. # name - App name to pass to printer. - proc _print_widget { wid {printer default} {name "Tk Print Job"} } { + proc _print_widget { wid {printer default} {name "Tk Print Output"} } { variable printargs -- cgit v0.12 From 57fb5234babf5952791315595fd7d5bd977b9387 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 17 May 2021 18:38:19 +0000 Subject: Try printing canvas --- library/print.tcl | 21 ++++++++++----------- win/tkWinGDI.c | 40 ++++++++++++++++++++-------------------- 2 files changed, 30 insertions(+), 31 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index b9bc96e..2f42fcb 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -271,16 +271,16 @@ namespace eval ::tk::print { set pm "page margins" set ppi "pixels per inch" - set printer_x [ expr ( [lindex $p($pd) 0] - \ - [lindex $p($pm) 0 ] - \ - [lindex $p($pm) 2 ] \ + set printer_x [ expr ( $printargs(pw) - \ + $printargs(lm)- \ + $printargs(rm) \ ) * \ - [lindex $p($ppi) 0] / 1000.0 ] - set printer_y [ expr ( [lindex $p($pd) 1] - \ - [lindex $p($pm) 1 ] - \ - [lindex $p($pm) 3 ] \ + $printargs(resx) / 1000.0 ] + set printer_y [ expr ( $printargs(pl) - \ + $printargs(tm) - \ + $printargs(bm) 1000 \ ) * \ - [lindex $p($ppi) 1] / 1000.0 ] + $printargs(resy) / 1000.0 ] set factor_x [ expr $window_x / $printer_x ] set factor_y [ expr $window_y / $printer_y ] @@ -292,7 +292,7 @@ namespace eval ::tk::print { set ph $printer_x } - ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph -offset $p(resolution) + ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph -offset $printargs(resx) # handling of canvas widgets # additional procs can be added for other widget types @@ -310,10 +310,9 @@ namespace eval ::tk::print { } } - # end printing process ------ + # End printing process ------ ::tk::print::_closepage ::tk::print::_closedoc - ::tk::print::_closeprinter } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 5467292..37b97b2 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -5020,9 +5020,9 @@ int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Ob return TCL_ERROR; } - int len = 0; + int len = 0; - /*Start an individual page.*/ + /*Start an individual page.*/ if ( StartPage(printDC) <= 0) { return TCL_ERROR; @@ -5031,14 +5031,14 @@ int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Ob char *printer = Tcl_GetStringFromObj(objv[1], &len); if (printDC == NULL) { - Tcl_AppendResult(interp, "unable to establish device context", NULL); + Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } -if ((OpenPrinter(printer, &printDC, NULL)) == FALSE) { - Tcl_AppendResult(interp, "unable to open printer", NULL); - return TCL_ERROR; - } + if ((OpenPrinter(printer, &printDC, NULL)) == FALSE) { + Tcl_AppendResult(interp, "unable to open printer", NULL); + return TCL_ERROR; + } return TCL_OK; } @@ -5062,8 +5062,8 @@ int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_O (void) argc; (void) objv; - if (printDC == NULL) { - Tcl_AppendResult(interp, "unable to establish device context", NULL); + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } @@ -5093,8 +5093,8 @@ int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *c int output = 0; - if (printDC == NULL) { - Tcl_AppendResult(interp, "unable to establish device context", NULL); + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } @@ -5131,14 +5131,14 @@ int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * (void) argc; (void) objv; - if (printDC == NULL) { - Tcl_AppendResult(interp, "unable to establish device context", NULL); + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } - + if ( EndDoc(printDC) <= 0) { - Tcl_AppendResult(interp, "unable to establish close document", NULL); + Tcl_AppendResult(interp, "unable to establish close document", NULL); return TCL_ERROR; } DeleteDC(printDC); @@ -5165,8 +5165,8 @@ int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * (void) argc; (void) objv; - if (printDC == NULL) { - Tcl_AppendResult(interp, "unable to establish device context", NULL); + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } @@ -5200,14 +5200,14 @@ int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj (void) argc; (void) objv; - if (printDC == NULL) { - Tcl_AppendResult(interp, "unable to establish device context", NULL); + if (printDC == NULL) { + Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } if ( EndPage(printDC) <= 0) { - Tcl_AppendResult(interp, "unable to close page", NULL); + Tcl_AppendResult(interp, "unable to close page", NULL); return TCL_ERROR; } return TCL_OK; -- cgit v0.12 From a14f3c5f994ac4ff201efd28cede0a35a1ac88bb Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 19 May 2021 02:02:31 +0000 Subject: Canvas printing works! --- library/print.tcl | 39 +++++++++++++++++---------------------- win/tkWinGDI.c | 12 ++++++------ 2 files changed, 23 insertions(+), 28 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 2f42fcb..43095af 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -57,6 +57,7 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies + set printargs(resolution) [list $::tk::print::dpi_x $::tk::print::dpi_y] } @@ -239,7 +240,7 @@ namespace eval ::tk::print { variable printargs - _set_dc + _set_dc array get printargs @@ -267,22 +268,18 @@ namespace eval ::tk::print { set window_y [ winfo height $wid ] } - set pd "page dimensions" - set pm "page margins" - set ppi "pixels per inch" - - set printer_x [ expr ( $printargs(pw) - \ - $printargs(lm)- \ - $printargs(rm) \ - ) * \ + set printer_x [ expr ( $printargs(pw) - \ + $printargs(lm) - \ + $printargs(rm) \ + ) * \ $printargs(resx) / 1000.0 ] - set printer_y [ expr ( $printargs(pl) - \ - $printargs(tm) - \ - $printargs(bm) 1000 \ - ) * \ + set printer_y [ expr ( $printargs(pl) - \ + $printargs(tm) - \ + $printargs(bm) \ + ) * \ $printargs(resy) / 1000.0 ] - set factor_x [ expr $window_x / $printer_x ] - set factor_y [ expr $window_y / $printer_y ] + set factor_x [ expr $window_x / $printer_x ] + set factor_y [ expr $window_y / $printer_y ] if { $factor_x < $factor_y } { set lo $window_y @@ -292,14 +289,14 @@ namespace eval ::tk::print { set ph $printer_x } - ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph -offset $printargs(resx) + ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph -offset $printargs(resolution) # handling of canvas widgets # additional procs can be added for other widget types switch [winfo class $wid] { Canvas { # if {[catch { - _print_canvas [lindex $printargs(hDC) 0] $wid + _print_canvas $printargs(hDC) $wid # } msg]} { # debug_puts "print_widget: $msg" # error "Windows Printing Problem: $msg" @@ -415,7 +412,7 @@ namespace eval ::tk::print { variable printargs array get printargs - set color [print_canvas.TransColor [$cw itemcget $id -outline]] + set color [_print_canvas.TransColor [$cw itemcget $id -outline]] if { [string match $vtgPrint(printer.bg) $color] } { return } @@ -496,7 +493,7 @@ namespace eval ::tk::print { set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} - set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] + set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} set coords [$cw coords $id] set wdth [$cw itemcget $id -width] @@ -524,7 +521,7 @@ namespace eval ::tk::print { set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} - set ocolor [print_canvas.TransColor [$cw itemcget $id -outline]] + set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} set coords [$cw coords $id] set wdth [$cw itemcget $id -width] @@ -546,8 +543,6 @@ namespace eval ::tk::print { proc _print_canvas.text {hdc cw id} { variable vtgPrint - _set_dc - variable printargs array get printargs diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 37b97b2..0c53112 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1515,9 +1515,9 @@ static int GdiCharWidths( /* Now, get the widths using the correct function for font type. */ - if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) + if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) { - retval = GetCharWidth (hDC, 0, 255, widths ); + retval = GetCharWidth (hDC, 0, 255, widths ); } /* @@ -4963,10 +4963,10 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_width = (int) localDevmode->dmPaperWidth / 0.254; /* Convert to logical points.*/ copies = pd.nCopies; printDC = CreateDC( - "WINSPOOL", - printerName, - NULL, - localDevmode); + "WINSPOOL", + printerName, + NULL, + localDevmode); } else { -- cgit v0.12 From 02eff3a5abdfd46241939910ad7b142cdbb3ca7c Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 19 May 2021 02:34:41 +0000 Subject: Minor cleanup --- library/print.tcl | 119 ++++++++++++++++++++++++++++-------------------------- win/tkWinGDI.c | 11 ++--- 2 files changed, 65 insertions(+), 65 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 43095af..19b650c 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -45,8 +45,8 @@ namespace eval ::tk::print { } #Next, set values. Some are taken from the printer, - #some are sane defaults. - + #some are sane defaults. + set printargs(hDC) [list $::tk::print::printer_name] set printargs(pw) $::tk::print::paper_width set printargs(pl) $::tk::print::paper_height @@ -57,9 +57,9 @@ namespace eval ::tk::print { set printargs(resx) $::tk::print::dpi_x set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies - set printargs(resolution) [list $::tk::print::dpi_x $::tk::print::dpi_y] + set printargs(resolution) [list $::tk::print::dpi_x $::tk::print::dpi_y] -} + } # _print_data # This function prints multiple-page files, using a line-oriented @@ -75,7 +75,7 @@ namespace eval ::tk::print { variable printargs _set_dc - + if { [string length $font] == 0 } { eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid } else { @@ -122,7 +122,7 @@ namespace eval ::tk::print { # _print_file # This function prints multiple-page files # It will either break lines or just let them run over the - # margins (and thus truncate). + # margins (and thus truncate). # The font argument is JUST the font name, not any additional # arguments. # Arguments: @@ -155,28 +155,30 @@ namespace eval ::tk::print { proc _print_page_nextline { string carray parray y font } { - upvar #0 $carray charwidths - upvar #0 $parray printargs - - variable printargs + upvar #0 $carray charwidths + upvar #0 $parray printargs + + variable printargs - set endindex 0 - set totwidth 0 - set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] - set maxstring [ string length $string ] - set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] + set endindex 0 + set totwidth 0 + set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] + set maxstring [ string length $string ] + set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] - for { set i 0 } { ( $i < $maxstring ) && ( $totwidth < $maxwidth ) } { incr i } { - incr totwidth $charwidths([string index $string $i]) - # set width($i) $totwidth - } - + for { set i 0 } { ( $i < $maxstring ) && ( $totwidth < $maxwidth ) } { incr i } { + incr totwidth $charwidths([string index $string $i]) + # set width($i) $totwidth + } + set endindex $i set startindex $endindex if { $i < $maxstring } { - # In this case, the whole data string is not used up, and we wish to break on a - # word. Since we have all the partial widths calculated, this should be easy. + # In this case, the whole data string is not used up, and we wish + # to break on a word. Since we have all the partial widths calculated, + # this should be easy. + set endindex [ expr [string wordstart $string $endindex] - 1 ] set startindex [ expr $endindex + 1 ] @@ -240,7 +242,7 @@ namespace eval ::tk::print { variable printargs - _set_dc + _set_dc array get printargs @@ -268,18 +270,18 @@ namespace eval ::tk::print { set window_y [ winfo height $wid ] } - set printer_x [ expr ( $printargs(pw) - \ - $printargs(lm) - \ - $printargs(rm) \ - ) * \ + set printer_x [ expr ( $printargs(pw) - \ + $printargs(lm) - \ + $printargs(rm) \ + ) * \ $printargs(resx) / 1000.0 ] - set printer_y [ expr ( $printargs(pl) - \ - $printargs(tm) - \ - $printargs(bm) \ - ) * \ + set printer_y [ expr ( $printargs(pl) - \ + $printargs(tm) - \ + $printargs(bm) \ + ) * \ $printargs(resy) / 1000.0 ] - set factor_x [ expr $window_x / $printer_x ] - set factor_y [ expr $window_y / $printer_y ] + set factor_x [ expr $window_x / $printer_x ] + set factor_y [ expr $window_y / $printer_y ] if { $factor_x < $factor_y } { set lo $window_y @@ -291,23 +293,17 @@ namespace eval ::tk::print { ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph -offset $printargs(resolution) - # handling of canvas widgets - # additional procs can be added for other widget types + # Handling of canvas widgets. switch [winfo class $wid] { Canvas { - # if {[catch { _print_canvas $printargs(hDC) $wid - # } msg]} { - # debug_puts "print_widget: $msg" - # error "Windows Printing Problem: $msg" - # } } default { puts "Can't print items of type [winfo class $wid]. No handler registered" } } - # End printing process ------ + # End printing process. ::tk::print::_closepage ::tk::print::_closedoc } @@ -327,11 +323,11 @@ namespace eval ::tk::print { variable printargs array get printargs - # get information about page being printed to + # Get information about page being printed to # print_canvas.CalcSizing $cw set vtgPrint(canvas.bg) [string tolower [$cw cget -background]] - # re-write each widget from cw to printer + # Re-write each widget from cw to printer foreach id [$cw find all] { set type [$cw type $id] if { [ info commands _print_canvas.$type ] == "_print_canvas.$type" } { @@ -559,14 +555,17 @@ namespace eval ::tk::print { set just [$cw itemcget $id -justify] - # Get the canvas font info + # Get the canvas font info. set font [ $cw itemcget $id -font ] - # Find the real font info + + # Find the real font info. set font [font actual $font] - # Create a compatible font, suitable for printer name extraction + + # Create a compatible font, suitable for printer name extraction. set font [ eval font create $font ] - # Just get the name and family, or some of the ::tk::print::_gdi commands will fail. - # Improve this as GDI improves + + # Just get the name and family, or some of the ::tk::print::_gdi + # commands will fail. set font [list [font configure $font -family] -[font configure $font -size] ] set cmmd "::tk::print::_gdi text $printargs(hDC) $coords -fill $color -text [list $txt] \ @@ -592,12 +591,14 @@ namespace eval ::tk::print { variable printargs array get printargs - # First, we have to get the image name + # First, we have to get the image name. set imagename [ $cw itemcget $id -image] - # Now we get the size + + # Now we get the size. set wid [ image width $imagename] set hgt [ image height $imagename ] - # next, we get the location and anchor + + # Next, we get the location and anchor set anchor [ $cw itemcget $id -anchor ] set coords [ $cw coords $id ] @@ -605,7 +606,8 @@ namespace eval ::tk::print { # Since the GDI commands don't yet support images and bitmaps, # and since this represents a rendered bitmap, we CAN use # copybits IF we create a new temporary toplevel to hold the beast. - # if this is too ugly, change the option! + # If this is too ugly, change the option! + if { [ info exist option(use_copybits) ] } { set firstcase $option(use_copybits) } else { @@ -648,19 +650,22 @@ namespace eval ::tk::print { variable printargs array get printargs - # First, we have to get the bitmap name + # First, we have to get the bitmap name. set imagename [ $cw itemcget $id -image] - # Now we get the size + + # Now we get the size. set wid [ image width $imagename] set hgt [ image height $imagename ] - # next, we get the location and anchor + + #Next, we get the location and anchor. set anchor [ $cw itemcget $id -anchor ] set coords [ $cw coords $id ] # Since the GDI commands don't yet support images and bitmaps, # and since this represents a rendered bitmap, we CAN use # copybits IF we create a new temporary toplevel to hold the beast. - # if this is too ugly, change the option! + # If this is too ugly, change the option! + if { [ info exist option(use_copybits) ] } { set firstcase $option(use_copybits) } else { @@ -707,7 +712,7 @@ namespace eval ::tk::print { return $color } - # Initialize all the variables once + # Initialize all the variables once. _init_print_canvas } #end win32 procedures diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 0c53112..8bc98a4 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1692,7 +1692,7 @@ int GdiText( argv++; if ( argc > 0 ) sizerect.right += atol(argv[0]); - /* If a width is specified, break at words.. */ + /* If a width is specified, break at words. */ format_flags |= DT_WORDBREAK; } else if ( strcmp(argv[0], "-single") == 0 ) @@ -3112,7 +3112,7 @@ static int GdiFreeBrush( * Functions have removed reliance on X and Tk libraries, * as well as removing the need for TkWindows. * GdiGetColor is a copy of a TkpGetColor from tkWinColor.c - * GdiParseColor is a copy of XParseColor from xcolors.c + * GdiParseColor is a copy of XParseColor from xcolors.c */ typedef struct { const char *name; @@ -4926,12 +4926,6 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; if (PrintDlg(&pd) == TRUE) { - /*Set device context here for all GDI printing operations.*/ - printDC = pd.hDC; - if (printDC = NULL) { - Tcl_AppendResult(interp, "can't allocate printer DC", NULL); - return TCL_ERROR; - } /*Get document info.*/ ZeroMemory( &di, sizeof(di)); @@ -4962,6 +4956,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_height = (int) localDevmode->dmPaperLength / 0.254; /*Convert to logical points.*/ paper_width = (int) localDevmode->dmPaperWidth / 0.254; /* Convert to logical points.*/ copies = pd.nCopies; + /*Set device context here for all GDI printing operations.*/ printDC = CreateDC( "WINSPOOL", printerName, -- cgit v0.12 From 061998017160f3222980a159b2b8fe9acd6cd6d7 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 22 May 2021 02:09:11 +0000 Subject: Test mapping to tk namespace --- library/print.tcl | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 53 insertions(+), 5 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 19b650c..36d11e1 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -1,7 +1,8 @@ # print.tcl -- -# This file defines the 'tk print' command for printing of the canvas widget and text on X11, Windows, and macOS. It implements an abstraction layer that -# presents a consistent API across the three platforms. +# This file defines the 'tk print' command for printing of the canvas +# widget and text on X11, Windows, and macOS. It implements an abstraction +# layer that presents a consistent API across the three platforms. # Copyright © 2009 Michael I. Schwartz. # Copyright © 2021 Kevin Walzer/WordTech Communications LLC. @@ -26,8 +27,8 @@ namespace eval ::tk::print { variable printargs array set printargs {} - # Multiple utility procedures for printing text based on the C printer - # primitives. + # Multiple utility procedures for printing text based on the + # C printer primitives. # _set_dc: # Select printer and set device context and other parameters @@ -715,6 +716,53 @@ namespace eval ::tk::print { # Initialize all the variables once. _init_print_canvas } - #end win32 procedures + #end win32 procedures + + namespace export canvas text + namespace ensemble create } + +# tk print -- +# This procedure prints the canvas and text widgets using platform- +# native API's. +# +# Subcommands: +# +# canvas - Print the display of a canvas widget. +# Arguments: +# w: Widget to print. +# +# text - Print the display of a text widget. +# Arguments: +# w: Widget to print. + + +proc ::tk::print::canvas {w} { + + if {[tk windowingsystem] eq "win32"} { + ::tk::print::_print_widget $w 0 "Tk Print Output" + } +} + + +proc ::tk::print::text {w} { + + if {[tk windowingsystem] eq "win32"} { + set txt [$w get 1.0 end] + set tmpfile [file join $env(TMPDIR) print_txt.txt] + set print_txt [open $tmpfile w] + puts $txt $print_txt + close $print_txt + ::tk::print::_print_file $tmpfile 1 {Arial 12} + } +} + +#Add this command to the tk command ensemble: tk print +#Thanks to Christian Gollwitzer for the guidance here +namespace ensemble configure tk -map \ + [dict merge [namespace ensemble configure tk -map] \ + {print ::tk::print}] + + + -- cgit v0.12 From 31dee897d0a63e144a8d8076521a899d0e1589e7 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 22 May 2021 02:37:03 +0000 Subject: tk print commands now work in tk ensemble on Windows --- library/print.tcl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 36d11e1..7d9cc39 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -750,11 +750,11 @@ proc ::tk::print::text {w} { if {[tk windowingsystem] eq "win32"} { set txt [$w get 1.0 end] - set tmpfile [file join $env(TMPDIR) print_txt.txt] - set print_txt [open $tmpfile w] - puts $txt $print_txt + set x [file join $::env(TEMP) tk_output.txt] + set print_txt [open $x w] + puts $print_txt $txt close $print_txt - ::tk::print::_print_file $tmpfile 1 {Arial 12} + ::tk::print::_print_file $x 1 {Arial 12} } } -- cgit v0.12 From 91cded51ce00d77dba21a22d68dd27b2b93b8f65 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 22 May 2021 13:40:06 +0000 Subject: Remove tkWinPrint.c and all traces from branch - code previously migrated to tkWinGDI.c --- win/tkWinInt.h | 2 +- win/tkWinPrint.c | 404 ------------------------------------------------------- 2 files changed, 1 insertion(+), 405 deletions(-) delete mode 100644 win/tkWinPrint.c diff --git a/win/tkWinInt.h b/win/tkWinInt.h index 702a574..fdde189 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.h @@ -222,7 +222,7 @@ MODULE_SCOPE void TkSetCursorPos(int x, int y); MODULE_SCOPE int WinIcoInit (Tcl_Interp* interp); /* - * The following is implemented in tkWinPrint.c + * The following is implemented in tkWinGDI.c */ MODULE_SCOPE int Winprint_Init(Tcl_Interp* interp); diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c deleted file mode 100644 index ed193f4..0000000 --- a/win/tkWinPrint.c +++ /dev/null @@ -1,404 +0,0 @@ -/* - * tkWinPrint.c -- - * - * This module implements Win32 printer access. - * - * Copyright © 1998-2019 Harald Oehlmann, Elmicron GmbH - * Copyright © 2009 Michael I. Schwartz. - * Copyright © 2018 Microsoft Corporation. - * Copyright © 2021 Kevin Walzer/WordTech Communications LLC. - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#include -#include -#include -#include -#include -#include -#include "tkWinInt.h" -#include -#include -#include - -/* Initialize variables for later use. */ -static PRINTDLG pd; -static DOCINFO di; -int copies, paper_width, paper_height, dpi_x, dpi_y; -char *localPrinterName; -PDEVMODE returnedDevmode; -PDEVMODE localDevmode; -static HDC hDC; - -/* - * Prototypes for functions used only in this file. - */ - -static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -HDC get_hdc(void); -int Winprint_Init(Tcl_Interp * interp); - -/*---------------------------------------------------------------------- - * - * PrintSelectPrinter-- - * - * Main dialog for selecting printer and initializing data for print job. - * - * Results: - * Printer selected. - * - *---------------------------------------------------------------------- - */ - -static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) -{ - - (void) clientData; - (void) argc; - (void) objv; - - returnedDevmode = NULL; - localDevmode = NULL; - localPrinterName = NULL; - copies = 0; - paper_width = 0; - paper_height = 0; - dpi_x = 0; - dpi_y = 0; - - /* Set up print dialog and initalize property structure. */ - - ZeroMemory( &pd, sizeof(pd)); - pd.lStructSize = sizeof(pd); - pd.hwndOwner = GetDesktopWindow(); - pd.Flags = PD_RETURNDC | PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; - - if (PrintDlg(&pd) == TRUE) { - hDC = pd.hDC; - if (hDC = NULL) { - Tcl_AppendResult(interp, "can't allocate printer DC", NULL); - return TCL_ERROR; - } - - /*Get document info.*/ - ZeroMemory( &di, sizeof(di)); - di.cbSize = sizeof(di); - di.lpszDocName = "Tk Print Output"; - - - /* Copy print attributes to local structure. */ - returnedDevmode = (PDEVMODE)GlobalLock(pd.hDevMode); - localDevmode = (LPDEVMODE)HeapAlloc(GetProcessHeap(), - HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, - returnedDevmode->dmSize); - - if (localDevmode !=NULL) - { - memcpy((LPVOID)localDevmode, - (LPVOID)returnedDevmode, - returnedDevmode->dmSize); - - /* Get values from user-set and built-in properties. */ - localPrinterName = (char*) localDevmode->dmDeviceName; - dpi_y = localDevmode->dmYResolution; - dpi_x = localDevmode->dmPrintQuality; - paper_height = (int) localDevmode->dmPaperLength; - paper_width = (int) localDevmode->dmPaperWidth; - copies = pd.nCopies; - } - else - { - localDevmode = NULL; - } - if (pd.hDevMode !=NULL) - { - GlobalFree(pd.hDevMode); - } - } - - - /* - * Store print properties and link variables - * so they can be accessed from script level. - */ - - char *varlink1 = Tcl_Alloc(100 * sizeof(char)); - char **varlink2 = (char **)Tcl_Alloc(sizeof(char *)); - *varlink2 = varlink1; - strcpy (varlink1, localPrinterName); - - Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::dpi_x", (char *)&dpi_x, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); - - return TCL_OK; -} - -/* - * -------------------------------------------------------------------------- - * - * PrintOpenPrinter-- - * - * Open the given printer. - * - * Results: - * Opens the selected printer. - * - * ------------------------------------------------------------------------- - */ - -int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) -{ - (void) clientData; - - if (argc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "printer"); - return TCL_ERROR; - } - - char *printer = Tcl_GetString(objv[2]); - if (hDC == NULL) { - return TCL_ERROR; - } - OpenPrinter(printer, &hDC, NULL); - return TCL_OK; -} - -/* - * -------------------------------------------------------------------------- - * - * PrintClosePrinter-- - * - * Closes the given printer. - * - * Results: - * Printer closed. - * - * ------------------------------------------------------------------------- - */ - -int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) -{ - (void) clientData; - (void) argc; - (void) objv; - - ClosePrinter(hDC); - return TCL_OK; -} - -/* - * -------------------------------------------------------------------------- - * - * PrintOpenDoc-- - * - * Opens the document for printing. - * - * Results: - * Opens the print document. - * - * ------------------------------------------------------------------------- - */ - -int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) -{ - - (void) clientData; - (void) argc; - (void) objv; - - int output = 0; - - if (hDC == NULL) { - return TCL_ERROR; - } - - /* - * Start printing. - */ - output = StartDoc(hDC, &di); - if (output <= 0) { - Tcl_AppendResult(interp, "unable to start document", NULL); - return TCL_ERROR; - } - - return TCL_OK; -} - -/* - * -------------------------------------------------------------------------- - * - * PrintCloseDoc-- - * - * Closes the document for printing. - * - * Results: - * Closes the print document. - * - * ------------------------------------------------------------------------- - */ - - -int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) -{ - - (void) clientData; - (void) argc; - (void) objv; - - if ( EndDoc(hDC) <= 0) { - return TCL_ERROR; - } - return TCL_OK; -} - -/* - * -------------------------------------------------------------------------- - * - * PrintOpenPage-- - * - * Opens a page for printing. - * - * Results: - * Opens the print page. - * - * ------------------------------------------------------------------------- - */ - -int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) -{ - - (void) clientData; - (void) argc; - (void) objv; - - /*Start an individual page.*/ - if ( StartPage(hDC) <= 0) { - Tcl_AppendResult(interp, "unable to start page", NULL); - return TCL_ERROR; - } - - return TCL_OK; -} - -/* - * -------------------------------------------------------------------------- - * - * PrintClosePage-- - * - * Closes the printed page. - * - * Results: - * Closes the page. - * - * ------------------------------------------------------------------------- - */ - -int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) -{ - - (void) clientData; - (void) argc; - (void) objv; - - if ( EndPage(hDC) <= 0) { - return TCL_ERROR; - } - return TCL_OK; -} - - -/* - * -------------------------------------------------------------------------- - * - * PrintGetHDC-- - * - * Gets the device context for the printer. - * - * Results: - * Returns HDC. - * - * ------------------------------------------------------------------------- - */ - -int PrintGetHDC(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) -{ - - (void) clientData; - (void) argc; - (void) objv; - - - if ( hDC == NULL) { - return TCL_ERROR; - } - - get_hdc(); - return TCL_OK; -} - -/* - * -------------------------------------------------------------------------- - * - * get_hdc-- - * - * Gets the device context for the printer. - * - * Results: - * Returns HDC. - * - * ------------------------------------------------------------------------- - */ - - -HDC get_hdc(void) { - - return hDC; - -} - -/* - * -------------------------------------------------------------------------- - * - * Winprint_Init-- - * - * Initializes printing module on Windows. - * - * Results: - * Module initialized. - * - * ------------------------------------------------------------------------- - */ - -int Winprint_Init(Tcl_Interp * interp) -{ - Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_openprinter", PrintOpenPrinter, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_closeprinter", PrintClosePrinter, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_opendoc", PrintOpenDoc, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_closedoc", PrintCloseDoc, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_openpage", PrintOpenPage, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_closepage", PrintClosePage, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_gethdc", PrintGetHDC, NULL, NULL); - return TCL_OK; -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ -- cgit v0.12 From 9527c3e096726a18167d4b2bc06aefed9424c1aa Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 23 May 2021 01:20:41 +0000 Subject: WIP on widget demo --- library/demos/widget | 3 +++ 1 file changed, 3 insertions(+) diff --git a/library/demos/widget b/library/demos/widget index 39e4dc5..d2c8834 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -388,6 +388,9 @@ addFormattedText { @@demo fontchoose Font selection dialog @@new @@demo systray System tray icon and notification + + @@new + @@demo print Printing from canvas and text widgets @@subtitle Animation @@demo anilabel Animated labels -- cgit v0.12 From a327016f886dab6a6fc066ead899d25c4234ff3f Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 23 May 2021 01:43:16 +0000 Subject: Add print demo --- library/demos/print.tcl | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 library/demos/print.tcl diff --git a/library/demos/print.tcl b/library/demos/print.tcl new file mode 100644 index 0000000..8ca4e37 --- /dev/null +++ b/library/demos/print.tcl @@ -0,0 +1,47 @@ +# print.tcl -- +# +# This demonstration script showcases the tk print commands. +# + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .print +destroy $w +toplevel $w +wm title $w "Printing Demonstration" +positionWindow $w + +pack [label $w.l -text "This demonstration showcases + the tk print command. Clicking the buttons below + print the data from the canvas and text widgets + using platform-native dialogs."] -side top + +pack [frame $w.m] -fill both -expand yes -side top + +set c [canvas $w.m.c -bg white] +pack $c -fill both -expand no -side left + +$c create rectangle 10 10 200 50 -fill blue -outline black +$c create oval 10 60 200 110 -fill green +$c create text 110 120 -anchor n -font {Helvetica 12} \ + -text "A short demo of simple canvas elements." + +set txt { +Tcl, or Tool Command Language, is an open-source multi-purpose C library which includes a powerful dynamic scripting language. Together they provide ideal cross-platform development environment for any programming project. It has served for decades as an essential system component in organizations ranging from NASA to Cisco Systems, is a must-know language in the fields of EDA, and powers companies such as FlightAware and F5 Networks. + +Tcl is fit for both the smallest and largest programming tasks, obviating the need to decide whether it is overkill for a given job or whether a system written in Tcl will scale up as needed. Wherever a shell script might be used Tcl is a better choice, and entire web ecosystems and mission-critical control and testing systems have also been written in Tcl. Tcl excels in all these roles due to the minimal syntax of the language, the unique programming paradigm exposed at the script level, and the careful engineering that has gone into the design of the Tcl internals. +} + +set t [text $w.m.t -wrap word] +pack $t -side right -fill both -expand no +$t insert end $txt + +pack [frame $w.f] -side top -fill both -expand no +pack [button $w.f.b -text "Print Canvas" -command [list tk print canvas $w.c]] -expand no +pack [button $w.f.x -text "Print Text" -command [list tk print text $w.t]] -expand no + +## See Code / Dismiss buttons +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x + -- cgit v0.12 From 9c156a8ee53daeaa404076997c8d4fc1d2189608 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 23 May 2021 14:45:43 +0000 Subject: More work on widget demo --- library/demos/widget | 77 ++-------------------------------------------------- library/print.tcl | 10 +++++++ 2 files changed, 13 insertions(+), 74 deletions(-) diff --git a/library/demos/widget b/library/demos/widget index d2c8834..04d215b 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -644,82 +644,11 @@ proc showCode w { # file - Name of the original file (implicitly for title) proc printCode {w file} { - set code [$w get 1.0 end-1c] - - set dir "." - if {[info exists ::env(HOME)]} { - set dir "$::env(HOME)" - } - if {[info exists ::env(TMP)]} { - set dir $::env(TMP) - } - if {[info exists ::env(TEMP)]} { - set dir $::env(TEMP) - } - - set filename [file join $dir "tkdemo-$file"] - set outfile [open $filename "w"] - puts $outfile $code - close $outfile - - switch -- $::tcl_platform(platform) { - unix { - if {[catch {exec lp -c $filename} msg]} { - tk_messageBox -title "Print spooling failure" \ - -message "Print spooling probably failed: $msg" - } - } - windows { - if {[catch {PrintTextWin32 $filename} msg]} { - tk_messageBox -title "Print spooling failure" \ - -message "Print spooling probably failed: $msg" - } - } - default { - tk_messageBox -title "Operation not Implemented" \ - -message "Wow! Unknown platform: $::tcl_platform(platform)" - } - } - # - # Be careful to throw away the temporary file in a gentle manner ... - # - if {[file exists $filename]} { - catch {file delete $filename} - } -} - -# PrintTextWin32 -- -# Print a file under Windows using all the "intelligence" necessary -# -# Arguments: -# filename - Name of the file -# -# Note: -# Taken from the Wiki page by Keith Vetter, "Printing text files under -# Windows". -# Note: -# Do not execute the command in the background: that way we can dispose of the -# file smoothly. -# -proc PrintTextWin32 {filename} { - package require registry - set app [auto_execok notepad.exe] - set pcmd "$app /p %1" - catch { - set app [registry get {HKEY_CLASSES_ROOT\.txt} {}] - set pcmd [registry get \ - {HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}] - } - - regsub -all {%1} $pcmd $filename pcmd - puts $pcmd - - regsub -all {\\} $pcmd {\\\\} pcmd - set command "[auto_execok start] /min $pcmd" - eval exec $command + tk print text $w + } - + # tkAboutDialog -- # # Pops up a message box with an "about" message diff --git a/library/print.tcl b/library/print.tcl index 1a049e2..bea590a 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -740,6 +740,11 @@ namespace eval ::tk::print { proc ::tk::print::canvas {w} { + if {[winfo class $w] ne "Canvas"} { + error "Tk only supports printing from canvas and text widgets." + return + } + if {[tk windowingsystem] eq "win32"} { ::tk::print::_print_widget $w 0 "Tk Print Output" } @@ -748,6 +753,11 @@ proc ::tk::print::canvas {w} { proc ::tk::print::text {w} { + if {[winfo class $w] ne "Text"} { + error "Tk only supports printing from canvas and text widgets." + return + } + if {[tk windowingsystem] eq "win32"} { set txt [$w get 1.0 end] set x [file join $::env(TEMP) tk_output.txt] -- cgit v0.12 From d17388ea3a1cb8c226a9432120c92df0ebc4d4e7 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 23 May 2021 15:00:29 +0000 Subject: Add image to demo --- library/demos/print.tcl | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/library/demos/print.tcl b/library/demos/print.tcl index 8ca4e37..bdfd8f7 100644 --- a/library/demos/print.tcl +++ b/library/demos/print.tcl @@ -13,6 +13,10 @@ toplevel $w wm title $w "Printing Demonstration" positionWindow $w +image create photo logo -data {R0lGODlhMABLAPUAAP//////zP//mf//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz//8zM/8zMzMyZzMyZmcyZZsyZAMxmZsxmM8xmAMwzM8wzAJnMzJmZzJmZmZlmmZlmZplmM5kzZpkzM5kzAGaZzGZmzGZmmWYzZmYzMzNmzDNmmTMzmTMzZgAzmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+BSAtZGwtACH5BAEKAAIALAAAAAAwAEsAAAb+QIFwSCwahY9HRMI8Op/JJVNSqVqv2OvjyRU8slbIJGwYg60S5ZR6jRi/4ITBOhkYIOd8dltEnAdmFQMJeoVXCEd/VnKGjRVOZ3NVgHlsjpBxVRCEYBIEAAARl4lgZmVgEQAKFx8Mo0ZnpqgAFyi2JqKGmGebWRIAILbCIo27cYFWASTCtievRXqSVwQfzLYeeYESxlnSVRIW1igjWHJmjBXbpKXeFQTizlh1eJNVHbYf0LGc39XW2PIoVZE0whasWPSqFBBHrkKEA3QG0DFTEMXBUsjCWesg4oMFAGwgtKsiwqA+jGiCiRPGAM6pLCVLGKHQ6EGJlc0IuDxzAgX+CCOW9DjAaUsEyAoT+GHpeSRoHgxEUWgAUEUpFhMWgTbKEPUBAU15TBZxekYD0RMEqCDLIpYIWTAcmGEd9rWQBxQyjeQqdK/ZTWEO3mK5l+9No75SrcHhm9WwnlzNoA5zdM+JHz0HCPQdUauZowoFnSw+c2CBvw6dUXT4LMKE6EIHUqMexgCiIREknOwl7Q+FhNQoLuzOc6Kw3kIIVOLqjYKBYCwinmgo9CBEswfMAziK7mRDoQhcUZxwoBKFibq3n3jXI0GyCPLC0DrS8GR1oaEoRBRYVhT99/qG4DcCA/yNU4Ajbjhhnx4P2DJggR3YZog6RyyYxwM9PSgMBaP+sQdgIRL0JAKBwnTooRMAFWLdiPyJ8JwvTnyQoh5midCASh149ZkTIFAmHnzOZOBfIU6U4Mhd4zF34DNEoDAhARGY50BvJkioyxFOGkKAShGkFsJwejiR5Xf8aZAaBp89coQJjuDXAQOApekEm45ANaAtIbyYxREf0OlICCK841uaahZBQjyfjXCACYjuaASjhFagRKSFNtloHg+hYWIxRohnBQWCSSAhBVZ+hkgRnlbxwJIVgIqGlaU6wkeTxHxjm6gVLImrFbHWVEQ1taZjWxJX7KqqnqgUEUxDwtqajrOaRkqhEDcxWwECbEjxTYe9gojqOJQ6JO231ob72bSqAjh4RgfsjiDCCfDCK8K8I9TL7r33nvGtCO7CO1dUAONk3LcBFxzwwEMwZ/DC4iAsRIE+CWNCbzeV8FfEtoDwVwnlacxMkcKQYIE/F5TQ2QcedUZCagyc3NsFGrXVZMipWVBCzKv4Q0JvCviDsjAwf4ylxBeX0KcwGs81ccgqGS3MBxc3RjDDVAvdBRcfeFy1MFd3bcQHJEQdlddkP5E1Cf9yXfbaV2d9RBAAOw== +} + + pack [label $w.l -text "This demonstration showcases the tk print command. Clicking the buttons below print the data from the canvas and text widgets @@ -25,7 +29,8 @@ pack $c -fill both -expand no -side left $c create rectangle 10 10 200 50 -fill blue -outline black $c create oval 10 60 200 110 -fill green -$c create text 110 120 -anchor n -font {Helvetica 12} \ +$c create image 110 150 -image logo +$c create text 210 220 -anchor n -font {Helvetica 12} \ -text "A short demo of simple canvas elements." set txt { -- cgit v0.12 From 382e1b53c68fea20896abe6be422ee5003592a1a Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 24 May 2021 02:15:29 +0000 Subject: Integration of new printing API and widget demo complete for win32; next up: documentation/man page, then macOS and X11 implementations --- library/demos/print.tcl | 13 +++++++------ library/print.tcl | 44 +------------------------------------------- 2 files changed, 8 insertions(+), 49 deletions(-) diff --git a/library/demos/print.tcl b/library/demos/print.tcl index bdfd8f7..cb3c3a9 100644 --- a/library/demos/print.tcl +++ b/library/demos/print.tcl @@ -27,10 +27,10 @@ pack [frame $w.m] -fill both -expand yes -side top set c [canvas $w.m.c -bg white] pack $c -fill both -expand no -side left -$c create rectangle 10 10 200 50 -fill blue -outline black -$c create oval 10 60 200 110 -fill green -$c create image 110 150 -image logo -$c create text 210 220 -anchor n -font {Helvetica 12} \ +$c create rectangle 30 10 200 50 -fill blue -outline black +$c create oval 30 60 200 110 -fill green +$c create image 130 150 -image logo +$c create text 150 250 -anchor n -font {Helvetica 12} \ -text "A short demo of simple canvas elements." set txt { @@ -44,9 +44,10 @@ pack $t -side right -fill both -expand no $t insert end $txt pack [frame $w.f] -side top -fill both -expand no -pack [button $w.f.b -text "Print Canvas" -command [list tk print canvas $w.c]] -expand no -pack [button $w.f.x -text "Print Text" -command [list tk print text $w.t]] -expand no +pack [button $w.f.b -text "Print Canvas" -command [list tk print canvas $w.m.c]] -expand no +pack [button $w.f.x -text "Print Text" -command [list tk print text $w.m.t]] -expand no ## See Code / Dismiss buttons pack [addSeeDismiss $w.buttons $w] -side bottom -fill x + diff --git a/library/print.tcl b/library/print.tcl index bea590a..082106d 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -218,7 +218,6 @@ namespace eval ::tk::print { array get printargs - set option(use_copybits) 1 set vtgPrint(printer.bg) white } @@ -393,8 +392,6 @@ namespace eval ::tk::print { } } - - # _print_canvas.arc # Prints a arc item. # Args: @@ -603,39 +600,10 @@ namespace eval ::tk::print { set anchor [ $cw itemcget $id -anchor ] set coords [ $cw coords $id ] - - # Since the GDI commands don't yet support images and bitmaps, - # and since this represents a rendered bitmap, we CAN use - # copybits IF we create a new temporary toplevel to hold the beast. - # If this is too ugly, change the option! - - if { [ info exist option(use_copybits) ] } { - set firstcase $option(use_copybits) - } else { - set firstcase 0 - } - - if { $firstcase > 0 } { - set tl [toplevel .tmptop[expr int( rand() * 65535 ) ] -height $hgt -width $wid -background $vtgPrint(printer.bg) ] - canvas $tl.canvas -width $wid -height $hgt - $tl.canvas create image 0 0 -image $imagename -anchor nw - pack $tl.canvas -side left -expand false -fill none - tkwait visibility $tl.canvas - update - #set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] - #set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] - set srccoords [ list "0 0 $wid $hgt" ] - set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] $wid $hgt" ] - set cmmd "::tk::print::_gdi copybits $printargs(hDC) -window $tl -client -source $srccoords -destination $dstcoords " + set cmmd "::tk::print::_gdi photo $printargs(hDC) -destination [list $coords] -photo $imagename " eval $cmmd - destroy $tl - } else { - set cmmd "::tk::print::_gdi image $printargs(hDC) $coords -anchor $anchor -image $imagename " - eval $cmmd - } } - # _print_canvas.bitmap # Prints a bitmap item. # Arguments: @@ -740,11 +708,6 @@ namespace eval ::tk::print { proc ::tk::print::canvas {w} { - if {[winfo class $w] ne "Canvas"} { - error "Tk only supports printing from canvas and text widgets." - return - } - if {[tk windowingsystem] eq "win32"} { ::tk::print::_print_widget $w 0 "Tk Print Output" } @@ -753,11 +716,6 @@ proc ::tk::print::canvas {w} { proc ::tk::print::text {w} { - if {[winfo class $w] ne "Text"} { - error "Tk only supports printing from canvas and text widgets." - return - } - if {[tk windowingsystem] eq "win32"} { set txt [$w get 1.0 end] set x [file join $::env(TEMP) tk_output.txt] -- cgit v0.12 From 7e42568264f229b6a9fa25dd2bce5c059f5670c0 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 24 May 2021 16:03:43 +0000 Subject: Initial draft of print man page --- doc/print.n | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 doc/print.n diff --git a/doc/print.n b/doc/print.n new file mode 100644 index 0000000..5e4854e --- /dev/null +++ b/doc/print.n @@ -0,0 +1,36 @@ +.\" Text automatically generated by txt2man +'\" +'\" Copyright (c) 2021 Kevin Walzer/WordTech Communications LLC. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +.TH tk print n "" Tk "Tk Built-in Commands" +.so man.macros +.SH NAME +print \- Print canvas and text widgets using native API's. +.SH SYNOPSIS + +\fBtk print\fR \fIcanvas\fR \fIwindow\fR + +\fBtk print\fR \fItext\fR \fIwindow\fR +.BE +.SH DESCRIPTION +.PP +The \fBtk print\fR command allows users to print output from +the \fBcanvas\fR and \fBtext\fR widgets using platform-native API's and +dialogs. +.TP +The \fBcanvas\fR widget has long supported PostScript export and both PostScript and text files can be sent directly to a printer on Unix-like systems using the "lp" or "lpr" commands, and the \fBtk print\fR command does not supersede that functionality; it builds on it. The \fBtk print\fR command is a fuller implementation that uses native dialogs on macOS and Windows, and a Tk-based dialog that provides parallel functionality on X11. +.SH PLATFORM NOTES +.TP +\fBWindows\fR +.PP +The Windows implementation is based on the GDI (Graphics Device Interface) +API. Because there are slight differences in how GDI and Tk's \fBcanvas\fR +widget display graphics, printed output from the \fBcanvas\fR on Windows +may not be identical to screen rendering. +. +.SH KEYWORDS +print, output, graphics, text, canvas + -- cgit v0.12 From b92547b9cbb348cfe8ad4d011d0f3317b620af84 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 31 May 2021 15:05:15 +0000 Subject: Merge trunk, remove additional merge conflicts --- .github/workflows/mac-build.yml | 7 ------- tests/tk.test | 8 -------- win/makefile.vc | 14 -------------- win/tcl.m4 | 1 - win/tkWinInit.c | 9 +-------- 5 files changed, 1 insertion(+), 38 deletions(-) diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index a9427e0..a14af01 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -67,17 +67,10 @@ jobs: touch tkStubInit.c mkdir "$HOME/install dir" echo "USE_XVFB=$SET_DISPLAY" >> $GITHUB_ENV -<<<<<<< BEGIN MERGE CONFLICT: local copy shown first <<<<<<<<<<<<<<< working-directory: tk/generic env: SET_DISPLAY: ${{ contains(matrix.options, '--disable-aqua') }} - name: Add X11 (if required) -======= COMMON ANCESTOR content follows ============================ - - name: Add X11 (if required) -======= MERGED IN content follows ================================== - working-directory: tk/generic - - name: Add X11 (if required) ->>>>>>> END MERGE CONFLICT >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> if: ${{ env.USE_XVFB }} # This involves black magic run: | diff --git a/tests/tk.test b/tests/tk.test index c6f5851..58db73d 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -10,7 +10,6 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test -<<<<<<< BEGIN MERGE CONFLICT: local copy shown first <<<<<<<<<<<<<<< testConstraint testprintf [llength [info command testprintf]] testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] @@ -22,13 +21,6 @@ test tk-1.1 {tk command: general} -body { } -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"} test tk-1.2 {tk command: general} -body { tk xyz -<<<<<<< BEGIN MERGE CONFLICT: local copy shown first <<<<<<<<<<<<<<< -} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, print, scaling, sysnotify, systray, useinputmethods, or windowingsystem} -======= COMMON ANCESTOR content follows ============================ -} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, useinputmethods, or windowingsystem} -======= MERGED IN content follows ================================== -} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, sysnotify, systray, useinputmethods, or windowingsystem} ->>>>>>> END MERGE CONFLICT >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> # Value stored to restore default settings after 2.* tests set appname [tk appname] diff --git a/win/makefile.vc b/win/makefile.vc index b029d5d..68daeee 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -188,16 +188,9 @@ TKOBJS = \ $(TMP_DIR)\tkWinDraw.obj \ $(TMP_DIR)\tkWinEmbed.obj \ $(TMP_DIR)\tkWinFont.obj \ -<<<<<<< BEGIN MERGE CONFLICT: local copy shown first <<<<<<<<<<<<<<< $(TMP_DIR)\tkWinGDI.obj \ $(TMP_DIR)\tkWinIco.obj \ $(TMP_DIR)\tkWinImage.obj \ -======= COMMON ANCESTOR content follows ============================ - $(TMP_DIR)\tkWinImage.obj \ -======= MERGED IN content follows ================================== - $(TMP_DIR)\tkWinIco.obj \ - $(TMP_DIR)\tkWinImage.obj \ ->>>>>>> END MERGE CONFLICT >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> $(TMP_DIR)\tkWinInit.obj \ $(TMP_DIR)\tkWinKey.obj \ $(TMP_DIR)\tkWinMenu.obj \ @@ -367,14 +360,7 @@ CONFIG_DEFS =/DHAVE_SYS_TYPES_H=1 /DHAVE_SYS_STAT_H=1 \ PRJ_DEFINES = /DBUILD_ttk $(CONFIG_DEFS) /Dinline=__inline /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE # Additional Link libraries needed beyond those in rules.vc -<<<<<<< BEGIN MERGE CONFLICT: local copy shown first <<<<<<<<<<<<<<< PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib -======= COMMON ANCESTOR content follows ============================ -PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib - -======= MERGED IN content follows ================================== -PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib ->>>>>>> END MERGE CONFLICT >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> #--------------------------------------------------------------------- # TkTest flags diff --git a/win/tcl.m4 b/win/tcl.m4 index 023071c..7bee166 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -907,7 +907,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" fi LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib" ->>>>>>> END MERGE CONFLICT >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" SHLIB_LD_LIBS='${LIBS}' diff --git a/win/tkWinInit.c b/win/tkWinInit.c index 99c42ad..c96a963 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -42,17 +42,10 @@ TkpInit( * initialize printing and systray API's here. */ -<<<<<<< BEGIN MERGE CONFLICT: local copy shown first <<<<<<<<<<<<<<< WinIcoInit(interp); Winprint_Init(interp); - Gdi_Init(interp); + Gdi_Init(interp); TkWinXInit(Tk_GetHINSTANCE()); -======= COMMON ANCESTOR content follows ============================ - TkWinXInit(Tk_GetHINSTANCE()); -======= MERGED IN content follows ================================== - WinIcoInit(interp); - TkWinXInit(Tk_GetHINSTANCE()); ->>>>>>> END MERGE CONFLICT >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> return TCL_OK; } -- cgit v0.12 From 0eb891fc9c85b4bf6feb7741d4d6987e654d3bfd Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 1 Jun 2021 02:20:57 +0000 Subject: Re-work macOS sysnotify implementation to remove code-signing requirement and multiple API's --- doc/sysnotify.n | 21 +-- macosx/tkMacOSXSysTray.c | 410 ++--------------------------------------------- 2 files changed, 13 insertions(+), 418 deletions(-) diff --git a/doc/sysnotify.n b/doc/sysnotify.n index 8951cf0..e375c7a 100644 --- a/doc/sysnotify.n +++ b/doc/sysnotify.n @@ -32,25 +32,8 @@ accompany the text. .TP \fBmacOS\fR . -The macOS version embeds two separate under-the-hood implementations -using different notification APIs. The choice of which one to use -depends on which version of the OS is being run and the state of the -Tk application code. The newer API, introduced in macOS 10.14, -requires that the application accessing the API be code-signed, or the -notification will not display. (A self-signed certificate seems to be -sufficient.) The older API was deprecated but not removed in macOS -11.0. Tk uses the newer API only for signed applications running on -macOS 10.14 or newer. Otherwise it falls back to the older API. A -quirk which developers should be aware of is that if an unsigned -version of Wish (or an application derived from it) is installed on -top of a signed version after the signed version has been registered -with System Preferences then neither API will be allowed to show -notifications, making Tk's automatic fallback to the older API -ineffective. To re-enable notifications the application must be -deleted from Apple's System Preferences Notifications section. (There -is no removal button, so this is done by selecting the application and -pressing the Delete key.) -. +The macOS version will request permission from the user to authorize +notifications. This must be activated in Apple's System Preferences Notifications section. .TP \fBWindows\fR . diff --git a/macosx/tkMacOSXSysTray.c b/macosx/tkMacOSXSysTray.c index a0f0829..d2ecfaf 100644 --- a/macosx/tkMacOSXSysTray.c +++ b/macosx/tkMacOSXSysTray.c @@ -19,71 +19,6 @@ #include "tkMacOSXPrivate.h" /* - * Prior to macOS 10.14 user notifications were handled by the NSApplication's - * NSUserNotificationCenter via a NSUserNotificationCenterDelegate object. - * These classes were defined in the CoreFoundation framework. In macOS 10.14 - * a separate UserNotifications framework was introduced which adds some - * additional features, including custom controls on the notification window - * but primarily a requirement that an application must be authorized before - * being allowed to post a notification. This framework uses a different - * class, the UNUserNotificationCenter, and its delegate follows a different - * protocol, named UNUserNotificationCenterDelegate. - * - * In macOS 11.0 the NSUserNotificationCenter and its delegate protocol were - * deprecated. To make matters more complicated, it turns out that there is a - * secret undocumented additional requirement that an app which is not signed - * can never be authorized to send notifications via the UNNotificationCenter. - * (As of 11.0, it appears that it is sufficient to sign the app with a - * self-signed certificate, however.) - * - * The workaround implemented here is to define two classes, TkNSNotifier and - * TkUNNotifier, each of which provides one of these protocols on macOS 10.14 - * and newer. If the TkUSNotifier is able to obtain authorization it is used. - * Otherwise, TkNSNotifier is used. Building TkNSNotifier on 11.0 or later - * produces deprecation warnings which are suppressed by enclosing the - * interface and implementation in #pragma blocks. The first time that the tk - * systray command in initialized in an interpreter an attempt is made to - * obtain authorization for sending notifications with the UNNotificationCenter - * on systems and the result is saved in a static variable. - */ - -//#define DEBUG -#ifdef DEBUG - -/* - * This macro uses the do ... while(0) trick to swallow semicolons. It logs to - * a temp file because apps launched from an icon have no stdout or stderr and - * because NSLog has a tendency to not produce any console messages at certain - * stages of launching an app. - */ - -#define DEBUG_LOG(format, ...) \ - do { \ - FILE* logfile = fopen("/tmp/tklog", "a"); \ - fprintf(logfile, format, ##__VA_ARGS__); \ - fflush(logfile); \ - fclose(logfile); } while (0) -#else -#define DEBUG_LOG(format, ...) -#endif - -#define BUILD_TARGET_HAS_NOTIFICATION (MAC_OS_X_VERSION_MAX_ALLOWED >= 101000) -#define BUILD_TARGET_HAS_UN_FRAMEWORK (MAC_OS_X_VERSION_MAX_ALLOWED >= 101400) -#if MAC_OS_X_VERSION_MAX_ALLOWED > 101500 -#define ALERT_OPTION UNNotificationPresentationOptionList | \ - UNNotificationPresentationOptionBanner -#else -#define ALERT_OPTION UNNotificationPresentationOptionAlert -#endif - -#if BUILD_TARGET_HAS_UN_FRAMEWORK -#import -static NSString *TkNotificationCategory; -#endif - -#if BUILD_TARGET_HAS_NOTIFICATION - -/* * Class declaration for TkStatusItem. */ @@ -107,97 +42,7 @@ static NSString *TkNotificationCategory; @end -/* - * Class declaration for TkNSNotifier. A TkNSNotifier object has no attributes - * but implements the NSUserNotificationCenterDelegate protocol. It also has - * one additional method which posts a user notification. There is one - * TkNSNotifier for the application, shared by all interpreters. - */ - -#pragma clang diagnostic push -#pragma clang diagnostic ignored "-Wdeprecated-declarations" -@interface TkNSNotifier: NSObject { -} - -/* - * Post a notification. - */ - -- (void) postNotificationWithTitle : (NSString *) title message: (NSString *) detail; - -/* - * The following methods comprise the NSUserNotificationCenterDelegate protocol. - */ - -- (void) userNotificationCenter:(NSUserNotificationCenter *)center - didDeliverNotification:(NSUserNotification *)notification; - -- (void) userNotificationCenter:(NSUserNotificationCenter *)center - didActivateNotification:(NSUserNotification *)notification; - -- (BOOL) userNotificationCenter:(NSUserNotificationCenter *)center - shouldPresentNotification:(NSUserNotification *)notification; - -@end -#pragma clang diagnostic pop - -/* - * The singleton instance of TkNSNotifier shared by all interpreters in this - * application. - */ - -static TkNSNotifier *NSnotifier = nil; -#if BUILD_TARGET_HAS_UN_FRAMEWORK - -/* - * Class declaration for TkUNNotifier. A TkUNNotifier object has no attributes - * but implements the UNUserNotificationCenterDelegate protocol It also has two - * additional methods. One requests authorization to post notification via the - * UserNotification framework and the other posts a user notification. There is - * at most one TkUNNotifier for the application, shared by all interpreters. - */ - -@interface TkUNNotifier: NSObject { -} - - /* - * Request authorization to post a notification. - */ - -- (void) requestAuthorization; - -/* - * Post a notification. - */ - -- (void) postNotificationWithTitle : (NSString *) title message: (NSString *) detail; - -/* - * The following methods comprise the UNNotificationCenterDelegate protocol: - */ - -- (void)userNotificationCenter:(UNUserNotificationCenter *)center - didReceiveNotificationResponse:(UNNotificationResponse *)response - withCompletionHandler:(void (^)(void))completionHandler; - -- (void)userNotificationCenter:(UNUserNotificationCenter *)center - willPresentNotification:(UNNotification *)notification - withCompletionHandler:(void (^)(UNNotificationPresentationOptions options))completionHandler; - -- (void)userNotificationCenter:(UNUserNotificationCenter *)center - openSettingsForNotification:(UNNotification *)notification; - -@end - -/* - * The singleton instance of TkUNNotifier shared by all interpeters is stored - * in this static variable. - */ - -static TkUNNotifier *UNnotifier = nil; - -#endif /* * Class declaration for TkStatusItem. A TkStatusItem represents an icon posted @@ -297,163 +142,7 @@ static TkUNNotifier *UNnotifier = nil; typedef TkStatusItem** StatusItemInfo; -#pragma clang diagnostic push -#pragma clang diagnostic ignored "-Wdeprecated-declarations" -@implementation TkNSNotifier : NSObject -- (void) postNotificationWithTitle : (NSString * ) title - message: (NSString * ) detail -{ - NSUserNotification *notification; - NSUserNotificationCenter *center; - - center = [NSUserNotificationCenter defaultUserNotificationCenter]; - notification = [[NSUserNotification alloc] init]; - notification.title = title; - notification.informativeText = detail; - notification.soundName = NSUserNotificationDefaultSoundName; - DEBUG_LOG("Sending NSNotification.\n"); - [center deliverNotification:notification]; -} - -/* - * Implementation of the NSUserNotificationDelegate protocol. - */ - -- (BOOL) userNotificationCenter: (NSUserNotificationCenter *) center - shouldPresentNotification: (NSUserNotification *)notification -{ - (void) center; - (void) notification; - - return YES; -} - -- (void) userNotificationCenter:(NSUserNotificationCenter *)center - didDeliverNotification:(NSUserNotification *)notification -{ - (void) center; - (void) notification; -} - -- (void) userNotificationCenter:(NSUserNotificationCenter *)center - didActivateNotification:(NSUserNotification *)notification -{ - (void) center; - (void) notification; -} - -@end -#pragma clang diagnostic pop - -/* - * Static variable which records whether the app is authorized to send - * notifications via the UNUserNotificationCenter. - */ - -#if BUILD_TARGET_HAS_UN_FRAMEWORK - -@implementation TkUNNotifier : NSObject - -- (void) requestAuthorization -{ - UNUserNotificationCenter *center; - UNAuthorizationOptions options = UNAuthorizationOptionAlert | - UNAuthorizationOptionSound | - UNAuthorizationOptionBadge | - UNAuthorizationOptionProvidesAppNotificationSettings; - if (![NSApp isSigned]) { - - /* - * No point in even asking. - */ - - DEBUG_LOG("Unsigned app: UNUserNotifications are not available.\n"); - return; - } - - center = [UNUserNotificationCenter currentNotificationCenter]; - [center requestAuthorizationWithOptions: options - completionHandler: ^(BOOL granted, NSError* error) - { - if (error || granted == NO) { - DEBUG_LOG("Authorization for UNUserNotifications denied\n"); - } - }]; -} - -- (void) postNotificationWithTitle: (NSString * ) title - message: (NSString * ) detail -{ - UNUserNotificationCenter *center; - UNMutableNotificationContent* content; - UNNotificationRequest *request; - center = [UNUserNotificationCenter currentNotificationCenter]; - center.delegate = (id) self; - content = [[UNMutableNotificationContent alloc] init]; - content.title = title; - content.body = detail; - content.sound = [UNNotificationSound defaultSound]; - content.categoryIdentifier = TkNotificationCategory; - request = [UNNotificationRequest - requestWithIdentifier:[[NSUUID UUID] UUIDString] - content:content - trigger:nil - ]; - [center addNotificationRequest: request - withCompletionHandler: ^(NSError* error) { - if (error) { - DEBUG_LOG("addNotificationRequest: error = %s\n", \ - [NSString stringWithFormat:@"%@", \ - error.userInfo].UTF8String); - } - }]; -} - -/* - * Implementation of the UNUserNotificationDelegate protocol. - */ - -- (void) userNotificationCenter:(UNUserNotificationCenter *)center - didReceiveNotificationResponse:(UNNotificationResponse *)response - withCompletionHandler:(void (^)(void))completionHandler -{ - /* - * Called when the user dismisses a notification. - */ - - DEBUG_LOG("didReceiveNotification\n"); - completionHandler(); -} - -- (void) userNotificationCenter:(UNUserNotificationCenter *)center - willPresentNotification:(UNNotification *)notification - withCompletionHandler:(void (^)(UNNotificationPresentationOptions options))completionHandler -{ - - /* - * This is called before presenting a notification, even when the user has - * turned off notifications. - */ - - DEBUG_LOG("willPresentNotification\n"); -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101400 - if (@available(macOS 11.0, *)) { - completionHandler(ALERT_OPTION); - } -#endif -} - -- (void) userNotificationCenter:(UNUserNotificationCenter *)center - openSettingsForNotification:(UNNotification *)notification -{ - DEBUG_LOG("openSettingsForNotification\n"); - // Does something need to be done here? -} - -@end - -#endif /* *---------------------------------------------------------------------- @@ -729,47 +418,20 @@ static int SysNotifyObjCmd( NSString *title = [NSString stringWithUTF8String: Tcl_GetString(objv[1])]; NSString *message = [NSString stringWithUTF8String: Tcl_GetString(objv[2])]; - - /* - * Update the authorization status in case the user enabled or disabled - * notifications after the app started up. - */ - -#if BUILD_TARGET_HAS_UN_FRAMEWORK - - if (UNnotifier && [NSApp isSigned]) { - UNUserNotificationCenter *center; - - center = [UNUserNotificationCenter currentNotificationCenter]; - [center getNotificationSettingsWithCompletionHandler: - ^(UNNotificationSettings *settings) - { -#if !defined(DEBUG) - (void) settings; -#endif - DEBUG_LOG("Reported authorization status is %ld\n", - settings.authorizationStatus); - }]; - } - -#endif - - if ([NSApp macOSVersion] < 101400 || ![NSApp isSigned]) { - DEBUG_LOG("Using the NSUserNotificationCenter\n"); - [NSnotifier postNotificationWithTitle : title message: message]; - } else { - -#if BUILD_TARGET_HAS_UN_FRAMEWORK - - DEBUG_LOG("Using the UNUserNotificationCenter\n"); - [UNnotifier postNotificationWithTitle : title message: message]; -#endif - } + NSMutableString *notify = [NSMutableString new]; + [notify appendString: @"display notification "]; + [notify appendString:@"\""]; + [notify appendString:message]; + [notify appendString:@"\""]; + [notify appendString:@" with title \""]; + [notify appendString:title]; + [notify appendString:@"\""]; + NSAppleScript *scpt = [[[NSAppleScript alloc] initWithSource:notify] autorelease]; + NSAppleEventDescriptor *result = [scpt executeAndReturnError:nil]; return TCL_OK; } -#endif // if BUILD_TARGET_HAS_NOTIFICATION /* *---------------------------------------------------------------------- @@ -791,73 +453,23 @@ static int SysNotifyObjCmd( *---------------------------------------------------------------------- */ -#if BUILD_TARGET_HAS_NOTIFICATION - int MacSystrayInit(Tcl_Interp *interp) { /* - * Initialize the TkStatusItem for this interpreter and, if necessary, - * the shared TkNSNotifier and TkUNNotifier. + * Initialize the TkStatusItem for this interpreter. */ StatusItemInfo info = (StatusItemInfo) ckalloc(sizeof(StatusItemInfo)); *info = 0; - if (NSnotifier == nil) { - NSnotifier = [[TkNSNotifier alloc] init]; - } - -#if BUILD_TARGET_HAS_UN_FRAMEWORK - - if (@available(macOS 10.14, *)) { - UNUserNotificationCenter *center; - UNNotificationCategory *category; - NSSet *categories; - - if (UNnotifier == nil) { - UNnotifier = [[TkUNNotifier alloc] init]; - - /* - * Request authorization to use the UserNotification framework. If - * the app code is signed and there are no notification preferences - * settings for this app, a dialog will be opened to prompt the - * user to choose settings. Note that the request is asynchronous, - * so even if the preferences setting exists the result is not - * available immediately. - */ - - [UNnotifier requestAuthorization]; - } - TkNotificationCategory = @"Basic Tk Notification"; - center = [UNUserNotificationCenter currentNotificationCenter]; - center = [UNUserNotificationCenter currentNotificationCenter]; - category = [UNNotificationCategory - categoryWithIdentifier:TkNotificationCategory - actions:@[] - intentIdentifiers:@[] - options: UNNotificationCategoryOptionNone]; - categories = [NSSet setWithObjects:category, nil]; - [center setNotificationCategories: categories]; - } -#endif - Tcl_CreateObjCommand(interp, "::tk::systray::_systray", MacSystrayObjCmd, info, (Tcl_CmdDeleteProc *)MacSystrayDestroy); Tcl_CreateObjCommand(interp, "::tk::sysnotify::_sysnotify", SysNotifyObjCmd, NULL, NULL); return TCL_OK; } -#else - -int -MacSystrayInit(TCL_UNUSED(Tcl_Interp *)) -{ - return TCL_OK; -} - -#endif // BUILD_TARGET_HAS_NOTIFICATION /* * Local Variables: -- cgit v0.12 From 7fb58e98d29359350aea04dbbd5f083a08ebdbfb Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 1 Jun 2021 12:28:49 +0000 Subject: Add comment --- macosx/tkMacOSXSysTray.c | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/macosx/tkMacOSXSysTray.c b/macosx/tkMacOSXSysTray.c index d2ecfaf..e433207 100644 --- a/macosx/tkMacOSXSysTray.c +++ b/macosx/tkMacOSXSysTray.c @@ -416,6 +416,15 @@ static int SysNotifyObjCmd( return TCL_OK; } + /* + * Using NSAppleScript API here allows us to use a single API rather + * than multiple, some deprecated, API's, and also allows notifications + * to work correctly without requiring Wish to be code-signed - an + * undocumented but apparently consistent requirement. And by calling + * NSAppleScript inline rather than shelling to out osascript, + * Wish shows correctly as the calling app rather than Script Editor. + */ + NSString *title = [NSString stringWithUTF8String: Tcl_GetString(objv[1])]; NSString *message = [NSString stringWithUTF8String: Tcl_GetString(objv[2])]; NSMutableString *notify = [NSMutableString new]; -- cgit v0.12 From 74c1b206af3d134fce5ad8fcf36b5171ce44b303 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 1 Jun 2021 21:58:36 +0000 Subject: Add some error checking --- macosx/tkMacOSXSysTray.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/macosx/tkMacOSXSysTray.c b/macosx/tkMacOSXSysTray.c index e433207..df2766c 100644 --- a/macosx/tkMacOSXSysTray.c +++ b/macosx/tkMacOSXSysTray.c @@ -436,7 +436,12 @@ static int SysNotifyObjCmd( [notify appendString:title]; [notify appendString:@"\""]; NSAppleScript *scpt = [[[NSAppleScript alloc] initWithSource:notify] autorelease]; - NSAppleEventDescriptor *result = [scpt executeAndReturnError:nil]; + NSDictionary *errorInfo; + NSAppleEventDescriptor *result = [scpt executeAndReturnError:&errorInfo]; + if (!result) { + NSLog(@"ERROR: %@", errorInfo); + return TCL_ERROR; + } return TCL_OK; } -- cgit v0.12 From 8fcfd778a5e73730893338debbb7af61049850e1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 2 Jun 2021 07:21:04 +0000 Subject: Use Wide-API in tkWinGDI.c. also make it compile with mingw-w64 --- doc/print.n | 8 +-- library/demos/widget | 4 +- win/configure | 4 +- win/tcl.m4 | 92 -------------------------------- win/tkWinGDI.c | 147 +++++++++++++++++++++------------------------------ 5 files changed, 67 insertions(+), 188 deletions(-) mode change 100644 => 100755 win/configure diff --git a/doc/print.n b/doc/print.n index 5e4854e..d6ec38c 100644 --- a/doc/print.n +++ b/doc/print.n @@ -7,7 +7,7 @@ .TH tk print n "" Tk "Tk Built-in Commands" .so man.macros -.SH NAME +.SH NAME print \- Print canvas and text widgets using native API's. .SH SYNOPSIS @@ -19,9 +19,9 @@ print \- Print canvas and text widgets using native API's. .PP The \fBtk print\fR command allows users to print output from the \fBcanvas\fR and \fBtext\fR widgets using platform-native API's and -dialogs. +dialogs. .TP -The \fBcanvas\fR widget has long supported PostScript export and both PostScript and text files can be sent directly to a printer on Unix-like systems using the "lp" or "lpr" commands, and the \fBtk print\fR command does not supersede that functionality; it builds on it. The \fBtk print\fR command is a fuller implementation that uses native dialogs on macOS and Windows, and a Tk-based dialog that provides parallel functionality on X11. +The \fBcanvas\fR widget has long supported PostScript export and both PostScript and text files can be sent directly to a printer on Unix-like systems using the "lp" or "lpr" commands, and the \fBtk print\fR command does not supersede that functionality; it builds on it. The \fBtk print\fR command is a fuller implementation that uses native dialogs on macOS and Windows, and a Tk-based dialog that provides parallel functionality on X11. .SH PLATFORM NOTES .TP \fBWindows\fR @@ -29,7 +29,7 @@ The \fBcanvas\fR widget has long supported PostScript export and both PostScript The Windows implementation is based on the GDI (Graphics Device Interface) API. Because there are slight differences in how GDI and Tk's \fBcanvas\fR widget display graphics, printed output from the \fBcanvas\fR on Windows -may not be identical to screen rendering. +may not be identical to screen rendering. . .SH KEYWORDS print, output, graphics, text, canvas diff --git a/library/demos/widget b/library/demos/widget index c7910e7..77e5066 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -643,11 +643,9 @@ proc showCode w { # file - Name of the original file (implicitly for title) proc printCode {w file} { - tk print text $w - } - + # tkAboutDialog -- # # Pops up a message box with an "about" message diff --git a/win/configure b/win/configure old mode 100644 new mode 100755 index 8ba1927..d815777 --- a/win/configure +++ b/win/configure @@ -4472,7 +4472,7 @@ printf %s "checking compiler flags... " >&6; } SHLIB_LD_LIBS='${LIBS}' LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32 -lwinspool" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -4678,7 +4678,7 @@ printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } LINKBIN="link" fi - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib" SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" SHLIB_LD_LIBS='${LIBS}' diff --git a/win/tcl.m4 b/win/tcl.m4 index 7bee166..3b3fc78 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -814,98 +814,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LINKBIN="link" fi - if test "$doWince" != "no" ; then - # Set defaults for common evc4/PPC2003 setup - # Currently Tcl requires 300+, possibly 420+ for sockets - CEVERSION=420; # could be 211 300 301 400 420 ... - TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... - ARCH=ARM; # could be ARM MIPS X86EM ... - PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" - if test "$doWince" != "yes"; then - # If !yes then the user specified something - # Reset ARCH to allow user to skip specifying it - ARCH= - eval `echo $doWince | awk -F "," '{ \ - if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \ - if ([$]1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ - if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \ - if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \ - if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \ - }'` - if test "x${ARCH}" = "x" ; then - ARCH=$TARGETCPU; - fi - fi - OSVERSION=WCE$CEVERSION; - if test "x${WCEROOT}" = "x" ; then - WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" - if test ! -d "${WCEROOT}" ; then - WCEROOT="C:/Program Files/Microsoft eMbedded Tools" - fi - fi - if test "x${SDKROOT}" = "x" ; then - SDKROOT="C:/Program Files/Windows CE Tools" - if test ! -d "${SDKROOT}" ; then - SDKROOT="C:/Windows CE Tools" - fi - fi - # The space-based-path will work for the Makefile, but will - # not work if AC_TRY_COMPILE is called. - WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` - SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` - CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` - if test ! -d "${CELIB_DIR}/inc"; then - AC_MSG_ERROR([Invalid celib directory "${CELIB_DIR}"]) - fi - if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\ - -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then - AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]]) - else - CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" - if test -d "${CEINCLUDE}/${TARGETCPU}" ; then - CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" - fi - CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" - fi - fi - - if test "$doWince" != "no" ; then - CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" - if test "${TARGETCPU}" = "X86"; then - CC="${CEBINROOT}/cl.exe" - else - CC="${CEBINROOT}/cl${ARCH}.exe" - fi - CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" - RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" - arch=`echo ${ARCH} | awk '{print tolower([$]0)}'` - defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS" - for i in $defs ; do - AC_DEFINE_UNQUOTED($i) - done -# if test "${ARCH}" = "X86EM"; then -# AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION) -# fi - AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION) - AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION) - CFLAGS_DEBUG="-nologo -Zi -Od" - CFLAGS_OPTIMIZE="-nologo -O2" - lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` - lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" - LINKBIN="\"${CEBINROOT}/link.exe\"" - AC_SUBST(CELIB_DIR) - if test "${CEVERSION}" -lt 400 ; then - LIBS="coredll.lib corelibc.lib winsock.lib" - else - LIBS="coredll.lib corelibc.lib ws2.lib" - fi - # celib currently stuck at wce300 status - #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib" - LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\"" - LIBS_GUI="commctrl.lib commdlg.lib" - else - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" - fi LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib" SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index ca22303..a99968a 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -62,7 +62,7 @@ static int TkGdiMakeBezierCurve(Tk_Canvas, double *, int, int, XPoint[], double[ /* * Helper functions. */ -static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC hDC); +static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONTW *lf, HDC hDC); static int GdiMakePen(Tcl_Interp *interp, int width, int dashstyle, const char *dashstyledata, int capstyle, @@ -89,7 +89,7 @@ static int PalEntriesOnDevice(HDC hDC); static HPALETTE GetSystemPalette(void); static void GetDisplaySize (LONG *width, LONG *height); static int GdiWordToWeight(const char *str); -static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs); +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONTW *lf, const char *str[], int numargs); static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); @@ -103,15 +103,15 @@ static const char gdi_usage_message[] = "::tk::print::_gdi [arc|characters|copyb "\thdc parameters can be generated by the printer extension"; static char msgbuf[1024]; -static PRINTDLG pd; -static DOCINFO di; +static PRINTDLGW pd; +static DOCINFOW di; int copies, paper_width, paper_height, dpi_x, dpi_y; char *localPrinterName; -LPCTSTR printerName; -LPCTSTR driver; -LPCTSTR output; -PDEVMODE returnedDevmode; -PDEVMODE localDevmode; +LPCWSTR printerName; +LPCWSTR driver; +LPCWSTR output; +PDEVMODEW returnedDevmode; +PDEVMODEW localDevmode; LPDEVNAMES devnames; HDC printDC; @@ -1467,7 +1467,7 @@ static int GdiCharWidths( */ HDC hDC; - LOGFONT lf; + LOGFONTW lf; HFONT hfont, oldfont; int made_font = 0; const char *aryvarname = "GdiCharWidths"; @@ -1493,7 +1493,7 @@ static int GdiCharWidths( argc--; argv++; if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) - if ( (hfont = CreateFontIndirect(&lf)) != NULL ) + if ( (hfont = CreateFontIndirectW(&lf)) != NULL ) { made_font = 1; oldfont = SelectObject(hDC, hfont); @@ -1515,9 +1515,9 @@ static int GdiCharWidths( /* Now, get the widths using the correct function for font type. */ - if ( (retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE ) + if ( (retval = GetCharWidth32W(hDC, 0, 255, widths)) == FALSE ) { - retval = GetCharWidth (hDC, 0, 255, widths ); + retval = GetCharWidthW(hDC, 0, 255, widths ); } /* @@ -1597,24 +1597,21 @@ int GdiText( RECT sizerect; UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas. */ Tk_Anchor anchor = 0; - LOGFONT lf; + LOGFONTW lf; HFONT hfont, oldfont; int made_font = 0; int retval; int dotextcolor=0; int dobgmode=0; - int dounicodeoutput=0; /* If non-zero, output will be drawn in Unicode. */ int bgmode; COLORREF textcolor = 0; int usesingle = 0; - const char *encoding_name = 0; + const char *encoding_name = "utf-8"; -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) TCHAR *ostring; Tcl_DString tds; Tcl_Encoding encoding = NULL; int tds_len; -#endif if ( argc >= 4 ) { @@ -1665,7 +1662,7 @@ int GdiText( argc--; argv++; if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) - if ( (hfont = CreateFontIndirect(&lf)) != NULL ) + if ( (hfont = CreateFontIndirectW(&lf)) != NULL ) { made_font = 1; oldfont = SelectObject(hDC, hfont); @@ -1701,13 +1698,6 @@ int GdiText( } else if ( strcmp(argv[0], "-backfill") == 0 ) dobgmode = 1; - else if ( strcmp(argv[0], "-unicode") == 0 ) - { - dounicodeoutput = 1; - /* Set the encoding name to utf-8, but can be overridden. */ - if ( encoding_name == 0 ) - encoding_name = "utf-8"; - } else if ( strcmp(argv[0], "-encoding") == 0 ) { argc--; argv++; @@ -1720,7 +1710,6 @@ int GdiText( argv++; } -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) /* Handle the encoding, if present. */ if ( encoding_name != 0 ) { @@ -1729,7 +1718,6 @@ int GdiText( if (tmp_encoding != NULL) encoding = tmp_encoding; } -#endif if (string == 0 ) { @@ -1746,27 +1734,17 @@ int GdiText( } /* Calculate the rectangle. */ -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) Tcl_DStringInit(&tds); Tcl_UtfToExternalDString(encoding, string, -1, &tds); ostring = Tcl_DStringValue(&tds); tds_len = Tcl_DStringLength(&tds); /* Just for fun, let's try translating ostring to Unicode. */ - if (dounicodeoutput) /* Convert UTF-8 to unicode. */ - { - Tcl_UniChar *ustring; - Tcl_DString tds2; - Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); - Tcl_DStringFree(&tds2); - } else /* Use UTF-8/local code page output. */ - { - DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); - } -#else - DrawText (hDC, string, -1, &sizerect, format_flags | DT_CALCRECT); -#endif + Tcl_UniChar *ustring; + Tcl_DString tds2; + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); + DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); + Tcl_DStringFree(&tds2); /* Adjust the rectangle according to the anchor. */ x = y = 0; @@ -1819,24 +1797,11 @@ int GdiText( /* Print the text. */ -#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1 ) - if (dounicodeoutput) /* Convert UTF-8 to unicode. */ - { - Tcl_UniChar *ustring; - Tcl_DString tds2; - Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); - Tcl_DStringFree(&tds2); - } - else - { - retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); - } + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); + retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); + Tcl_DStringFree(&tds2); Tcl_DStringFree(&tds); -#else - retval = DrawText (hDC, string, -1, &sizerect, format_flags); -#endif /* Get the color set back. */ if ( dotextcolor ) @@ -2318,7 +2283,7 @@ static int GdiCopyBits ( else { /* Use strtoul() so octal or hex representations will be parsed. */ - wnd = (HWND)strtoul(argv[++k], &strend, 0); + wnd = (HWND)INT2PTR(strtoul(argv[++k], &strend, 0)); if ( strend == 0 || strend == argv[k] ) { sprintf(msgbuf, "Can't understand window id %s", argv[k]); @@ -2681,7 +2646,7 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) static int GdiParseFontWords( TCL_UNUSED(Tcl_Interp *), - LOGFONT *lf, + LOGFONTW *lf, const char *str[], int numargs) { @@ -2777,7 +2742,7 @@ static int GdiWordToWeight(const char *str) *---------------------------------------------------------------------- */ -static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC hDC) +static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONTW *lf, HDC hDC) { const char **list; int count; @@ -2796,10 +2761,14 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONT *lf, HDC return 0; /* Now we have the font structure broken into name, size, weight. */ - if ( count >= 1 ) - strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); - else + if ( count >= 1 ) { + Tcl_DString ds; + Tcl_DStringInit(&ds); + wcsncpy(lf->lfFaceName, Tcl_UtfToWCharDString(list[0], -1, &ds), sizeof(lf->lfFaceName) - 1); + Tcl_DStringFree(&ds); + } else { return 0; + } if ( count >= 2 ) { @@ -4163,7 +4132,7 @@ static void GetDisplaySize (LONG *width, LONG *height) { HDC hDC; - hDC = CreateDC("DISPLAY", 0, 0, 0); + hDC = CreateDCW(L"DISPLAY", 0, 0, 0); *width = GetDeviceCaps (hDC, HORZRES); *height = GetDeviceCaps (hDC, VERTRES); DeleteDC(hDC); @@ -4201,7 +4170,7 @@ static HBITMAP CopyScreenToBitmap(LPRECT lpRect) * a memory DC compatible to screen DC. */ - hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL); + hScrDC = CreateDCW(L"DISPLAY", NULL, NULL, NULL); hMemDC = CreateCompatibleDC(hScrDC); /* Get points of rectangle to grab. */ @@ -4287,7 +4256,7 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) /* Fill in BITMAP structure, return NULL if it didn't work. */ - if (!GetObject(hBitmap, sizeof(bm), (LPSTR)&bm)) + if (!GetObjectW(hBitmap, sizeof(bm), (LPWSTR)&bm)) return NULL; /* Ff no palette is specified, use default palette. */ @@ -4903,7 +4872,6 @@ TkGdiMakeBezierCurve( static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) { - (void) clientData; (void) argc; (void) objv; @@ -4925,21 +4893,21 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg pd.hwndOwner = GetDesktopWindow(); pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; - if (PrintDlg(&pd) == TRUE) { + if (PrintDlgW(&pd) == TRUE) { /*Get document info.*/ ZeroMemory( &di, sizeof(di)); di.cbSize = sizeof(di); - di.lpszDocName = "Tk Print Output"; + di.lpszDocName = L"Tk Print Output"; /* Copy print attributes to local structure. */ - returnedDevmode = (PDEVMODE)GlobalLock(pd.hDevMode); + returnedDevmode = (PDEVMODEW)GlobalLock(pd.hDevMode); devnames = (LPDEVNAMES)GlobalLock(pd.hDevNames); - printerName = (LPCTSTR)devnames + devnames->wDeviceOffset; - driver = (LPCTSTR)devnames + devnames->wDriverOffset; - output = (LPCTSTR)devnames + devnames->wOutputOffset; - localDevmode = (LPDEVMODE)HeapAlloc(GetProcessHeap(), + printerName = (LPCWSTR)devnames + devnames->wDeviceOffset; + driver = (LPCWSTR)devnames + devnames->wDriverOffset; + output = (LPCWSTR)devnames + devnames->wOutputOffset; + localDevmode = (LPDEVMODEW)HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); @@ -4957,8 +4925,8 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg paper_width = (int) localDevmode->dmPaperWidth / 0.254; /* Convert to logical points.*/ copies = pd.nCopies; /*Set device context here for all GDI printing operations.*/ - printDC = CreateDC( - "WINSPOOL", + printDC = CreateDCW( + L"WINSPOOL", printerName, NULL, localDevmode); @@ -5006,35 +4974,40 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg * ------------------------------------------------------------------------- */ -int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +int PrintOpenPrinter( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + Tcl_Obj *const objv[]) { - (void) clientData; + Tcl_DString ds; if (argc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "printer"); return TCL_ERROR; } - int len = 0; - /*Start an individual page.*/ if ( StartPage(printDC) <= 0) { return TCL_ERROR; } - char *printer = Tcl_GetStringFromObj(objv[1], &len); + const char *printer = Tcl_GetString(objv[1]); if (printDC == NULL) { Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } - if ((OpenPrinter(printer, &printDC, NULL)) == FALSE) { + Tcl_DStringInit(&ds); + if ((OpenPrinterW(Tcl_UtfToWCharDString(printer, -1, &ds), (LPHANDLE)&printDC, NULL)) == FALSE) { Tcl_AppendResult(interp, "unable to open printer", NULL); + Tcl_DStringFree(&ds); return TCL_ERROR; } + Tcl_DStringFree(&ds); return TCL_OK; } @@ -5096,7 +5069,7 @@ int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *c /* * Start printing. */ - output = StartDoc(printDC, &di); + output = StartDocW(printDC, &di); if (output <= 0) { Tcl_AppendResult(interp, "unable to start document", NULL); return TCL_ERROR; -- cgit v0.12 From 8a7f6c4089a6c5559991f0eac70773ece0679c7d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 2 Jun 2021 07:25:59 +0000 Subject: Fix earlier merge conflict --- tests/tk.test | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/tests/tk.test b/tests/tk.test index 58db73d..a42008f 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -11,16 +11,13 @@ tcltest::loadTestedCommands namespace import -force tcltest::test testConstraint testprintf [llength [info command testprintf]] -testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] - -test tk-1.1 {tk command: general} -body { -testConstraint testprintf [llength [info command testprintf]] test tk-1.1 {tk command: general} -body { tk } -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"} test tk-1.2 {tk command: general} -body { tk xyz +} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, sysnotify, systray, useinputmethods, or windowingsystem} # Value stored to restore default settings after 2.* tests set appname [tk appname] @@ -157,12 +154,12 @@ test tk-6.3 {tk inactive wrong argument} -body { test tk-6.4 {tk inactive too many arguments} -body { tk inactive reset foo } -returnCodes 1 -result {wrong # args: should be "tk inactive ?-displayof window? ?reset?"} -test tk-6.5 {tk inactive} -constraints failsOnXQuarz -body { +test tk-6.5 {tk inactive} -body { tk inactive reset update after 100 set i [tk inactive] - expr {$i < 0 || ( $i > 90 && $i < 200 )} + expr {$i < 0 || ( $i > 90 && $i < 300 )} } -result 1 test tk-7.1 {tk inactive in a safe interpreter} -body { -- cgit v0.12 From 14ac5dcbe3cba1564d55e0953ac38a27cda0b748 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 2 Jun 2021 18:22:11 +0000 Subject: Minor update to add output --- macosx/tkMacOSXSysTray.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/macosx/tkMacOSXSysTray.c b/macosx/tkMacOSXSysTray.c index df2766c..0a0202a 100644 --- a/macosx/tkMacOSXSysTray.c +++ b/macosx/tkMacOSXSysTray.c @@ -438,10 +438,12 @@ static int SysNotifyObjCmd( NSAppleScript *scpt = [[[NSAppleScript alloc] initWithSource:notify] autorelease]; NSDictionary *errorInfo; NSAppleEventDescriptor *result = [scpt executeAndReturnError:&errorInfo]; - if (!result) { - NSLog(@"ERROR: %@", errorInfo); - return TCL_ERROR; - } + NSString *info = [result stringValue]; + char *output = [info UTF8String]; + + Tcl_AppendResult(interp, + output, + NULL); return TCL_OK; } -- cgit v0.12 From 97997c36ceaecf8adfa667e7674c2a97cde62f8d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 3 Jun 2021 09:49:20 +0000 Subject: Merge more changed from 8.7 branch, which - somehow - were lost due to earlier merges --- .github/workflows/mac-build.yml | 39 ++++++++++++++++++++++++++++----------- .github/workflows/onefiledist.yml | 2 +- macosx/tkMacOSXKeyEvent.c | 8 ++++++-- macosx/tkMacOSXMouseEvent.c | 11 +++++++++++ macosx/tkMacOSXWm.c | 1 + 5 files changed, 47 insertions(+), 14 deletions(-) diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index a14af01..a5fbf59 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -4,7 +4,7 @@ env: ERROR_ON_FAILURES: 1 jobs: xcode: - runs-on: macos-11.0 + runs-on: macos-11 defaults: run: shell: bash @@ -37,8 +37,17 @@ jobs: echo "::error::Failure during Build" exit 1 } + - name: Run Tests + run: | + make test | tee out.txt + nmatches=$( grep -c "Failed 0" out.txt ) + if [ $nmatches -lt 4 ] + then + echo "::error::Failure during Test" + exit 1 + fi clang: - runs-on: macos-11.0 + runs-on: macos-11 strategy: matrix: symbols: @@ -63,16 +72,15 @@ jobs: ref: core-8-6-branch path: tcl - name: Prepare checked out repositories + env: + SET_DISPLAY: ${{ contains(matrix.options, '--disable-aqua') }} run: | touch tkStubInit.c mkdir "$HOME/install dir" echo "USE_XVFB=$SET_DISPLAY" >> $GITHUB_ENV working-directory: tk/generic - env: - SET_DISPLAY: ${{ contains(matrix.options, '--disable-aqua') }} - name: Add X11 (if required) - if: ${{ env.USE_XVFB }} - # This involves black magic + if: ${{ env.USE_XVFB == 'true' }} run: | brew install --cask xquartz sudo /opt/X11/libexec/privileged_startx || true @@ -120,20 +128,29 @@ jobs: Xvfb $1 & XVFB_PID=$! echo Launched Xvfb $1 as process $XVFB_PID >&2 + trap "echo killing process $XVFB_PID... >&2; kill $XVFB_PID" 0 export DISPLAY=$1 sleep 2 } else function runXvfb { - : do nothing + echo Xvfb not used, this is a --enable-aqua build } fi - ( runXvfb :0; make test-classic test-ttk; exit $? ) | tee out.txt || { - echo "::error::Failure during Test" + ( runXvfb :0; make test-classic; exit $? ) | tee out-classic.txt || { + echo "::error::Failure during Test (classic)" + exit 1 + } + ( runXvfb :0; make test-ttk; exit $? ) | tee out-ttk.txt || { + echo "::error::Failure during Test (ttk)" + exit 1 + } + cat out-classic.txt | grep -q "Failed 0" || { + echo "::error::Failure in classic test results" exit 1 } - cat out.txt | grep -q "Failed [1-9]" && { - echo "::error::Failure in test results" + cat out-ttk.txt | grep -q "Failed 0" || { + echo "::error::Failure in ttk test results" exit 1 } - name: Carry out trial installation diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 7ff914f..f32e8ed 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -67,7 +67,7 @@ jobs: working-directory: ${{ env.INST_DIR }} macos: name: macOS - runs-on: macos-11.0 + runs-on: macos-11 defaults: run: shell: bash diff --git a/macosx/tkMacOSXKeyEvent.c b/macosx/tkMacOSXKeyEvent.c index 76626cc..794e704 100644 --- a/macosx/tkMacOSXKeyEvent.c +++ b/macosx/tkMacOSXKeyEvent.c @@ -727,8 +727,12 @@ XGrabKeyboard( MacDrawable *macWin = (MacDrawable *)grab_window; if (w && macWin->toplevel->winPtr == (TkWindow *) captureWinPtr) { - if (modalSession) { - Tcl_Panic("XGrabKeyboard: already grabbed"); + if (modalSession ) { + if (keyboardGrabNSWindow == w) { + return GrabSuccess; + } else { + Tcl_Panic("XGrabKeyboard: already grabbed"); + } } keyboardGrabNSWindow = w; [w retain]; diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 7241e13..4790549 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -124,6 +124,17 @@ enum { } case NSLeftMouseUp: case NSLeftMouseDown: + + /* + * Ignore mouse button events which arrive while the app is inactive. + * These events will be resent after activation, causing duplicate + * actions when an app is activated by a bound mouse event. See ticket + * [7bda9882cb]. + */ + + if (! [NSApp isActive]) { + return theEvent; + } case NSMouseMoved: case NSScrollWheel: #if 0 diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 840964e..80515fd 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -3736,6 +3736,7 @@ WmTransientCmd( if (TkGetWindowFromObj(interp, tkwin, objv[3], &container) != TCL_OK) { return TCL_ERROR; } + RemoveTransient(winPtr); containerPtr = (TkWindow*) container; while (!Tk_TopWinHierarchy(containerPtr)) { /* -- cgit v0.12 From 4a59ae730e1e465d49cd9e4b783adb5a90f9fe6f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 3 Jun 2021 14:18:11 +0000 Subject: Fix test failure --- tests/tk.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/tk.test b/tests/tk.test index a42008f..0316a7b 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -17,7 +17,7 @@ test tk-1.1 {tk command: general} -body { } -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"} test tk-1.2 {tk command: general} -body { tk xyz -} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, sysnotify, systray, useinputmethods, or windowingsystem} +} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, print, scaling, sysnotify, systray, useinputmethods, or windowingsystem} # Value stored to restore default settings after 2.* tests set appname [tk appname] -- cgit v0.12 From 7729408515b3663234a7ac51f4447c08dee8fb6a Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 15 Jun 2021 17:36:26 +0000 Subject: Add X11 implementation; next, update docs with platform notes and begin translation of X11 implementation --- doc/sysnotify.n | 6 ++ library/print.tcl | 219 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 221 insertions(+), 4 deletions(-) diff --git a/doc/sysnotify.n b/doc/sysnotify.n index 8951cf0..be26ba4 100644 --- a/doc/sysnotify.n +++ b/doc/sysnotify.n @@ -51,6 +51,12 @@ deleted from Apple's System Preferences Notifications section. (There is no removal button, so this is done by selecting the application and pressing the Delete key.) . + +If deploying an application using the standalone version of Wish.app, +setting the bundle ID in the applications Info.plist file to begin with +"com" seems necessary for notifications to work. Using a different prefix +for the bundle ID, such as something like "tk.tcl.tkchat," will cause +notifications to silently fail. .TP \fBWindows\fR . diff --git a/library/print.tcl b/library/print.tcl index 082106d..dcf5774 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -470,8 +470,6 @@ namespace eval ::tk::print { eval $cmmd } - - # _print_canvas.oval # Prints an oval item. # Arguments: @@ -600,8 +598,8 @@ namespace eval ::tk::print { set anchor [ $cw itemcget $id -anchor ] set coords [ $cw coords $id ] - set cmmd "::tk::print::_gdi photo $printargs(hDC) -destination [list $coords] -photo $imagename " - eval $cmmd + set cmmd "::tk::print::_gdi photo $printargs(hDC) -destination [list $coords] -photo $imagename " + eval $cmmd } # _print_canvas.bitmap @@ -686,6 +684,213 @@ namespace eval ::tk::print { } #end win32 procedures + #begin X11 procedures + + if {[tk windowingsystem] eq "x11"} { + + variable printcmd + variable printlist + variable choosepaper + variable p + + set printmcd "" + set chooseprinter "" + set printlist {} + + #Set the print environtment - print command, and list of printers. + proc _setprintenv {} { + variable printcmd + variable printlist + + #Select print command. We prefer lpr, but will fall back to lp if necessary. + set printcmd {exec which lpr} + if {$printcmd == ""} { + set printcmd lp + } else { + set printcmd lpr + } + + #Build list of printers, + set printdata [exec lpstat -a] + foreach item [split $printdata \n] { + lappend printlist [lindex [split $item] 0] + } + } + + #Main printer dialog. Select printer, set options, and fire print command. + proc _print {w} { + + variable printlist + variable printcmd + variable chooseprinter + variable printcopies + variable choosepaper + variable color + variable p + + + _setprintenv + + set chooseprinter [lindex $printlist 0] + + set p ._print + + catch {destroy $p} + + toplevel $p + wm title $p "Print" + wm resizable $p 0 0 + + frame $p.frame -padx 10 -pady 10 + pack $p.frame -fill x -expand no + + #The main dialog + frame $p.frame.printframe -padx 5 -pady 5 + pack $p.frame.printframe -side top -fill x -expand no + + label $p.frame.printframe.printlabel -text "Printer:" + ttk::combobox $p.frame.printframe.mb -textvariable chooseprinter -state readonly -values [lsort -unique $printlist] + pack $p.frame.printframe.printlabel $p.frame.printframe.mb -side left -fill x -expand no + + bind $p.frame.printframe.mb <> { set chooseprinter} + + set paperlist {Letter Legal A4} + set colorlist {Grayscale RGB} + + #Initialize with sane defaults. Because some of these variables + #are tied to tk_optionMenu, they are global and cannot be tied + #to the ::tk::print namespace. To minimize name collision, we have + #given them similar names to the current namespace. And wherever + #possible, we are using namespaced variables. + + set printcopies 1 + set ::tkprint_choosepaper A4 + set ::tkprint_color RGB + set ::tkprint_orientation portrait + + set percentlist {100 90 80 70 60 50 40 30 20 10} + + #Only load widgets where a variable is set - ignore errors. + labelframe $p.frame.copyframe -text Options -padx 5 -pady 5 + pack $p.frame.copyframe -fill x -expand no + + frame $p.frame.copyframe.l -padx 5 -pady 5 + pack $p.frame.copyframe.l -side top -fill x -expand no + + label $p.frame.copyframe.l.copylabel -text "Copies:" + spinbox $p.frame.copyframe.l.field -from 1 -to 1000 -textvariable printcopies -width 5 + + pack $p.frame.copyframe.l.copylabel $p.frame.copyframe.l.field -side left -fill x -expand no + + set printcopies [$p.frame.copyframe.l.field get] + + frame $p.frame.copyframe.r -padx 5 -pady 5 + pack $p.frame.copyframe.r -fill x -expand no + + label $p.frame.copyframe.r.paper -text "Paper:" + tk_optionMenu $p.frame.copyframe.r.menu ::tkprint_choosepaper {*}$paperlist + + pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu -side left -fill x -expand no + + if {[winfo class $w] eq "Canvas"} { + + frame $p.frame.copyframe.z -padx 5 -pady 5 + pack $p.frame.copyframe.z -fill x -expand no + + label $p.frame.copyframe.z.zlabel -text "Scale %:" + tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber {*}$percentlist + + frame $p.frame.copyframe.orient -padx 5 -pady 5 + pack $p.frame.copyframe.orient -fill x -expand no + + label $p.frame.copyframe.orient.text -text "Orientation:" + radiobutton $p.frame.copyframe.orient.v -text "Portrait" -value portrait -variable ::tkprint_printorientation -compound left + radiobutton $p.frame.copyframe.orient.h -text "Landscape" -value landscape -variable ::tkprint_printorientation -compound left + + pack $p.frame.copyframe.orient.text $p.frame.copyframe.orient.v $p.frame.copyframe.orient.h -side left -fill x -expand no + + frame $p.frame.copyframe.c -padx 5 -pady 5 + pack $p.frame.copyframe.c -fill x -expand no + + label $p.frame.copyframe.c.l -text "Output:" + tk_optionMenu $p.frame.copyframe.c.c ::tkprint_color {*}$colorlist + pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left -fill x -expand no + } + + #Build rest of GUI from bottom up + frame $p.frame.buttonframe + pack $p.frame.buttonframe -fill x -expand no -side bottom + + button $p.frame.buttonframe.printbutton -text "Print" -command "::tk::print::_runprint $w" + button $p.frame.buttonframe.cancel -text "Cancel" -command {destroy ._print} + + pack $p.frame.buttonframe.printbutton $p.frame.buttonframe.cancel -side right -fill x -expand no + + } + + + #execute the print command--print the file + proc _runprint {w} { + + variable printlist + variable printcmd + variable chooseprinter + variable printcopies + variable p + + + #First, generate print file. + + if {[winfo class $w] eq "Text"} { + set txt [$w get 1.0 end] + set file /tmp/tk_text.txt + set print_txt [open $file w] + puts $print_txt $txt + close $print_txt + } + + if {[winfo class $w] eq "Canvas"} { + + set file /tmp/tk_canvas.ps + if {$::tkprint_color eq "RGB"} { + set colormode color + } else { + set colormode gray + } + + if {$::tkprint_printorientation eq "landscape"} { + set willrotate "1" + } else { + set willrotate "0" + } + set printwidth [expr {$::tkprint_zoomnumber / 100.00} * [winfo width $w] ] + $w postscript -file $file -colormode $colormode -rotate $willrotate -pagewidth $printwidth + } + + #Built list of args to pass to print command. + + set printargs {} + set printcopies [$p.frame.copyframe.l.field get] + + + if {$printcmd eq "lpr"} { + lappend printargs "-P $chooseprinter -# $printcopies" + } else { + lappend printargs " -d $chooseprinter -n $printcopies" + } + lappend printargs " -o PageSize=$::tkprint_choosepaper" + + after 500 + set cmd [join "$printcmd $printargs $file"] + eval exec $cmd + + after 500 + destroy ._print + + } + } + #end X11 procedures + namespace export canvas text namespace ensemble create } @@ -711,6 +916,9 @@ proc ::tk::print::canvas {w} { if {[tk windowingsystem] eq "win32"} { ::tk::print::_print_widget $w 0 "Tk Print Output" } + if {[tk windowingsystem] eq "x11"} { + ::tk::print::_print $w + } } @@ -724,6 +932,9 @@ proc ::tk::print::text {w} { close $print_txt ::tk::print::_print_file $x 1 {Arial 12} } + if {[tk windowingsystem] eq "x11"} { + ::tk::print::_print $w + } } #Add this command to the tk command ensemble: tk print -- cgit v0.12 From 7532b52d4b6015fdfe48a441e7989c3ca11b486a Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 15 Jun 2021 19:42:04 +0000 Subject: Refinements of X11 printing on Linux system that uses lp, not lpr --- library/print.tcl | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index dcf5774..1f4fed0 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -703,12 +703,12 @@ namespace eval ::tk::print { variable printlist #Select print command. We prefer lpr, but will fall back to lp if necessary. - set printcmd {exec which lpr} - if {$printcmd == ""} { - set printcmd lp - } else { + if {[file exists "/usr/bin/lpr"]} { set printcmd lpr + } else { + set printcmd lp } + puts "printcmd is $printcmd" #Build list of printers, set printdata [exec lpstat -a] @@ -799,6 +799,8 @@ namespace eval ::tk::print { label $p.frame.copyframe.z.zlabel -text "Scale %:" tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber {*}$percentlist + + pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry -side left -fill x -expand no frame $p.frame.copyframe.orient -padx 5 -pady 5 pack $p.frame.copyframe.orient -fill x -expand no -- cgit v0.12 From 3412589a8e5b38a284c75325ee1b59451b39b81e Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 15 Jun 2021 20:15:07 +0000 Subject: Remove typos, debugging statement --- library/print.tcl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 1f4fed0..95cfa6f 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -708,7 +708,6 @@ namespace eval ::tk::print { } else { set printcmd lp } - puts "printcmd is $printcmd" #Build list of printers, set printdata [exec lpstat -a] @@ -869,7 +868,7 @@ namespace eval ::tk::print { $w postscript -file $file -colormode $colormode -rotate $willrotate -pagewidth $printwidth } - #Built list of args to pass to print command. + #Build list of args to pass to print command. set printargs {} set printcopies [$p.frame.copyframe.l.field get] -- cgit v0.12 From 7f78a312ce4997637ca682626c4dda78a4431c98 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 17 Jun 2021 02:38:27 +0000 Subject: Clean up comments --- library/print.tcl | 36 +++++++++++++++++++++++++++++------- 1 file changed, 29 insertions(+), 7 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 95cfa6f..cfdfa64 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -686,6 +686,11 @@ namespace eval ::tk::print { #begin X11 procedures + # X11 procedures wrap standard Unix shell commands such + # as lp/lpr and lpstat for printing. Some output configuration that on + # other platforms is managed through the printer driver/dialog + # is configured through the canvas postscript command. + if {[tk windowingsystem] eq "x11"} { variable printcmd @@ -697,7 +702,11 @@ namespace eval ::tk::print { set chooseprinter "" set printlist {} - #Set the print environtment - print command, and list of printers. + # _setprintenv + # Set the print environtment - print command, and list of printers. + # Arguments: + # none. + proc _setprintenv {} { variable printcmd variable printlist @@ -709,14 +718,20 @@ namespace eval ::tk::print { set printcmd lp } - #Build list of printers, + #Build list of printers. set printdata [exec lpstat -a] foreach item [split $printdata \n] { lappend printlist [lindex [split $item] 0] } } - #Main printer dialog. Select printer, set options, and fire print command. + # _print + # Main printer dialog. Select printer, set options, and + # fire print command. + # Arguments: + # w - widget with contents to print. + # + proc _print {w} { variable printlist @@ -769,7 +784,7 @@ namespace eval ::tk::print { set percentlist {100 90 80 70 60 50 40 30 20 10} - #Only load widgets where a variable is set - ignore errors. + #Base widgets to load. labelframe $p.frame.copyframe -text Options -padx 5 -pady 5 pack $p.frame.copyframe -fill x -expand no @@ -791,6 +806,7 @@ namespace eval ::tk::print { pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu -side left -fill x -expand no + #Widgets with additional options for canvas output. if {[winfo class $w] eq "Canvas"} { frame $p.frame.copyframe.z -padx 5 -pady 5 @@ -818,7 +834,7 @@ namespace eval ::tk::print { pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left -fill x -expand no } - #Build rest of GUI from bottom up + #Build rest of GUI. frame $p.frame.buttonframe pack $p.frame.buttonframe -fill x -expand no -side bottom @@ -830,7 +846,11 @@ namespace eval ::tk::print { } - #execute the print command--print the file + # _runprint - + # Execute the print command--print the file. + # Arguments: + # w - widget with contents to print. + # proc _runprint {w} { variable printlist @@ -845,7 +865,7 @@ namespace eval ::tk::print { if {[winfo class $w] eq "Text"} { set txt [$w get 1.0 end] set file /tmp/tk_text.txt - set print_txt [open $file w] + set print_txt [open $file w] puts $print_txt $txt close $print_txt } @@ -864,6 +884,8 @@ namespace eval ::tk::print { } else { set willrotate "0" } + + #Scale based on size of widget, not size of paper. set printwidth [expr {$::tkprint_zoomnumber / 100.00} * [winfo width $w] ] $w postscript -file $file -colormode $colormode -rotate $willrotate -pagewidth $printwidth } -- cgit v0.12 From 444279bbce9e737df9a61dc1d5c0f7deef817e42 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 24 Jun 2021 08:48:56 +0000 Subject: Fix [c2d964e537]: tk.tcl file in glyph_indexing_2 branch is outdated --- library/tk.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tk.tcl b/library/tk.tcl index 2f83f57..2668491 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -11,7 +11,7 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Verify that we have Tk binary and script components from the same release -package require -exact tk 8.7a4 +package require -exact tk 8.7a6 # Create a ::tk namespace namespace eval ::tk { -- cgit v0.12 From afebc679a1637210fafc9315203027237bab8d0d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 2 Jul 2021 14:43:04 +0000 Subject: Fix [dba9f5ce3b]: tkInt.h: define MODULE_SCOPE before including tkPort.h Since X11/Xlib.h doesn't compile with -Wc++-compat, don't even try. --- macosx/tkMacOSXPort.h | 16 ++++++++++++++++ unix/tkUnixPort.h | 3 +++ win/tkWinPort.h | 4 ++++ 3 files changed, 23 insertions(+) diff --git a/macosx/tkMacOSXPort.h b/macosx/tkMacOSXPort.h index 9393df3..088d402 100644 --- a/macosx/tkMacOSXPort.h +++ b/macosx/tkMacOSXPort.h @@ -49,6 +49,9 @@ # include #endif #include +#if defined(__GNUC__) && !defined(__cplusplus) +# pragma GCC diagnostic ignored "-Wc++-compat" +#endif #include #include #include @@ -75,6 +78,19 @@ #endif /* + * Used to tag functions that are only to be visible within the module being + * built and not outside it (where this is supported by the linker). + */ + +#ifndef MODULE_SCOPE +# ifdef __cplusplus +# define MODULE_SCOPE extern "C" +# else +# define MODULE_SCOPE extern +# endif +#endif + +/* * The following macro defines the number of fd_masks in an fd_set: */ diff --git a/unix/tkUnixPort.h b/unix/tkUnixPort.h index c8d842d..44926a4 100644 --- a/unix/tkUnixPort.h +++ b/unix/tkUnixPort.h @@ -58,6 +58,9 @@ #else # include "../compat/unistd.h" #endif +#if defined(__GNUC__) && !defined(__cplusplus) +# pragma GCC diagnostic ignored "-Wc++-compat" +#endif #include #include #include diff --git a/win/tkWinPort.h b/win/tkWinPort.h index 337a866..0118608 100644 --- a/win/tkWinPort.h +++ b/win/tkWinPort.h @@ -21,6 +21,7 @@ *--------------------------------------------------------------------------- */ +#include #include #include #include @@ -64,6 +65,9 @@ typedef _TCHAR TCHAR; #endif +#if defined(__GNUC__) && !defined(__cplusplus) +# pragma GCC diagnostic ignored "-Wc++-compat" +#endif #include #include #include -- cgit v0.12 From 0093962104e9c604b7d299866aebcde3349e4e61 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 2 Jul 2021 14:59:40 +0000 Subject: Ignore -Wc++-compat in one more place (before including X11/Xlib.h) --- generic/tk.h | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tk.h b/generic/tk.h index af8e5ca..ec1f78d 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -93,6 +93,9 @@ extern "C" { #ifndef RC_INVOKED #if !defined(_XLIB_H) && !defined(_X11_XLIB_H_) +#if defined(__GNUC__) && !defined(__cplusplus) +# pragma GCC diagnostic ignored "-Wc++-compat" +#endif # include # ifdef MAC_OSX_TK # include -- cgit v0.12 From cc065b16238b7ebe705c73d94a85abb3bbd30066 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 3 Jul 2021 02:24:10 +0000 Subject: Add localization to print dialog for X11 --- library/msgs/cs.msg | 18 ++++++++++++++++++ library/msgs/da.msg | 18 ++++++++++++++++++ library/msgs/de.msg | 18 ++++++++++++++++++ library/msgs/el.msg | 18 ++++++++++++++++++ library/msgs/eo.msg | 18 ++++++++++++++++++ library/msgs/es.msg | 18 ++++++++++++++++++ library/msgs/fr.msg | 18 ++++++++++++++++++ library/msgs/hu.msg | 18 ++++++++++++++++++ library/msgs/it.msg | 18 ++++++++++++++++++ library/msgs/nl.msg | 18 ++++++++++++++++++ library/msgs/pl.msg | 18 ++++++++++++++++++ library/msgs/pt.msg | 18 ++++++++++++++++++ library/msgs/ru.msg | 18 ++++++++++++++++++ library/msgs/sv.msg | 18 ++++++++++++++++++ library/print.tcl | 28 +++++++++++++++------------- 15 files changed, 267 insertions(+), 13 deletions(-) diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg index a93c4ec..92e98e3 100644 --- a/library/msgs/cs.msg +++ b/library/msgs/cs.msg @@ -75,3 +75,21 @@ namespace eval ::tk { ::msgcat::mcset cs "retry" "znovu" ::msgcat::mcset cs "yes" "ano" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset cs "Print" "Tisknout" + ::msgcat::mcset cs "Printer" "Tiskárna" + ::msgcat::mcset cs "Letter " "Dopis " + ::msgcat::mcset cs "Legal " "Legální " + ::msgcat::mcset cs "A4" "A4" + ::msgcat::mcset cs "Grayscale" "StupnÄ› Å edi" + ::msgcat::mcset cs "RGB" "RGB" + ::msgcat::mcset cs "Options" "Možnosti" + ::msgcat::mcset cs "Copies" "Kopie" + ::msgcat::mcset cs "Paper" "Papír" + ::msgcat::mcset cs "Scale" "Å kála" + ::msgcat::mcset cs "Orientation" "Orientace" + ::msgcat::mcset cs "Portrait" "Portrét" + ::msgcat::mcset cs "Landscape" "Krajina" + ::msgcat::mcset cs "Output" "Výstup" +} \ No newline at end of file diff --git a/library/msgs/da.msg b/library/msgs/da.msg index 282f919..7f9559e 100644 --- a/library/msgs/da.msg +++ b/library/msgs/da.msg @@ -76,3 +76,21 @@ namespace eval ::tk { ::msgcat::mcset da "retry" "gentag" ::msgcat::mcset da "yes" "ja" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset da "Print" "Trykke" + ::msgcat::mcset da "Printer" "Printer" + ::msgcat::mcset da "Letter " "Brev" + ::msgcat::mcset da "Legal " "Juridisk" + ::msgcat::mcset da "A4" "A4" + ::msgcat::mcset da "Grayscale" "GrÃ¥toneskala" + ::msgcat::mcset da "RGB" "Rgb" + ::msgcat::mcset da "Options" "Indstillinger" + ::msgcat::mcset da "Copies" "Kopier" + ::msgcat::mcset da "Paper" "Papir" + ::msgcat::mcset da "Scale" "Skalere" + ::msgcat::mcset da "Orientation" "Orientering" + ::msgcat::mcset da "Portrait" "Portræt" + ::msgcat::mcset da "Landscape" "Landskab" + ::msgcat::mcset da "Output" "Udskriv Publikation" +} \ No newline at end of file diff --git a/library/msgs/de.msg b/library/msgs/de.msg index 2cf25d2..9f485db 100644 --- a/library/msgs/de.msg +++ b/library/msgs/de.msg @@ -89,3 +89,21 @@ namespace eval ::tk { ::msgcat::mcset de "retry" "wiederholen" ::msgcat::mcset de "yes" "ja" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset de "Print" "Drucken" + ::msgcat::mcset de "Printer" "Drucker" + ::msgcat::mcset de "Letter " "Brief" + ::msgcat::mcset de "Legal " "Rechtlich" + ::msgcat::mcset de "A4" "A4" + ::msgcat::mcset de "Grayscale" "Graustufen" + ::msgcat::mcset de "RGB" "Rgb" + ::msgcat::mcset de "Options" "Optionen" + ::msgcat::mcset de "Copies" "Kopien" + ::msgcat::mcset de "Paper" "Papier" + ::msgcat::mcset de "Scale" "Skala" + ::msgcat::mcset de "Orientation" "Ausrichtung" + ::msgcat::mcset de "Portrait" "Porträt" + ::msgcat::mcset de "Landscape" "Landschaft" + ::msgcat::mcset de "Output" "Ausgabe" +} \ No newline at end of file diff --git a/library/msgs/el.msg b/library/msgs/el.msg index 34f4aa7..c7f2781 100644 --- a/library/msgs/el.msg +++ b/library/msgs/el.msg @@ -84,3 +84,21 @@ namespace eval ::tk { ::msgcat::mcset el "retry" "Ï€Ïοσπάθησε ξανά" ::msgcat::mcset el "yes" "ναι" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset el "Print" "Τυπώνω" + ::msgcat::mcset el "Printer" "Εκτυπωτής" + ::msgcat::mcset el "Letter " "ΓÏάμμα" + ::msgcat::mcset el "Legal " "Îομικός" + ::msgcat::mcset el "A4" "Α4" + ::msgcat::mcset el "Grayscale" "Κλίμακα Του ΓκÏι" + ::msgcat::mcset el "RGB" "Rgb" + ::msgcat::mcset el "Options" "Επιλογές" + ::msgcat::mcset el "Copies" "ΑντίγÏαφα" + ::msgcat::mcset el "Paper" "ΧαÏτί" + ::msgcat::mcset el "Scale" "Κλίμακα" + ::msgcat::mcset el "Orientation" "ΠÏοσανατολισμός" + ::msgcat::mcset el "Portrait" "ΠÏοσωπογÏαφία" + ::msgcat::mcset el "Landscape" "Τοπίο" + ::msgcat::mcset el "Output" "Έξοδος" +} \ No newline at end of file diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg index d285fb8..04a73e8 100644 --- a/library/msgs/eo.msg +++ b/library/msgs/eo.msg @@ -73,3 +73,21 @@ namespace eval ::tk { ::msgcat::mcset eo "retry" "ripetu" ::msgcat::mcset eo "yes" "jes" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset eo "Print" "Presi" + ::msgcat::mcset eo "Printer" "Presilo" + ::msgcat::mcset eo "Letter " "Letero" + ::msgcat::mcset eo "Legal " "LaÅ­leÄa" + ::msgcat::mcset eo "A4" "A4" + ::msgcat::mcset eo "Grayscale" "Grizskalo" + ::msgcat::mcset eo "RGB" "RGB" + ::msgcat::mcset eo "Options" "Opcioj" + ::msgcat::mcset eo "Copies" "Kopioj" + ::msgcat::mcset eo "Paper" "Papero" + ::msgcat::mcset eo "Scale" "Skalo" + ::msgcat::mcset eo "Orientation" "OrientiÄo" + ::msgcat::mcset eo "Portrait" "Portreto" + ::msgcat::mcset eo "Landscape" "PejzaÄo" + ::msgcat::mcset eo "Output" "Eligo" +} \ No newline at end of file diff --git a/library/msgs/es.msg b/library/msgs/es.msg index f7082b8..ea96929 100644 --- a/library/msgs/es.msg +++ b/library/msgs/es.msg @@ -74,3 +74,21 @@ namespace eval ::tk { ::msgcat::mcset es "retry" "reintentar" ::msgcat::mcset es "yes" "sí" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset es "Print" "Imprimir" + ::msgcat::mcset es "Printer" "Impresora" + ::msgcat::mcset es "Letter " "Carta" + ::msgcat::mcset es "Legal " "Legal" + ::msgcat::mcset es "A4" "A4" + ::msgcat::mcset es "Grayscale" "Escala De Grises" + ::msgcat::mcset es "RGB" "Rgb" + ::msgcat::mcset es "Options" "Opciones" + ::msgcat::mcset es "Copies" "Copias" + ::msgcat::mcset es "Paper" "Papel" + ::msgcat::mcset es "Scale" "Escama" + ::msgcat::mcset es "Orientation" "Orientación" + ::msgcat::mcset es "Portrait" "Retrato" + ::msgcat::mcset es "Landscape" "Paisaje" + ::msgcat::mcset es "Output" "Salida" +} \ No newline at end of file diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg index cab8c50..7d492e7 100644 --- a/library/msgs/fr.msg +++ b/library/msgs/fr.msg @@ -70,3 +70,21 @@ namespace eval ::tk { ::msgcat::mcset fr "retry" "réessayer" ::msgcat::mcset fr "yes" "oui" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset fr "Print" "Imprimer" + ::msgcat::mcset fr "Printer" "Imprimante" + ::msgcat::mcset fr "Letter " "Lettre" + ::msgcat::mcset fr "Legal " "Légal" + ::msgcat::mcset fr "A4" "A4" + ::msgcat::mcset fr "Grayscale" "Niveaux de Gris" + ::msgcat::mcset fr "RGB" "Rvb" + ::msgcat::mcset fr "Options" "Options" + ::msgcat::mcset fr "Copies" "Copies" + ::msgcat::mcset fr "Paper" "Papier" + ::msgcat::mcset fr "Scale" "Écaille" + ::msgcat::mcset fr "Orientation" "Orientation" + ::msgcat::mcset fr "Portrait" "Portrait" + ::msgcat::mcset fr "Landscape" "Paysage" + ::msgcat::mcset fr "Output" "Sortie" +} \ No newline at end of file diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg index 6d60cc6..1640076 100644 --- a/library/msgs/hu.msg +++ b/library/msgs/hu.msg @@ -76,3 +76,21 @@ namespace eval ::tk { ::msgcat::mcset hu "retry" "újra" ::msgcat::mcset hu "yes" "igen" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset hu "Print" "Nyomtat" + ::msgcat::mcset hu "Printer" "Nyomtató" + ::msgcat::mcset hu "Letter " "Levél" + ::msgcat::mcset hu "Legal " "Törvényes" + ::msgcat::mcset hu "A4" "A4" + ::msgcat::mcset hu "Grayscale" "Szürkeárnyalatos" + ::msgcat::mcset hu "RGB" "Rgb" + ::msgcat::mcset hu "Options" "Beállítások" + ::msgcat::mcset hu "Copies" "Másolatok" + ::msgcat::mcset hu "Paper" "Papír" + ::msgcat::mcset hu "Scale" "Hangsor" + ::msgcat::mcset hu "Orientation" "Tájékozódás" + ::msgcat::mcset hu "Portrait" "Portré" + ::msgcat::mcset hu "Landscape" "Táj" + ::msgcat::mcset hu "Output" "Hozam" +} \ No newline at end of file diff --git a/library/msgs/it.msg b/library/msgs/it.msg index f6ad124..65f836f 100644 --- a/library/msgs/it.msg +++ b/library/msgs/it.msg @@ -71,3 +71,21 @@ namespace eval ::tk { ::msgcat::mcset it "retry" "riprova" ::msgcat::mcset it "yes" "sì" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset it "Print" "Stampare" + ::msgcat::mcset it "Printer" "Stampante" + ::msgcat::mcset it "Letter " "Lettera" + ::msgcat::mcset it "Legal " "Legale" + ::msgcat::mcset it "A4" "A4" + ::msgcat::mcset it "Grayscale" "Scala Di Grigi" + ::msgcat::mcset it "RGB" "Rgb" + ::msgcat::mcset it "Options" "Opzioni" + ::msgcat::mcset it "Copies" "Copie" + ::msgcat::mcset it "Paper" "Carta" + ::msgcat::mcset it "Scale" "Scala" + ::msgcat::mcset it "Orientation" "Orientamento" + ::msgcat::mcset it "Portrait" "Ritratto" + ::msgcat::mcset it "Landscape" "Paesaggio" + ::msgcat::mcset it "Output" "Prodotto" +} \ No newline at end of file diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg index fd0348b..bd8a01f 100644 --- a/library/msgs/nl.msg +++ b/library/msgs/nl.msg @@ -89,3 +89,21 @@ namespace eval ::tk { ::msgcat::mcset nl "retry" "opnieuw" ::msgcat::mcset nl "yes" "ja" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset nl "Print" "Afdrukken" + ::msgcat::mcset nl "Printer" "Printer" + ::msgcat::mcset nl "Letter " "Brief" + ::msgcat::mcset nl "Legal " "Legaal" + ::msgcat::mcset nl "A4" "A4" + ::msgcat::mcset nl "Grayscale" "Grijswaarden" + ::msgcat::mcset nl "RGB" "Rgb" + ::msgcat::mcset nl "Options" "Opties" + ::msgcat::mcset nl "Copies" "Kopieën" + ::msgcat::mcset nl "Paper" "Papier" + ::msgcat::mcset nl "Scale" "Schub" + ::msgcat::mcset nl "Orientation" "Oriëntatie" + ::msgcat::mcset nl "Portrait" "Portret" + ::msgcat::mcset nl "Landscape" "Landschap" + ::msgcat::mcset nl "Output" "Uitvoer" +} \ No newline at end of file diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg index f616397..a5d55e4 100644 --- a/library/msgs/pl.msg +++ b/library/msgs/pl.msg @@ -89,3 +89,21 @@ namespace eval ::tk { ::msgcat::mcset pl "retry" "ponów" ::msgcat::mcset pl "yes" "tak" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset pl "Print" "Drukować" + ::msgcat::mcset pl "Printer" "Drukarka" + ::msgcat::mcset pl "Letter " "Litera" + ::msgcat::mcset pl "Legal " "Legalny" + ::msgcat::mcset pl "A4" "A4" + ::msgcat::mcset pl "Grayscale" "Skala SzaroÅ›ci" + ::msgcat::mcset pl "RGB" "Rgb" + ::msgcat::mcset pl "Options" "Opcje" + ::msgcat::mcset pl "Copies" "Kopie" + ::msgcat::mcset pl "Paper" "Papier" + ::msgcat::mcset pl "Scale" "Skala" + ::msgcat::mcset pl "Orientation" "Orientacja" + ::msgcat::mcset pl "Portrait" "Portret" + ::msgcat::mcset pl "Landscape" "Krajobraz" + ::msgcat::mcset pl "Output" "Produkt WyjÅ›ciowy" +} \ No newline at end of file diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg index 91c7f7a..43b25b4 100644 --- a/library/msgs/pt.msg +++ b/library/msgs/pt.msg @@ -72,3 +72,21 @@ namespace eval ::tk { ::msgcat::mcset pt "retry" "tentar novamente" ::msgcat::mcset pt "yes" "sim" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset pt "Print" "Imprimir" + ::msgcat::mcset pt "Printer" "Impressora" + ::msgcat::mcset pt "Letter " "Letra" + ::msgcat::mcset pt "Legal " "Legal" + ::msgcat::mcset pt "A4" "A4" + ::msgcat::mcset pt "Grayscale" "Escala De Cinza" + ::msgcat::mcset pt "RGB" "Rgb" + ::msgcat::mcset pt "Options" "Opções" + ::msgcat::mcset pt "Copies" "Exemplares" + ::msgcat::mcset pt "Paper" "Papel" + ::msgcat::mcset pt "Scale" "Escala" + ::msgcat::mcset pt "Orientation" "Orientação" + ::msgcat::mcset pt "Portrait" "Retrato" + ::msgcat::mcset pt "Landscape" "Paisagem" + ::msgcat::mcset pt "Output" "Saída" +} \ No newline at end of file diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg index 3389ce8..fea3c1a 100644 --- a/library/msgs/ru.msg +++ b/library/msgs/ru.msg @@ -73,3 +73,21 @@ namespace eval ::tk { ::msgcat::mcset ru "yes" "да" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset ru "Print" "Печатать" + ::msgcat::mcset ru "Printer" "Принтер" + ::msgcat::mcset ru "Letter " "ПиÑьмо" + ::msgcat::mcset ru "Legal " "Законный" + ::msgcat::mcset ru "A4" "A4" + ::msgcat::mcset ru "Grayscale" "Серый МаÑштаб" + ::msgcat::mcset ru "RGB" "Ргб" + ::msgcat::mcset ru "Options" "Параметры" + ::msgcat::mcset ru "Copies" "Копии" + ::msgcat::mcset ru "Paper" "Бумага" + ::msgcat::mcset ru "Scale" "Шкала" + ::msgcat::mcset ru "Orientation" "ОриентациÑ" + ::msgcat::mcset ru "Portrait" "Портрет" + ::msgcat::mcset ru "Landscape" "Ландшафт" + ::msgcat::mcset ru "Output" "ВыпуÑк" +} \ No newline at end of file diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg index a1ef8c5..5dc81ab 100644 --- a/library/msgs/sv.msg +++ b/library/msgs/sv.msg @@ -74,3 +74,21 @@ namespace eval ::tk { ::msgcat::mcset sv "retry" "försök igen" ::msgcat::mcset sv "yes" "ja" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset sv "Print" "Trycka" + ::msgcat::mcset sv "Printer" "Skrivare" + ::msgcat::mcset sv "Letter " "Brev" + ::msgcat::mcset sv "Legal " "Laglig" + ::msgcat::mcset sv "A4" "A4 (PÃ¥ 199" + ::msgcat::mcset sv "Grayscale" "GrÃ¥skala" + ::msgcat::mcset sv "RGB" "Rgb" + ::msgcat::mcset sv "Options" "Alternativ" + ::msgcat::mcset sv "Copies" "Kopior" + ::msgcat::mcset sv "Paper" "Papper" + ::msgcat::mcset sv "Scale" "Skala" + ::msgcat::mcset sv "Orientation" "Orientering" + ::msgcat::mcset sv "Portrait" "Porträtt" + ::msgcat::mcset sv "Landscape" "Landskap" + ::msgcat::mcset sv "Output" "Utdata" +} \ No newline at end of file diff --git a/library/print.tcl b/library/print.tcl index e39619d..b10a366 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -14,6 +14,8 @@ namespace eval ::tk::print { + namespace import -force ::tk::msgcat::* + if {[tk windowingsystem] eq "win32"} { variable ::tk::print::printer_name @@ -762,14 +764,14 @@ namespace eval ::tk::print { frame $p.frame.printframe -padx 5 -pady 5 pack $p.frame.printframe -side top -fill x -expand no - label $p.frame.printframe.printlabel -text "Printer:" + label $p.frame.printframe.printlabel -text [mc "Printer:"] ttk::combobox $p.frame.printframe.mb -textvariable chooseprinter -state readonly -values [lsort -unique $printlist] pack $p.frame.printframe.printlabel $p.frame.printframe.mb -side left -fill x -expand no bind $p.frame.printframe.mb <> { set chooseprinter} - set paperlist {Letter Legal A4} - set colorlist {Grayscale RGB} + set paperlist [list [mc Letter] [mc Legal] [mc A4]] + set colorlist [list [mc Grayscale] [mc RGB]] #Initialize with sane defaults. Because some of these variables #are tied to tk_optionMenu, they are global and cannot be tied @@ -785,13 +787,13 @@ namespace eval ::tk::print { set percentlist {100 90 80 70 60 50 40 30 20 10} #Base widgets to load. - labelframe $p.frame.copyframe -text Options -padx 5 -pady 5 + labelframe $p.frame.copyframe -text [mc "Options"] -padx 5 -pady 5 pack $p.frame.copyframe -fill x -expand no frame $p.frame.copyframe.l -padx 5 -pady 5 pack $p.frame.copyframe.l -side top -fill x -expand no - label $p.frame.copyframe.l.copylabel -text "Copies:" + label $p.frame.copyframe.l.copylabel -text [mc "Copies:"] spinbox $p.frame.copyframe.l.field -from 1 -to 1000 -textvariable printcopies -width 5 pack $p.frame.copyframe.l.copylabel $p.frame.copyframe.l.field -side left -fill x -expand no @@ -801,7 +803,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.r -padx 5 -pady 5 pack $p.frame.copyframe.r -fill x -expand no - label $p.frame.copyframe.r.paper -text "Paper:" + label $p.frame.copyframe.r.paper -text [mc "Paper:"] tk_optionMenu $p.frame.copyframe.r.menu ::tkprint_choosepaper {*}$paperlist pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu -side left -fill x -expand no @@ -812,7 +814,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.z -padx 5 -pady 5 pack $p.frame.copyframe.z -fill x -expand no - label $p.frame.copyframe.z.zlabel -text "Scale %:" + label $p.frame.copyframe.z.zlabel -text [mc"Scale %:"] tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber {*}$percentlist pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry -side left -fill x -expand no @@ -820,16 +822,16 @@ namespace eval ::tk::print { frame $p.frame.copyframe.orient -padx 5 -pady 5 pack $p.frame.copyframe.orient -fill x -expand no - label $p.frame.copyframe.orient.text -text "Orientation:" - radiobutton $p.frame.copyframe.orient.v -text "Portrait" -value portrait -variable ::tkprint_printorientation -compound left - radiobutton $p.frame.copyframe.orient.h -text "Landscape" -value landscape -variable ::tkprint_printorientation -compound left + label $p.frame.copyframe.orient.text -text [mc "Orientation:"] + radiobutton $p.frame.copyframe.orient.v -text [mc "Portrait"] -value portrait -variable ::tkprint_printorientation -compound left + radiobutton $p.frame.copyframe.orient.h -text [mc "Landscape"] -value landscape -variable ::tkprint_printorientation -compound left pack $p.frame.copyframe.orient.text $p.frame.copyframe.orient.v $p.frame.copyframe.orient.h -side left -fill x -expand no frame $p.frame.copyframe.c -padx 5 -pady 5 pack $p.frame.copyframe.c -fill x -expand no - label $p.frame.copyframe.c.l -text "Output:" + label $p.frame.copyframe.c.l -text [mc "Output:"] tk_optionMenu $p.frame.copyframe.c.c ::tkprint_color {*}$colorlist pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left -fill x -expand no } @@ -838,8 +840,8 @@ namespace eval ::tk::print { frame $p.frame.buttonframe pack $p.frame.buttonframe -fill x -expand no -side bottom - button $p.frame.buttonframe.printbutton -text "Print" -command "::tk::print::_runprint $w" - button $p.frame.buttonframe.cancel -text "Cancel" -command {destroy ._print} + button $p.frame.buttonframe.printbutton -text [mc "Print"] -command "::tk::print::_runprint $w" + button $p.frame.buttonframe.cancel -text [mc "Cancel"] -command {destroy ._print} pack $p.frame.buttonframe.printbutton $p.frame.buttonframe.cancel -side right -fill x -expand no -- cgit v0.12 From ac22f29e5ff6afb5bdeda331f3f292bdd192095a Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 3 Jul 2021 02:34:11 +0000 Subject: Clean up en locale --- library/msgs/en.msg | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/library/msgs/en.msg b/library/msgs/en.msg index 5ad1094..8f192f0 100644 --- a/library/msgs/en.msg +++ b/library/msgs/en.msg @@ -89,3 +89,22 @@ namespace eval ::tk { ::msgcat::mcset en "retry" ::msgcat::mcset en "yes" } + +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset en "Print" + ::msgcat::mcset en "Printer" + ::msgcat::mcset en "Letter " + ::msgcat::mcset en "Legal " + ::msgcat::mcset en "A4" + ::msgcat::mcset en "Grayscale" + ::msgcat::mcset en "RGB" + ::msgcat::mcset en "Options" + ::msgcat::mcset en "Copies" + ::msgcat::mcset en "Paper" + ::msgcat::mcset en "Scale" + ::msgcat::mcset en "Orientation" + ::msgcat::mcset en "Portrait" + ::msgcat::mcset en "Landscape" + ::msgcat::mcset en "Output" +} -- cgit v0.12 From 17473f0d4843c8e39f6e7853df6cbcfb7eb1e6be Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 3 Jul 2021 02:52:56 +0000 Subject: Tweak localization --- library/print.tcl | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index b10a366..367a140 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -770,8 +770,8 @@ namespace eval ::tk::print { bind $p.frame.printframe.mb <> { set chooseprinter} - set paperlist [list [mc Letter] [mc Legal] [mc A4]] - set colorlist [list [mc Grayscale] [mc RGB]] + set paperlist [list [::tk::msgcat::mc Letter] [::tk::msgcat::mc Legal] [::tk::msgcat::mc A4]] + set colorlist [list [::tk::msgcat::mc Grayscale] [::tk::msgcat::mc RGB]] #Initialize with sane defaults. Because some of these variables #are tied to tk_optionMenu, they are global and cannot be tied @@ -780,20 +780,20 @@ namespace eval ::tk::print { #possible, we are using namespaced variables. set printcopies 1 - set ::tkprint_choosepaper A4 - set ::tkprint_color RGB + set ::tkprint_choosepaper [::tk::msgcat::mc A4] + set ::tkprint_color [::tk::msgcat::mc RGB] set ::tkprint_orientation portrait set percentlist {100 90 80 70 60 50 40 30 20 10} #Base widgets to load. - labelframe $p.frame.copyframe -text [mc "Options"] -padx 5 -pady 5 + labelframe $p.frame.copyframe -text [::tk::msgcat::mc "Options"] -padx 5 -pady 5 pack $p.frame.copyframe -fill x -expand no frame $p.frame.copyframe.l -padx 5 -pady 5 pack $p.frame.copyframe.l -side top -fill x -expand no - label $p.frame.copyframe.l.copylabel -text [mc "Copies:"] + label $p.frame.copyframe.l.copylabel -text [::tk::msgcat::mc "Copies:"] spinbox $p.frame.copyframe.l.field -from 1 -to 1000 -textvariable printcopies -width 5 pack $p.frame.copyframe.l.copylabel $p.frame.copyframe.l.field -side left -fill x -expand no @@ -803,7 +803,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.r -padx 5 -pady 5 pack $p.frame.copyframe.r -fill x -expand no - label $p.frame.copyframe.r.paper -text [mc "Paper:"] + label $p.frame.copyframe.r.paper -text [::tk::msgcat::mc "Paper:"] tk_optionMenu $p.frame.copyframe.r.menu ::tkprint_choosepaper {*}$paperlist pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu -side left -fill x -expand no @@ -814,7 +814,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.z -padx 5 -pady 5 pack $p.frame.copyframe.z -fill x -expand no - label $p.frame.copyframe.z.zlabel -text [mc"Scale %:"] + label $p.frame.copyframe.z.zlabel -text [::tk::msgcat::mc "Scale %:"] tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber {*}$percentlist pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry -side left -fill x -expand no @@ -822,16 +822,16 @@ namespace eval ::tk::print { frame $p.frame.copyframe.orient -padx 5 -pady 5 pack $p.frame.copyframe.orient -fill x -expand no - label $p.frame.copyframe.orient.text -text [mc "Orientation:"] - radiobutton $p.frame.copyframe.orient.v -text [mc "Portrait"] -value portrait -variable ::tkprint_printorientation -compound left - radiobutton $p.frame.copyframe.orient.h -text [mc "Landscape"] -value landscape -variable ::tkprint_printorientation -compound left + label $p.frame.copyframe.orient.text -text [::tk::msgcat::mc "Orientation:"] + radiobutton $p.frame.copyframe.orient.v -text [::tk::msgcat::mc "Portrait"] -value portrait -variable ::tkprint_printorientation -compound left + radiobutton $p.frame.copyframe.orient.h -text [::tk::msgcat::mc "Landscape"] -value landscape -variable ::tkprint_printorientation -compound left pack $p.frame.copyframe.orient.text $p.frame.copyframe.orient.v $p.frame.copyframe.orient.h -side left -fill x -expand no frame $p.frame.copyframe.c -padx 5 -pady 5 pack $p.frame.copyframe.c -fill x -expand no - label $p.frame.copyframe.c.l -text [mc "Output:"] + label $p.frame.copyframe.c.l -text [::tk::msgcat::mc "Output:"] tk_optionMenu $p.frame.copyframe.c.c ::tkprint_color {*}$colorlist pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left -fill x -expand no } @@ -840,8 +840,8 @@ namespace eval ::tk::print { frame $p.frame.buttonframe pack $p.frame.buttonframe -fill x -expand no -side bottom - button $p.frame.buttonframe.printbutton -text [mc "Print"] -command "::tk::print::_runprint $w" - button $p.frame.buttonframe.cancel -text [mc "Cancel"] -command {destroy ._print} + button $p.frame.buttonframe.printbutton -text [::tk::msgcat::mc "Print"] -command "::tk::print::_runprint $w" + button $p.frame.buttonframe.cancel -text [::tk::msgcat::mc "Cancel"] -command {destroy ._print} pack $p.frame.buttonframe.printbutton $p.frame.buttonframe.cancel -side right -fill x -expand no @@ -875,7 +875,7 @@ namespace eval ::tk::print { if {[winfo class $w] eq "Canvas"} { set file /tmp/tk_canvas.ps - if {$::tkprint_color eq "RGB"} { + if {$::tkprint_color eq [::tk::msgcat::mc "RGB"]} { set colormode color } else { set colormode gray -- cgit v0.12 From f33fd555d813005d90ccf08ac03e77cbaddbbfb5 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 3 Jul 2021 03:24:21 +0000 Subject: Clean up mc errors in print.tcl --- library/print.tcl | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 367a140..8ad3cdf 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -770,8 +770,8 @@ namespace eval ::tk::print { bind $p.frame.printframe.mb <> { set chooseprinter} - set paperlist [list [::tk::msgcat::mc Letter] [::tk::msgcat::mc Legal] [::tk::msgcat::mc A4]] - set colorlist [list [::tk::msgcat::mc Grayscale] [::tk::msgcat::mc RGB]] + set paperlist [list [mc Letter] [mc Legal] [mc A4]] + set colorlist [list [mc Grayscale] [mc RGB]] #Initialize with sane defaults. Because some of these variables #are tied to tk_optionMenu, they are global and cannot be tied @@ -780,20 +780,20 @@ namespace eval ::tk::print { #possible, we are using namespaced variables. set printcopies 1 - set ::tkprint_choosepaper [::tk::msgcat::mc A4] - set ::tkprint_color [::tk::msgcat::mc RGB] + set ::tkprint_choosepaper [mc A4] + set ::tkprint_color [mc RGB] set ::tkprint_orientation portrait set percentlist {100 90 80 70 60 50 40 30 20 10} #Base widgets to load. - labelframe $p.frame.copyframe -text [::tk::msgcat::mc "Options"] -padx 5 -pady 5 + labelframe $p.frame.copyframe -text [mc "Options"] -padx 5 -pady 5 pack $p.frame.copyframe -fill x -expand no frame $p.frame.copyframe.l -padx 5 -pady 5 pack $p.frame.copyframe.l -side top -fill x -expand no - label $p.frame.copyframe.l.copylabel -text [::tk::msgcat::mc "Copies:"] + label $p.frame.copyframe.l.copylabel -text [mc "Copies:"] spinbox $p.frame.copyframe.l.field -from 1 -to 1000 -textvariable printcopies -width 5 pack $p.frame.copyframe.l.copylabel $p.frame.copyframe.l.field -side left -fill x -expand no @@ -803,7 +803,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.r -padx 5 -pady 5 pack $p.frame.copyframe.r -fill x -expand no - label $p.frame.copyframe.r.paper -text [::tk::msgcat::mc "Paper:"] + label $p.frame.copyframe.r.paper -text [mc "Paper:"] tk_optionMenu $p.frame.copyframe.r.menu ::tkprint_choosepaper {*}$paperlist pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu -side left -fill x -expand no @@ -814,7 +814,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.z -padx 5 -pady 5 pack $p.frame.copyframe.z -fill x -expand no - label $p.frame.copyframe.z.zlabel -text [::tk::msgcat::mc "Scale %:"] + label $p.frame.copyframe.z.zlabel -text [mc Scale %:"] tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber {*}$percentlist pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry -side left -fill x -expand no @@ -822,16 +822,16 @@ namespace eval ::tk::print { frame $p.frame.copyframe.orient -padx 5 -pady 5 pack $p.frame.copyframe.orient -fill x -expand no - label $p.frame.copyframe.orient.text -text [::tk::msgcat::mc "Orientation:"] - radiobutton $p.frame.copyframe.orient.v -text [::tk::msgcat::mc "Portrait"] -value portrait -variable ::tkprint_printorientation -compound left - radiobutton $p.frame.copyframe.orient.h -text [::tk::msgcat::mc "Landscape"] -value landscape -variable ::tkprint_printorientation -compound left + label $p.frame.copyframe.orient.text -text [mc "Orientation:"] + radiobutton $p.frame.copyframe.orient.v -text [mc "Portrait"] -value portrait -variable ::tkprint_printorientation -compound left + radiobutton $p.frame.copyframe.orient.h -text [mc "Landscape"] -value landscape -variable ::tkprint_printorientation -compound left pack $p.frame.copyframe.orient.text $p.frame.copyframe.orient.v $p.frame.copyframe.orient.h -side left -fill x -expand no frame $p.frame.copyframe.c -padx 5 -pady 5 pack $p.frame.copyframe.c -fill x -expand no - label $p.frame.copyframe.c.l -text [::tk::msgcat::mc "Output:"] + label $p.frame.copyframe.c.l -text [mc "Output:"] tk_optionMenu $p.frame.copyframe.c.c ::tkprint_color {*}$colorlist pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left -fill x -expand no } @@ -840,8 +840,8 @@ namespace eval ::tk::print { frame $p.frame.buttonframe pack $p.frame.buttonframe -fill x -expand no -side bottom - button $p.frame.buttonframe.printbutton -text [::tk::msgcat::mc "Print"] -command "::tk::print::_runprint $w" - button $p.frame.buttonframe.cancel -text [::tk::msgcat::mc "Cancel"] -command {destroy ._print} + button $p.frame.buttonframe.printbutton -text [mc "Print"] -command "::tk::print::_runprint $w" + button $p.frame.buttonframe.cancel -text [mc "Cancel"] -command {destroy ._print} pack $p.frame.buttonframe.printbutton $p.frame.buttonframe.cancel -side right -fill x -expand no @@ -875,7 +875,7 @@ namespace eval ::tk::print { if {[winfo class $w] eq "Canvas"} { set file /tmp/tk_canvas.ps - if {$::tkprint_color eq [::tk::msgcat::mc "RGB"]} { + if {$::tkprint_color eq [mc"RGB"]} { set colormode color } else { set colormode gray -- cgit v0.12 From ec928a37f196cdf710ead0c723adcb90e9d52bd4 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 3 Jul 2021 03:29:44 +0000 Subject: More cleanup --- library/print.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 8ad3cdf..ee30329 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -814,7 +814,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.z -padx 5 -pady 5 pack $p.frame.copyframe.z -fill x -expand no - label $p.frame.copyframe.z.zlabel -text [mc Scale %:"] + label $p.frame.copyframe.z.zlabel -text [mc "Scale %:"] tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber {*}$percentlist pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry -side left -fill x -expand no @@ -875,7 +875,7 @@ namespace eval ::tk::print { if {[winfo class $w] eq "Canvas"} { set file /tmp/tk_canvas.ps - if {$::tkprint_color eq [mc"RGB"]} { + if {$::tkprint_color eq [mc "RGB"]} { set colormode color } else { set colormode gray -- cgit v0.12 From f8d8b14443463897e316ca7955796dcaef1823b5 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 3 Jul 2021 15:15:06 +0000 Subject: Initial commit of macOS implementation for tk_print; does not build yet, must remove some depcrecated API calls --- library/print.tcl | 20 ++- macosx/tkMacOSXInit.c | 1 + macosx/tkMacOSXPrint.c | 326 +++++++++++++++++++++++++++++++++++++++++++++++ macosx/tkMacOSXPrivate.h | 1 + unix/Makefile.in | 6 +- 5 files changed, 352 insertions(+), 2 deletions(-) create mode 100644 macosx/tkMacOSXPrint.c diff --git a/library/print.tcl b/library/print.tcl index ee30329..4c9e13e 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -944,6 +944,14 @@ proc ::tk::print::canvas {w} { if {[tk windowingsystem] eq "x11"} { ::tk::print::_print $w } + if {[tk windowingsystem] eq "aqua"} { + set file /tmp/tk_canvas.ps + $w postscript -file $file + set printfile /tmp/tk_canvas.pdf + catch {exec /usr/sbin/cupsfilter $file > $printfile} + ::tk::print::_print $printfile + } + } @@ -959,7 +967,17 @@ proc ::tk::print::text {w} { } if {[tk windowingsystem] eq "x11"} { ::tk::print::_print $w - } + } + if {[tk windowingsystem] eq "aqua"} { + set txt [$w get 1.0 end] + set file /tmp/tk_text.txt + set print_txt [open $file w] + puts $print_txt $txt + close $print_txt + set printfile /tmp/tk_text.pdf + catch {exec /usr/sbin/cupsfilter $file > $printfile} + ::tk::print::_print $printfile + } } #Add this command to the tk command ensemble: tk print diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c index 0198504..7dc9f32 100644 --- a/macosx/tkMacOSXInit.c +++ b/macosx/tkMacOSXInit.c @@ -586,6 +586,7 @@ TkpInit( Tcl_CreateObjCommand(interp, "::tk::mac::GetAppPath", TkMacOSXGetAppPathCmd, NULL, NULL); MacSystrayInit(interp); + MacPrint_Init(interp); return TCL_OK; } diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c new file mode 100644 index 0000000..fcb5663 --- /dev/null +++ b/macosx/tkMacOSXPrint.c @@ -0,0 +1,326 @@ +/* + * tkMacOSXPrint.c -- + * + * This module implements native printing dialogs for macOS. + * + * Copyright © 2006-2012 Apple Corp. + * Copyright © 2011-2021 Kevin Walzer/WordTech Communications LLC. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include +#include +#include +#include +#include +#include +#include +#include + + +/* Forward declarations of functions and variables. */ +NSString * fileName = nil; +CFStringRef urlFile = NULL; +int StartPrint(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +OSStatus FinishPrint(NSString * file, int buttonValue); +int MacPrint_Init(Tcl_Interp * interp); + +/* Class definitions for Cocoa delegates to retrieve values from dialogs. */ + +/* Delegate class for print dialogs. */ +@interface PrintDelegate: NSObject + + - + (id) init; + +- +(void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo; + +@end + +@implementation PrintDelegate + + - (id) init { + self = [super init]; + return self; + } + + - (void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo { + + /* Pass returnCode to FinishPrint function to determine how to handle. */ + FinishPrint(fileName, returnCode); + + } + +@end + +/* + *---------------------------------------------------------------------- + * + * StartPrint -- + * + * Launch native print dialog. + * + * Results: + * Configures values and starts print process. + * + *---------------------------------------------------------------------- + */ + +int StartPrint(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) { + + void clientData; + NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; + NSPrintPanel * printPanel = [NSPrintPanel printPanel]; + int accepted; + NSWindow * windowRef; + PMPrintSession printSession; + PMPageFormat pageFormat; + PMPrintSettings printSettings; + OSStatus status = noErr; + + /* Check for proper number of arguments. */ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "file"); + return TCL_ERROR; + } + + fileName = [NSString stringWithUTF8String: Tcl_GetString(objv[1])]; + urlFile = (CFStringRef) fileName; + CFRetain(urlFile); + + /* Initialize the delegate for the callback from the page panel. */ + PrintDelegate * printDelegate = [ + [PrintDelegate alloc] init]; + + status = PMCreateSession( & printSession); + if (status != noErr) { + NSLog(@ "Error creating print session."); + return TCL_ERROR; + } + + status = PMCreatePrintSettings( & printSettings); + if (status != noErr) { + NSLog(@ "Error creating print settings."); + return TCL_ERROR; + } + + status = PMSessionDefaultPrintSettings(printSession, printSettings); + if (status != noErr) { + NSLog(@ "Error creating default print settings."); + return TCL_ERROR; + } + + printSession = (PMPrintSession)[printInfo PMPrintSession]; + pageFormat = (PMPageFormat)[printInfo PMPageFormat]; + printSettings = (PMPrintSettings)[printInfo PMPrintSettings]; + + accepted = [printPanel runModalWithPrintInfo: printInfo]; + [printDelegate printPanelDidEnd: printPanel returnCode: accepted contextInfo: printInfo]; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * FinishPrint -- + * + * Handles print process based on input from dialog. + * + * Results: + * Completes print process. + * + *---------------------------------------------------------------------- + */ +OSStatus FinishPrint(NSString * file, int buttonValue) { + + NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; + PMPrintSession printSession; + PMPageFormat pageFormat; + PMPrintSettings printSettings; + OSStatus status = noErr; + CFStringRef * mimeType = NULL; + + /* + * If value passed here is NSCancelButton, return noErr; + * otherwise printing will occur regardless of value. + */ + if (buttonValue == NSModalResponseCancel) { + return noErr; + } + + status = PMCreateSession( & printSession); + if (status != noErr) { + NSLog(@ "Error creating print session."); + return status; + } + + status = PMCreatePrintSettings( & printSettings); + if (status != noErr) { + NSLog(@ "Error creating print settings."); + return status; + } + + status = PMSessionDefaultPrintSettings(printSession, printSettings); + if (status != noErr) { + NSLog(@ "Error creating default print settings."); + return status; + } + + printSession = (PMPrintSession)[printInfo PMPrintSession]; + pageFormat = (PMPageFormat)[printInfo PMPageFormat]; + printSettings = (PMPrintSettings)[printInfo PMPrintSettings]; + + /*Handle print operation.*/ + if (buttonValue = NSModalResponseOK) { + + if (urlFile == NULL) { + NSLog(@ "Could not get file to print."); + return noErr; + } + + fileName = file; + + CFURLRef * printURL = CFURLCreateWithFileSystemPath(kCFAllocatorDefault, urlFile, kCFURLPOSIXPathStyle, false); + + PMPrinter currentPrinter; + PMDestinationType printDestination; + + /*Get the intended destination.*/ + status = PMSessionGetDestinationType(printSession, printSettings, & printDestination); + + /*Destination is printer. Send file to printer.*/ + if (status == noErr && printDestination == kPMDestinationPrinter) { + + status = PMSessionGetCurrentPrinter(printSession, & currentPrinter); + if (status == noErr) { + CFArrayRef mimeTypes; + status = PMPrinterGetMimeTypes(currentPrinter, printSettings, & mimeTypes); + if (status == noErr && mimeTypes != NULL) { + mimeType = CFSTR("application/pdf"); + if (CFArrayContainsValue(mimeTypes, CFRangeMake(0, CFArrayGetCount(mimeTypes)), mimeType)) { + status = PMPrinterPrintWithFile(currentPrinter, printSettings, pageFormat, mimeType, printURL); + CFRelease(urlFile); + return status; + } + } + } + } + + /* Destination is file. Determine how to handle. */ + if (status == noErr && printDestination == kPMDestinationFile) { + CFURLRef * outputLocation; + status = PMSessionCopyDestinationLocation(printSession, printSettings, & outputLocation); + if (status == noErr) { + /*Get the source file and target destination, convert to strings.*/ + CFStringRef sourceFile = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); + CFStringRef savePath = CFURLCopyFileSystemPath(outputLocation, kCFURLPOSIXPathStyle); + NSString * sourcePath = (NSString * ) sourceFile; + NSString * finalPath = (NSString * ) savePath; + NSString * pathExtension = [finalPath pathExtension]; + + /*Is the target file a PDF? If so, copy print file to output location.*/ + if ([pathExtension isEqualToString: @ "pdf"]) { + NSFileManager * fileManager = [NSFileManager defaultManager]; + if ([fileManager fileExistsAtPath: sourcePath]) { + [fileManager copyPath: sourcePath toPath: finalPath handler: nil]; + } + } + + /* Is the target file PostScript? If so, run print file + * through CUPS filter to convert back to PostScript. + * Using strcat to build up system command is ugly, but it is + * simpler than NSTask and it works. + */ + + if ([pathExtension isEqualToString: @ "ps"]) { + + char source[5012]; + char target[5012]; + + [sourcePath getCString: source maxLength: (sizeof source) encoding: NSUTF8StringEncoding]; + [finalPath getCString: target maxLength: (sizeof target) encoding: NSUTF8StringEncoding]; + + /*Add quote marks to address path names with spaces.*/ + char cmd[50000]; + strcpy(cmd, "/usr/sbin/cupsfilter "); + strcat(cmd, "\""); + strcat(cmd, source); + strcat(cmd, "\""); + strcat(cmd, " -m application/postscript > "); + strcat(cmd, "\""); + strcat(cmd, target); + strcat(cmd, "\""); + system(cmd); + } + + return status; + + } + } + + /* Destination is preview. Open file in default application for PDF. */ + if (status == noErr && printDestination == kPMDestinationPreview) { + CFStringRef urlpath = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); + NSString * path = (NSString * ) urlpath; + NSWorkspace * ws = [NSWorkspace sharedWorkspace]; + [ws openFile: path]; + status == noErr; + return status; + } + + /* + * If destination is not printer, file or preview, + * we do not support it. Display alert. + */ + + if (status == noErr && printDestination != kPMDestinationPreview || kPMDestinationFile || kPMDestinationPrinter) { + + NSAlert * alert = [ + [ + [NSAlert alloc] init + ] autorelease + ]; + [alert addButtonWithTitle: @ "OK"]; + + [alert setMessageText: @ "Unsupported Printing Operation"]; + [alert setInformativeText: @ "This printing operation is not supported."]; + [alert setAlertStyle: NSInformationalAlertStyle]; + [alert runModal]; + return status; + } + } + + /* Return because cancel button was clicked. */ + if (buttonValue = NSModalResponseCancel) { + + PMRelease(printSession); + return status; + } + + return status; + +} + +/* + *---------------------------------------------------------------------- + * + * MacPrint_Init-- + * + * Initializes the printing module. + * + * Results: + * Printing module initialized. + * + *---------------------------------------------------------------------- + */ +int MacPrint_Init(Tcl_Interp * interp) { + + NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; + Tcl_CreateObjCommand(interp, "::tk::print::_print", StartPrint, (ClientData) NULL, (Tcl_CmdDeleteProc * ) NULL); + [pool release]; + return TCL_OK; +} diff --git a/macosx/tkMacOSXPrivate.h b/macosx/tkMacOSXPrivate.h index 33df1d8..0de2805 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -298,6 +298,7 @@ MODULE_SCOPE Bool TkMacOSXInDarkMode(Tk_Window tkwin); MODULE_SCOPE void TkMacOSXDrawAllViews(ClientData clientData); MODULE_SCOPE unsigned long TkMacOSXClearPixel(void); MODULE_SCOPE int MacSystrayInit(Tcl_Interp *); +MODULE_SCOPE int MacPrint_Init(Tcl_Interp *); #pragma mark Private Objective-C Classes diff --git a/unix/Makefile.in b/unix/Makefile.in index 0165697..89298fc 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -403,7 +403,8 @@ AQUA_OBJS = tkMacOSXBitmap.o tkMacOSXButton.o tkMacOSXClipboard.o \ tkMacOSXInit.o tkMacOSXKeyboard.o tkMacOSXKeyEvent.o \ tkMacOSXMenu.o \ tkMacOSXMenubutton.o tkMacOSXMenus.o tkMacOSXMouseEvent.o \ - tkMacOSXNotify.o tkMacOSXRegion.o tkMacOSXScrlbr.o tkMacOSXSend.o \ + tkMacOSXNotify.o tkMacOSXPrint.o tkMacOSXRegion.o \ + tkMacOSXScrlbr.o tkMacOSXSend.o \ tkMacOSXServices.o tkMacOSXSubwindows.o tkMacOSXWindowEvent.o \ tkMacOSXWm.o tkMacOSXXStubs.o tkMacOSXSysTray.o\ tkFileFilter.o tkMacWinMenu.o tkPointer.o tkUnix3d.o tkUnixScale.o \ @@ -1427,6 +1428,9 @@ tkMacOSXMouseEvent.o: $(MAC_OSX_DIR)/tkMacOSXMouseEvent.c tkMacOSXNotify.o: $(MAC_OSX_DIR)/tkMacOSXNotify.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXNotify.c +tkMacOSXPrint.o: $(MAC_OSX_DIR)/tkMacOSXPrint.c + $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXPrint.c + tkMacOSXRegion.o: $(MAC_OSX_DIR)/tkMacOSXRegion.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXRegion.c -- cgit v0.12 From 83e47456f9fcc95c5c7e42da2a94bbcf45b0d4d7 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 3 Jul 2021 22:01:11 +0000 Subject: Mac printing works --- library/print.tcl | 16 +++++++--------- macosx/tkMacOSXPrint.c | 13 ++++++------- 2 files changed, 13 insertions(+), 16 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 4c9e13e..bed0cd3 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -861,7 +861,6 @@ namespace eval ::tk::print { variable printcopies variable p - #First, generate print file. if {[winfo class $w] eq "Text"} { @@ -954,7 +953,6 @@ proc ::tk::print::canvas {w} { } - proc ::tk::print::text {w} { if {[tk windowingsystem] eq "win32"} { @@ -965,19 +963,19 @@ proc ::tk::print::text {w} { close $print_txt ::tk::print::_print_file $x 1 {Arial 12} } - if {[tk windowingsystem] eq "x11"} { + if {[tk windowingsystem] eq "x11"} { ::tk::print::_print $w - } + } if {[tk windowingsystem] eq "aqua"} { - set txt [$w get 1.0 end] - set file /tmp/tk_text.txt - set print_txt [open $file w] - puts $print_txt $txt + set txt [$w get 1.0 end] + set file /tmp/tk_text.txt + set print_txt [open $file w] + puts $print_txt $txt close $print_txt set printfile /tmp/tk_text.pdf catch {exec /usr/sbin/cupsfilter $file > $printfile} ::tk::print::_print $printfile - } + } } #Add this command to the tk command ensemble: tk print diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index fcb5663..cd55975 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -23,7 +23,7 @@ /* Forward declarations of functions and variables. */ NSString * fileName = nil; CFStringRef urlFile = NULL; -int StartPrint(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +int StartPrint(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); OSStatus FinishPrint(NSString * file, int buttonValue); int MacPrint_Init(Tcl_Interp * interp); @@ -69,9 +69,9 @@ int MacPrint_Init(Tcl_Interp * interp); *---------------------------------------------------------------------- */ -int StartPrint(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) { +int StartPrint(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - void clientData; + (void) clientData; NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; NSPrintPanel * printPanel = [NSPrintPanel printPanel]; int accepted; @@ -82,7 +82,7 @@ int StartPrint(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *con OSStatus status = noErr; /* Check for proper number of arguments. */ - if (objc != 2) { + if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "file"); return TCL_ERROR; } @@ -92,8 +92,7 @@ int StartPrint(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *con CFRetain(urlFile); /* Initialize the delegate for the callback from the page panel. */ - PrintDelegate * printDelegate = [ - [PrintDelegate alloc] init]; + PrintDelegate * printDelegate = [[PrintDelegate alloc] init]; status = PMCreateSession( & printSession); if (status != noErr) { @@ -175,7 +174,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { printSettings = (PMPrintSettings)[printInfo PMPrintSettings]; /*Handle print operation.*/ - if (buttonValue = NSModalResponseOK) { + if (buttonValue == NSModalResponseOK) { if (urlFile == NULL) { NSLog(@ "Could not get file to print."); -- cgit v0.12 From aaaabefb7f1a8a99db8d71193bdab14ef4e9836f Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 4 Jul 2021 01:59:40 +0000 Subject: Eliminate compiler warnings --- macosx/tkMacOSXPrint.c | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index cd55975..cb512bf 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -75,7 +75,6 @@ int StartPrint(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *con NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; NSPrintPanel * printPanel = [NSPrintPanel printPanel]; int accepted; - NSWindow * windowRef; PMPrintSession printSession; PMPageFormat pageFormat; PMPrintSettings printSettings; @@ -88,7 +87,7 @@ int StartPrint(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *con } fileName = [NSString stringWithUTF8String: Tcl_GetString(objv[1])]; - urlFile = (CFStringRef) fileName; + urlFile = (CFStringRef) fileName; CFRetain(urlFile); /* Initialize the delegate for the callback from the page panel. */ @@ -141,7 +140,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { PMPageFormat pageFormat; PMPrintSettings printSettings; OSStatus status = noErr; - CFStringRef * mimeType = NULL; + CFStringRef mimeType = NULL; /* * If value passed here is NSCancelButton, return noErr; @@ -183,7 +182,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { fileName = file; - CFURLRef * printURL = CFURLCreateWithFileSystemPath(kCFAllocatorDefault, urlFile, kCFURLPOSIXPathStyle, false); + CFURLRef printURL = CFURLCreateWithFileSystemPath(kCFAllocatorDefault, urlFile, kCFURLPOSIXPathStyle, false); PMPrinter currentPrinter; PMDestinationType printDestination; @@ -211,8 +210,8 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { /* Destination is file. Determine how to handle. */ if (status == noErr && printDestination == kPMDestinationFile) { - CFURLRef * outputLocation; - status = PMSessionCopyDestinationLocation(printSession, printSettings, & outputLocation); + CFURLRef *outputLocation = NULL; + status = PMSessionCopyDestinationLocation(printSession, printSettings, &outputLocation); if (status == noErr) { /*Get the source file and target destination, convert to strings.*/ CFStringRef sourceFile = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); @@ -225,7 +224,8 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { if ([pathExtension isEqualToString: @ "pdf"]) { NSFileManager * fileManager = [NSFileManager defaultManager]; if ([fileManager fileExistsAtPath: sourcePath]) { - [fileManager copyPath: sourcePath toPath: finalPath handler: nil]; + NSError *error = nil; + [fileManager copyItemAtPath:sourcePath toPath:finalPath error:&error]; } } @@ -262,12 +262,13 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { } /* Destination is preview. Open file in default application for PDF. */ - if (status == noErr && printDestination == kPMDestinationPreview) { + if ((status = noErr) && (printDestination == kPMDestinationPreview)) { CFStringRef urlpath = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); NSString * path = (NSString * ) urlpath; + NSURL * url= [NSURL fileURLWithPath:path]; NSWorkspace * ws = [NSWorkspace sharedWorkspace]; - [ws openFile: path]; - status == noErr; + [ws openURL: url]; + status = noErr; return status; } @@ -276,7 +277,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { * we do not support it. Display alert. */ - if (status == noErr && printDestination != kPMDestinationPreview || kPMDestinationFile || kPMDestinationPrinter) { + if ((status == noErr) && (printDestination != kPMDestinationPreview || kPMDestinationFile || kPMDestinationPrinter)) { NSAlert * alert = [ [ @@ -287,14 +288,14 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { [alert setMessageText: @ "Unsupported Printing Operation"]; [alert setInformativeText: @ "This printing operation is not supported."]; - [alert setAlertStyle: NSInformationalAlertStyle]; + [alert setAlertStyle: NSAlertStyleInformational]; [alert runModal]; return status; } } /* Return because cancel button was clicked. */ - if (buttonValue = NSModalResponseCancel) { + if (buttonValue == NSModalResponseCancel) { PMRelease(printSession); return status; @@ -323,3 +324,4 @@ int MacPrint_Init(Tcl_Interp * interp) { [pool release]; return TCL_OK; } + -- cgit v0.12 From acd0a9576f426e1f232cfa9facbfa06b8d6a34af Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 4 Jul 2021 02:16:33 +0000 Subject: Update man page --- doc/print.n | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/doc/print.n b/doc/print.n index d6ec38c..dd0abd6 100644 --- a/doc/print.n +++ b/doc/print.n @@ -10,7 +10,6 @@ .SH NAME print \- Print canvas and text widgets using native API's. .SH SYNOPSIS - \fBtk print\fR \fIcanvas\fR \fIwindow\fR \fBtk print\fR \fItext\fR \fIwindow\fR @@ -20,16 +19,34 @@ print \- Print canvas and text widgets using native API's. The \fBtk print\fR command allows users to print output from the \fBcanvas\fR and \fBtext\fR widgets using platform-native API's and dialogs. -.TP +.PP The \fBcanvas\fR widget has long supported PostScript export and both PostScript and text files can be sent directly to a printer on Unix-like systems using the "lp" or "lpr" commands, and the \fBtk print\fR command does not supersede that functionality; it builds on it. The \fBtk print\fR command is a fuller implementation that uses native dialogs on macOS and Windows, and a Tk-based dialog that provides parallel functionality on X11. .SH PLATFORM NOTES .TP +. +\fBmacOS\fR +.PP +The Mac implementation uses native print dialogs and relies on the +underlying Common Unix Printing System (CUPS) to render text output from +the text widget and PostScript output from the canvas widget to the +printer, to a PDF file, or a PostScript file. +.TP \fBWindows\fR .PP The Windows implementation is based on the GDI (Graphics Device Interface) API. Because there are slight differences in how GDI and Tk's \fBcanvas\fR widget display graphics, printed output from the \fBcanvas\fR on Windows may not be identical to screen rendering. +.TP +\fBX11\fR +.PP +The X11 implementation uses a Tk GUI to configure print jobs for sending +to a printer via the "lpr" or "lp" commands. While these commands have a +large number of parameters for configuring print jobs, printers vary +widely in how they support these parameters. As a result, only printer +selection and number of copies are configured as arguments to the print +command; many aspects of print rendering, such as grayscale or color for +the canvas, are instead configured when PostScript is generated. . .SH KEYWORDS print, output, graphics, text, canvas -- cgit v0.12 From 369d5077bb9552a1aa618bb0693fcd24031b3200 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 4 Jul 2021 02:39:50 +0000 Subject: Minor tweak --- macosx/tkMacOSXPrint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index cb512bf..51f09cb 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -262,7 +262,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { } /* Destination is preview. Open file in default application for PDF. */ - if ((status = noErr) && (printDestination == kPMDestinationPreview)) { + if ((status == noErr) && (printDestination == kPMDestinationPreview)) { CFStringRef urlpath = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); NSString * path = (NSString * ) urlpath; NSURL * url= [NSURL fileURLWithPath:path]; -- cgit v0.12 From ad044aaf9bd8082b9260fe3836a99c58d9593fe0 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 4 Jul 2021 02:40:28 +0000 Subject: Fix copyright --- macosx/tkMacOSXPrint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 51f09cb..f3b08e9 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -3,7 +3,7 @@ * * This module implements native printing dialogs for macOS. * - * Copyright © 2006-2012 Apple Corp. + * Copyright © 2006 Apple Inc. * Copyright © 2011-2021 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution of -- cgit v0.12 From 134393d5a203e14b5011ceebe8032f970fad20e6 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 4 Jul 2021 02:43:22 +0000 Subject: Fix formatting issues --- macosx/tkMacOSXPrint.c | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index f3b08e9..6d34cc1 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -32,8 +32,7 @@ int MacPrint_Init(Tcl_Interp * interp); /* Delegate class for print dialogs. */ @interface PrintDelegate: NSObject - - - (id) init; + - (id) init; - (void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo; @@ -279,11 +278,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { if ((status == noErr) && (printDestination != kPMDestinationPreview || kPMDestinationFile || kPMDestinationPrinter)) { - NSAlert * alert = [ - [ - [NSAlert alloc] init - ] autorelease - ]; + NSAlert * alert = [[[NSAlert alloc] init ] autorelease]; [alert addButtonWithTitle: @ "OK"]; [alert setMessageText: @ "Unsupported Printing Operation"]; @@ -319,7 +314,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { */ int MacPrint_Init(Tcl_Interp * interp) { - NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; + NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; Tcl_CreateObjCommand(interp, "::tk::print::_print", StartPrint, (ClientData) NULL, (Tcl_CmdDeleteProc * ) NULL); [pool release]; return TCL_OK; -- cgit v0.12 From ae3ccb06f8b9d627d08b16f3850cb9cd4a310791 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 4 Jul 2021 02:44:50 +0000 Subject: Minor tweak --- macosx/tkMacOSXPrint.c | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 6d34cc1..2993b48 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -33,9 +33,7 @@ int MacPrint_Init(Tcl_Interp * interp); @interface PrintDelegate: NSObject - (id) init; - -- -(void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo; + -(void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo; @end @@ -47,10 +45,11 @@ int MacPrint_Init(Tcl_Interp * interp); } - (void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo { - - /* Pass returnCode to FinishPrint function to determine how to handle. */ + /* + * Pass returnCode to FinishPrint function to determine how to + * handle. + */ FinishPrint(fileName, returnCode); - } @end @@ -254,9 +253,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { strcat(cmd, "\""); system(cmd); } - return status; - } } -- cgit v0.12 From 9d4d3a9134d67e5386feb99544a9dca3bd876469 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 4 Jul 2021 03:33:20 +0000 Subject: Fix indentation of tkMacOSXPrint.c to better conform to Tcl Engineering Manual --- macosx/tkMacOSXPrint.c | 374 +++++++++++++++++++++++++------------------------ 1 file changed, 188 insertions(+), 186 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 2993b48..2f9c7be 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -23,17 +23,15 @@ /* Forward declarations of functions and variables. */ NSString * fileName = nil; CFStringRef urlFile = NULL; -int StartPrint(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +int StartPrint(ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj * const objv[]); OSStatus FinishPrint(NSString * file, int buttonValue); int MacPrint_Init(Tcl_Interp * interp); -/* Class definitions for Cocoa delegates to retrieve values from dialogs. */ - /* Delegate class for print dialogs. */ @interface PrintDelegate: NSObject - (id) init; - -(void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo; + -(void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode:(int) returnCode contextInfo: (void * ) contextInfo; @end @@ -67,56 +65,57 @@ int MacPrint_Init(Tcl_Interp * interp); *---------------------------------------------------------------------- */ -int StartPrint(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - - (void) clientData; - NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; - NSPrintPanel * printPanel = [NSPrintPanel printPanel]; - int accepted; - PMPrintSession printSession; - PMPageFormat pageFormat; - PMPrintSettings printSettings; - OSStatus status = noErr; - - /* Check for proper number of arguments. */ - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "file"); - return TCL_ERROR; - } +int StartPrint(ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj * + const objv[]) { + + (void) clientData; + NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; + NSPrintPanel * printPanel = [NSPrintPanel printPanel]; + int accepted; + PMPrintSession printSession; + PMPageFormat pageFormat; + PMPrintSettings printSettings; + OSStatus status = noErr; + + /* Check for proper number of arguments. */ + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "file"); + return TCL_ERROR; + } - fileName = [NSString stringWithUTF8String: Tcl_GetString(objv[1])]; - urlFile = (CFStringRef) fileName; - CFRetain(urlFile); + fileName = [NSString stringWithUTF8String: Tcl_GetString(objv[1])]; + urlFile = (CFStringRef) fileName; + CFRetain(urlFile); - /* Initialize the delegate for the callback from the page panel. */ - PrintDelegate * printDelegate = [[PrintDelegate alloc] init]; + /* Initialize the delegate for the callback from the page panel. */ + PrintDelegate * printDelegate = [[PrintDelegate alloc] init]; - status = PMCreateSession( & printSession); - if (status != noErr) { - NSLog(@ "Error creating print session."); - return TCL_ERROR; - } + status = PMCreateSession( & printSession); + if (status != noErr) { + NSLog(@ "Error creating print session."); + return TCL_ERROR; + } - status = PMCreatePrintSettings( & printSettings); - if (status != noErr) { - NSLog(@ "Error creating print settings."); - return TCL_ERROR; - } + status = PMCreatePrintSettings( & printSettings); + if (status != noErr) { + NSLog(@ "Error creating print settings."); + return TCL_ERROR; + } - status = PMSessionDefaultPrintSettings(printSession, printSettings); - if (status != noErr) { - NSLog(@ "Error creating default print settings."); - return TCL_ERROR; - } + status = PMSessionDefaultPrintSettings(printSession, printSettings); + if (status != noErr) { + NSLog(@ "Error creating default print settings."); + return TCL_ERROR; + } - printSession = (PMPrintSession)[printInfo PMPrintSession]; - pageFormat = (PMPageFormat)[printInfo PMPageFormat]; - printSettings = (PMPrintSettings)[printInfo PMPrintSettings]; + printSession = (PMPrintSession)[printInfo PMPrintSession]; + pageFormat = (PMPageFormat)[printInfo PMPageFormat]; + printSettings = (PMPrintSettings)[printInfo PMPrintSettings]; - accepted = [printPanel runModalWithPrintInfo: printInfo]; - [printDelegate printPanelDidEnd: printPanel returnCode: accepted contextInfo: printInfo]; + accepted = [printPanel runModalWithPrintInfo: printInfo]; + [printDelegate printPanelDidEnd: printPanel returnCode: accepted contextInfo: printInfo]; - return TCL_OK; + return TCL_OK; } /* @@ -133,167 +132,170 @@ int StartPrint(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *con */ OSStatus FinishPrint(NSString * file, int buttonValue) { - NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; - PMPrintSession printSession; - PMPageFormat pageFormat; - PMPrintSettings printSettings; - OSStatus status = noErr; - CFStringRef mimeType = NULL; - - /* - * If value passed here is NSCancelButton, return noErr; - * otherwise printing will occur regardless of value. - */ - if (buttonValue == NSModalResponseCancel) { - return noErr; - } + NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; + PMPrintSession printSession; + PMPageFormat pageFormat; + PMPrintSettings printSettings; + OSStatus status = noErr; + CFStringRef mimeType = NULL; - status = PMCreateSession( & printSession); - if (status != noErr) { - NSLog(@ "Error creating print session."); - return status; - } + /* + * If value passed here is NSCancelButton, return noErr; + * otherwise printing will occur regardless of value. + */ + if (buttonValue == NSModalResponseCancel) { + return noErr; + } - status = PMCreatePrintSettings( & printSettings); - if (status != noErr) { - NSLog(@ "Error creating print settings."); - return status; - } + status = PMCreateSession( & printSession); + if (status != noErr) { + NSLog(@ "Error creating print session."); + return status; + } - status = PMSessionDefaultPrintSettings(printSession, printSettings); - if (status != noErr) { - NSLog(@ "Error creating default print settings."); - return status; - } + status = PMCreatePrintSettings( & printSettings); + if (status != noErr) { + NSLog(@ "Error creating print settings."); + return status; + } - printSession = (PMPrintSession)[printInfo PMPrintSession]; - pageFormat = (PMPageFormat)[printInfo PMPageFormat]; - printSettings = (PMPrintSettings)[printInfo PMPrintSettings]; + status = PMSessionDefaultPrintSettings(printSession, printSettings); + if (status != noErr) { + NSLog(@ "Error creating default print settings."); + return status; + } - /*Handle print operation.*/ - if (buttonValue == NSModalResponseOK) { + printSession = (PMPrintSession)[printInfo PMPrintSession]; + pageFormat = (PMPageFormat)[printInfo PMPageFormat]; + printSettings = (PMPrintSettings)[printInfo PMPrintSettings]; - if (urlFile == NULL) { - NSLog(@ "Could not get file to print."); - return noErr; - } + /*Handle print operation.*/ + if (buttonValue == NSModalResponseOK) { - fileName = file; + if (urlFile == NULL) { + NSLog(@ "Could not get file to print."); + return noErr; + } - CFURLRef printURL = CFURLCreateWithFileSystemPath(kCFAllocatorDefault, urlFile, kCFURLPOSIXPathStyle, false); + fileName = file; - PMPrinter currentPrinter; - PMDestinationType printDestination; + CFURLRef printURL = CFURLCreateWithFileSystemPath(kCFAllocatorDefault, urlFile, kCFURLPOSIXPathStyle, false); - /*Get the intended destination.*/ - status = PMSessionGetDestinationType(printSession, printSettings, & printDestination); + PMPrinter currentPrinter; + PMDestinationType printDestination; - /*Destination is printer. Send file to printer.*/ - if (status == noErr && printDestination == kPMDestinationPrinter) { + /*Get the intended destination.*/ + status = PMSessionGetDestinationType(printSession, printSettings, & printDestination); - status = PMSessionGetCurrentPrinter(printSession, & currentPrinter); - if (status == noErr) { - CFArrayRef mimeTypes; - status = PMPrinterGetMimeTypes(currentPrinter, printSettings, & mimeTypes); - if (status == noErr && mimeTypes != NULL) { - mimeType = CFSTR("application/pdf"); - if (CFArrayContainsValue(mimeTypes, CFRangeMake(0, CFArrayGetCount(mimeTypes)), mimeType)) { - status = PMPrinterPrintWithFile(currentPrinter, printSettings, pageFormat, mimeType, printURL); - CFRelease(urlFile); - return status; - } - } - } - } + /*Destination is printer. Send file to printer.*/ + if (status == noErr && printDestination == kPMDestinationPrinter) { - /* Destination is file. Determine how to handle. */ - if (status == noErr && printDestination == kPMDestinationFile) { - CFURLRef *outputLocation = NULL; - status = PMSessionCopyDestinationLocation(printSession, printSettings, &outputLocation); - if (status == noErr) { - /*Get the source file and target destination, convert to strings.*/ - CFStringRef sourceFile = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); - CFStringRef savePath = CFURLCopyFileSystemPath(outputLocation, kCFURLPOSIXPathStyle); - NSString * sourcePath = (NSString * ) sourceFile; - NSString * finalPath = (NSString * ) savePath; - NSString * pathExtension = [finalPath pathExtension]; - - /*Is the target file a PDF? If so, copy print file to output location.*/ - if ([pathExtension isEqualToString: @ "pdf"]) { - NSFileManager * fileManager = [NSFileManager defaultManager]; - if ([fileManager fileExistsAtPath: sourcePath]) { - NSError *error = nil; - [fileManager copyItemAtPath:sourcePath toPath:finalPath error:&error]; - } + status = PMSessionGetCurrentPrinter(printSession, & currentPrinter); + if (status == noErr) { + CFArrayRef mimeTypes; + status = PMPrinterGetMimeTypes(currentPrinter, printSettings, & mimeTypes); + if (status == noErr && mimeTypes != NULL) { + mimeType = CFSTR("application/pdf"); + if (CFArrayContainsValue(mimeTypes, CFRangeMake(0, CFArrayGetCount(mimeTypes)), mimeType)) { + status = PMPrinterPrintWithFile(currentPrinter, printSettings, pageFormat, mimeType, printURL); + CFRelease(urlFile); + return status; + } + } + } } - /* Is the target file PostScript? If so, run print file - * through CUPS filter to convert back to PostScript. - * Using strcat to build up system command is ugly, but it is - * simpler than NSTask and it works. - */ + /* Destination is file. Determine how to handle. */ + if (status == noErr && printDestination == kPMDestinationFile) { + CFURLRef * outputLocation = NULL; + status = PMSessionCopyDestinationLocation(printSession, printSettings, & outputLocation); + if (status == noErr) { + /*Get the source file and target destination, convert to strings.*/ + CFStringRef sourceFile = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); + CFStringRef savePath = CFURLCopyFileSystemPath(outputLocation, kCFURLPOSIXPathStyle); + NSString * sourcePath = (NSString * ) sourceFile; + NSString * finalPath = (NSString * ) savePath; + NSString * pathExtension = [finalPath pathExtension]; + + /* + * Is the target file a PDF? If so, copy print file + * to output location. + */ + if ([pathExtension isEqualToString: @ "pdf"]) { + NSFileManager * fileManager = [NSFileManager defaultManager]; + if ([fileManager fileExistsAtPath: sourcePath]) { + NSError * error = nil; + [fileManager copyItemAtPath: sourcePath toPath: finalPath error: & error]; + } + } + + /* Is the target file PostScript? If so, run print file + * through CUPS filter to convert back to PostScript. + * Using strcat to build up system command is ugly, but it is + * simpler than NSTask and it works. + */ + + if ([pathExtension isEqualToString: @ "ps"]) { + + char source[5012]; + char target[5012]; + + [sourcePath getCString: source maxLength: (sizeof source) encoding: NSUTF8StringEncoding]; + [finalPath getCString: target maxLength: (sizeof target) encoding: NSUTF8StringEncoding]; + + /*Add quote marks to address path names with spaces.*/ + char cmd[50000]; + strcpy(cmd, "/usr/sbin/cupsfilter "); + strcat(cmd, "\""); + strcat(cmd, source); + strcat(cmd, "\""); + strcat(cmd, " -m application/postscript > "); + strcat(cmd, "\""); + strcat(cmd, target); + strcat(cmd, "\""); + system(cmd); + } + return status; + } + } - if ([pathExtension isEqualToString: @ "ps"]) { - - char source[5012]; - char target[5012]; - - [sourcePath getCString: source maxLength: (sizeof source) encoding: NSUTF8StringEncoding]; - [finalPath getCString: target maxLength: (sizeof target) encoding: NSUTF8StringEncoding]; - - /*Add quote marks to address path names with spaces.*/ - char cmd[50000]; - strcpy(cmd, "/usr/sbin/cupsfilter "); - strcat(cmd, "\""); - strcat(cmd, source); - strcat(cmd, "\""); - strcat(cmd, " -m application/postscript > "); - strcat(cmd, "\""); - strcat(cmd, target); - strcat(cmd, "\""); - system(cmd); + /* Destination is preview. Open file in default application for PDF. */ + if ((status == noErr) && (printDestination == kPMDestinationPreview)) { + CFStringRef urlpath = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); + NSString * path = (NSString * ) urlpath; + NSURL * url = [NSURL fileURLWithPath: path]; + NSWorkspace * ws = [NSWorkspace sharedWorkspace]; + [ws openURL: url]; + status = noErr; + return status; } - return status; - } - } - /* Destination is preview. Open file in default application for PDF. */ - if ((status == noErr) && (printDestination == kPMDestinationPreview)) { - CFStringRef urlpath = CFURLCopyFileSystemPath(printURL, kCFURLPOSIXPathStyle); - NSString * path = (NSString * ) urlpath; - NSURL * url= [NSURL fileURLWithPath:path]; - NSWorkspace * ws = [NSWorkspace sharedWorkspace]; - [ws openURL: url]; - status = noErr; - return status; - } + /* + * If destination is not printer, file or preview, + * we do not support it. Display alert. + */ - /* - * If destination is not printer, file or preview, - * we do not support it. Display alert. - */ - - if ((status == noErr) && (printDestination != kPMDestinationPreview || kPMDestinationFile || kPMDestinationPrinter)) { + if ((status == noErr) && (printDestination != kPMDestinationPreview || kPMDestinationFile || kPMDestinationPrinter)) { - NSAlert * alert = [[[NSAlert alloc] init ] autorelease]; - [alert addButtonWithTitle: @ "OK"]; + NSAlert * alert = [[[NSAlert alloc] init] autorelease]; + [alert addButtonWithTitle: @ "OK"]; - [alert setMessageText: @ "Unsupported Printing Operation"]; - [alert setInformativeText: @ "This printing operation is not supported."]; - [alert setAlertStyle: NSAlertStyleInformational]; - [alert runModal]; - return status; + [alert setMessageText: @ "Unsupported Printing Operation"]; + [alert setInformativeText: @ "This printing operation is not supported."]; + [alert setAlertStyle: NSAlertStyleInformational]; + [alert runModal]; + return status; + } } - } - /* Return because cancel button was clicked. */ - if (buttonValue == NSModalResponseCancel) { + /* Return because cancel button was clicked. */ + if (buttonValue == NSModalResponseCancel) { - PMRelease(printSession); - return status; - } + PMRelease(printSession); + return status; + } - return status; + return status; } @@ -311,9 +313,9 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { */ int MacPrint_Init(Tcl_Interp * interp) { - NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; - Tcl_CreateObjCommand(interp, "::tk::print::_print", StartPrint, (ClientData) NULL, (Tcl_CmdDeleteProc * ) NULL); - [pool release]; - return TCL_OK; + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + Tcl_CreateObjCommand(interp, "::tk::print::_print", StartPrint, (ClientData) NULL, (Tcl_CmdDeleteProc * ) NULL); + [pool release]; + return TCL_OK; } -- cgit v0.12 From 336db58961b4429c3c52da4daae2d2f3530d76e4 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 4 Jul 2021 16:48:37 +0000 Subject: Fix some minor formatting issues; groff has weird gotchas --- doc/sysnotify.n | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/doc/sysnotify.n b/doc/sysnotify.n index 59e75d3..ea1ab89 100644 --- a/doc/sysnotify.n +++ b/doc/sysnotify.n @@ -18,8 +18,10 @@ The \fBtk sysnotify\fR command creates a platform-specific system notification a .SH EXAMPLE .PP Here is an example of the \fBtk sysnotify\fR code: +.PP .CS - tk sysnotify "Alert" "This is just a test of the Tk System Notification Code." +tk sysnotify "Alert" \e + "This is just a test of the Tk System Notification Code." .CE .SH PLATFORM NOTES .PP @@ -28,23 +30,27 @@ API's. The X11 version has a conditional dependency on libnotify, and falls back to a Tcl-only implementation if libnotify is not installed. On each platform the notification includes a platform-specific default image to accompany the text. -. .TP \fBmacOS\fR . The macOS version will request permission from the user to authorize -notifications. This must be activated in Apple's System Preferences Notifications section. - +notifications. This must be activated in Apple's System Preferences +Notifications section. +.RS +.PP If deploying an application using the standalone version of Wish.app, setting the bundle ID in the applications Info.plist file to begin with -"com" seems necessary for notifications to work. Using a different prefix -for the bundle ID, such as something like "tk.tcl.tkchat," will cause -notifications to silently fail. +.QW \fBcom\fR +seems necessary for notifications to work. Using a different prefix +for the bundle ID, such as something like +.QW \fBtk.tcl.tkchat\fR , +will cause notifications to silently fail. +.RE .TP \fBWindows\fR . -The image is taken from the systray i.e. a sysnotify can only be -called when a systray was installed. +The image is taken from the system tray, i.e., \fBsysnotify\fR can only be +called when a \fBsystray\fR was installed. . .SH KEYWORDS notify, alert -- cgit v0.12 From b847a55b2e14bd0021dcc94a0ff3dd264427828a Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 4 Jul 2021 17:18:26 +0000 Subject: Fixed more formatting issues --- doc/print.n | 67 +++++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 41 insertions(+), 26 deletions(-) diff --git a/doc/print.n b/doc/print.n index dd0abd6..c12d369 100644 --- a/doc/print.n +++ b/doc/print.n @@ -8,46 +8,61 @@ .TH tk print n "" Tk "Tk Built-in Commands" .so man.macros .SH NAME -print \- Print canvas and text widgets using native API's. +print \- Print canvas and text widgets using native dialogs and APIs. .SH SYNOPSIS -\fBtk print\fR \fIcanvas\fR \fIwindow\fR - -\fBtk print\fR \fItext\fR \fIwindow\fR +\fBtk print canvas\fR \fIwindow\fR +.sp +\fBtk print text\fR \fIwindow\fR .BE .SH DESCRIPTION .PP -The \fBtk print\fR command allows users to print output from -the \fBcanvas\fR and \fBtext\fR widgets using platform-native API's and -dialogs. +The \fBtk print\fR command posts a dialog that allows users to print output +from the \fBcanvas\fR and \fBtext\fR widgets. The printing will be done using +platform-native APIs and dialogs where available. +.PP +The \fBcanvas\fR widget has long supported PostScript export and both +PostScript and text files can be sent directly to a printer on Unix-like +systems using the +.QW "lp" +and +.QW "lpr" +Unix commands, and the \fBtk print\fR command does not supersede that +functionality; it builds on it. The \fBtk print\fR command is a fuller +implementation that uses native dialogs on macOS and Windows, and a Tk-based +dialog that provides parallel functionality on X11. .PP -The \fBcanvas\fR widget has long supported PostScript export and both PostScript and text files can be sent directly to a printer on Unix-like systems using the "lp" or "lpr" commands, and the \fBtk print\fR command does not supersede that functionality; it builds on it. The \fBtk print\fR command is a fuller implementation that uses native dialogs on macOS and Windows, and a Tk-based dialog that provides parallel functionality on X11. +Note that the first argument to \fBtk print\fR is the type of widget being +printed; currently only \fBcanvas\fR and \fBtext\fR widgets may be printed. .SH PLATFORM NOTES .TP -. \fBmacOS\fR -.PP -The Mac implementation uses native print dialogs and relies on the -underlying Common Unix Printing System (CUPS) to render text output from -the text widget and PostScript output from the canvas widget to the -printer, to a PDF file, or a PostScript file. +. +The Mac implementation uses native print dialogs and relies on the underlying +Common Unix Printing System (CUPS) to render text output from the text widget +and PostScript output from the canvas widget to the printer, to a PDF file, or +a PostScript file. .TP \fBWindows\fR -.PP +. The Windows implementation is based on the GDI (Graphics Device Interface) API. Because there are slight differences in how GDI and Tk's \fBcanvas\fR -widget display graphics, printed output from the \fBcanvas\fR on Windows -may not be identical to screen rendering. +widget display graphics, printed output from the \fBcanvas\fR on Windows may +not be identical to screen rendering. .TP \fBX11\fR -.PP -The X11 implementation uses a Tk GUI to configure print jobs for sending -to a printer via the "lpr" or "lp" commands. While these commands have a -large number of parameters for configuring print jobs, printers vary -widely in how they support these parameters. As a result, only printer -selection and number of copies are configured as arguments to the print -command; many aspects of print rendering, such as grayscale or color for -the canvas, are instead configured when PostScript is generated. . +The X11 implementation uses a Tk GUI to configure print jobs for sending to a +printer via the +.QW "lpr" +or +.QW "lp" +commands. While these commands have a large number of parameters for +configuring print jobs, printers vary widely in how they support these +parameters. As a result, only printer selection and number of copies are +configured as arguments to the print command; many aspects of print rendering, +such as grayscale or color for the canvas, are instead configured when +PostScript is generated. +.SH "SEE ALSO" +canvas(n), text(n), tk(n) .SH KEYWORDS print, output, graphics, text, canvas - -- cgit v0.12 From b2121aa67639f868f6f62a40a5ca0a61c4ef69e4 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 5 Jul 2021 04:39:30 +0000 Subject: Remove some compiler warnings --- macosx/tkMacOSXPrint.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 2f9c7be..731d1b5 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -231,11 +231,11 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { /* Is the target file PostScript? If so, run print file * through CUPS filter to convert back to PostScript. - * Using strcat to build up system command is ugly, but it is - * simpler than NSTask and it works. + * Using strcat to build up system command is ugly, but + * it is simpler than NSTask and it works. */ - if ([pathExtension isEqualToString: @ "ps"]) { + if ([pathExtension isEqualToString: @ "ps"]) { char source[5012]; char target[5012]; @@ -275,7 +275,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { * we do not support it. Display alert. */ - if ((status == noErr) && (printDestination != kPMDestinationPreview || kPMDestinationFile || kPMDestinationPrinter)) { + if (((status == noErr) && (printDestination != kPMDestinationPreview)) || ((status == noErr) && (printDestination != kPMDestinationFile)) || ((status == noErr) && (printDestination != kPMDestinationPrinter))) { NSAlert * alert = [[[NSAlert alloc] init] autorelease]; [alert addButtonWithTitle: @ "OK"]; -- cgit v0.12 From d23f6acf9a16e4b728177590faafd4a30fda869f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 5 Jul 2021 07:26:54 +0000 Subject: eliminate end-of-line spacing --- library/msgs/cs.msg | 32 ++++++++++++++++---------------- library/msgs/da.msg | 32 ++++++++++++++++---------------- library/msgs/de.msg | 32 ++++++++++++++++---------------- library/msgs/el.msg | 32 ++++++++++++++++---------------- library/msgs/en.msg | 32 ++++++++++++++++---------------- library/msgs/eo.msg | 32 ++++++++++++++++---------------- library/msgs/es.msg | 32 ++++++++++++++++---------------- library/msgs/fr.msg | 32 ++++++++++++++++---------------- library/msgs/hu.msg | 32 ++++++++++++++++---------------- library/msgs/it.msg | 32 ++++++++++++++++---------------- library/msgs/nl.msg | 32 ++++++++++++++++---------------- library/msgs/pl.msg | 32 ++++++++++++++++---------------- library/msgs/pt.msg | 32 ++++++++++++++++---------------- library/msgs/ru.msg | 32 ++++++++++++++++---------------- library/msgs/sv.msg | 32 ++++++++++++++++---------------- library/print.tcl | 2 +- macosx/tkMacOSXPrint.c | 20 ++++++++++---------- 17 files changed, 251 insertions(+), 251 deletions(-) diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg index 92e98e3..c9ee256 100644 --- a/library/msgs/cs.msg +++ b/library/msgs/cs.msg @@ -76,20 +76,20 @@ namespace eval ::tk { ::msgcat::mcset cs "yes" "ano" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset cs "Print" "Tisknout" - ::msgcat::mcset cs "Printer" "Tiskárna" - ::msgcat::mcset cs "Letter " "Dopis " - ::msgcat::mcset cs "Legal " "Legální " - ::msgcat::mcset cs "A4" "A4" - ::msgcat::mcset cs "Grayscale" "StupnÄ› Å edi" - ::msgcat::mcset cs "RGB" "RGB" - ::msgcat::mcset cs "Options" "Možnosti" - ::msgcat::mcset cs "Copies" "Kopie" - ::msgcat::mcset cs "Paper" "Papír" - ::msgcat::mcset cs "Scale" "Å kála" - ::msgcat::mcset cs "Orientation" "Orientace" - ::msgcat::mcset cs "Portrait" "Portrét" - ::msgcat::mcset cs "Landscape" "Krajina" - ::msgcat::mcset cs "Output" "Výstup" +namespace eval ::tk { + ::msgcat::mcset cs "Print" "Tisknout" + ::msgcat::mcset cs "Printer" "Tiskárna" + ::msgcat::mcset cs "Letter " "Dopis " + ::msgcat::mcset cs "Legal " "Legální " + ::msgcat::mcset cs "A4" "A4" + ::msgcat::mcset cs "Grayscale" "StupnÄ› Å edi" + ::msgcat::mcset cs "RGB" "RGB" + ::msgcat::mcset cs "Options" "Možnosti" + ::msgcat::mcset cs "Copies" "Kopie" + ::msgcat::mcset cs "Paper" "Papír" + ::msgcat::mcset cs "Scale" "Å kála" + ::msgcat::mcset cs "Orientation" "Orientace" + ::msgcat::mcset cs "Portrait" "Portrét" + ::msgcat::mcset cs "Landscape" "Krajina" + ::msgcat::mcset cs "Output" "Výstup" } \ No newline at end of file diff --git a/library/msgs/da.msg b/library/msgs/da.msg index 7f9559e..eb86516 100644 --- a/library/msgs/da.msg +++ b/library/msgs/da.msg @@ -77,20 +77,20 @@ namespace eval ::tk { ::msgcat::mcset da "yes" "ja" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset da "Print" "Trykke" - ::msgcat::mcset da "Printer" "Printer" - ::msgcat::mcset da "Letter " "Brev" - ::msgcat::mcset da "Legal " "Juridisk" - ::msgcat::mcset da "A4" "A4" - ::msgcat::mcset da "Grayscale" "GrÃ¥toneskala" - ::msgcat::mcset da "RGB" "Rgb" - ::msgcat::mcset da "Options" "Indstillinger" - ::msgcat::mcset da "Copies" "Kopier" - ::msgcat::mcset da "Paper" "Papir" - ::msgcat::mcset da "Scale" "Skalere" - ::msgcat::mcset da "Orientation" "Orientering" - ::msgcat::mcset da "Portrait" "Portræt" - ::msgcat::mcset da "Landscape" "Landskab" - ::msgcat::mcset da "Output" "Udskriv Publikation" +namespace eval ::tk { + ::msgcat::mcset da "Print" "Trykke" + ::msgcat::mcset da "Printer" "Printer" + ::msgcat::mcset da "Letter " "Brev" + ::msgcat::mcset da "Legal " "Juridisk" + ::msgcat::mcset da "A4" "A4" + ::msgcat::mcset da "Grayscale" "GrÃ¥toneskala" + ::msgcat::mcset da "RGB" "Rgb" + ::msgcat::mcset da "Options" "Indstillinger" + ::msgcat::mcset da "Copies" "Kopier" + ::msgcat::mcset da "Paper" "Papir" + ::msgcat::mcset da "Scale" "Skalere" + ::msgcat::mcset da "Orientation" "Orientering" + ::msgcat::mcset da "Portrait" "Portræt" + ::msgcat::mcset da "Landscape" "Landskab" + ::msgcat::mcset da "Output" "Udskriv Publikation" } \ No newline at end of file diff --git a/library/msgs/de.msg b/library/msgs/de.msg index 9f485db..fb4a8e7 100644 --- a/library/msgs/de.msg +++ b/library/msgs/de.msg @@ -90,20 +90,20 @@ namespace eval ::tk { ::msgcat::mcset de "yes" "ja" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset de "Print" "Drucken" - ::msgcat::mcset de "Printer" "Drucker" - ::msgcat::mcset de "Letter " "Brief" - ::msgcat::mcset de "Legal " "Rechtlich" - ::msgcat::mcset de "A4" "A4" - ::msgcat::mcset de "Grayscale" "Graustufen" - ::msgcat::mcset de "RGB" "Rgb" - ::msgcat::mcset de "Options" "Optionen" - ::msgcat::mcset de "Copies" "Kopien" - ::msgcat::mcset de "Paper" "Papier" - ::msgcat::mcset de "Scale" "Skala" - ::msgcat::mcset de "Orientation" "Ausrichtung" - ::msgcat::mcset de "Portrait" "Porträt" - ::msgcat::mcset de "Landscape" "Landschaft" - ::msgcat::mcset de "Output" "Ausgabe" +namespace eval ::tk { + ::msgcat::mcset de "Print" "Drucken" + ::msgcat::mcset de "Printer" "Drucker" + ::msgcat::mcset de "Letter " "Brief" + ::msgcat::mcset de "Legal " "Rechtlich" + ::msgcat::mcset de "A4" "A4" + ::msgcat::mcset de "Grayscale" "Graustufen" + ::msgcat::mcset de "RGB" "Rgb" + ::msgcat::mcset de "Options" "Optionen" + ::msgcat::mcset de "Copies" "Kopien" + ::msgcat::mcset de "Paper" "Papier" + ::msgcat::mcset de "Scale" "Skala" + ::msgcat::mcset de "Orientation" "Ausrichtung" + ::msgcat::mcset de "Portrait" "Porträt" + ::msgcat::mcset de "Landscape" "Landschaft" + ::msgcat::mcset de "Output" "Ausgabe" } \ No newline at end of file diff --git a/library/msgs/el.msg b/library/msgs/el.msg index c7f2781..7aa6246 100644 --- a/library/msgs/el.msg +++ b/library/msgs/el.msg @@ -85,20 +85,20 @@ namespace eval ::tk { ::msgcat::mcset el "yes" "ναι" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset el "Print" "Τυπώνω" - ::msgcat::mcset el "Printer" "Εκτυπωτής" - ::msgcat::mcset el "Letter " "ΓÏάμμα" - ::msgcat::mcset el "Legal " "Îομικός" - ::msgcat::mcset el "A4" "Α4" - ::msgcat::mcset el "Grayscale" "Κλίμακα Του ΓκÏι" - ::msgcat::mcset el "RGB" "Rgb" - ::msgcat::mcset el "Options" "Επιλογές" - ::msgcat::mcset el "Copies" "ΑντίγÏαφα" - ::msgcat::mcset el "Paper" "ΧαÏτί" - ::msgcat::mcset el "Scale" "Κλίμακα" - ::msgcat::mcset el "Orientation" "ΠÏοσανατολισμός" - ::msgcat::mcset el "Portrait" "ΠÏοσωπογÏαφία" - ::msgcat::mcset el "Landscape" "Τοπίο" - ::msgcat::mcset el "Output" "Έξοδος" +namespace eval ::tk { + ::msgcat::mcset el "Print" "Τυπώνω" + ::msgcat::mcset el "Printer" "Εκτυπωτής" + ::msgcat::mcset el "Letter " "ΓÏάμμα" + ::msgcat::mcset el "Legal " "Îομικός" + ::msgcat::mcset el "A4" "Α4" + ::msgcat::mcset el "Grayscale" "Κλίμακα Του ΓκÏι" + ::msgcat::mcset el "RGB" "Rgb" + ::msgcat::mcset el "Options" "Επιλογές" + ::msgcat::mcset el "Copies" "ΑντίγÏαφα" + ::msgcat::mcset el "Paper" "ΧαÏτί" + ::msgcat::mcset el "Scale" "Κλίμακα" + ::msgcat::mcset el "Orientation" "ΠÏοσανατολισμός" + ::msgcat::mcset el "Portrait" "ΠÏοσωπογÏαφία" + ::msgcat::mcset el "Landscape" "Τοπίο" + ::msgcat::mcset el "Output" "Έξοδος" } \ No newline at end of file diff --git a/library/msgs/en.msg b/library/msgs/en.msg index 8f192f0..3f0d988 100644 --- a/library/msgs/en.msg +++ b/library/msgs/en.msg @@ -91,20 +91,20 @@ namespace eval ::tk { } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset en "Print" - ::msgcat::mcset en "Printer" - ::msgcat::mcset en "Letter " - ::msgcat::mcset en "Legal " - ::msgcat::mcset en "A4" - ::msgcat::mcset en "Grayscale" - ::msgcat::mcset en "RGB" - ::msgcat::mcset en "Options" - ::msgcat::mcset en "Copies" - ::msgcat::mcset en "Paper" - ::msgcat::mcset en "Scale" - ::msgcat::mcset en "Orientation" - ::msgcat::mcset en "Portrait" - ::msgcat::mcset en "Landscape" - ::msgcat::mcset en "Output" +namespace eval ::tk { + ::msgcat::mcset en "Print" + ::msgcat::mcset en "Printer" + ::msgcat::mcset en "Letter " + ::msgcat::mcset en "Legal " + ::msgcat::mcset en "A4" + ::msgcat::mcset en "Grayscale" + ::msgcat::mcset en "RGB" + ::msgcat::mcset en "Options" + ::msgcat::mcset en "Copies" + ::msgcat::mcset en "Paper" + ::msgcat::mcset en "Scale" + ::msgcat::mcset en "Orientation" + ::msgcat::mcset en "Portrait" + ::msgcat::mcset en "Landscape" + ::msgcat::mcset en "Output" } diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg index 04a73e8..08dfc1e 100644 --- a/library/msgs/eo.msg +++ b/library/msgs/eo.msg @@ -74,20 +74,20 @@ namespace eval ::tk { ::msgcat::mcset eo "yes" "jes" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset eo "Print" "Presi" - ::msgcat::mcset eo "Printer" "Presilo" - ::msgcat::mcset eo "Letter " "Letero" - ::msgcat::mcset eo "Legal " "LaÅ­leÄa" - ::msgcat::mcset eo "A4" "A4" - ::msgcat::mcset eo "Grayscale" "Grizskalo" - ::msgcat::mcset eo "RGB" "RGB" - ::msgcat::mcset eo "Options" "Opcioj" - ::msgcat::mcset eo "Copies" "Kopioj" - ::msgcat::mcset eo "Paper" "Papero" - ::msgcat::mcset eo "Scale" "Skalo" - ::msgcat::mcset eo "Orientation" "OrientiÄo" - ::msgcat::mcset eo "Portrait" "Portreto" - ::msgcat::mcset eo "Landscape" "PejzaÄo" - ::msgcat::mcset eo "Output" "Eligo" +namespace eval ::tk { + ::msgcat::mcset eo "Print" "Presi" + ::msgcat::mcset eo "Printer" "Presilo" + ::msgcat::mcset eo "Letter " "Letero" + ::msgcat::mcset eo "Legal " "LaÅ­leÄa" + ::msgcat::mcset eo "A4" "A4" + ::msgcat::mcset eo "Grayscale" "Grizskalo" + ::msgcat::mcset eo "RGB" "RGB" + ::msgcat::mcset eo "Options" "Opcioj" + ::msgcat::mcset eo "Copies" "Kopioj" + ::msgcat::mcset eo "Paper" "Papero" + ::msgcat::mcset eo "Scale" "Skalo" + ::msgcat::mcset eo "Orientation" "OrientiÄo" + ::msgcat::mcset eo "Portrait" "Portreto" + ::msgcat::mcset eo "Landscape" "PejzaÄo" + ::msgcat::mcset eo "Output" "Eligo" } \ No newline at end of file diff --git a/library/msgs/es.msg b/library/msgs/es.msg index ea96929..724ea3b 100644 --- a/library/msgs/es.msg +++ b/library/msgs/es.msg @@ -75,20 +75,20 @@ namespace eval ::tk { ::msgcat::mcset es "yes" "sí" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset es "Print" "Imprimir" - ::msgcat::mcset es "Printer" "Impresora" - ::msgcat::mcset es "Letter " "Carta" - ::msgcat::mcset es "Legal " "Legal" - ::msgcat::mcset es "A4" "A4" - ::msgcat::mcset es "Grayscale" "Escala De Grises" - ::msgcat::mcset es "RGB" "Rgb" - ::msgcat::mcset es "Options" "Opciones" - ::msgcat::mcset es "Copies" "Copias" - ::msgcat::mcset es "Paper" "Papel" - ::msgcat::mcset es "Scale" "Escama" - ::msgcat::mcset es "Orientation" "Orientación" - ::msgcat::mcset es "Portrait" "Retrato" - ::msgcat::mcset es "Landscape" "Paisaje" - ::msgcat::mcset es "Output" "Salida" +namespace eval ::tk { + ::msgcat::mcset es "Print" "Imprimir" + ::msgcat::mcset es "Printer" "Impresora" + ::msgcat::mcset es "Letter " "Carta" + ::msgcat::mcset es "Legal " "Legal" + ::msgcat::mcset es "A4" "A4" + ::msgcat::mcset es "Grayscale" "Escala De Grises" + ::msgcat::mcset es "RGB" "Rgb" + ::msgcat::mcset es "Options" "Opciones" + ::msgcat::mcset es "Copies" "Copias" + ::msgcat::mcset es "Paper" "Papel" + ::msgcat::mcset es "Scale" "Escama" + ::msgcat::mcset es "Orientation" "Orientación" + ::msgcat::mcset es "Portrait" "Retrato" + ::msgcat::mcset es "Landscape" "Paisaje" + ::msgcat::mcset es "Output" "Salida" } \ No newline at end of file diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg index 7d492e7..570138d 100644 --- a/library/msgs/fr.msg +++ b/library/msgs/fr.msg @@ -71,20 +71,20 @@ namespace eval ::tk { ::msgcat::mcset fr "yes" "oui" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset fr "Print" "Imprimer" - ::msgcat::mcset fr "Printer" "Imprimante" - ::msgcat::mcset fr "Letter " "Lettre" - ::msgcat::mcset fr "Legal " "Légal" - ::msgcat::mcset fr "A4" "A4" - ::msgcat::mcset fr "Grayscale" "Niveaux de Gris" - ::msgcat::mcset fr "RGB" "Rvb" - ::msgcat::mcset fr "Options" "Options" - ::msgcat::mcset fr "Copies" "Copies" - ::msgcat::mcset fr "Paper" "Papier" - ::msgcat::mcset fr "Scale" "Écaille" - ::msgcat::mcset fr "Orientation" "Orientation" - ::msgcat::mcset fr "Portrait" "Portrait" - ::msgcat::mcset fr "Landscape" "Paysage" - ::msgcat::mcset fr "Output" "Sortie" +namespace eval ::tk { + ::msgcat::mcset fr "Print" "Imprimer" + ::msgcat::mcset fr "Printer" "Imprimante" + ::msgcat::mcset fr "Letter " "Lettre" + ::msgcat::mcset fr "Legal " "Légal" + ::msgcat::mcset fr "A4" "A4" + ::msgcat::mcset fr "Grayscale" "Niveaux de Gris" + ::msgcat::mcset fr "RGB" "Rvb" + ::msgcat::mcset fr "Options" "Options" + ::msgcat::mcset fr "Copies" "Copies" + ::msgcat::mcset fr "Paper" "Papier" + ::msgcat::mcset fr "Scale" "Écaille" + ::msgcat::mcset fr "Orientation" "Orientation" + ::msgcat::mcset fr "Portrait" "Portrait" + ::msgcat::mcset fr "Landscape" "Paysage" + ::msgcat::mcset fr "Output" "Sortie" } \ No newline at end of file diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg index 1640076..5c1d929 100644 --- a/library/msgs/hu.msg +++ b/library/msgs/hu.msg @@ -77,20 +77,20 @@ namespace eval ::tk { ::msgcat::mcset hu "yes" "igen" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset hu "Print" "Nyomtat" - ::msgcat::mcset hu "Printer" "Nyomtató" - ::msgcat::mcset hu "Letter " "Levél" - ::msgcat::mcset hu "Legal " "Törvényes" - ::msgcat::mcset hu "A4" "A4" - ::msgcat::mcset hu "Grayscale" "Szürkeárnyalatos" - ::msgcat::mcset hu "RGB" "Rgb" - ::msgcat::mcset hu "Options" "Beállítások" - ::msgcat::mcset hu "Copies" "Másolatok" - ::msgcat::mcset hu "Paper" "Papír" - ::msgcat::mcset hu "Scale" "Hangsor" - ::msgcat::mcset hu "Orientation" "Tájékozódás" - ::msgcat::mcset hu "Portrait" "Portré" - ::msgcat::mcset hu "Landscape" "Táj" - ::msgcat::mcset hu "Output" "Hozam" +namespace eval ::tk { + ::msgcat::mcset hu "Print" "Nyomtat" + ::msgcat::mcset hu "Printer" "Nyomtató" + ::msgcat::mcset hu "Letter " "Levél" + ::msgcat::mcset hu "Legal " "Törvényes" + ::msgcat::mcset hu "A4" "A4" + ::msgcat::mcset hu "Grayscale" "Szürkeárnyalatos" + ::msgcat::mcset hu "RGB" "Rgb" + ::msgcat::mcset hu "Options" "Beállítások" + ::msgcat::mcset hu "Copies" "Másolatok" + ::msgcat::mcset hu "Paper" "Papír" + ::msgcat::mcset hu "Scale" "Hangsor" + ::msgcat::mcset hu "Orientation" "Tájékozódás" + ::msgcat::mcset hu "Portrait" "Portré" + ::msgcat::mcset hu "Landscape" "Táj" + ::msgcat::mcset hu "Output" "Hozam" } \ No newline at end of file diff --git a/library/msgs/it.msg b/library/msgs/it.msg index 65f836f..d7d9263 100644 --- a/library/msgs/it.msg +++ b/library/msgs/it.msg @@ -72,20 +72,20 @@ namespace eval ::tk { ::msgcat::mcset it "yes" "sì" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset it "Print" "Stampare" - ::msgcat::mcset it "Printer" "Stampante" - ::msgcat::mcset it "Letter " "Lettera" - ::msgcat::mcset it "Legal " "Legale" - ::msgcat::mcset it "A4" "A4" - ::msgcat::mcset it "Grayscale" "Scala Di Grigi" - ::msgcat::mcset it "RGB" "Rgb" - ::msgcat::mcset it "Options" "Opzioni" - ::msgcat::mcset it "Copies" "Copie" - ::msgcat::mcset it "Paper" "Carta" - ::msgcat::mcset it "Scale" "Scala" - ::msgcat::mcset it "Orientation" "Orientamento" - ::msgcat::mcset it "Portrait" "Ritratto" - ::msgcat::mcset it "Landscape" "Paesaggio" - ::msgcat::mcset it "Output" "Prodotto" +namespace eval ::tk { + ::msgcat::mcset it "Print" "Stampare" + ::msgcat::mcset it "Printer" "Stampante" + ::msgcat::mcset it "Letter " "Lettera" + ::msgcat::mcset it "Legal " "Legale" + ::msgcat::mcset it "A4" "A4" + ::msgcat::mcset it "Grayscale" "Scala Di Grigi" + ::msgcat::mcset it "RGB" "Rgb" + ::msgcat::mcset it "Options" "Opzioni" + ::msgcat::mcset it "Copies" "Copie" + ::msgcat::mcset it "Paper" "Carta" + ::msgcat::mcset it "Scale" "Scala" + ::msgcat::mcset it "Orientation" "Orientamento" + ::msgcat::mcset it "Portrait" "Ritratto" + ::msgcat::mcset it "Landscape" "Paesaggio" + ::msgcat::mcset it "Output" "Prodotto" } \ No newline at end of file diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg index bd8a01f..b751824 100644 --- a/library/msgs/nl.msg +++ b/library/msgs/nl.msg @@ -90,20 +90,20 @@ namespace eval ::tk { ::msgcat::mcset nl "yes" "ja" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset nl "Print" "Afdrukken" - ::msgcat::mcset nl "Printer" "Printer" - ::msgcat::mcset nl "Letter " "Brief" - ::msgcat::mcset nl "Legal " "Legaal" - ::msgcat::mcset nl "A4" "A4" - ::msgcat::mcset nl "Grayscale" "Grijswaarden" - ::msgcat::mcset nl "RGB" "Rgb" - ::msgcat::mcset nl "Options" "Opties" - ::msgcat::mcset nl "Copies" "Kopieën" - ::msgcat::mcset nl "Paper" "Papier" - ::msgcat::mcset nl "Scale" "Schub" - ::msgcat::mcset nl "Orientation" "Oriëntatie" - ::msgcat::mcset nl "Portrait" "Portret" - ::msgcat::mcset nl "Landscape" "Landschap" - ::msgcat::mcset nl "Output" "Uitvoer" +namespace eval ::tk { + ::msgcat::mcset nl "Print" "Afdrukken" + ::msgcat::mcset nl "Printer" "Printer" + ::msgcat::mcset nl "Letter " "Brief" + ::msgcat::mcset nl "Legal " "Legaal" + ::msgcat::mcset nl "A4" "A4" + ::msgcat::mcset nl "Grayscale" "Grijswaarden" + ::msgcat::mcset nl "RGB" "Rgb" + ::msgcat::mcset nl "Options" "Opties" + ::msgcat::mcset nl "Copies" "Kopieën" + ::msgcat::mcset nl "Paper" "Papier" + ::msgcat::mcset nl "Scale" "Schub" + ::msgcat::mcset nl "Orientation" "Oriëntatie" + ::msgcat::mcset nl "Portrait" "Portret" + ::msgcat::mcset nl "Landscape" "Landschap" + ::msgcat::mcset nl "Output" "Uitvoer" } \ No newline at end of file diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg index a5d55e4..d47b834 100644 --- a/library/msgs/pl.msg +++ b/library/msgs/pl.msg @@ -90,20 +90,20 @@ namespace eval ::tk { ::msgcat::mcset pl "yes" "tak" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset pl "Print" "Drukować" - ::msgcat::mcset pl "Printer" "Drukarka" - ::msgcat::mcset pl "Letter " "Litera" - ::msgcat::mcset pl "Legal " "Legalny" - ::msgcat::mcset pl "A4" "A4" - ::msgcat::mcset pl "Grayscale" "Skala SzaroÅ›ci" - ::msgcat::mcset pl "RGB" "Rgb" - ::msgcat::mcset pl "Options" "Opcje" - ::msgcat::mcset pl "Copies" "Kopie" - ::msgcat::mcset pl "Paper" "Papier" - ::msgcat::mcset pl "Scale" "Skala" - ::msgcat::mcset pl "Orientation" "Orientacja" - ::msgcat::mcset pl "Portrait" "Portret" - ::msgcat::mcset pl "Landscape" "Krajobraz" - ::msgcat::mcset pl "Output" "Produkt WyjÅ›ciowy" +namespace eval ::tk { + ::msgcat::mcset pl "Print" "Drukować" + ::msgcat::mcset pl "Printer" "Drukarka" + ::msgcat::mcset pl "Letter " "Litera" + ::msgcat::mcset pl "Legal " "Legalny" + ::msgcat::mcset pl "A4" "A4" + ::msgcat::mcset pl "Grayscale" "Skala SzaroÅ›ci" + ::msgcat::mcset pl "RGB" "Rgb" + ::msgcat::mcset pl "Options" "Opcje" + ::msgcat::mcset pl "Copies" "Kopie" + ::msgcat::mcset pl "Paper" "Papier" + ::msgcat::mcset pl "Scale" "Skala" + ::msgcat::mcset pl "Orientation" "Orientacja" + ::msgcat::mcset pl "Portrait" "Portret" + ::msgcat::mcset pl "Landscape" "Krajobraz" + ::msgcat::mcset pl "Output" "Produkt WyjÅ›ciowy" } \ No newline at end of file diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg index 43b25b4..d4fdfea 100644 --- a/library/msgs/pt.msg +++ b/library/msgs/pt.msg @@ -73,20 +73,20 @@ namespace eval ::tk { ::msgcat::mcset pt "yes" "sim" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset pt "Print" "Imprimir" - ::msgcat::mcset pt "Printer" "Impressora" - ::msgcat::mcset pt "Letter " "Letra" - ::msgcat::mcset pt "Legal " "Legal" - ::msgcat::mcset pt "A4" "A4" - ::msgcat::mcset pt "Grayscale" "Escala De Cinza" - ::msgcat::mcset pt "RGB" "Rgb" - ::msgcat::mcset pt "Options" "Opções" - ::msgcat::mcset pt "Copies" "Exemplares" - ::msgcat::mcset pt "Paper" "Papel" - ::msgcat::mcset pt "Scale" "Escala" - ::msgcat::mcset pt "Orientation" "Orientação" - ::msgcat::mcset pt "Portrait" "Retrato" - ::msgcat::mcset pt "Landscape" "Paisagem" - ::msgcat::mcset pt "Output" "Saída" +namespace eval ::tk { + ::msgcat::mcset pt "Print" "Imprimir" + ::msgcat::mcset pt "Printer" "Impressora" + ::msgcat::mcset pt "Letter " "Letra" + ::msgcat::mcset pt "Legal " "Legal" + ::msgcat::mcset pt "A4" "A4" + ::msgcat::mcset pt "Grayscale" "Escala De Cinza" + ::msgcat::mcset pt "RGB" "Rgb" + ::msgcat::mcset pt "Options" "Opções" + ::msgcat::mcset pt "Copies" "Exemplares" + ::msgcat::mcset pt "Paper" "Papel" + ::msgcat::mcset pt "Scale" "Escala" + ::msgcat::mcset pt "Orientation" "Orientação" + ::msgcat::mcset pt "Portrait" "Retrato" + ::msgcat::mcset pt "Landscape" "Paisagem" + ::msgcat::mcset pt "Output" "Saída" } \ No newline at end of file diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg index fea3c1a..bd7c7b2 100644 --- a/library/msgs/ru.msg +++ b/library/msgs/ru.msg @@ -74,20 +74,20 @@ namespace eval ::tk { } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset ru "Print" "Печатать" - ::msgcat::mcset ru "Printer" "Принтер" - ::msgcat::mcset ru "Letter " "ПиÑьмо" - ::msgcat::mcset ru "Legal " "Законный" - ::msgcat::mcset ru "A4" "A4" - ::msgcat::mcset ru "Grayscale" "Серый МаÑштаб" - ::msgcat::mcset ru "RGB" "Ргб" - ::msgcat::mcset ru "Options" "Параметры" - ::msgcat::mcset ru "Copies" "Копии" - ::msgcat::mcset ru "Paper" "Бумага" - ::msgcat::mcset ru "Scale" "Шкала" - ::msgcat::mcset ru "Orientation" "ОриентациÑ" - ::msgcat::mcset ru "Portrait" "Портрет" - ::msgcat::mcset ru "Landscape" "Ландшафт" - ::msgcat::mcset ru "Output" "ВыпуÑк" +namespace eval ::tk { + ::msgcat::mcset ru "Print" "Печатать" + ::msgcat::mcset ru "Printer" "Принтер" + ::msgcat::mcset ru "Letter " "ПиÑьмо" + ::msgcat::mcset ru "Legal " "Законный" + ::msgcat::mcset ru "A4" "A4" + ::msgcat::mcset ru "Grayscale" "Серый МаÑштаб" + ::msgcat::mcset ru "RGB" "Ргб" + ::msgcat::mcset ru "Options" "Параметры" + ::msgcat::mcset ru "Copies" "Копии" + ::msgcat::mcset ru "Paper" "Бумага" + ::msgcat::mcset ru "Scale" "Шкала" + ::msgcat::mcset ru "Orientation" "ОриентациÑ" + ::msgcat::mcset ru "Portrait" "Портрет" + ::msgcat::mcset ru "Landscape" "Ландшафт" + ::msgcat::mcset ru "Output" "ВыпуÑк" } \ No newline at end of file diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg index 5dc81ab..5858221 100644 --- a/library/msgs/sv.msg +++ b/library/msgs/sv.msg @@ -75,20 +75,20 @@ namespace eval ::tk { ::msgcat::mcset sv "yes" "ja" } #localization of print terms by Kevin Walzer via Microsoft Translator -namespace eval ::tk { - ::msgcat::mcset sv "Print" "Trycka" - ::msgcat::mcset sv "Printer" "Skrivare" - ::msgcat::mcset sv "Letter " "Brev" - ::msgcat::mcset sv "Legal " "Laglig" - ::msgcat::mcset sv "A4" "A4 (PÃ¥ 199" - ::msgcat::mcset sv "Grayscale" "GrÃ¥skala" - ::msgcat::mcset sv "RGB" "Rgb" - ::msgcat::mcset sv "Options" "Alternativ" - ::msgcat::mcset sv "Copies" "Kopior" - ::msgcat::mcset sv "Paper" "Papper" - ::msgcat::mcset sv "Scale" "Skala" - ::msgcat::mcset sv "Orientation" "Orientering" - ::msgcat::mcset sv "Portrait" "Porträtt" - ::msgcat::mcset sv "Landscape" "Landskap" - ::msgcat::mcset sv "Output" "Utdata" +namespace eval ::tk { + ::msgcat::mcset sv "Print" "Trycka" + ::msgcat::mcset sv "Printer" "Skrivare" + ::msgcat::mcset sv "Letter " "Brev" + ::msgcat::mcset sv "Legal " "Laglig" + ::msgcat::mcset sv "A4" "A4 (PÃ¥ 199" + ::msgcat::mcset sv "Grayscale" "GrÃ¥skala" + ::msgcat::mcset sv "RGB" "Rgb" + ::msgcat::mcset sv "Options" "Alternativ" + ::msgcat::mcset sv "Copies" "Kopior" + ::msgcat::mcset sv "Paper" "Papper" + ::msgcat::mcset sv "Scale" "Skala" + ::msgcat::mcset sv "Orientation" "Orientering" + ::msgcat::mcset sv "Portrait" "Porträtt" + ::msgcat::mcset sv "Landscape" "Landskap" + ::msgcat::mcset sv "Output" "Utdata" } \ No newline at end of file diff --git a/library/print.tcl b/library/print.tcl index bed0cd3..8439485 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -950,7 +950,7 @@ proc ::tk::print::canvas {w} { catch {exec /usr/sbin/cupsfilter $file > $printfile} ::tk::print::_print $printfile } - + } proc ::tk::print::text {w} { diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 731d1b5..5dca510 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -43,9 +43,9 @@ int MacPrint_Init(Tcl_Interp * interp); } - (void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo { - /* - * Pass returnCode to FinishPrint function to determine how to - * handle. + /* + * Pass returnCode to FinishPrint function to determine how to + * handle. */ FinishPrint(fileName, returnCode); } @@ -140,7 +140,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { CFStringRef mimeType = NULL; /* - * If value passed here is NSCancelButton, return noErr; + * If value passed here is NSCancelButton, return noErr; * otherwise printing will occur regardless of value. */ if (buttonValue == NSModalResponseCancel) { @@ -217,8 +217,8 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { NSString * finalPath = (NSString * ) savePath; NSString * pathExtension = [finalPath pathExtension]; - /* - * Is the target file a PDF? If so, copy print file + /* + * Is the target file a PDF? If so, copy print file * to output location. */ if ([pathExtension isEqualToString: @ "pdf"]) { @@ -229,9 +229,9 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { } } - /* Is the target file PostScript? If so, run print file - * through CUPS filter to convert back to PostScript. - * Using strcat to build up system command is ugly, but + /* Is the target file PostScript? If so, run print file + * through CUPS filter to convert back to PostScript. + * Using strcat to build up system command is ugly, but * it is simpler than NSTask and it works. */ @@ -271,7 +271,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { } /* - * If destination is not printer, file or preview, + * If destination is not printer, file or preview, * we do not support it. Display alert. */ -- cgit v0.12 From c9c59a0fb0e8365c5c8e72d6f55403a756587593 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 5 Jul 2021 09:16:05 +0000 Subject: Eliminate two unused variables --- win/tkWinGDI.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 68b8fce..f825ef3 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -923,12 +923,11 @@ static int GdiLine( /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y. */ POINT ahead[6]; double dx, dy, length; - double backup, sinTheta, cosTheta; + double sinTheta, cosTheta; double vertX, vertY, temp; double fracHeight; fracHeight = 2.0 / arrowshape[2]; - backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; ahead[0].x = ahead[5].x = polypoints[npoly-1].x; ahead[0].y = ahead[5].y = polypoints[npoly-1].y; @@ -963,12 +962,11 @@ static int GdiLine( /* Arrowhead at end = polypoints[0].x, polypoints[0].y. */ POINT ahead[6]; double dx, dy, length; - double backup, sinTheta, cosTheta; + double sinTheta, cosTheta; double vertX, vertY, temp; double fracHeight; fracHeight = 2.0 / arrowshape[2]; - backup = fracHeight*arrowshape[1] + arrowshape[0]*(1.0 - fracHeight)/2.0; ahead[0].x = ahead[5].x = polypoints[0].x; ahead[0].y = ahead[5].y = polypoints[0].y; -- cgit v0.12 From 34a2e7754410601db6cd1e16fbd35a691137ea5f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 5 Jul 2021 09:43:10 +0000 Subject: Eliminate more (gcc) warnings --- win/tkWinGDI.c | 73 ++++++++++++++++++++++++---------------------------------- 1 file changed, 30 insertions(+), 43 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index f825ef3..28707e4 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -35,11 +35,6 @@ static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, c /* Main dispatcher for subcommands. */ static int TkWinGDISubcmd (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -/* Initialize all these API's. */ -int Winprint_Init(Tcl_Interp * interp); -int Gdi_Init(Tcl_Interp *interp); - - /* Real functions. */ static int GdiArc (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); static int GdiBitmap (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); @@ -91,8 +86,8 @@ static void GetDisplaySize (LONG *width, LONG *height); static int GdiWordToWeight(const char *str); static int GdiParseFontWords(Tcl_Interp *interp, LOGFONTW *lf, const char *str[], int numargs); static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +static int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +static int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); static int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); static int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); static int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); @@ -105,15 +100,10 @@ static const char gdi_usage_message[] = "::tk::print::_gdi [arc|characters|copyb static char msgbuf[1024]; static PRINTDLGW pd; static DOCINFOW di; -int copies, paper_width, paper_height, dpi_x, dpi_y; -char *localPrinterName; -LPCWSTR printerName; -LPCWSTR driver; -LPCWSTR output; -PDEVMODEW returnedDevmode; -PDEVMODEW localDevmode; -LPDEVNAMES devnames; -HDC printDC; +static WCHAR *localPrinterName = NULL; +static int copies, paper_width, paper_height, dpi_x, dpi_y; +static LPDEVNAMES devnames; +static HDC printDC; /* *---------------------------------------------------------------------- @@ -2198,10 +2188,10 @@ static int GdiCopyBits ( Tk_Window mainWin; Tk_Window workwin; - Window w; + Window wnd; HDC src; HDC dst; - HWND wnd = 0; + HWND hwnd = 0; HANDLE hDib; /* Handle for device-independent bitmap. */ LPBITMAPINFOHEADER lpDIBHdr; @@ -2281,7 +2271,7 @@ static int GdiCopyBits ( else { /* Use strtoul() so octal or hex representations will be parsed. */ - wnd = (HWND)INT2PTR(strtoul(argv[++k], &strend, 0)); + hwnd = (HWND)INT2PTR(strtoul(argv[++k], &strend, 0)); if ( strend == 0 || strend == argv[k] ) { sprintf(msgbuf, "Can't understand window id %s", argv[k]); @@ -2388,12 +2378,12 @@ static int GdiCopyBits ( * Get the MS Window we want to copy. * Given the HDC, we can get the "Window". */ - if (wnd == 0 ) + if (hwnd == 0 ) { if ( Tk_IsTopLevel(workwin) ) is_toplevel = 1; - if ( (w = Tk_WindowId(workwin)) == 0 ) + if ( (wnd = Tk_WindowId(workwin)) == 0 ) { Tcl_AppendResult(interp, "Can't get id for Tk window", NULL); return TCL_ERROR; @@ -2401,7 +2391,7 @@ static int GdiCopyBits ( /* Given the "Window" we can get a Microsoft Windows HWND. */ - if ( (wnd = Tk_GetHWND(w)) == 0 ) + if ( (hwnd = Tk_GetHWND(wnd)) == 0 ) { Tcl_AppendResult(interp, "Can't get Windows handle for Tk window", NULL); return TCL_ERROR; @@ -2415,14 +2405,14 @@ static int GdiCopyBits ( */ if ( is_toplevel ) { - HWND tmpWnd = wnd; + HWND tmpWnd = hwnd; while ( (tmpWnd = GetParent( tmpWnd ) ) != 0 ) - wnd = tmpWnd; + hwnd = tmpWnd; } } /* Given the HWND, we can get the window's device context. */ - if ( (src = GetWindowDC(wnd)) == 0 ) + if ( (src = GetWindowDC(hwnd)) == 0 ) { Tcl_AppendResult(interp, "Can't get device context for Tk window", NULL); return TCL_ERROR; @@ -2438,7 +2428,7 @@ static int GdiCopyBits ( else if ( is_toplevel ) { RECT tl; - GetWindowRect(wnd, &tl); + GetWindowRect(hwnd, &tl); wid = tl.right - tl.left; hgt = tl.bottom - tl.top; } @@ -2447,14 +2437,14 @@ static int GdiCopyBits ( if ( (hgt = Tk_Height(workwin)) <= 0 ) { Tcl_AppendResult(interp, "Can't get height of Tk window", NULL); - ReleaseDC(wnd,src); + ReleaseDC(hwnd,src); return TCL_ERROR; } if ( (wid = Tk_Width(workwin)) <= 0 ) { Tcl_AppendResult(interp, "Can't get width of Tk window", NULL); - ReleaseDC(wnd,src); + ReleaseDC(hwnd,src); return TCL_ERROR; } } @@ -2507,20 +2497,20 @@ static int GdiCopyBits ( * c) Client window only * for the "grab" */ - hDib = CopyToDIB( wnd, wintype ); + hDib = CopyToDIB( hwnd, wintype ); /* GdiFlush();. */ if (!hDib) { Tcl_AppendResult(interp, "Can't create DIB", NULL); - ReleaseDC(wnd,src); + ReleaseDC(hwnd,src); return TCL_ERROR; } lpDIBHdr = (LPBITMAPINFOHEADER)GlobalLock(hDib); if (!lpDIBHdr) { Tcl_AppendResult(interp, "Can't get DIB header", NULL); - ReleaseDC(wnd,src); + ReleaseDC(hwnd,src); return TCL_ERROR; } @@ -2537,7 +2527,7 @@ static int GdiCopyBits ( errcode = GetLastError(); GlobalUnlock(hDib); GlobalFree(hDib); - ReleaseDC(wnd,src); + ReleaseDC(hwnd,src); sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); Tcl_AppendResult(interp, msgbuf, NULL); return TCL_ERROR; @@ -2548,7 +2538,7 @@ static int GdiCopyBits ( GlobalFree(hDib); } - ReleaseDC(wnd,src); + ReleaseDC(hwnd,src); /* * The return value should relate to the size in the destination space. @@ -4870,14 +4860,13 @@ TkGdiMakeBezierCurve( static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) { + LPCWSTR printerName = NULL; + PDEVMODEW returnedDevmode = NULL; + PDEVMODEW localDevmode = NULL; (void) clientData; (void) argc; (void) objv; - returnedDevmode = NULL; - localDevmode = NULL; - localPrinterName = NULL; - printerName = NULL; copies = 0; paper_width = 0; paper_height = 0; @@ -4903,8 +4892,6 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg returnedDevmode = (PDEVMODEW)GlobalLock(pd.hDevMode); devnames = (LPDEVNAMES)GlobalLock(pd.hDevNames); printerName = (LPCWSTR)devnames + devnames->wDeviceOffset; - driver = (LPCWSTR)devnames + devnames->wDriverOffset; - output = (LPCWSTR)devnames + devnames->wOutputOffset; localDevmode = (LPDEVMODEW)HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); @@ -4916,7 +4903,7 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg returnedDevmode->dmSize); /* Get values from user-set and built-in properties. */ - localPrinterName = (char*) localDevmode->dmDeviceName; + localPrinterName = localDevmode->dmDeviceName; dpi_y = localDevmode->dmYResolution; dpi_x = localDevmode->dmPrintQuality; paper_height = (int) localDevmode->dmPaperLength / 0.254; /*Convert to logical points.*/ @@ -4944,10 +4931,10 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg * so they can be accessed from script level. */ - char *varlink1 = Tcl_Alloc(100 * sizeof(char)); - char **varlink2 = (char **)Tcl_Alloc(sizeof(char *)); + WCHAR *varlink1 = (WCHAR *)Tcl_Alloc(100 * sizeof(char)); + WCHAR **varlink2 = (WCHAR **)Tcl_Alloc(sizeof(char *)); *varlink2 = varlink1; - strcpy (varlink1, localPrinterName); + wcscpy (varlink1, localPrinterName); Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, TCL_LINK_INT | TCL_LINK_READ_ONLY); -- cgit v0.12 From 91bc681bdecad4f2fa479ab5459a93e1c1fe8617 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 5 Jul 2021 09:46:14 +0000 Subject: Make gdi_command struct "static const" --- win/tkWinGDI.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 28707e4..5693291 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -138,7 +138,7 @@ static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const * add them to this array. The first element is the subcommand * name, and the second a standard Tcl command handler. */ -struct gdi_command +static const struct gdi_command { const char *command_string; int (*command) (ClientData, Tcl_Interp *, int, const char **); -- cgit v0.12 From 33e913ff563dcc835f0a69265cbcaf1724f5d613 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 01:50:15 +0000 Subject: Remove canvas and text literals from Tk print command; replace system() call in macOSX implementation with execv; clean up documentation --- doc/print.n | 9 ++---- library/demos/print.tcl | 4 +-- library/demos/widget | 5 +-- library/print.tcl | 86 +++++++++++++++++++++++-------------------------- macosx/tkMacOSXPrint.c | 26 ++++++++++----- 5 files changed, 65 insertions(+), 65 deletions(-) diff --git a/doc/print.n b/doc/print.n index c12d369..3f51866 100644 --- a/doc/print.n +++ b/doc/print.n @@ -10,10 +10,8 @@ .SH NAME print \- Print canvas and text widgets using native dialogs and APIs. .SH SYNOPSIS -\fBtk print canvas\fR \fIwindow\fR -.sp -\fBtk print text\fR \fIwindow\fR -.BE +\fBtk print \fIwindow\fR +. .SH DESCRIPTION .PP The \fBtk print\fR command posts a dialog that allows users to print output @@ -30,9 +28,6 @@ Unix commands, and the \fBtk print\fR command does not supersede that functionality; it builds on it. The \fBtk print\fR command is a fuller implementation that uses native dialogs on macOS and Windows, and a Tk-based dialog that provides parallel functionality on X11. -.PP -Note that the first argument to \fBtk print\fR is the type of widget being -printed; currently only \fBcanvas\fR and \fBtext\fR widgets may be printed. .SH PLATFORM NOTES .TP \fBmacOS\fR diff --git a/library/demos/print.tcl b/library/demos/print.tcl index cb3c3a9..ebe6553 100644 --- a/library/demos/print.tcl +++ b/library/demos/print.tcl @@ -44,8 +44,8 @@ pack $t -side right -fill both -expand no $t insert end $txt pack [frame $w.f] -side top -fill both -expand no -pack [button $w.f.b -text "Print Canvas" -command [list tk print canvas $w.m.c]] -expand no -pack [button $w.f.x -text "Print Text" -command [list tk print text $w.m.t]] -expand no +pack [button $w.f.b -text "Print Canvas" -command [list tk print $w.m.c]] -expand no +pack [button $w.f.x -text "Print Text" -command [list tk print $w.m.t]] -expand no ## See Code / Dismiss buttons pack [addSeeDismiss $w.buttons $w] -side bottom -fill x diff --git a/library/demos/widget b/library/demos/widget index 77e5066..5bf1e2a 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -643,7 +643,7 @@ proc showCode w { # file - Name of the original file (implicitly for title) proc printCode {w file} { - tk print text $w + tk print $w } # tkAboutDialog -- @@ -656,7 +656,8 @@ proc tkAboutDialog {} { "[mc "Copyright © %s" {1996-1997 Sun Microsystems, Inc.}] [mc "Copyright © %s" {1997-2000 Ajuba Solutions, Inc.}] [mc "Copyright © %s" {2001-2009 Donal K. Fellows}] -[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}]" +[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}] +[mc "Copyright © %s" {2021 Kevin Walzer}]" } # Local Variables: diff --git a/library/print.tcl b/library/print.tcl index 8439485..941e841 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -923,58 +923,52 @@ namespace eval ::tk::print { # tk print -- # This procedure prints the canvas and text widgets using platform- # native API's. -# -# Subcommands: -# -# canvas - Print the display of a canvas widget. -# Arguments: -# w: Widget to print. -# -# text - Print the display of a text widget. -# Arguments: -# w: Widget to print. +# Arguments: +# w: Widget to print. -proc ::tk::print::canvas {w} { +proc ::tk::print {w} { - if {[tk windowingsystem] eq "win32"} { - ::tk::print::_print_widget $w 0 "Tk Print Output" - } - if {[tk windowingsystem] eq "x11"} { - ::tk::print::_print $w - } - if {[tk windowingsystem] eq "aqua"} { - set file /tmp/tk_canvas.ps - $w postscript -file $file - set printfile /tmp/tk_canvas.pdf - catch {exec /usr/sbin/cupsfilter $file > $printfile} - ::tk::print::_print $printfile - } + if {[winfo class $w] eq "Canvas"} { -} + if {[tk windowingsystem] eq "win32"} { + ::tk::print::_print_widget $w 0 "Tk Print Output" + } + if {[tk windowingsystem] eq "x11"} { + ::tk::print::_print $w + } + if {[tk windowingsystem] eq "aqua"} { + set file /tmp/tk_canvas.ps + $w postscript -file $file + set printfile /tmp/tk_canvas.pdf + catch {exec /usr/sbin/cupsfilter $file > $printfile} + ::tk::print::_print $printfile + } + } -proc ::tk::print::text {w} { + if {[winfo class $w] eq "Text"} { - if {[tk windowingsystem] eq "win32"} { - set txt [$w get 1.0 end] - set x [file join $::env(TEMP) tk_output.txt] - set print_txt [open $x w] - puts $print_txt $txt - close $print_txt - ::tk::print::_print_file $x 1 {Arial 12} - } - if {[tk windowingsystem] eq "x11"} { - ::tk::print::_print $w - } - if {[tk windowingsystem] eq "aqua"} { - set txt [$w get 1.0 end] - set file /tmp/tk_text.txt - set print_txt [open $file w] - puts $print_txt $txt - close $print_txt - set printfile /tmp/tk_text.pdf - catch {exec /usr/sbin/cupsfilter $file > $printfile} - ::tk::print::_print $printfile + if {[tk windowingsystem] eq "win32"} { + set txt [$w get 1.0 end] + set x [file join $::env(TEMP) tk_output.txt] + set print_txt [open $x w] + puts $print_txt $txt + close $print_txt + ::tk::print::_print_file $x 1 {Arial 12} + } + if {[tk windowingsystem] eq "x11"} { + ::tk::print::_print $w + } + if {[tk windowingsystem] eq "aqua"} { + set txt [$w get 1.0 end] + set file /tmp/tk_text.txt + set print_txt [open $file w] + puts $print_txt $txt + close $print_txt + set printfile /tmp/tk_text.pdf + catch {exec /usr/sbin/cupsfilter $file > $printfile} + ::tk::print::_print $printfile + } } } diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 5dca510..b9bbfd5 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -18,6 +18,9 @@ #include #include #include +#include +#include +#include /* Forward declarations of functions and variables. */ @@ -208,6 +211,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { /* Destination is file. Determine how to handle. */ if (status == noErr && printDestination == kPMDestinationFile) { CFURLRef * outputLocation = NULL; + status = PMSessionCopyDestinationLocation(printSession, printSettings, & outputLocation); if (status == noErr) { /*Get the source file and target destination, convert to strings.*/ @@ -236,15 +240,11 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { */ if ([pathExtension isEqualToString: @ "ps"]) { - char source[5012]; char target[5012]; - [sourcePath getCString: source maxLength: (sizeof source) encoding: NSUTF8StringEncoding]; [finalPath getCString: target maxLength: (sizeof target) encoding: NSUTF8StringEncoding]; - - /*Add quote marks to address path names with spaces.*/ - char cmd[50000]; + char cmd[50000]; strcpy(cmd, "/usr/sbin/cupsfilter "); strcat(cmd, "\""); strcat(cmd, source); @@ -253,9 +253,19 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { strcat(cmd, "\""); strcat(cmd, target); strcat(cmd, "\""); - system(cmd); - } - return status; + + pid_t pid; + char * const paramlist[] = {"/bin/sh", "-c", cmd, NULL}; + if ((pid = fork()) == -1) { + status != noErr; + return status; + } else if (pid == 0) { + execv("/bin/sh", paramlist); + } + wait(2); + return status; + } + return status; } } -- cgit v0.12 From e246ac78f44970417524ab20da9ec29ff14f8891 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 01:56:06 +0000 Subject: Restore comment --- macosx/tkMacOSXPrint.c | 1 + 1 file changed, 1 insertion(+) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index b9bbfd5..3b9a863 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -244,6 +244,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { char target[5012]; [sourcePath getCString: source maxLength: (sizeof source) encoding: NSUTF8StringEncoding]; [finalPath getCString: target maxLength: (sizeof target) encoding: NSUTF8StringEncoding]; + /*Add quote marks to address path names with spaces.*/ char cmd[50000]; strcpy(cmd, "/usr/sbin/cupsfilter "); strcat(cmd, "\""); -- cgit v0.12 From 49ac3ff945212cca77b26202e9dfa021e4aa5518 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 13:58:31 +0000 Subject: Clean up comments, silence noisy debugging output --- macosx/tkMacOSXPrint.c | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 3b9a863..946c5ed 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -244,7 +244,10 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { char target[5012]; [sourcePath getCString: source maxLength: (sizeof source) encoding: NSUTF8StringEncoding]; [finalPath getCString: target maxLength: (sizeof target) encoding: NSUTF8StringEncoding]; - /*Add quote marks to address path names with spaces.*/ + /* + * Add quote marks to address path names with spaces. Redirect stderr + * to quiet debugging output. + */ char cmd[50000]; strcpy(cmd, "/usr/sbin/cupsfilter "); strcat(cmd, "\""); @@ -254,16 +257,17 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { strcat(cmd, "\""); strcat(cmd, target); strcat(cmd, "\""); - + strcat(cmd, " 2>/dev/null "); + + /*Fork and start new process with command string.*/ pid_t pid; - char * const paramlist[] = {"/bin/sh", "-c", cmd, NULL}; + char *const paramlist[] = {"/bin/sh", "-c", cmd, NULL}; if ((pid = fork()) == -1) { - status != noErr; - return status; + return -1; } else if (pid == 0) { execv("/bin/sh", paramlist); + exit(0); } - wait(2); return status; } return status; -- cgit v0.12 From 5d9f5a6aa4a63d1aa557d330084804e6ec112d38 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 17:28:45 +0000 Subject: Re-factor PostScript export from printer on macOS to avoid calling shell; thanks to Peter Da Silva for suggestions --- macosx/tkMacOSXPrint.c | 38 ++++++++++++++++---------------------- 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 946c5ed..00f5a7b 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -21,6 +21,7 @@ #include #include #include +#include /* Forward declarations of functions and variables. */ @@ -244,35 +245,28 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { char target[5012]; [sourcePath getCString: source maxLength: (sizeof source) encoding: NSUTF8StringEncoding]; [finalPath getCString: target maxLength: (sizeof target) encoding: NSUTF8StringEncoding]; - /* - * Add quote marks to address path names with spaces. Redirect stderr - * to quiet debugging output. - */ - char cmd[50000]; - strcpy(cmd, "/usr/sbin/cupsfilter "); - strcat(cmd, "\""); - strcat(cmd, source); - strcat(cmd, "\""); - strcat(cmd, " -m application/postscript > "); - strcat(cmd, "\""); - strcat(cmd, target); - strcat(cmd, "\""); - strcat(cmd, " 2>/dev/null "); - /*Fork and start new process with command string.*/ + /* + * Fork and start new process with command string. Thanks to Peter da Silva + * for assistance. + */ pid_t pid; - char *const paramlist[] = {"/bin/sh", "-c", cmd, NULL}; if ((pid = fork()) == -1) { return -1; } else if (pid == 0) { - execv("/bin/sh", paramlist); - exit(0); - } + /* Redirect output to file and silence debugging output.*/ + dup2(open(target, O_RDWR | O_CREAT, 0777), 1); + dup2(open("/dev/null", O_WRONLY), 2); + execl("/usr/sbin/cupsfilter", "cupsfilter", "-m", "application/postscript", source, NULL); + close(1); + close(2); + exit(0); return status; - } + } return status; - } - } + } + } + } /* Destination is preview. Open file in default application for PDF. */ if ((status == noErr) && (printDestination == kPMDestinationPreview)) { -- cgit v0.12 From 0c15d1665c5a0a735ff6db449bf786c33e4759a5 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 17:35:56 +0000 Subject: Tweak path --- macosx/tkMacOSXPrint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 00f5a7b..ec0b636 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -257,7 +257,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { /* Redirect output to file and silence debugging output.*/ dup2(open(target, O_RDWR | O_CREAT, 0777), 1); dup2(open("/dev/null", O_WRONLY), 2); - execl("/usr/sbin/cupsfilter", "cupsfilter", "-m", "application/postscript", source, NULL); + execl("/usr/sbin/cupsfilter", "/usr/sbin/cupsfilter", "-m", "application/postscript", source, NULL); close(1); close(2); exit(0); -- cgit v0.12 From 064f7238e77a06ab9008f739090eea8354c4f764 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 17:53:39 +0000 Subject: Fix error with PDF export from Mac printer dialog --- macosx/tkMacOSXPrint.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index ec0b636..9d5e9a7 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -228,10 +228,16 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { */ if ([pathExtension isEqualToString: @ "pdf"]) { NSFileManager * fileManager = [NSFileManager defaultManager]; + NSError * error = nil; + /*Make sure no file conflict exists.*/ + if ([fileManager fileExistsAtPath: finalPath]) { + [fileManager removeItemAtPath: finalPath error: &error]; + } if ([fileManager fileExistsAtPath: sourcePath]) { NSError * error = nil; [fileManager copyItemAtPath: sourcePath toPath: finalPath error: & error]; } + return status; } /* Is the target file PostScript? If so, run print file -- cgit v0.12 From c954fef4cc80fcf07ab1a0453fe1bdfcfbb44c00 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 17:55:30 +0000 Subject: Clean up comment --- macosx/tkMacOSXPrint.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 9d5e9a7..92096de 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -240,10 +240,9 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { return status; } - /* Is the target file PostScript? If so, run print file + /* + * Is the target file PostScript? If so, run print file * through CUPS filter to convert back to PostScript. - * Using strcat to build up system command is ugly, but - * it is simpler than NSTask and it works. */ if ([pathExtension isEqualToString: @ "ps"]) { -- cgit v0.12 From 118df676a89f82b1db665692a72caee7ec63d4b8 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 18:04:14 +0000 Subject: Prune a few unnecessary calls --- macosx/tkMacOSXPrint.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 92096de..7c1edc2 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -263,10 +263,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { dup2(open(target, O_RDWR | O_CREAT, 0777), 1); dup2(open("/dev/null", O_WRONLY), 2); execl("/usr/sbin/cupsfilter", "/usr/sbin/cupsfilter", "-m", "application/postscript", source, NULL); - close(1); - close(2); exit(0); - return status; } return status; } -- cgit v0.12 From 45da91752433ff330ff546e008626f486b7bf142 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 6 Jul 2021 18:16:57 +0000 Subject: Minor update to X11 --- library/print.tcl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/library/print.tcl b/library/print.tcl index 941e841..f6049ec 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -844,6 +844,8 @@ namespace eval ::tk::print { button $p.frame.buttonframe.cancel -text [mc "Cancel"] -command {destroy ._print} pack $p.frame.buttonframe.printbutton $p.frame.buttonframe.cancel -side right -fill x -expand no + #Center the window as a dialog. + ::tk::PlaceWindow $p } -- cgit v0.12 From 0edba1b0d1e134f07873c1ae83211fd156fb070c Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 6 Jul 2021 19:25:20 +0000 Subject: Fix the macOS build warnings --- macosx/tkMacOSXPrint.c | 78 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 47 insertions(+), 31 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 7c1edc2..4ad40f2 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -21,41 +21,41 @@ #include #include #include -#include - +#include /* Forward declarations of functions and variables. */ NSString * fileName = nil; CFStringRef urlFile = NULL; -int StartPrint(ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj * const objv[]); -OSStatus FinishPrint(NSString * file, int buttonValue); -int MacPrint_Init(Tcl_Interp * interp); - +int StartPrint(ClientData clientData, Tcl_Interp * interp, + int objc, Tcl_Obj * const objv[]); +OSStatus FinishPrint(NSString *file, int buttonValue); +int MacPrint_Init(Tcl_Interp * interp); + /* Delegate class for print dialogs. */ @interface PrintDelegate: NSObject - - - (id) init; - -(void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode:(int) returnCode contextInfo: (void * ) contextInfo; - + - (id) init; + - (void) printPanelDidEnd: (NSPrintPanel *) printPanel + returnCode: (int) returnCode + contextInfo: (void *) contextInfo; @end @implementation PrintDelegate - - - (id) init { +- (id) init { self = [super init]; return self; - } +} - - (void) printPanelDidEnd: (NSPrintPanel * ) printPanel returnCode: (int) returnCode contextInfo: (void * ) contextInfo { +- (void) printPanelDidEnd: (NSPrintPanel *) printPanel + returnCode: (int) returnCode + contextInfo: (void *) contextInfo { /* * Pass returnCode to FinishPrint function to determine how to * handle. */ FinishPrint(fileName, returnCode); - } - +} @end - + /* *---------------------------------------------------------------------- * @@ -69,9 +69,13 @@ int MacPrint_Init(Tcl_Interp * interp); *---------------------------------------------------------------------- */ -int StartPrint(ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj * - const objv[]) { - +int +StartPrint( + ClientData clientData, + Tcl_Interp * interp, + int objc, + Tcl_Obj *const objv[]) +{ (void) clientData; NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; NSPrintPanel * printPanel = [NSPrintPanel printPanel]; @@ -117,11 +121,13 @@ int StartPrint(ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj * printSettings = (PMPrintSettings)[printInfo PMPrintSettings]; accepted = [printPanel runModalWithPrintInfo: printInfo]; - [printDelegate printPanelDidEnd: printPanel returnCode: accepted contextInfo: printInfo]; + [printDelegate printPanelDidEnd: printPanel + returnCode: accepted + contextInfo: printInfo]; return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -134,8 +140,12 @@ int StartPrint(ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj * * *---------------------------------------------------------------------- */ -OSStatus FinishPrint(NSString * file, int buttonValue) { +OSStatus +FinishPrint( + NSString *file, + int buttonValue) +{ NSPrintInfo * printInfo = [NSPrintInfo sharedPrintInfo]; PMPrintSession printSession; PMPageFormat pageFormat; @@ -211,7 +221,7 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { /* Destination is file. Determine how to handle. */ if (status == noErr && printDestination == kPMDestinationFile) { - CFURLRef * outputLocation = NULL; + CFURLRef outputLocation = NULL; status = PMSessionCopyDestinationLocation(printSession, printSettings, & outputLocation); if (status == noErr) { @@ -232,9 +242,9 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { /*Make sure no file conflict exists.*/ if ([fileManager fileExistsAtPath: finalPath]) { [fileManager removeItemAtPath: finalPath error: &error]; - } + } if ([fileManager fileExistsAtPath: sourcePath]) { - NSError * error = nil; + error = nil; [fileManager copyItemAtPath: sourcePath toPath: finalPath error: & error]; } return status; @@ -301,15 +311,13 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { /* Return because cancel button was clicked. */ if (buttonValue == NSModalResponseCancel) { - PMRelease(printSession); return status; } return status; - } - + /* *---------------------------------------------------------------------- * @@ -322,11 +330,19 @@ OSStatus FinishPrint(NSString * file, int buttonValue) { * *---------------------------------------------------------------------- */ -int MacPrint_Init(Tcl_Interp * interp) { +int MacPrint_Init(Tcl_Interp * interp) { NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; Tcl_CreateObjCommand(interp, "::tk::print::_print", StartPrint, (ClientData) NULL, (Tcl_CmdDeleteProc * ) NULL); [pool release]; return TCL_OK; } - + +/* + * Local Variables: + * mode: objc + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ -- cgit v0.12 From 7dc797335476ae31e64034d5aeb611ea0fb3edaf Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 6 Jul 2021 20:25:16 +0000 Subject: We can assume Tcl 8.6; use Tcl 8.6 coding style in a few places --- library/print.tcl | 459 +++++++++++++++++++++++++----------------------------- 1 file changed, 209 insertions(+), 250 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index f6049ec..2607247 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -11,9 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. - namespace eval ::tk::print { - namespace import -force ::tk::msgcat::* if {[tk windowingsystem] eq "win32"} { @@ -42,7 +40,7 @@ namespace eval ::tk::print { #First, we select the printer. ::tk::print::_selectprinter - if {$::tk::print::printer_name == ""} { + if {$::tk::print::printer_name eq ""} { #they pressed cancel return } @@ -50,7 +48,7 @@ namespace eval ::tk::print { #Next, set values. Some are taken from the printer, #some are sane defaults. - set printargs(hDC) [list $::tk::print::printer_name] + set printargs(hDC) $::tk::print::printer_name set printargs(pw) $::tk::print::paper_width set printargs(pl) $::tk::print::paper_height set printargs(lm) 1000 @@ -61,7 +59,6 @@ namespace eval ::tk::print { set printargs(resy) $::tk::print::dpi_y set printargs(copies) $::tk::print::copies set printargs(resolution) [list $::tk::print::dpi_x $::tk::print::dpi_y] - } # _print_data @@ -72,23 +69,22 @@ namespace eval ::tk::print { # breaklines - If non-zero, keep newlines in the string as # newlines in the output. # font - Font for printing - - proc _print_data { data {breaklines 1 } {font {}} } { - + proc _print_data {data {breaklines 1 } {font ""}} { variable printargs _set_dc - if { [string length $font] == 0 } { - eval ::tk::print::_gdi characters $printargs(hDC) -array printcharwid + if { $font eq "" } { + ::tk::print::_gdi characters $printargs(hDC) -array printcharwid } else { - eval ::tk::print::_gdi characters $printargs(hDC) -font $font -array printcharwid + ::tk::print::_gdi characters $printargs(hDC) -font $font \ + -array printcharwid } - set pagewid [ expr ( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) ] - set pagehgt [ expr ( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) ] + set pagewid [expr {( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) }] + set pagehgt [expr {( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) }] set totallen [ string length $data ] set curlen 0 - set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] + set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000 }] ::tk::print::_opendoc ::tk::print::_openpage @@ -100,7 +96,7 @@ namespace eval ::tk::print { if { $endind != -1 } { set linestring [ string range $linestring 0 $endind ] # handle blank lines.... - if { $linestring == "" } { + if { $linestring eq "" } { set linestring " " } } @@ -110,10 +106,10 @@ namespace eval ::tk::print { printcharwid printargs $curhgt $font] incr curlen [lindex $result 0] incr curhgt [lindex $result 1] - if { [expr $curhgt + [lindex $result 1] ] > $pagehgt } { + if { $curhgt + [lindex $result 1] > $pagehgt } { ::tk::print::_closepage ::tk::print::_openpage - set curhgt [ expr $printargs(tm) * $printargs(resy) / 1000 ] + set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000 }] } } @@ -121,7 +117,6 @@ namespace eval ::tk::print { ::tk::print::_closedoc } - # _print_file # This function prints multiple-page files # It will either break lines or just let them run over the @@ -132,14 +127,9 @@ namespace eval ::tk::print { # filename - File to open for printing # breaklines - 1 to break lines as done on input, 0 to ignore newlines # font - Optional arguments to supply to the text command - - proc _print_file { filename {breaklines 1 } { font {}} } { - - variable printargs - array get printargs - + proc _print_file {filename {breaklines 1} {font ""}} { set fn [open $filename r] - set data [ read $fn ] + set data [read $fn] close $fn _print_data $data $breaklines $font } @@ -154,10 +144,7 @@ namespace eval ::tk::print { # cdata - Array of values for character widths # y - Y value to begin printing at # font - if non-empty specifies a font to draw the line in - proc _print_page_nextline { string carray parray y font } { - - upvar #0 $carray charwidths upvar #0 $parray printargs @@ -165,11 +152,13 @@ namespace eval ::tk::print { set endindex 0 set totwidth 0 - set maxwidth [ expr ( ( $printargs(pw) - $printargs(rm) ) / 1000 ) * $printargs(resx) ] + set maxwidth [expr { + (($printargs(pw) - $printargs(rm)) / 1000) * $printargs(resx) + }] set maxstring [ string length $string ] - set lm [ expr $printargs(lm) * $printargs(resx) / 1000 ] + set lm [expr {$printargs(lm) * $printargs(resx) / 1000 }] - for { set i 0 } { ( $i < $maxstring ) && ( $totwidth < $maxwidth ) } { incr i } { + for {set i 0} {($i < $maxstring) && ($totwidth < $maxwidth)} {incr i} { incr totwidth $charwidths([string index $string $i]) # set width($i) $totwidth } @@ -178,35 +167,33 @@ namespace eval ::tk::print { set startindex $endindex if { $i < $maxstring } { - # In this case, the whole data string is not used up, and we wish - # to break on a word. Since we have all the partial widths calculated, - # this should be easy. + # In this case, the whole data string is not used up, and we + # wish to break on a word. Since we have all the partial + # widths calculated, this should be easy. - set endindex [ expr [string wordstart $string $endindex] - 1 ] - set startindex [ expr $endindex + 1 ] + set endindex [expr {[string wordstart $string $endindex] - 1 }] + set startindex [expr {$endindex + 1 }] - # If the line is just too long (no word breaks), print as much as you can.... + # If the line is just too long (no word breaks), print as much + # as you can.... if { $endindex <= 1 } { set endindex $i set startindex $i } } - if { [string length $font] > 0 } { + set txt [string trim [string range $string 0 $endindex] "\r\n"] + if { $font ne "" } { set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ -anchor nw -justify left \ - -text [ string trim [ string range $string 0 $endindex ] "\r\n" ] \ - -font $font ] + -text $txt -font $font ] } else { set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ - -anchor nw -justify left \ - -text [string trim [ string range $string 0 $endindex ] "\r\n" ] ] + -anchor nw -justify left -text $txt ] } return "$startindex $result" } - - # These procedures read in the canvas widget, and write all of # its contents out to the Windows printer. @@ -218,20 +205,15 @@ namespace eval ::tk::print { variable vtgPrint variable printargs - array get printargs - set vtgPrint(printer.bg) white } proc _is_win {} { variable printargs - array get printargs - return [ info exist tk_patchLevel ] } - # _print_widget # Main procedure for printing a widget. Currently supports # canvas widgets. Handles opening and closing of printer. @@ -240,14 +222,11 @@ namespace eval ::tk::print { # printer - Flag whether to use the default printer. # name - App name to pass to printer. - proc _print_widget { wid {printer default} {name "Tk Print Output"} } { - + proc _print_widget {wid {printer default} {name "Tk Print Output"}} { variable printargs _set_dc - array get printargs - ::tk::print::_opendoc ::tk::print::_openpage @@ -255,14 +234,14 @@ namespace eval ::tk::print { # For now, scale so the dimensions of the window are sized to the # width of the page. Scale evenly. - # For normal windows, this may be fine--but for a canvas, one wants the - # canvas dimensions, and not the WINDOW dimensions. - if { [winfo class $wid] == "Canvas" } { - set sc [ lindex [ $wid configure -scrollregion ] 4 ] + # For normal windows, this may be fine--but for a canvas, one + # wants the canvas dimensions, and not the WINDOW dimensions. + if { [winfo class $wid] eq "Canvas" } { + set sc [ $wid cget -scrollregion ] # if there is no scrollregion, use width and height. - if { "$sc" == "" } { - set window_x [ lindex [ $wid configure -width ] 4 ] - set window_y [ lindex [ $wid configure -height ] 4 ] + if { $sc eq "" } { + set window_x [ $wid cget -width ] + set window_y [ $wid cget -height ] } else { set window_x [ lindex $sc 2 ] set window_y [ lindex $sc 3 ] @@ -272,18 +251,16 @@ namespace eval ::tk::print { set window_y [ winfo height $wid ] } - set printer_x [ expr ( $printargs(pw) - \ - $printargs(lm) - \ - $printargs(rm) \ - ) * \ - $printargs(resx) / 1000.0 ] - set printer_y [ expr ( $printargs(pl) - \ - $printargs(tm) - \ - $printargs(bm) \ - ) * \ - $printargs(resy) / 1000.0 ] - set factor_x [ expr $window_x / $printer_x ] - set factor_y [ expr $window_y / $printer_y ] + set printer_x [expr { + ( $printargs(pw) - $printargs(lm) - $printargs(rm) ) * + $printargs(resx) / 1000.0 + }] + set printer_y [expr { + ( $printargs(pl) - $printargs(tm) - $printargs(bm) ) * + $printargs(resy) / 1000.0 + }] + set factor_x [expr {$window_x / $printer_x} ] + set factor_y [expr {$window_y / $printer_y} ] if { $factor_x < $factor_y } { set lo $window_y @@ -293,7 +270,8 @@ namespace eval ::tk::print { set ph $printer_x } - ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph -offset $printargs(resolution) + ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph \ + -offset $printargs(resolution) # Handling of canvas widgets. switch [winfo class $wid] { @@ -310,20 +288,14 @@ namespace eval ::tk::print { ::tk::print::_closedoc } - - # _print_canvas # Main procedure for writing canvas widget items to printer. # Arguments: # hdc - The printer handle. # cw - The canvas widget. - - proc _print_canvas {hdc cw} { variable vtgPrint - variable printargs - array get printargs # Get information about page being printed to # print_canvas.CalcSizing $cw @@ -332,7 +304,7 @@ namespace eval ::tk::print { # Re-write each widget from cw to printer foreach id [$cw find all] { set type [$cw type $id] - if { [ info commands _print_canvas.$type ] == "_print_canvas.$type" } { + if { [ info commands _print_canvas.$type ] eq "_print_canvas.$type" } { _print_canvas.[$cw type $id] $printargs(hDC) $cw $id } else { puts "Omitting canvas item of type $type since there is no handler registered for it" @@ -340,9 +312,9 @@ namespace eval ::tk::print { } } - # These procedures support the various canvas item types, - # reading the information about the item on the real canvas - # and then writing a similar item to the printer. + # These procedures support the various canvas item types, reading the + # information about the item on the real canvas and then writing a + # similar item to the printer. # _print_canvas.line # Description: @@ -351,16 +323,14 @@ namespace eval ::tk::print { # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - - proc _print_canvas.line {hdc cw id} { variable vtgPrint - variable printargs - array get printargs set color [_print_canvas.TransColor [$cw itemcget $id -fill]] - if {[string match $vtgPrint(printer.bg) $color]} {return} + if {[string match $vtgPrint(printer.bg) $color]} { + return + } set coords [$cw coords $id] set wdth [$cw itemcget $id -width] @@ -370,26 +340,25 @@ namespace eval ::tk::print { set smooth [$cw itemcget $id -smooth ] set splinesteps [ $cw itemcget $id -splinesteps ] - set cmmd "::tk::print::_gdi line $printargs(hDC) $coords -fill $color -arrow $arrow -arrowshape [list $arwshp]" + set cmdargs {} if { $wdth > 1 } { - set cmmd "$cmmd -width $wdth" + lappend cmdargs -width $wdth } - - if { $dash != "" } { - set cmmd "$cmmd -dash [list $dash]" + if { $dash ne "" } { + lappend cmdargs -dash $dash } - - if { $smooth != "" } { - set cmmd "$cmmd -smooth $smooth" + if { $smooth ne "" } { + lappend cmdargs -smooth $smooth } - - if { $splinesteps != "" } { - set cmmd "$cmmd -splinesteps $splinesteps" + if { $splinesteps ne "" } { + lappend cmdargs -splinesteps $splinesteps } - set result [eval $cmmd] - if { $result != "" } { + set result [::tk::print::_gdi line $hdc {*}$coords \ + -fill $color -arrow $arrow -arrowshape $arwshp \ + {*}$cmdargs] + if { $result ne "" } { puts $result } } @@ -400,13 +369,9 @@ namespace eval ::tk::print { # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - - proc _print_canvas.arc {hdc cw id} { variable vtgPrint - variable printargs - array get printargs set color [_print_canvas.TransColor [$cw itemcget $id -outline]] if { [string match $vtgPrint(printer.bg) $color] } { @@ -419,38 +384,35 @@ namespace eval ::tk::print { set extent [ $cw itemcget $id -extent ] set fill [ $cw itemcget $id -fill ] - set cmmd "::tk::print::_gdi arc $printargs(hDC) $coords -outline $color -style $style -start $start -extent $extent" + set cmdargs {} if { $wdth > 1 } { - set cmmd "$cmmd -width $wdth" + lappend cmdargs -width $wdth } - if { $fill != "" } { - set cmmd "$cmmd -fill $fill" + if { $fill ne "" } { + lappend cmdargs -fill $fill } - eval $cmmd + ::tk::print::_gdi arc $hdc {*}$coords \ + -outline $color -style $style -start $start -extent $extent \ + {*}$cmdargs } - # _print_canvas.polygon # Prints a polygon item. # Arguments: # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - - proc _print_canvas.polygon {hdc cw id} { variable vtgPrint - variable printargs - array get printargs set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] - if { ![string length $fcolor] } { + if { $fcolor eq "" } { set fcolor $vtgPrint(printer.bg) } set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] - if { ![string length $ocolor] } { + if { $ocolor eq "" } { set ocolor $vtgPrint(printer.bg) } set coords [$cw coords $id] @@ -458,18 +420,16 @@ namespace eval ::tk::print { set smooth [$cw itemcget $id -smooth ] set splinesteps [ $cw itemcget $id -splinesteps ] - - set cmmd "::tk::print::_gdi polygon $printargs(hDC) $coords -width $wdth \ - -fill $fcolor -outline $ocolor" - if { $smooth != "" } { - set cmmd "$cmmd -smooth $smooth" + set cmdargs {} + if { $smooth ne "" } { + lappend cmdargs -smooth $smooth } - - if { $splinesteps != "" } { - set cmmd "$cmmd -splinesteps $splinesteps" + if { $splinesteps ne "" } { + lappend cmdargs -splinesteps $splinesteps } - eval $cmmd + ::tk::print::_gdi polygon $hdc {*}$coords \ + -width $wdth -fill $fcolor -outline $ocolor {*}$cmdargs } # _print_canvas.oval @@ -478,52 +438,46 @@ namespace eval ::tk::print { # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - proc _print_canvas.oval { hdc cw id } { variable vtgPrint - variable printargs - array get printargs - set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] - if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} + if { $fcolor eq "" } { + set fcolor $vtgPrint(printer.bg) + } set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] - if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} + if { $ocolor eq "" } { + set ocolor $vtgPrint(printer.bg) + } set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - set cmmd "::tk::print::_gdi oval $printargs(hDC) $coords -width $wdth \ - -fill $fcolor -outline $ocolor" - - eval $cmmd + ::tk::print::_gdi oval $hdc {*}$coords \ + -width $wdth -fill $fcolor -outline $ocolor } - # _print_canvas.rectangle # Prints a rectangle item. # Arguments: # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - - proc _print_canvas.rectangle {hdc cw id} { variable vtgPrint - variable printargs - array get printargs - set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] - if {![string length $fcolor]} {set fcolor $vtgPrint(printer.bg)} + if { $fcolor eq "" } { + set fcolor $vtgPrint(printer.bg) + } set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] - if {![string length $ocolor]} {set ocolor $vtgPrint(printer.bg)} + if { $ocolor eq "" } { + set ocolor $vtgPrint(printer.bg) + } set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - set cmmd "::tk::print::_gdi rectangle $printargs(hDC) $coords -width $wdth \ - -fill $fcolor -outline $ocolor" - - eval $cmmd + ::tk::print::_gdi rectangle $hdc {*}$coords \ + -width $wdth -fill $fcolor -outline $ocolor } # _print_canvas.text @@ -532,63 +486,46 @@ namespace eval ::tk::print { # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - - proc _print_canvas.text {hdc cw id} { variable vtgPrint - variable printargs - array get printargs set color [_print_canvas.TransColor [$cw itemcget $id -fill]] - # if {[string match white [string tolower $color]]} {return} + # if { "white" eq [string tolower $color] } {return} # set color black set txt [$cw itemcget $id -text] - if {![string length $txt]} {return} + if { $txt eq "" } { + return + } set coords [$cw coords $id] set anchr [$cw itemcget $id -anchor] set bbox [$cw bbox $id] - set wdth [expr [lindex $bbox 2] - [lindex $bbox 0]] + set wdth [expr {[lindex $bbox 2] - [lindex $bbox 0]}] set just [$cw itemcget $id -justify] - # Get the canvas font info. - set font [ $cw itemcget $id -font ] - - # Find the real font info. - set font [font actual $font] - - # Create a compatible font, suitable for printer name extraction. - set font [ eval font create $font ] + # Get the real canvas font info and create a compatible font, + # suitable for printer name extraction. + set font [font create {*}[font actual [$cw itemcget $id -font]]] # Just get the name and family, or some of the ::tk::print::_gdi # commands will fail. - set font [list [font configure $font -family] -[font configure $font -size] ] + set font [list [font configure $font -family] \ + -[font configure $font -size] ] - set cmmd "::tk::print::_gdi text $printargs(hDC) $coords -fill $color -text [list $txt] \ - -anchor $anchr -font [ list $font ] \ - -width $wdth -justify $just" - eval $cmmd + ::tk::print::_gdi text $hdc {*}$coords \ + -fill $color -text $txt -font $font \ + -anchor $anchr -width $wdth -justify $just } - # _print_canvas.image # Prints an image item. # Arguments: # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - - proc _print_canvas.image {hdc cw id} { - - variable vtgPrint - variable option - - variable printargs - array get printargs - # First, we have to get the image name. set imagename [ $cw itemcget $id -image] @@ -600,8 +537,7 @@ namespace eval ::tk::print { set anchor [ $cw itemcget $id -anchor ] set coords [ $cw coords $id ] - set cmmd "::tk::print::_gdi photo $printargs(hDC) -destination [list $coords] -photo $imagename " - eval $cmmd + ::tk::print::_gdi photo $hdc -destination $coords -photo $imagename } # _print_canvas.bitmap @@ -610,15 +546,10 @@ namespace eval ::tk::print { # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - - proc _print_canvas.bitmap {hdc cw id} { variable option variable vtgPrint - variable printargs - array get printargs - # First, we have to get the bitmap name. set imagename [ $cw itemcget $id -image] @@ -641,24 +572,25 @@ namespace eval ::tk::print { set firstcase 0 } if { $firstcase > 0 } { - set tl [toplevel .tmptop[expr int( rand() * 65535 ) ] -height $hgt -width $wid -background $vtgPrint(canvas.bg) ] + set tl [toplevel .tmptop[expr {int( rand() * 65535 )} ] \ + -height $hgt -width $wid \ + -background $vtgPrint(canvas.bg) ] canvas $tl.canvas -width $wid -height $hgt $tl.canvas create image 0 0 -image $imagename -anchor nw pack $tl.canvas -side left -expand false -fill none tkwait visibility $tl.canvas update - set srccoords [list "0 0 [ expr $wid - 1] [expr $hgt - 1 ]" ] - set dstcoords [ list "[lindex $coords 0] [lindex $coords 1] [expr $wid - 1] [expr $hgt - 1]" ] - set cmmd "::tk::print::_gdi copybits $printargs(hDC) -window $tl -client -source $srccoords -destination $dstcoords " - eval $cmmd + set srccoords [list 0 0 [expr {$wid - 1}] [expr {$hgt - 1}]] + set dstcoords [list [lindex $coords 0] [lindex $coords 1] [expr {$wid - 1}] [expr {$hgt - 1}]] + ::tk::print::_gdi copybits $hdc -window $tl -client \ + -source $srccoords -destination $dstcoords destroy $tl } else { - set cmmd "::tk::print::_gdi bitmap $printargs(hDC) $coords -anchor $anchor -bitmap $imagename" - eval $cmmd + ::tk::print::_gdi bitmap $hdc {*}$coords \ + -anchor $anchor -bitmap $imagename } } - # These procedures transform attribute setting from the real # canvas to the appropriate setting for printing to paper. @@ -667,13 +599,9 @@ namespace eval ::tk::print { # canvas widget to paper. # Arguments: # color - The color value to be transformed. - - proc _print_canvas.TransColor {color} { variable vtgPrint - variable printargs - array get printargs switch [string toupper $color] { $vtgPrint(canvas.bg) {return $vtgPrint(printer.bg)} @@ -688,10 +616,10 @@ namespace eval ::tk::print { #begin X11 procedures - # X11 procedures wrap standard Unix shell commands such - # as lp/lpr and lpstat for printing. Some output configuration that on - # other platforms is managed through the printer driver/dialog - # is configured through the canvas postscript command. + # X11 procedures wrap standard Unix shell commands such as lp/lpr and + # lpstat for printing. Some output configuration that on other platforms + # is managed through the printer driver/dialog is configured through the + # canvas postscript command. if {[tk windowingsystem] eq "x11"} { @@ -713,8 +641,9 @@ namespace eval ::tk::print { variable printcmd variable printlist - #Select print command. We prefer lpr, but will fall back to lp if necessary. - if {[file exists "/usr/bin/lpr"]} { + # Select print command. We prefer lpr, but will fall back to lp if + # necessary. + if {[auto_execok lpr] ne ""} { set printcmd lpr } else { set printcmd lp @@ -735,7 +664,6 @@ namespace eval ::tk::print { # proc _print {w} { - variable printlist variable printcmd variable chooseprinter @@ -744,7 +672,6 @@ namespace eval ::tk::print { variable color variable p - _setprintenv set chooseprinter [lindex $printlist 0] @@ -765,10 +692,14 @@ namespace eval ::tk::print { pack $p.frame.printframe -side top -fill x -expand no label $p.frame.printframe.printlabel -text [mc "Printer:"] - ttk::combobox $p.frame.printframe.mb -textvariable chooseprinter -state readonly -values [lsort -unique $printlist] - pack $p.frame.printframe.printlabel $p.frame.printframe.mb -side left -fill x -expand no + ttk::combobox $p.frame.printframe.mb -textvariable chooseprinter \ + -state readonly -values [lsort -unique $printlist] + pack $p.frame.printframe.printlabel $p.frame.printframe.mb \ + -side left -fill x -expand no - bind $p.frame.printframe.mb <> { set chooseprinter} + bind $p.frame.printframe.mb <> { + set chooseprinter + } set paperlist [list [mc Letter] [mc Legal] [mc A4]] set colorlist [list [mc Grayscale] [mc RGB]] @@ -794,9 +725,11 @@ namespace eval ::tk::print { pack $p.frame.copyframe.l -side top -fill x -expand no label $p.frame.copyframe.l.copylabel -text [mc "Copies:"] - spinbox $p.frame.copyframe.l.field -from 1 -to 1000 -textvariable printcopies -width 5 + spinbox $p.frame.copyframe.l.field -from 1 -to 1000 \ + -textvariable printcopies -width 5 - pack $p.frame.copyframe.l.copylabel $p.frame.copyframe.l.field -side left -fill x -expand no + pack $p.frame.copyframe.l.copylabel $p.frame.copyframe.l.field \ + -side left -fill x -expand no set printcopies [$p.frame.copyframe.l.field get] @@ -804,9 +737,11 @@ namespace eval ::tk::print { pack $p.frame.copyframe.r -fill x -expand no label $p.frame.copyframe.r.paper -text [mc "Paper:"] - tk_optionMenu $p.frame.copyframe.r.menu ::tkprint_choosepaper {*}$paperlist + tk_optionMenu $p.frame.copyframe.r.menu ::tkprint_choosepaper \ + {*}$paperlist - pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu -side left -fill x -expand no + pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu \ + -side left -fill x -expand no #Widgets with additional options for canvas output. if {[winfo class $w] eq "Canvas"} { @@ -815,41 +750,52 @@ namespace eval ::tk::print { pack $p.frame.copyframe.z -fill x -expand no label $p.frame.copyframe.z.zlabel -text [mc "Scale %:"] - tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber {*}$percentlist + tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber \ + {*}$percentlist - pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry -side left -fill x -expand no + pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry \ + -side left -fill x -expand no frame $p.frame.copyframe.orient -padx 5 -pady 5 pack $p.frame.copyframe.orient -fill x -expand no label $p.frame.copyframe.orient.text -text [mc "Orientation:"] - radiobutton $p.frame.copyframe.orient.v -text [mc "Portrait"] -value portrait -variable ::tkprint_printorientation -compound left - radiobutton $p.frame.copyframe.orient.h -text [mc "Landscape"] -value landscape -variable ::tkprint_printorientation -compound left + radiobutton $p.frame.copyframe.orient.v -text [mc "Portrait"] \ + -value portrait -variable ::tkprint_printorientation \ + -compound left + radiobutton $p.frame.copyframe.orient.h -text [mc "Landscape"] \ + -value landscape -variable ::tkprint_printorientation \ + -compound left - pack $p.frame.copyframe.orient.text $p.frame.copyframe.orient.v $p.frame.copyframe.orient.h -side left -fill x -expand no + pack $p.frame.copyframe.orient.text \ + $p.frame.copyframe.orient.v $p.frame.copyframe.orient.h \ + -side left -fill x -expand no frame $p.frame.copyframe.c -padx 5 -pady 5 pack $p.frame.copyframe.c -fill x -expand no label $p.frame.copyframe.c.l -text [mc "Output:"] - tk_optionMenu $p.frame.copyframe.c.c ::tkprint_color {*}$colorlist - pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left -fill x -expand no + tk_optionMenu $p.frame.copyframe.c.c ::tkprint_color \ + {*}$colorlist + pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left \ + -fill x -expand no } #Build rest of GUI. frame $p.frame.buttonframe pack $p.frame.buttonframe -fill x -expand no -side bottom - button $p.frame.buttonframe.printbutton -text [mc "Print"] -command "::tk::print::_runprint $w" - button $p.frame.buttonframe.cancel -text [mc "Cancel"] -command {destroy ._print} + button $p.frame.buttonframe.printbutton -text [mc "Print"] \ + -command "::tk::print::_runprint $w" + button $p.frame.buttonframe.cancel -text [mc "Cancel"] \ + -command {destroy ._print} - pack $p.frame.buttonframe.printbutton $p.frame.buttonframe.cancel -side right -fill x -expand no + pack $p.frame.buttonframe.printbutton $p.frame.buttonframe.cancel \ + -side right -fill x -expand no #Center the window as a dialog. ::tk::PlaceWindow $p - } - # _runprint - # Execute the print command--print the file. # Arguments: @@ -874,7 +820,6 @@ namespace eval ::tk::print { } if {[winfo class $w] eq "Canvas"} { - set file /tmp/tk_canvas.ps if {$::tkprint_color eq [mc "RGB"]} { set colormode color @@ -889,46 +834,59 @@ namespace eval ::tk::print { } #Scale based on size of widget, not size of paper. - set printwidth [expr {$::tkprint_zoomnumber / 100.00} * [winfo width $w] ] - $w postscript -file $file -colormode $colormode -rotate $willrotate -pagewidth $printwidth + set printwidth [expr { + ($::tkprint_zoomnumber / 100.00) * [winfo width $w] + }] + $w postscript -file $file -colormode $colormode \ + -rotate $willrotate -pagewidth $printwidth } #Build list of args to pass to print command. set printargs {} set printcopies [$p.frame.copyframe.l.field get] - - if {$printcmd eq "lpr"} { - lappend printargs "-P $chooseprinter -# $printcopies" + lappend printargs -P $chooseprinter -# $printcopies } else { - lappend printargs " -d $chooseprinter -n $printcopies" + lappend printargs -d $chooseprinter -n $printcopies } - lappend printargs " -o PageSize=$::tkprint_choosepaper" after 500 - set cmd [join "$printcmd $printargs $file"] - eval exec $cmd + exec $printcmd {*}$printargs -o PageSize=$::tkprint_choosepaper \ + $file after 500 destroy ._print - } } #end X11 procedures + #begin macOS Aqua procedures + if {[tk windowingsystem] eq "aqua"} { + proc makeTempFile {filename contents} { + # TODO: Tcl 8.6 has better ways to make temporary files! + set filename /tmp/$filename + set f [open $filename w] + puts $f $contents + close $f + return $filename + } + + proc makePDF {inFilename outFilename} { + catch {exec /usr/sbin/cupsfilter $inFilename > $outFilename} + } + } + #end macOS Aqua procedures + namespace export canvas text namespace ensemble create } - # tk print -- # This procedure prints the canvas and text widgets using platform- # native API's. # Arguments: # w: Widget to print. - - proc ::tk::print {w} { if {[winfo class $w] eq "Canvas"} { @@ -940,10 +898,10 @@ proc ::tk::print {w} { ::tk::print::_print $w } if {[tk windowingsystem] eq "aqua"} { - set file /tmp/tk_canvas.ps + set file [_make_temp_file tk_canvas.ps ""] $w postscript -file $file - set printfile /tmp/tk_canvas.pdf - catch {exec /usr/sbin/cupsfilter $file > $printfile} + set printfile [_make_temp_file tk_canvas.pdf ""] + makePDF $file $printfile ::tk::print::_print $printfile } } @@ -953,7 +911,7 @@ proc ::tk::print {w} { if {[tk windowingsystem] eq "win32"} { set txt [$w get 1.0 end] set x [file join $::env(TEMP) tk_output.txt] - set print_txt [open $x w] + set print_txt [open $x w] puts $print_txt $txt close $print_txt ::tk::print::_print_file $x 1 {Arial 12} @@ -963,12 +921,9 @@ proc ::tk::print {w} { } if {[tk windowingsystem] eq "aqua"} { set txt [$w get 1.0 end] - set file /tmp/tk_text.txt - set print_txt [open $file w] - puts $print_txt $txt - close $print_txt - set printfile /tmp/tk_text.pdf - catch {exec /usr/sbin/cupsfilter $file > $printfile} + set file [_make_temp_file tk_text.txt $txt] + set printfile [_make_temp_file tk_text.pdf ""] + makePDF $file $printfile ::tk::print::_print $printfile } } @@ -979,6 +934,10 @@ proc ::tk::print {w} { namespace ensemble configure tk -map \ [dict merge [namespace ensemble configure tk -map] \ {print ::tk::print}] + +return - - +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: -- cgit v0.12 From 7153a36ac3d4a0d2a861440e7150e8204390fa8f Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 7 Jul 2021 15:44:57 +0000 Subject: Bring the GDI code into something close to Core style. --- win/tkWinGDI.c | 4814 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 2366 insertions(+), 2448 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 5693291..bb0cfda 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -12,7 +12,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ - /* Remove deprecation warnings. */ #define _CRT_SECURE_NO_WARNINGS @@ -28,83 +27,116 @@ #include "tkWinInt.h" - /* Main dispatcher for commands. */ -static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int TkWinGDI(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); /* Main dispatcher for subcommands. */ -static int TkWinGDISubcmd (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int TkWinGDISubcmd(ClientData clientData, + Tcl_Interp *interp, int argc, const char **argv); /* Real functions. */ -static int GdiArc (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiBitmap (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiCharWidths (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiImage (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiPhoto (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiLine (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiOval (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiPolygon (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiRectangle(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiText (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiMap (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -static int GdiCopyBits (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int GdiArc(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiBitmap(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiCharWidths(ClientData clientData, + Tcl_Interp *interp, int argc, const char **argv); +static int GdiImage(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiPhoto(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiLine(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiOval(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiPolygon(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiRectangle(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiText(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiMap(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); +static int GdiCopyBits(ClientData clientData, Tcl_Interp *interp, + int argc, const char **argv); /* Local copies of similar routines elsewhere in Tcl/Tk. */ -static int GdiParseColor (const char *name, unsigned long *color); -static int GdiGetColor (const char *name, unsigned long *color); -static int TkGdiMakeBezierCurve(Tk_Canvas, double *, int, int, XPoint[], double[]); +static int GdiParseColor(const char *name, unsigned long *color); +static int GdiGetColor(const char *name, unsigned long *color); +static int TkGdiMakeBezierCurve(Tk_Canvas, double *, int, int, + XPoint[], double[]); /* * Helper functions. */ -static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONTW *lf, HDC hDC); -static int GdiMakePen(Tcl_Interp *interp, int width, - int dashstyle, const char *dashstyledata, - int capstyle, - int joinstyle, - int stipplestyle, const char *stippledata, - unsigned long color, - HDC hDC, HGDIOBJ *oldPen); -static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen); -static int GdiMakeBrush (Tcl_Interp *interp, unsigned int style, unsigned long color, - long hatch, LOGBRUSH *lb, HDC hDC, HGDIOBJ *oldBrush); -static int GdiFreeBrush (Tcl_Interp *interp, HDC hDC, HGDIOBJ oldBcrush); -static int GdiGetHdcInfo( HDC hdc, - LPPOINT worigin, LPSIZE wextent, - LPPOINT vorigin, LPSIZE vextent); +static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, + LOGFONTW *lf, HDC hDC); +static int GdiMakePen(Tcl_Interp *interp, int width, + int dashstyle, const char *dashstyledata, + int capstyle, int joinstyle, + int stipplestyle, const char *stippledata, + unsigned long color, HDC hDC, HGDIOBJ *oldPen); +static int GdiFreePen(Tcl_Interp *interp, HDC hDC, HGDIOBJ oldPen); +static int GdiMakeBrush(Tcl_Interp *interp, unsigned int style, + unsigned long color, long hatch, LOGBRUSH *lb, + HDC hDC, HGDIOBJ *oldBrush); +static int GdiFreeBrush(Tcl_Interp *interp, HDC hDC, + HGDIOBJ oldBcrush); +static int GdiGetHdcInfo(HDC hdc, + LPPOINT worigin, LPSIZE wextent, + LPPOINT vorigin, LPSIZE vextent); /* Helper functions for printing the window client area. */ -enum PrintType { PTWindow=0, PTClient=1, PTScreen=2 }; -static HANDLE CopyToDIB ( HWND wnd, enum PrintType type ); -static HBITMAP CopyScreenToBitmap(LPRECT lpRect); -static HANDLE BitmapToDIB (HBITMAP hb, HPALETTE hp); -static HANDLE CopyScreenToDIB(LPRECT lpRect); -static int DIBNumColors(LPBITMAPINFOHEADER lpDIB); -static int PalEntriesOnDevice(HDC hDC); -static HPALETTE GetSystemPalette(void); -static void GetDisplaySize (LONG *width, LONG *height); -static int GdiWordToWeight(const char *str); -static int GdiParseFontWords(Tcl_Interp *interp, LOGFONTW *lf, const char *str[], int numargs); -static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintOpenPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); - -static const char gdi_usage_message[] = "::tk::print::_gdi [arc|characters|copybits|line|map|oval|" +enum PrintType { PTWindow = 0, PTClient = 1, PTScreen = 2 }; + +static HANDLE CopyToDIB(HWND wnd, enum PrintType type); +static HBITMAP CopyScreenToBitmap(LPRECT lpRect); +static HANDLE BitmapToDIB(HBITMAP hb, HPALETTE hp); +static HANDLE CopyScreenToDIB(LPRECT lpRect); +static int DIBNumColors(LPBITMAPINFOHEADER lpDIB); +static int PalEntriesOnDevice(HDC hDC); +static HPALETTE GetSystemPalette(void); +static void GetDisplaySize(LONG *width, LONG *height); +static int GdiWordToWeight(const char *str); +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONTW *lf, + const char *str[], int numargs); +static int PrintSelectPrinter(ClientData clientData, + Tcl_Interp *interp, int argc, + Tcl_Obj *const objv[]); +static int PrintOpenPrinter(ClientData clientData, + Tcl_Interp *interp, int argc, + Tcl_Obj *const objv[]); +static int PrintClosePrinter(ClientData clientData, + Tcl_Interp *interp, int argc, + Tcl_Obj *const objv[]); +static int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, + int argc, Tcl_Obj *const objv[]); +static int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, + int argc, Tcl_Obj *const objv[]); +static int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, + int argc, Tcl_Obj *const objv[]); +static int PrintClosePage(ClientData clientData, + Tcl_Interp *interp, int argc, + Tcl_Obj *const objv[]); + +static const char gdi_usage_message[] = + "::tk::print::_gdi [arc|characters|copybits|line|map|oval|" "photo|polygon|rectangle|text|version]\n" "\thdc parameters can be generated by the printer extension"; +/* + * Global state. + */ + static char msgbuf[1024]; static PRINTDLGW pd; -static DOCINFOW di; +static DOCINFOW di; static WCHAR *localPrinterName = NULL; static int copies, paper_width, paper_height, dpi_x, dpi_y; static LPDEVNAMES devnames; static HDC printDC; - + /* *---------------------------------------------------------------------- * @@ -114,52 +146,51 @@ static HDC printDC; * * Results: * It strips off the first word of the command (::tk::print::_gdi) and - * sends the result to a subcommand parser. + * sends the result to a subcommand parser. * *---------------------------------------------------------------------- */ -static int TkWinGDI (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) +static int TkWinGDI( + ClientData clientData, + Tcl_Interp *interp, + int argc, + const char **argv) { - - if ( argc > 1 && strcmp(*argv, "::tk::print::_gdi") == 0 ) - { - argc--; - argv++; - return TkWinGDISubcmd(clientData, interp, argc, argv); - } + if (argc > 1 && strcmp(argv[0], "::tk::print::_gdi") == 0) { + argc--; + argv++; + return TkWinGDISubcmd(clientData, interp, argc, argv); + } Tcl_AppendResult(interp, gdi_usage_message, NULL); return TCL_ERROR; } /* - * To make the "subcommands" follow a standard convention, - * add them to this array. The first element is the subcommand - * name, and the second a standard Tcl command handler. + * To make the "subcommands" follow a standard convention, add them to this + * array. The first element is the subcommand name, and the second a standard + * Tcl command handler. */ -static const struct gdi_command -{ - const char *command_string; - int (*command) (ClientData, Tcl_Interp *, int, const char **); -} gdi_commands[] = - { - { "arc", GdiArc }, - { "bitmap", GdiBitmap }, - { "characters", GdiCharWidths }, - { "image", GdiImage }, - { "line", GdiLine }, - { "map", GdiMap }, - { "oval", GdiOval }, - { "photo", GdiPhoto }, - { "polygon", GdiPolygon }, - { "rectangle", GdiRectangle }, - { "text", GdiText }, - { "copybits", GdiCopyBits }, - - }; - +static const struct gdi_command { + const char *command_string; + Tcl_CmdProc *command; +} gdi_commands[] = { + { "arc", GdiArc }, + { "bitmap", GdiBitmap }, + { "characters", GdiCharWidths }, + { "image", GdiImage }, + { "line", GdiLine }, + { "map", GdiMap }, + { "oval", GdiOval }, + { "photo", GdiPhoto }, + { "polygon", GdiPolygon }, + { "rectangle", GdiRectangle }, + { "text", GdiText }, + { "copybits", GdiCopyBits }, +}; + /* *---------------------------------------------------------------------- * @@ -173,19 +204,24 @@ static const struct gdi_command *---------------------------------------------------------------------- */ -static int TkWinGDISubcmd (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) +static int TkWinGDISubcmd( + ClientData clientData, + Tcl_Interp *interp, + int argc, + const char **argv) { size_t i; - for (i=0; i= 5) - { - - hDC = printDC; - - x1 = atoi(argv[1]); - y1 = atoi(argv[2]); - x2 = atoi(argv[3]); - y2 = atoi(argv[4]); - - argc -= 5; - argv += 5; - while ( argc >= 2 ) - { - if ( strcmp (argv[0], "-extent") == 0 ) - extent = atof(argv[1]); - else if ( strcmp (argv[0], "-start") == 0 ) - start = atof(argv[1]); - else if ( strcmp (argv[0], "-style") == 0 ) - { - if ( strcmp (argv[1], "pieslice") == 0 ) - drawfunc = Pie; - else if ( strcmp(argv[1], "arc") == 0 ) - drawfunc = Arc; - else if ( strcmp(argv[1], "chord") == 0 ) - drawfunc = Chord; - } - /* Handle all args, even if we don't use them yet. */ - else if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( GdiGetColor(argv[1], &fillcolor) ) - dofillcolor=1; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor=1; - } - else if (strcmp(argv[0], "-outlinestipple") == 0 ) - { - } - else if (strcmp(argv[0], "-stipple") == 0 ) - { - } - else if (strcmp(argv[0], "-width") == 0 ) - { - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } - argc -= 2; - argv += 2; - } - xr0 = xr1 = ( x1 + x2 ) / 2; - yr0 = yr1 = ( y1 + y2 ) / 2; + if (argc < 5) { + Tcl_AppendResult(interp, "::tk::print::_gdi", NULL); + return TCL_ERROR; + } + hDC = printDC; - /* - * The angle used by the arc must be "warped" by the eccentricity of the ellipse. - * Thanks to Nigel Dodd for bringing a nice example. - */ - xr0 += (int)(100.0 * (x2 - x1) * cos( (start * 2.0 * 3.14159265) / 360.0 ) ); - yr0 -= (int)(100.0 * (y2 - y1) * sin( (start * 2.0 * 3.14159265) / 360.0 ) ); - xr1 += (int)(100.0 * (x2 - x1) * cos( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); - yr1 -= (int)(100.0 * (y2 - y1) * sin( ((start+extent) * 2.0 * 3.14159265) / 360.0 ) ); - - /* Under Win95, SetArcDirection isn't implemented--so we have to - * assume that arcs are drawn counterclockwise (e.g., positive extent) - * So if it's negative, switch the coordinates! - */ - if ( extent < 0 ) - { - int xr2 = xr0; - int yr2 = yr0; - xr0 = xr1; - xr1 = xr2; - yr0 = yr1; - yr1 = yr2; - } + x1 = atoi(argv[1]); + y1 = atoi(argv[2]); + x2 = atoi(argv[3]); + y2 = atoi(argv[4]); + + argc -= 5; + argv += 5; + while (argc >= 2) { + if (strcmp(argv[0], "-extent") == 0) { + extent = atof(argv[1]); + } else if (strcmp(argv[0], "-start") == 0) { + start = atof(argv[1]); + } else if (strcmp(argv[0], "-style") == 0) { + if (strcmp(argv[1], "pieslice") == 0) { + drawfunc = Pie; + } else if (strcmp(argv[1], "arc") == 0) { + drawfunc = Arc; + } else if (strcmp(argv[1], "chord") == 0) { + drawfunc = Chord; + } + } else if (strcmp(argv[0], "-fill") == 0) { + /* Handle all args, even if we don't use them yet. */ + if (GdiGetColor(argv[1], &fillcolor)) { + dofillcolor = 1; + } + } else if (strcmp(argv[0], "-outline") == 0) { + if (GdiGetColor(argv[1], &linecolor)) { + dolinecolor = 1; + } + } else if (strcmp(argv[0], "-outlinestipple") == 0) { + } else if (strcmp(argv[0], "-stipple") == 0) { + } else if (strcmp(argv[0], "-width") == 0) { + width = atoi(argv[1]); + } else if (strcmp(argv[0], "-dash") == 0) { + if (argv[1]) { + dodash = 1; + dashdata = argv[1]; + } + } + argc -= 2; + argv += 2; + } + xr0 = xr1 = (x1 + x2) / 2; + yr0 = yr1 = (y1 + y2) / 2; - if ( dofillcolor ) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH) ); + /* + * The angle used by the arc must be "warped" by the eccentricity of the + * ellipse. Thanks to Nigel Dodd for bringing a + * nice example. + */ - if ( width || dolinecolor ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); + xr0 += (int)(100.0 * (x2 - x1) * cos((start * 2.0 * 3.14159265) / 360.0)); + yr0 -= (int)(100.0 * (y2 - y1) * sin((start * 2.0 * 3.14159265) / 360.0)); + xr1 += (int)(100.0 * (x2 - x1) * cos(((start+extent) * 2.0 * 3.14159265) / 360.0)); + yr1 -= (int)(100.0 * (y2 - y1) * sin(((start+extent) * 2.0 * 3.14159265) / 360.0)); - (*drawfunc)(hDC, x1, y1, x2, y2, xr0, yr0, xr1, yr1); + /* + * Under Win95, SetArcDirection isn't implemented--so we have to assume + * that arcs are drawn counterclockwise (e.g., positive extent) So if it's + * negative, switch the coordinates! + */ - if ( width || dolinecolor ) - GdiFreePen(interp, hDC, hPen); - if ( dofillcolor ) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject(hDC, oldobj); + if (extent < 0) { + int xr2 = xr0; + int yr2 = yr0; - return TCL_OK; - } + xr0 = xr1; + xr1 = xr2; + yr0 = yr1; + yr1 = yr2; + } - Tcl_AppendResult(interp, "::tk::print::_gdi", NULL); - return TCL_ERROR; -} + if (dofillcolor) { + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + } else { + oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH)); + } + + if (width || dolinecolor) { + GdiMakePen(interp, width, dodash, dashdata, + 0, 0, 0, 0, linecolor, hDC, (HGDIOBJ *)&hPen); + } + + (*drawfunc)(hDC, x1, y1, x2, y2, xr0, yr0, xr1, yr1); + + if (width || dolinecolor) { + GdiFreePen(interp, hDC, hPen); + } + if (dofillcolor) { + GdiFreeBrush(interp, hDC, hBrush); + } else { + SelectObject(hDC, oldobj); + } + return TCL_OK; +} + /* *---------------------------------------------------------------------- * * GdiBitmap -- * - * Unimplemented for now. Should use the same techniques as CanvasPsBitmap (tkCanvPs.c). + * Unimplemented for now. Should use the same techniques as + * CanvasPsBitmap (tkCanvPs.c). * * Results: * None. @@ -360,10 +387,10 @@ static int GdiArc( */ static int GdiBitmap( - TCL_UNUSED(void *), - Tcl_Interp *interp, - TCL_UNUSED(int), - TCL_UNUSED(const char **)) + TCL_UNUSED(void *), + Tcl_Interp *interp, + TCL_UNUSED(int), + TCL_UNUSED(const char **)) { static const char usage_message[] = "::tk::print::_gdi bitmap hdc x y " "-anchor [center|n|e|s|w] -background color " @@ -371,22 +398,22 @@ static int GdiBitmap( "Not implemented yet. Sorry!"; /* - * Skip this for now. Should be based on common - * code with the copybits command. + * Skip this for now. Should be based on common code with the copybits + * command. */ Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } - - + /* *---------------------------------------------------------------------- * * GdiImage -- * - * Unimplemented for now. Unimplemented for now. Should switch on image type and call - * either GdiPhoto or GdiBitmap. This code is similar to that in tkWinImage.c. + * Unimplemented for now. Unimplemented for now. Should switch on image + * type and call either GdiPhoto or GdiBitmap. This code is similar to + * that in tkWinImage.c. * * Results: * None. @@ -395,10 +422,10 @@ static int GdiBitmap( */ static int GdiImage( - TCL_UNUSED(void *), - Tcl_Interp *interp, - TCL_UNUSED(int), - TCL_UNUSED(const char **)) + TCL_UNUSED(void *), + Tcl_Interp *interp, + TCL_UNUSED(int), + TCL_UNUSED(const char **)) { static const char usage_message[] = "::tk::print::_gdi image hdc x y -anchor [center|n|e|s|w] -image name\n" "Not implemented yet. Sorry!"; @@ -410,16 +437,18 @@ static int GdiImage( /* Normally, usage results in TCL_ERROR--but wait til' it's implemented. */ return TCL_OK; } - + /* *---------------------------------------------------------------------- * * GdiPhoto -- * - * Contributed by Lukas Rosenthaler - * Note: The canvas doesn't directly support photos (only as images), - * so this is the first ::tk::print::_gdi command without an equivalent canvas command. - * This code may be modified to support photo images on the canvas. + * Contributed by Lukas Rosenthaler + * + * Note: The canvas doesn't directly support photos (only as images), so + * this is the first ::tk::print::_gdi command without an equivalent + * canvas command. This code may be modified to support photo images on + * the canvas. * * Results: * Renders a photo. @@ -428,32 +457,32 @@ static int GdiImage( */ static int GdiPhoto( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { static const char usage_message[] = "::tk::print::_gdi photo hdc [-destination x y [w [h]]] -photo name\n"; HDC dst; int dst_x = 0, dst_y = 0, dst_w = 0, dst_h = 0; int nx, ny, sll; - const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char *. */ + const char *photoname = 0; /* For some reason Tk_FindPhoto takes a char *. */ Tk_PhotoHandle photo_handle; Tk_PhotoImageBlock img_block; - BITMAPINFO bitmapinfo; /* Since we don't need the bmiColors table, - there is no need for dynamic allocation. */ - int oldmode; /* For saving the old stretch mode. */ - POINT pt; /* For saving the brush org. */ + BITMAPINFO bitmapinfo; /* Since we don't need the bmiColors table, + * there is no need for dynamic allocation. */ + int oldmode; /* For saving the old stretch mode. */ + POINT pt; /* For saving the brush org. */ char *pbuf = NULL; int i, j, k; int retval = TCL_OK; /* - * Parse the arguments. + * Parse the arguments. */ /* HDC is required. */ - if ( argc < 1 ) { + if (argc < 1) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } @@ -464,95 +493,89 @@ static int GdiPhoto( * Next, check to see if 'dst' can support BitBlt. * If not, raise an error. */ - if ( (GetDeviceCaps (dst, RASTERCAPS) & RC_STRETCHDIB) == 0 ) { + + if ((GetDeviceCaps(dst, RASTERCAPS) & RC_STRETCHDIB) == 0) { sprintf(msgbuf, "::tk::print::_gdi photo not supported on device context (0x%s)", argv[0]); Tcl_AppendResult(interp, msgbuf, NULL); return TCL_ERROR; } /* Parse the command line arguments. */ - for (j = 1; j < argc; j++) - { - if (strcmp (argv[j], "-destination") == 0) - { - double x, y, w, h; - int count = 0; - - if ( j < argc ) - count = sscanf(argv[++j], "%lf%lf%lf%lf", &x, &y, &w, &h); - - if ( count < 2 ) /* Destination must provide at least 2 arguments. */ - { - Tcl_AppendResult(interp, "-destination requires a list of at least 2 numbers\n", - usage_message, NULL); - return TCL_ERROR; - } - else - { - dst_x = (int) x; - dst_y = (int) y; - if ( count == 3 ) - { - dst_w = (int) w; - dst_h = -1; - } - else if ( count == 4 ) - { - dst_w = (int) w; - dst_h = (int) h; - } - } - } - else if (strcmp (argv[j], "-photo") == 0) - photoname = argv[++j]; - } + for (j = 1; j < argc; j++) { + if (strcmp(argv[j], "-destination") == 0) { + double x, y, w, h; + int count = 0; - if ( photoname == 0 ) /* No photo provided. */ - { - Tcl_AppendResult(interp, "No photo name provided to ::tk::print::_gdi photo\n", usage_message, NULL); - return TCL_ERROR; - } + if (j < argc) { + count = sscanf(argv[++j], "%lf%lf%lf%lf", &x, &y, &w, &h); + } - photo_handle = Tk_FindPhoto (interp, photoname); - if ( photo_handle == 0 ) - { - Tcl_AppendResult(interp, "::tk::print::_gdi photo: Photo name ", photoname, " can't be located\n", - usage_message, NULL); - return TCL_ERROR; + if (count < 2) { /* Destination must provide at least 2 arguments. */ + Tcl_AppendResult(interp, + "-destination requires a list of at least 2 numbers\n", + usage_message, NULL); + return TCL_ERROR; + } + + dst_x = (int) x; + dst_y = (int) y; + if (count == 3) { + dst_w = (int) w; + dst_h = -1; + } else if (count == 4) { + dst_w = (int) w; + dst_h = (int) h; + } + } else if (strcmp(argv[j], "-photo") == 0) { + photoname = argv[++j]; } - Tk_PhotoGetImage (photo_handle, &img_block); + } + + if (photoname == 0) { /* No photo provided. */ + Tcl_AppendResult(interp, + "No photo name provided to ::tk::print::_gdi photo\n", + usage_message, NULL); + return TCL_ERROR; + } + photo_handle = Tk_FindPhoto(interp, photoname); + if (photo_handle == 0) { + Tcl_AppendResult(interp, + "::tk::print::_gdi photo: Photo name ", photoname, + " can't be located\n", usage_message, NULL); + return TCL_ERROR; + } + Tk_PhotoGetImage(photo_handle, &img_block); nx = img_block.width; ny = img_block.height; sll = ((3*nx + 3) / 4)*4; /* Must be multiple of 4. */ - pbuf = (char *) Tcl_Alloc (sll*ny*sizeof (char)); - if ( pbuf == 0 ) /* Memory allocation failure. */ - { - Tcl_AppendResult(interp, "::tk::print::_gdi photo failed--out of memory", NULL); - return TCL_ERROR; - } + pbuf = (char *) Tcl_Alloc(sll * ny * sizeof(char)); + if (pbuf == 0) { /* Memory allocation failure. */ + /* TODO: unreachable */ + Tcl_AppendResult(interp, + "::tk::print::_gdi photo failed--out of memory", NULL); + return TCL_ERROR; + } /* After this, all returns must go through retval. */ /* BITMAP expects BGR; photo provides RGB. */ - for (k = 0; k < ny; k++) - { - for (i = 0; i < nx; i++) - { - pbuf[k*sll + 3*i] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[2]]; - pbuf[k*sll + 3*i + 1] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[1]]; - pbuf[k*sll + 3*i + 2] = - img_block.pixelPtr[k*img_block.pitch + i*img_block.pixelSize + img_block.offset[0]]; - } + for (k = 0; k < ny; k++) { + for (i = 0; i < nx; i++) { + pbuf[k*sll + 3*i] = img_block.pixelPtr[ + k*img_block.pitch + i*img_block.pixelSize + img_block.offset[2]]; + pbuf[k*sll + 3*i + 1] = img_block.pixelPtr[ + k*img_block.pitch + i*img_block.pixelSize + img_block.offset[1]]; + pbuf[k*sll + 3*i + 2] = img_block.pixelPtr[ + k*img_block.pitch + i*img_block.pixelSize + img_block.offset[0]]; } + } - memset (&bitmapinfo, 0L, sizeof (BITMAPINFO)); + memset(&bitmapinfo, 0L, sizeof(BITMAPINFO)); - bitmapinfo.bmiHeader.biSize = sizeof (BITMAPINFOHEADER); + bitmapinfo.bmiHeader.biSize = sizeof(BITMAPINFOHEADER); bitmapinfo.bmiHeader.biWidth = nx; bitmapinfo.bmiHeader.biHeight = -ny; bitmapinfo.bmiHeader.biPlanes = 1; @@ -564,56 +587,55 @@ static int GdiPhoto( bitmapinfo.bmiHeader.biClrUsed = 0; bitmapinfo.bmiHeader.biClrImportant = 0; - oldmode = SetStretchBltMode (dst, HALFTONE); - /* According to the Win32 Programmer's Manual, we have to set the brush org, now. */ + oldmode = SetStretchBltMode(dst, HALFTONE); + /* + * According to the Win32 Programmer's Manual, we have to set the brush + * org, now. + */ SetBrushOrgEx(dst, 0, 0, &pt); - if (dst_w <= 0) - { - dst_w = nx; - dst_h = ny; - } - else if (dst_h <= 0) - { - dst_h = ny*dst_w / nx; - } + if (dst_w <= 0) { + dst_w = nx; + dst_h = ny; + } else if (dst_h <= 0) { + dst_h = ny*dst_w / nx; + } if (StretchDIBits(dst, dst_x, dst_y, dst_w, dst_h, 0, 0, nx, ny, - pbuf, &bitmapinfo, DIB_RGB_COLORS, SRCCOPY) == (int)GDI_ERROR) { + pbuf, &bitmapinfo, DIB_RGB_COLORS, SRCCOPY) == (int)GDI_ERROR) { int errcode; errcode = GetLastError(); - sprintf(msgbuf, "::tk::print::_gdi photo internal failure: StretchDIBits error code %d", errcode); + sprintf(msgbuf, + "::tk::print::_gdi photo internal failure: StretchDIBits error code %d", + errcode); Tcl_AppendResult(interp, msgbuf, NULL); retval = TCL_ERROR; } /* Clean up the hDC. */ - if (oldmode != 0 ) - { - SetStretchBltMode(dst, oldmode); - SetBrushOrgEx(dst, pt.x, pt.y, &pt); - } + if (oldmode != 0) { + SetStretchBltMode(dst, oldmode); + SetBrushOrgEx(dst, pt.x, pt.y, &pt); + } - Tcl_Free (pbuf); + Tcl_Free(pbuf); - if ( retval == TCL_OK ) - { - sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); - Tcl_AppendResult(interp, msgbuf, NULL); - } + if (retval == TCL_OK) { + sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); + Tcl_AppendResult(interp, msgbuf, NULL); + } return retval; } - - + /* *---------------------------------------------------------------------- * * Bezierize -- * - * Interface to Tk's line smoother, used for lines and pollies. - * Provided by Jasper Taylor . + * Interface to Tk's line smoother, used for lines and pollies. + * Provided by Jasper Taylor . * * Results: * Smooths lines. @@ -621,59 +643,63 @@ static int GdiPhoto( *---------------------------------------------------------------------- */ -int Bezierize(POINT* polypoints, int npoly, int nStep, POINT* bpointptr) { +int Bezierize( + POINT* polypoints, + int npoly, + int nStep, + POINT* bpointptr) +{ /* First, translate my points into a list of doubles. */ double *inPointList, *outPointList; int n; int nbpoints = 0; POINT* bpoints; - - inPointList=(double *)Tcl_Alloc(2*sizeof(double)*npoly); - if ( inPointList == 0 ) { + inPointList = (double *) Tcl_Alloc(2 * sizeof(double) * npoly); + if (inPointList == 0) { + /* TODO: unreachable */ return nbpoints; /* 0. */ } - for (n=0;n= 5) - { + if (argc < 5) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - hDC = printDC; + hDC = printDC; - if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) - { - Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); - return TCL_ERROR; + if ((polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0) { + /* TODO: unreachable */ + Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); + return TCL_ERROR; + } + polypoints[0].x = atol(argv[1]); + polypoints[0].y = atol(argv[2]); + polypoints[1].x = atol(argv[3]); + polypoints[1].y = atol(argv[4]); + argc -= 5; + argv += 5; + npoly = 2; + + while (argc >= 2) { + /* Check for a number. */ + x = strtoul(argv[0], &strend, 0); + if (strend > argv[0]) { + /* One number.... */ + y = strtoul(argv[1], &strend, 0); + if (strend > argv[1]) { + /* TWO numbers!. */ + polypoints[npoly].x = x; + polypoints[npoly].y = y; + npoly++; + argc -= 2; + argv += 2; + } else { + /* Only one number... Assume a usage error. */ + Tcl_Free((void *)polypoints); + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } + } else { + if (strcmp(*argv, "-arrow") == 0) { + if (strcmp(argv[1], "none") == 0) { + doarrow = 0; + } else if (strcmp(argv[1], "both") == 0) { + doarrow = 3; + } else if (strcmp(argv[1], "first") == 0) { + doarrow = 2; + } else if (strcmp(argv[1], "last") == 0) { + doarrow = 1; } - polypoints[0].x = atol(argv[1]); - polypoints[0].y = atol(argv[2]); - polypoints[1].x = atol(argv[3]); - polypoints[1].y = atol(argv[4]); - argc -= 5; - argv += 5; - npoly = 2; - - while ( argc >= 2 ) - { - /* Check for a number. */ - x = strtoul(argv[0], &strend, 0); - if ( strend > argv[0] ) - { - /* One number.... */ - y = strtoul (argv[1], &strend, 0); - if ( strend > argv[1] ) - { - /* TWO numbers!. */ - polypoints[npoly].x = x; - polypoints[npoly].y = y; - npoly++; - argc-=2; - argv+=2; - } - else - { - /* Only one number... Assume a usage error. */ - Tcl_Free((void *)polypoints); - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - } - else - { - if ( strcmp(*argv, "-arrow") == 0 ) - { - if ( strcmp(argv[1], "none") == 0 ) - doarrow = 0; - else if ( strcmp(argv[1], "both") == 0 ) - doarrow = 3; - else if ( strcmp(argv[1], "first") == 0 ) - doarrow = 2; - else if ( strcmp(argv[1], "last") == 0 ) - doarrow = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-arrowshape") == 0 ) - { - /* List of 3 numbers--set arrowshape array. */ - int a1, a2, a3; - - if ( sscanf(argv[1], "%d%d%d", &a1, &a2, &a3) == 3 ) - { - if (a1 > 0 && a2 > 0 && a3 > 0 ) - { - arrowshape[0] = a1; - arrowshape[1] = a2; - arrowshape[2] = a3; - } - /* Else the numbers are bad. */ - } - /* Else the argument was bad. */ - - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-capstyle") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-fill") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-joinstyle") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-smooth") == 0 ) - { - /* Argument is true/false or 1/0 or bezier. */ - if ( argv[1] ) { - switch ( argv[1][0] ) { - case 't': case 'T': - case '1': - case 'b': case 'B': /* bezier. */ - dosmooth = 1; - break; - default: - dosmooth = 0; - break; - } - argv+=2; - argc-=2; - } - } - else if ( strcmp(*argv, "-splinesteps") == 0 ) - { - nStep = atoi(argv[1]); - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-dash" ) == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - argv += 2; - argc -= 2; - } - else if ( strcmp(*argv, "-dashoffset" ) == 0 ) - { - argv += 2; - argc -= 2; - } - else if ( strcmp(*argv, "-stipple") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(*argv, "-width") == 0 ) - { - width = atoi(argv[1]); - argv+=2; - argc-=2; - } - else /* It's an unknown argument!. */ - { - argc--; - argv++; - } - /* Check for arguments - * Most of the arguments affect the "Pen" - */ - } + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-arrowshape") == 0) { + /* List of 3 numbers--set arrowshape array. */ + int a1, a2, a3; + + if (sscanf(argv[1], "%d%d%d", &a1, &a2, &a3) == 3) { + if (a1 > 0 && a2 > 0 && a3 > 0) { + arrowshape[0] = a1; + arrowshape[1] = a2; + arrowshape[2] = a3; + } + /* Else the numbers are bad. */ } - - if (width || dolinecolor || dodash ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - if ( doarrow != 0 ) - GdiMakeBrush(interp, 0, linecolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - - if (dosmooth) /* Use PolyBezier. */ - { - int nbpoints; - POINT *bpoints = 0; - nbpoints = Bezierize(polypoints,npoly,nStep,bpoints); - if (nbpoints > 0 ) - Polyline(hDC, bpoints, nbpoints); - else - Polyline(hDC, polypoints, npoly); /* Out of memory? Just draw a regular line. */ - if ( bpoints != 0 ) - Tcl_Free((void *)bpoints); + /* Else the argument was bad. */ + + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-capstyle") == 0) { + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-fill") == 0) { + if (GdiGetColor(argv[1], &linecolor)) { + dolinecolor = 1; } - else - Polyline(hDC, polypoints, npoly); - - if ( dodash && doarrow ) /* Don't use dashed or thick pen for the arrows! */ - { - GdiFreePen(interp, hDC, hPen); - GdiMakePen(interp, width, - 0, 0, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-joinstyle") == 0) { + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-smooth") == 0) { + /* Argument is true/false or 1/0 or bezier. */ + if (argv[1]) { + switch (argv[1][0]) { + case 't': case 'T': + case '1': + case 'b': case 'B': /* bezier. */ + dosmooth = 1; + break; + default: + dosmooth = 0; + break; + } + argv += 2; + argc -= 2; } - - /* Now the arrowheads, if any. */ - if ( doarrow & 1 ) - { - /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y. */ - POINT ahead[6]; - double dx, dy, length; - double sinTheta, cosTheta; - double vertX, vertY, temp; - double fracHeight; - - fracHeight = 2.0 / arrowshape[2]; - - ahead[0].x = ahead[5].x = polypoints[npoly-1].x; - ahead[0].y = ahead[5].y = polypoints[npoly-1].y; - dx = ahead[0].x - polypoints[npoly-2].x; - dy = ahead[0].y - polypoints[npoly-2].y; - if ( (length = hypot(dx, dy)) == 0 ) - sinTheta = cosTheta = 0.0; - else - { - sinTheta = dy / length; - cosTheta = dx / length; - } - vertX = ahead[0].x - arrowshape[0]*cosTheta; - vertY = ahead[0].y - arrowshape[0]*sinTheta; - temp = arrowshape[2]*sinTheta; - ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); - ahead[4].x = (long)(ahead[1].x - 2 * temp); - temp = arrowshape[2]*cosTheta; - ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); - ahead[4].y = (long)(ahead[1].y + 2 * temp); - ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); - ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); - - Polygon(hDC, ahead, 6); - + } else if (strcmp(*argv, "-splinesteps") == 0) { + nStep = atoi(argv[1]); + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-dash") == 0) { + if (argv[1]) { + dodash = 1; + dashdata = argv[1]; } + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-dashoffset") == 0) { + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-stipple") == 0) { + argv += 2; + argc -= 2; + } else if (strcmp(*argv, "-width") == 0) { + width = atoi(argv[1]); + argv += 2; + argc -= 2; + } else { /* It's an unknown argument!. */ + argc--; + argv++; + } + /* Check for arguments + * Most of the arguments affect the "Pen" + */ + } + } - if ( doarrow & 2 ) - { - /* Arrowhead at end = polypoints[0].x, polypoints[0].y. */ - POINT ahead[6]; - double dx, dy, length; - double sinTheta, cosTheta; - double vertX, vertY, temp; - double fracHeight; - - fracHeight = 2.0 / arrowshape[2]; - - ahead[0].x = ahead[5].x = polypoints[0].x; - ahead[0].y = ahead[5].y = polypoints[0].y; - dx = ahead[0].x - polypoints[1].x; - dy = ahead[0].y - polypoints[1].y; - if ( (length = hypot(dx, dy)) == 0 ) - sinTheta = cosTheta = 0.0; - else - { - sinTheta = dy / length; - cosTheta = dx / length; - } - vertX = ahead[0].x - arrowshape[0]*cosTheta; - vertY = ahead[0].y - arrowshape[0]*sinTheta; - temp = arrowshape[2]*sinTheta; - ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); - ahead[4].x = (long)(ahead[1].x - 2 * temp); - temp = arrowshape[2]*cosTheta; - ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); - ahead[4].y = (long)(ahead[1].y + 2 * temp); - ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); - ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); - ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); - - Polygon(hDC, ahead, 6); - } + if (width || dolinecolor || dodash) { + GdiMakePen(interp, width, dodash, dashdata, + 0, 0, 0, 0, linecolor, hDC, (HGDIOBJ *)&hPen); + } + if (doarrow != 0) { + GdiMakeBrush(interp, 0, linecolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + } + if (dosmooth) { /* Use PolyBezier. */ + int nbpoints; + POINT *bpoints = 0; - if (width || dolinecolor || dodash ) - GdiFreePen(interp, hDC, hPen); - if ( doarrow ) - GdiFreeBrush(interp, hDC, hBrush); + nbpoints = Bezierize(polypoints,npoly,nStep,bpoints); + if (nbpoints > 0) { + Polyline(hDC, bpoints, nbpoints); + } else { + Polyline(hDC, polypoints, npoly); /* Out of memory? Just draw a regular line. */ + } + if (bpoints != 0) { + Tcl_Free((void *)bpoints); + } + } else { + Polyline(hDC, polypoints, npoly); + } - Tcl_Free((void *)polypoints); + if (dodash && doarrow) { /* Don't use dashed or thick pen for the arrows! */ + GdiFreePen(interp, hDC, hPen); + GdiMakePen(interp, width, 0, 0, 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + } - return TCL_OK; + /* Now the arrowheads, if any. */ + if (doarrow & 1) { + /* Arrowhead at end = polypoints[npoly-1].x, polypoints[npoly-1].y. */ + POINT ahead[6]; + double dx, dy, length; + double sinTheta, cosTheta; + double vertX, vertY, temp; + double fracHeight; + + fracHeight = 2.0 / arrowshape[2]; + + ahead[0].x = ahead[5].x = polypoints[npoly-1].x; + ahead[0].y = ahead[5].y = polypoints[npoly-1].y; + dx = ahead[0].x - polypoints[npoly-2].x; + dy = ahead[0].y - polypoints[npoly-2].y; + if ((length = hypot(dx, dy)) == 0) { + sinTheta = cosTheta = 0.0; + } else { + sinTheta = dy / length; + cosTheta = dx / length; } + vertX = ahead[0].x - arrowshape[0]*cosTheta; + vertY = ahead[0].y - arrowshape[0]*sinTheta; + temp = arrowshape[2]*sinTheta; + ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); + ahead[4].x = (long)(ahead[1].x - 2 * temp); + temp = arrowshape[2]*cosTheta; + ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); + ahead[4].y = (long)(ahead[1].y + 2 * temp); + ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); + ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); + + Polygon(hDC, ahead, 6); + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; -} + if (doarrow & 2) { + /* Arrowhead at end = polypoints[0].x, polypoints[0].y. */ + POINT ahead[6]; + double dx, dy, length; + double sinTheta, cosTheta; + double vertX, vertY, temp; + double fracHeight; + + fracHeight = 2.0 / arrowshape[2]; + + ahead[0].x = ahead[5].x = polypoints[0].x; + ahead[0].y = ahead[5].y = polypoints[0].y; + dx = ahead[0].x - polypoints[1].x; + dy = ahead[0].y - polypoints[1].y; + if ((length = hypot(dx, dy)) == 0) { + sinTheta = cosTheta = 0.0; + } else { + sinTheta = dy / length; + cosTheta = dx / length; + } + vertX = ahead[0].x - arrowshape[0]*cosTheta; + vertY = ahead[0].y - arrowshape[0]*sinTheta; + temp = arrowshape[2]*sinTheta; + ahead[1].x = (long)(ahead[0].x - arrowshape[1]*cosTheta + temp); + ahead[4].x = (long)(ahead[1].x - 2 * temp); + temp = arrowshape[2]*cosTheta; + ahead[1].y = (long)(ahead[0].y - arrowshape[1]*sinTheta - temp); + ahead[4].y = (long)(ahead[1].y + 2 * temp); + ahead[2].x = (long)(ahead[1].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[2].y = (long)(ahead[1].y*fracHeight + vertY*(1.0-fracHeight)); + ahead[3].x = (long)(ahead[4].x*fracHeight + vertX*(1.0-fracHeight)); + ahead[3].y = (long)(ahead[4].y*fracHeight + vertY*(1.0-fracHeight)); + + Polygon(hDC, ahead, 6); + } + + if (width || dolinecolor || dodash) { + GdiFreePen(interp, hDC, hPen); + } + if (doarrow) { + GdiFreeBrush(interp, hDC, hBrush); + } + Tcl_Free((void *)polypoints); + return TCL_OK; +} + /* *---------------------------------------------------------------------- * * GdiOval -- * - * Maps ovals to GDI context. + * Maps ovals to GDI context. * * Results: * Renders ovals. @@ -1014,17 +1002,17 @@ static int GdiLine( */ static int GdiOval( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { static const char usage_message[] = "::tk::print::_gdi oval hdc x1 y1 x2 y2 -fill color -outline color " "-stipple bitmap -width linewid"; int x1, y1, x2, y2; HDC hDC; HPEN hPen; - int width=0; + int width = 0; COLORREF linecolor = 0, fillcolor = 0; int dolinecolor = 0, dofillcolor = 0; HBRUSH hBrush; @@ -1035,99 +1023,91 @@ static int GdiOval( const char *dashdata = 0; /* Verrrrrry simple for now.... */ - if (argc >= 5) - { - - hDC = printDC; - - - x1 = atol(argv[1]); - y1 = atol(argv[2]); - x2 = atol(argv[3]); - y2 = atol(argv[4]); - if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } - if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } - argc -= 5; - argv += 5; - - while ( argc > 0 ) - { - /* Now handle any other arguments that occur. */ - if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( argv[1] ) - if ( GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( argv[1] ) - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-stipple") == 0 ) - { - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-width") == 0 ) - { - if (argv[1]) - width = atoi(argv[1]); - argv+=2; - argc-=2; - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - argv+=2; - argc-=2; - } - } + if (argc < 5) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject( hDC, GetStockObject(HOLLOW_BRUSH) ); + hDC = printDC; - if (width || dolinecolor) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - /* - * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and - * earlier documentation, canvas rectangle does not. Thus, add 1 to - * right and lower bounds to get appropriate behavior. - */ - Ellipse (hDC, x1, y1, x2+1, y2+1); - if (width || dolinecolor) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject (hDC, oldobj ); - - return TCL_OK; + x1 = atol(argv[1]); + y1 = atol(argv[2]); + x2 = atol(argv[3]); + y2 = atol(argv[4]); + if (x1 > x2) { + int x3 = x1; + x1 = x2; + x2 = x3; + } + if (y1 > y2) { + int y3 = y1; + y1 = y2; + y2 = y3; + } + argc -= 5; + argv += 5; + + while (argc > 0) { + /* Now handle any other arguments that occur. */ + if (strcmp(argv[0], "-fill") == 0) { + if (argv[1] && GdiGetColor(argv[1], &fillcolor)) { + dofillcolor = 1; + } + } else if (strcmp(argv[0], "-outline") == 0) { + if (argv[1] && GdiGetColor(argv[1], &linecolor)) { + dolinecolor = 1; + } + } else if (strcmp(argv[0], "-stipple") == 0) { + /* Not actually implemented */ + } else if (strcmp(argv[0], "-width") == 0) { + if (argv[1]) { + width = atoi(argv[1]); + } + } else if (strcmp(argv[0], "-dash") == 0) { + if (argv[1]) { + dodash = 1; + dashdata = argv[1]; + } } + argv += 2; + argc -= 2; + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; -} + if (dofillcolor) { + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + } else { + oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH)); + } + + if (width || dolinecolor) { + GdiMakePen(interp, width, dodash, dashdata, + 0, 0, 0, 0, linecolor, hDC, (HGDIOBJ *)&hPen); + } + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to right + * and lower bounds to get appropriate behavior. + */ + Ellipse(hDC, x1, y1, x2+1, y2+1); + + if (width || dolinecolor) { + GdiFreePen(interp, hDC, hPen); + } + if (dofillcolor) { + GdiFreeBrush(interp, hDC, hBrush); + } else { + SelectObject(hDC, oldobj); + } + return TCL_OK; +} + /* *---------------------------------------------------------------------- * * GdiPolygon -- * - * Maps polygons to GDI context. + * Maps polygons to GDI context. * * Results: * Renders polygons. @@ -1136,10 +1116,10 @@ static int GdiOval( */ static int GdiPolygon( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { static const char usage_message[] = "::tk::print::_gdi polygon hdc x1 y1 ... xn yn " "-fill color -outline color -smooth [true|false|bezier] " @@ -1154,8 +1134,8 @@ static int GdiPolygon( HDC hDC; HPEN hPen; int width = 0; - COLORREF linecolor=0, fillcolor=BS_NULL; - int dolinecolor=0, dofillcolor=0; + COLORREF linecolor = 0, fillcolor = BS_NULL; + int dolinecolor = 0, dofillcolor = 0; LOGBRUSH lbrush; HBRUSH hBrush; HGDIOBJ oldobj; @@ -1164,151 +1144,138 @@ static int GdiPolygon( const char *dashdata = 0; /* Verrrrrry simple for now.... */ - if (argc >= 5) - { - hDC = printDC; + if (argc < 5) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - if ( (polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0 ) - { - Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); - return TCL_ERROR; + hDC = printDC; + + if ((polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0) { + /* TODO: unreachable */ + Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); + return TCL_ERROR; + } + polypoints[0].x = atol(argv[1]); + polypoints[0].y = atol(argv[2]); + polypoints[1].x = atol(argv[3]); + polypoints[1].y = atol(argv[4]); + argc -= 5; + argv += 5; + npoly = 2; + + while (argc >= 2) { + /* Check for a number */ + x = strtoul(argv[0], &strend, 0); + if (strend > argv[0]) { + /* One number.... */ + y = strtoul(argv[1], &strend, 0); + if (strend > argv[1]) { + /* TWO numbers!. */ + polypoints[npoly].x = x; + polypoints[npoly].y = y; + npoly++; + argc -= 2; + argv += 2; + } else { + /* Only one number... Assume a usage error. */ + Tcl_Free((void *) polypoints); + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } + } else { + /* + * Check for arguments. + * Most of the arguments affect the "Pen" and "Brush". + */ + if (strcmp(argv[0], "-fill") == 0) { + if (argv[1] && GdiGetColor(argv[1], &fillcolor)) { + dofillcolor = 1; } - polypoints[0].x = atol(argv[1]); - polypoints[0].y = atol(argv[2]); - polypoints[1].x = atol(argv[3]); - polypoints[1].y = atol(argv[4]); - argc -= 5; - argv += 5; - npoly = 2; - - while ( argc >= 2 ) - { - /* Check for a number */ - x = strtoul(argv[0], &strend, 0); - if ( strend > argv[0] ) - { - /* One number.... */ - y = strtoul (argv[1], &strend, 0); - if ( strend > argv[1] ) - { - /* TWO numbers!. */ - polypoints[npoly].x = x; - polypoints[npoly].y = y; - npoly++; - argc-=2; - argv+=2; - } - else - { - /* Only one number... Assume a usage error. */ - Tcl_Free((void *)polypoints); - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } - } - else - { - if ( strcmp(argv[0], "-fill") == 0 ) - { - if ( argv[1] && GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - } - else if ( strcmp(argv[0], "-outline") == 0 ) - { - if ( GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 0; - } - else if ( strcmp(argv[0], "-smooth") == 0 ) { - if ( argv[1] ) { - switch ( argv[1][0] ) { - case 't': case 'T': - case '1': - case 'b': case 'B': /* bezier. */ - dosmooth = 1; - break; - default: - dosmooth = 0; - break; - } - } - } - else if ( strcmp(argv[0], "-splinesteps") == 0 ) - { - if ( argv[1] ) - nStep = atoi(argv[1]); - } - else if (strcmp(argv[0], "-stipple") == 0 ) - { - } - else if (strcmp(argv[0], "-width") == 0 ) - { - if (argv[1]) - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } - argc -= 2; - argv += 2; - /* - * Check for arguments. - * Most of the arguments affect the "Pen" and "Brush". - */ - } + } else if (strcmp(argv[0], "-outline") == 0) { + if (GdiGetColor(argv[1], &linecolor)) { + dolinecolor = 0; } - - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); - - if (width || dolinecolor) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - - if ( dosmooth) - { - int nbpoints; - POINT *bpoints = 0; - nbpoints = Bezierize(polypoints,npoly,nStep,bpoints); - if ( nbpoints > 0 ) - Polygon(hDC, bpoints, nbpoints); - else - Polygon(hDC, polypoints, npoly); - if ( bpoints != 0 ) - Tcl_Free((void *)bpoints); + } else if (strcmp(argv[0], "-smooth") == 0) { + if (argv[1]) { + switch (argv[1][0]) { + case 't': case 'T': + case '1': + case 'b': case 'B': /* bezier. */ + dosmooth = 1; + break; + default: + dosmooth = 0; + break; + } } - else - Polygon(hDC, polypoints, npoly); - - if (width || dolinecolor) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject (hDC, oldobj); - - Tcl_Free((void *)polypoints); - - return TCL_OK; + } else if (strcmp(argv[0], "-splinesteps") == 0) { + if (argv[1]) { + nStep = atoi(argv[1]); + } + } else if (strcmp(argv[0], "-stipple") == 0) { + /* Not supported */ + } else if (strcmp(argv[0], "-width") == 0) { + if (argv[1]) { + width = atoi(argv[1]); + } + } else if (strcmp(argv[0], "-dash") == 0) { + if (argv[1]) { + dodash = 1; + dashdata = argv[1]; + } + } + argc -= 2; + argv += 2; } + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; -} + if (dofillcolor) { + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + } else { + oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH)); + } + + if (width || dolinecolor) { + GdiMakePen(interp, width, dodash, dashdata, 0, 0, 0, 0, + linecolor, hDC, (HGDIOBJ *)&hPen); + } + + if (dosmooth) { + int nbpoints; + POINT *bpoints = 0; + nbpoints = Bezierize(polypoints,npoly,nStep,bpoints); + if (nbpoints > 0) { + Polygon(hDC, bpoints, nbpoints); + } else { + Polygon(hDC, polypoints, npoly); + } + if (bpoints != 0) { + Tcl_Free((void *)bpoints); + } + } else { + Polygon(hDC, polypoints, npoly); + } + if (width || dolinecolor) { + GdiFreePen(interp, hDC, hPen); + } + if (dofillcolor) { + GdiFreeBrush(interp, hDC, hBrush); + } else { + SelectObject(hDC, oldobj); + } + + Tcl_Free((void *)polypoints); + return TCL_OK; +} + /* *---------------------------------------------------------------------- * * GdiRectangle -- * - * Maps rectangles to GDI context. + * Maps rectangles to GDI context. * * Results: * Renders rectangles. @@ -1317,12 +1284,13 @@ static int GdiPolygon( */ static int GdiRectangle( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi rectangle hdc x1 y1 x2 y2 " + static const char usage_message[] = + "::tk::print::_gdi rectangle hdc x1 y1 x2 y2 " "-fill color -outline color " "-stipple bitmap -width linewid"; @@ -1330,8 +1298,8 @@ static int GdiRectangle( HDC hDC; HPEN hPen; int width = 0; - COLORREF linecolor=0, fillcolor=BS_NULL; - int dolinecolor=0, dofillcolor=0; + COLORREF linecolor = 0, fillcolor = BS_NULL; + int dolinecolor = 0, dofillcolor = 0; LOGBRUSH lbrush; HBRUSH hBrush; HGDIOBJ oldobj; @@ -1340,98 +1308,99 @@ static int GdiRectangle( const char *dashdata = 0; /* Verrrrrry simple for now.... */ - if (argc >= 5) - { - - hDC = printDC; - - x1 = atol(argv[1]); - y1 = atol(argv[2]); - x2 = atol(argv[3]); - y2 = atol(argv[4]); - if ( x1 > x2 ) { int x3 = x1; x1 = x2; x2 = x3; } - if ( y1 > y2 ) { int y3 = y1; y1 = y2; y2 = y3; } - argc -= 5; - argv += 5; - - /* Now handle any other arguments that occur. */ - while (argc > 1) - { - if ( strcmp(argv[0], "-fill") == 0 ) - { - if (argv[1]) - if (GdiGetColor(argv[1], &fillcolor) ) - dofillcolor = 1; - } - else if ( strcmp(argv[0], "-outline") == 0) - { - if (argv[1]) - if (GdiGetColor(argv[1], &linecolor) ) - dolinecolor = 1; - } - else if ( strcmp(argv[0], "-stipple") == 0) - { - } - else if ( strcmp(argv[0], "-width") == 0) - { - if (argv[1] ) - width = atoi(argv[1]); - } - else if ( strcmp(argv[0], "-dash") == 0 ) - { - if ( argv[1] ) { - dodash = 1; - dashdata = argv[1]; - } - } + if (argc < 5) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - argc -= 2; - argv += 2; - } + hDC = printDC; - /* - * Note: If any fill is specified, the function must create a brush and - * put the coordinates in a RECTANGLE structure, and call FillRect. - * FillRect requires a BRUSH / color. - * If not, the function Rectangle must be called. - */ - if (dofillcolor) - GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); - else - oldobj = SelectObject (hDC, GetStockObject(HOLLOW_BRUSH)); - - if ( width || dolinecolor ) - GdiMakePen(interp, width, - dodash, dashdata, - 0, 0, 0, 0, - linecolor, hDC, (HGDIOBJ *)&hPen); - /* - * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and - * earlier documentation, canvas rectangle does not. Thus, add 1 to - * right and lower bounds to get appropriate behavior. - */ - Rectangle (hDC, x1, y1, x2+1, y2+1); - if ( width || dolinecolor ) - GdiFreePen(interp, hDC, hPen); - if (dofillcolor) - GdiFreeBrush(interp, hDC, hBrush); - else - SelectObject(hDC, oldobj); - - return TCL_OK; + x1 = atol(argv[1]); + y1 = atol(argv[2]); + x2 = atol(argv[3]); + y2 = atol(argv[4]); + if (x1 > x2) { + int x3 = x1; + x1 = x2; + x2 = x3; + } + if (y1 > y2) { + int y3 = y1; + y1 = y2; + y2 = y3; + } + argc -= 5; + argv += 5; + + /* Now handle any other arguments that occur. */ + while (argc > 1) { + if (strcmp(argv[0], "-fill") == 0) { + if (argv[1] && GdiGetColor(argv[1], &fillcolor)) { + dofillcolor = 1; + } + } else if (strcmp(argv[0], "-outline") == 0) { + if (argv[1] && GdiGetColor(argv[1], &linecolor)) { + dolinecolor = 1; + } + } else if (strcmp(argv[0], "-stipple") == 0) { + /* Not supported; ignored */ + } else if (strcmp(argv[0], "-width") == 0) { + if (argv[1]) { + width = atoi(argv[1]); + } + } else if (strcmp(argv[0], "-dash") == 0) { + if (argv[1]) { + dodash = 1; + dashdata = argv[1]; + } } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; -} + argc -= 2; + argv += 2; + } + + /* + * Note: If any fill is specified, the function must create a brush and + * put the coordinates in a RECTANGLE structure, and call FillRect. + * FillRect requires a BRUSH / color. + * If not, the function Rectangle must be called. + */ + if (dofillcolor) { + GdiMakeBrush(interp, 0, fillcolor, 0, &lbrush, hDC, (HGDIOBJ *)&hBrush); + } else { + oldobj = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH)); + } + if (width || dolinecolor) { + GdiMakePen(interp, width, dodash, dashdata, + 0, 0, 0, 0, linecolor, hDC, (HGDIOBJ *)&hPen); + } + /* + * Per Win32, Rectangle includes lower and right edges--per Tcl8.3.2 and + * earlier documentation, canvas rectangle does not. Thus, add 1 to + * right and lower bounds to get appropriate behavior. + */ + Rectangle(hDC, x1, y1, x2+1, y2+1); + + if (width || dolinecolor) { + GdiFreePen(interp, hDC, hPen); + } + if (dofillcolor) { + GdiFreeBrush(interp, hDC, hBrush); + } else { + SelectObject(hDC, oldobj); + } + + return TCL_OK; +} + /* *---------------------------------------------------------------------- * * GdiCharWidths -- * - * Computes /character widths. This is completely inadequate for typesetting, - but should work for simple text manipulation. + * Computes /character widths. This is completely inadequate for + * typesetting, but should work for simple text manipulation. * * Results: * Returns character width. @@ -1441,17 +1410,18 @@ static int GdiRectangle( static int GdiCharWidths( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi characters hdc [-font fontname] [-array ary]"; + static const char usage_message[] = + "::tk::print::_gdi characters hdc [-font fontname] [-array ary]"; /* - * Returns widths of characters from font in an associative array. - * Font is currently selected font for HDC if not specified. - * Array name is GdiCharWidths if not specified. - * Widths should be in the same measures as all other values (1/1000 inch). + * Returns widths of characters from font in an associative array. + * Font is currently selected font for HDC if not specified. + * Array name is GdiCharWidths if not specified. + * Widths should be in the same measures as all other values (1/1000 inch). */ HDC hDC; @@ -1463,69 +1433,61 @@ static int GdiCharWidths( int widths[256]; int retval; - if ( argc < 1 ) - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } + if (argc < 1) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } hDC = printDC; argc--; argv++; - while ( argc > 0 ) - { - if ( strcmp(argv[0], "-font") == 0 ) - { - argc--; - argv++; - if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) - if ( (hfont = CreateFontIndirectW(&lf)) != NULL ) - { - made_font = 1; - oldfont = SelectObject(hDC, hfont); - } - /* Else leave the font alone!. */ - } - else if ( strcmp(argv[0], "-array") == 0 ) - { - argv++; - argc--; - if ( argc > 0 ) - { - aryvarname=argv[0]; - } + while (argc > 0) { + if (strcmp(argv[0], "-font") == 0) { + argc--; + argv++; + if (GdiMakeLogFont(interp, argv[0], &lf, hDC)) { + if ((hfont = CreateFontIndirectW(&lf)) != NULL) { + made_font = 1; + oldfont = SelectObject(hDC, hfont); } + } + /* Else leave the font alone!. */ + } else if (strcmp(argv[0], "-array") == 0) { argv++; argc--; + if (argc > 0) { + aryvarname = argv[0]; + } } - + argv++; + argc--; + } /* Now, get the widths using the correct function for font type. */ - if ( (retval = GetCharWidth32W(hDC, 0, 255, widths)) == FALSE ) - { - retval = GetCharWidthW(hDC, 0, 255, widths ); - } + if ((retval = GetCharWidth32W(hDC, 0, 255, widths)) == FALSE) { + retval = GetCharWidthW(hDC, 0, 255, widths); + } /* - * Retval should be 1 (TRUE) if the function succeeded. If the function fails, - * get the "extended" error code and return. Be sure to deallocate the font if - * necessary. + * Retval should be 1 (TRUE) if the function succeeded. If the function + * fails, get the "extended" error code and return. Be sure to deallocate + * the font if necessary. */ - if (retval == FALSE) - { - DWORD val = GetLastError(); - char intstr[12+1]; - sprintf (intstr, "%ld", val ); - Tcl_AppendResult (interp, "::tk::print::_gdi character failed with code ", intstr, NULL); - if ( made_font ) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } - return TCL_ERROR; + if (retval == FALSE) { + DWORD val = GetLastError(); + char intstr[12+1]; + + sprintf(intstr, "%ld", val); + Tcl_AppendResult(interp, + "::tk::print::_gdi character failed with code ", intstr, NULL); + if (made_font) { + SelectObject(hDC, oldfont); + DeleteObject(hfont); } + return TCL_ERROR; + } { int i; @@ -1533,32 +1495,30 @@ static int GdiCharWidths( char ind[2]; ind[1] = '\0'; - for (i = 0; i < 255; i++ ) - { - /* May need to convert the widths here(?). */ - sprintf(numbuf, "%d", widths[i]); - ind[0] = i; - Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); - } + for (i = 0; i < 255; i++) { + /* May need to convert the widths here(?). */ + sprintf(numbuf, "%d", widths[i]); + ind[0] = i; + Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); + } } /* Now, remove the font if we created it only for this function. */ - if ( made_font ) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } + if (made_font) { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } /* The return value should be the array name(?). */ Tcl_AppendResult(interp, (char *)aryvarname, NULL); return TCL_OK; } - + /* *---------------------------------------------------------------------- * * GdiText -- * - * Maps text to GDI context. + * Maps text to GDI context. * * Results: * Renders text. @@ -1567,12 +1527,13 @@ static int GdiCharWidths( */ int GdiText( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { - static const char usage_message[] = "::tk::print::_gdi text hdc x y -anchor [center|n|e|s|w] " + static const char usage_message[] = + "::tk::print::_gdi text hdc x y -anchor [center|n|e|s|w] " "-fill color -font fontname " "-justify [left|right|center] " "-stipple bitmap -text string -width linelen " @@ -1587,10 +1548,10 @@ int GdiText( Tk_Anchor anchor = 0; LOGFONTW lf; HFONT hfont, oldfont; - int made_font = 0; + int made_font = 0; int retval; - int dotextcolor=0; - int dobgmode=0; + int dotextcolor = 0; + int dobgmode = 0; int bgmode; COLORREF textcolor = 0; int usesingle = 0; @@ -1601,295 +1562,274 @@ int GdiText( Tcl_Encoding encoding = NULL; int tds_len; - if ( argc >= 4 ) - { - /* Parse the command. */ + if (argc < 4) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - hDC = printDC; + /* Parse the command. */ - x = atol(argv[1]); - y = atol(argv[2]); - argc -= 3; - argv += 3; + hDC = printDC; - sizerect.left = sizerect.right = x; - sizerect.top = sizerect.bottom = y; + x = atol(argv[1]); + y = atol(argv[2]); + argc -= 3; + argv += 3; - while ( argc > 0 ) - { - if ( strcmp(argv[0], "-anchor") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - Tk_GetAnchor(interp, argv[0], &anchor); - } - else if ( strcmp(argv[0], "-justify") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - { - if ( strcmp(argv[0], "left") == 0 ) - format_flags |= DT_LEFT; - else if ( strcmp(argv[0], "center") == 0 ) - format_flags |= DT_CENTER; - else if ( strcmp(argv[0], "right") == 0 ) - format_flags |= DT_RIGHT; - } - } - else if ( strcmp(argv[0], "-text") == 0 ) - { - argc--; - argv++; - if (argc > 0 ) - string = argv[0]; - } - else if ( strcmp(argv[0], "-font") == 0 ) - { - argc--; - argv++; - if ( GdiMakeLogFont(interp, argv[0], &lf, hDC) ) - if ( (hfont = CreateFontIndirectW(&lf)) != NULL ) - { - made_font = 1; - oldfont = SelectObject(hDC, hfont); - } - /* Else leave the font alone! */ - } - else if ( strcmp(argv[0], "-stipple") == 0 ) - { - argc--; - argv++; - /* Not implemented yet. */ - } - else if ( strcmp(argv[0], "-fill") == 0 ) - { - argc--; - argv++; - /* Get text color. */ - if ( GdiGetColor(argv[0], &textcolor) ) - dotextcolor = 1; - } - else if ( strcmp(argv[0], "-width") == 0 ) - { - argc--; - argv++; - if ( argc > 0 ) - sizerect.right += atol(argv[0]); - /* If a width is specified, break at words. */ - format_flags |= DT_WORDBREAK; - } - else if ( strcmp(argv[0], "-single") == 0 ) - { - usesingle = 1; - } - else if ( strcmp(argv[0], "-backfill") == 0 ) - dobgmode = 1; - else if ( strcmp(argv[0], "-encoding") == 0 ) { - argc--; - argv++; - if ( argc > 0 ) { - encoding_name = argv[0]; - } - } + sizerect.left = sizerect.right = x; + sizerect.top = sizerect.bottom = y; - argc--; - argv++; + while (argc > 0) { + if (strcmp(argv[0], "-anchor") == 0) { + argc--; + argv++; + if (argc > 0) { + Tk_GetAnchor(interp, argv[0], &anchor); + } + } else if (strcmp(argv[0], "-justify") == 0) { + argc--; + argv++; + if (argc > 0) { + if (strcmp(argv[0], "left") == 0) { + format_flags |= DT_LEFT; + } else if (strcmp(argv[0], "center") == 0) { + format_flags |= DT_CENTER; + } else if (strcmp(argv[0], "right") == 0) { + format_flags |= DT_RIGHT; } - - /* Handle the encoding, if present. */ - if ( encoding_name != 0 ) - { - Tcl_Encoding tmp_encoding; - tmp_encoding = Tcl_GetEncoding(interp,encoding_name); - if (tmp_encoding != NULL) - encoding = tmp_encoding; + } + } else if (strcmp(argv[0], "-text") == 0) { + argc--; + argv++; + if (argc > 0) { + string = argv[0]; + } + } else if (strcmp(argv[0], "-font") == 0) { + argc--; + argv++; + if (GdiMakeLogFont(interp, argv[0], &lf, hDC)) { + if ((hfont = CreateFontIndirectW(&lf)) != NULL) { + made_font = 1; + oldfont = SelectObject(hDC, hfont); } + } + /* Else leave the font alone! */ + } else if (strcmp(argv[0], "-stipple") == 0) { + argc--; + argv++; + /* Not implemented yet. */ + } else if (strcmp(argv[0], "-fill") == 0) { + argc--; + argv++; + /* Get text color. */ + if (GdiGetColor(argv[0], &textcolor)) { + dotextcolor = 1; + } + } else if (strcmp(argv[0], "-width") == 0) { + argc--; + argv++; + if (argc > 0) { + sizerect.right += atol(argv[0]); + } + /* If a width is specified, break at words. */ + format_flags |= DT_WORDBREAK; + } else if (strcmp(argv[0], "-single") == 0) { + usesingle = 1; + } else if (strcmp(argv[0], "-backfill") == 0) { + dobgmode = 1; + } else if (strcmp(argv[0], "-encoding") == 0) { + argc--; + argv++; + if (argc > 0) { + encoding_name = argv[0]; + } + } - if (string == 0 ) - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } + argc--; + argv++; + } - /* Set the format flags for -single: Overrides -width. */ - if ( usesingle == 1 ) - { - format_flags |= DT_SINGLELINE; - format_flags |= DT_NOCLIP; - format_flags &= ~DT_WORDBREAK; - } + /* Handle the encoding, if present. */ + if (encoding_name != 0) { + Tcl_Encoding tmp_encoding = Tcl_GetEncoding(interp,encoding_name); + if (tmp_encoding != NULL) { + encoding = tmp_encoding; + } + } - /* Calculate the rectangle. */ - Tcl_DStringInit(&tds); - Tcl_UtfToExternalDString(encoding, string, -1, &tds); - ostring = Tcl_DStringValue(&tds); - tds_len = Tcl_DStringLength(&tds); - /* Just for fun, let's try translating ostring to Unicode. */ - Tcl_UniChar *ustring; - Tcl_DString tds2; - Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); - Tcl_DStringFree(&tds2); - - /* Adjust the rectangle according to the anchor. */ - x = y = 0; - switch ( anchor ) - { - case TK_ANCHOR_N: - x = ( sizerect.right - sizerect.left ) / 2; - break; - case TK_ANCHOR_S: - x = ( sizerect.right - sizerect.left ) / 2; - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_E: - x = ( sizerect.right - sizerect.left ); - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - case TK_ANCHOR_W: - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - case TK_ANCHOR_NE: - x = ( sizerect.right - sizerect.left ); - break; - case TK_ANCHOR_NW: - break; - case TK_ANCHOR_SE: - x = ( sizerect.right - sizerect.left ); - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_SW: - y = ( sizerect.bottom - sizerect.top ); - break; - case TK_ANCHOR_CENTER: - x = ( sizerect.right - sizerect.left ) / 2; - y = ( sizerect.bottom - sizerect.top ) / 2; - break; - } - sizerect.right -= x; - sizerect.left -= x; - sizerect.top -= y; - sizerect.bottom -= y; - - /* Get the color right. */ - if ( dotextcolor ) - textcolor = SetTextColor(hDC, textcolor); - - if ( dobgmode ) - bgmode = SetBkMode(hDC, OPAQUE); - else - bgmode = SetBkMode(hDC, TRANSPARENT); - - - /* Print the text. */ - Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - retval = DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); - Tcl_DStringFree(&tds2); - Tcl_DStringFree(&tds); - - /* Get the color set back. */ - if ( dotextcolor ) - textcolor = SetTextColor(hDC, textcolor); - - SetBkMode(hDC, bgmode); - - if (made_font) - { - SelectObject(hDC, oldfont); - DeleteObject(hfont); - } + if (string == 0) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - /* In this case, the return value is the height of the text. */ - sprintf(msgbuf, "%d", retval); - Tcl_AppendResult(interp, msgbuf, NULL); + /* Set the format flags for -single: Overrides -width. */ + if (usesingle == 1) { + format_flags |= DT_SINGLELINE; + format_flags |= DT_NOCLIP; + format_flags &= ~DT_WORDBREAK; + } - return TCL_OK; - } + /* Calculate the rectangle. */ + Tcl_DStringInit(&tds); + Tcl_UtfToExternalDString(encoding, string, -1, &tds); + ostring = Tcl_DStringValue(&tds); + tds_len = Tcl_DStringLength(&tds); + + /* Just for fun, let's try translating ostring to Unicode. */ + Tcl_UniChar *ustring; + Tcl_DString tds2; + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); + DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, + format_flags | DT_CALCRECT); + Tcl_DStringFree(&tds2); + + /* Adjust the rectangle according to the anchor. */ + x = y = 0; + switch (anchor) { + case TK_ANCHOR_N: + x = (sizerect.right - sizerect.left) / 2; + break; + case TK_ANCHOR_S: + x = (sizerect.right - sizerect.left) / 2; + y = (sizerect.bottom - sizerect.top); + break; + case TK_ANCHOR_E: + x = (sizerect.right - sizerect.left); + y = (sizerect.bottom - sizerect.top) / 2; + break; + case TK_ANCHOR_W: + y = (sizerect.bottom - sizerect.top) / 2; + break; + case TK_ANCHOR_NE: + x = (sizerect.right - sizerect.left); + break; + case TK_ANCHOR_NW: + break; + case TK_ANCHOR_SE: + x = (sizerect.right - sizerect.left); + y = (sizerect.bottom - sizerect.top); + break; + case TK_ANCHOR_SW: + y = (sizerect.bottom - sizerect.top); + break; + case TK_ANCHOR_CENTER: + x = (sizerect.right - sizerect.left) / 2; + y = (sizerect.bottom - sizerect.top) / 2; + break; + } + sizerect.right -= x; + sizerect.left -= x; + sizerect.top -= y; + sizerect.bottom -= y; + + /* Get the color right. */ + if (dotextcolor) { + textcolor = SetTextColor(hDC, textcolor); + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; -} + if (dobgmode) { + bgmode = SetBkMode(hDC, OPAQUE); + } else { + bgmode = SetBkMode(hDC, TRANSPARENT); + } + /* Print the text. */ + Tcl_DStringInit(&tds2); + ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); + retval = DrawTextW(hDC, (LPWSTR) ustring, + Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); + Tcl_DStringFree(&tds2); + Tcl_DStringFree(&tds); + + /* Get the color set back. */ + if (dotextcolor) { + textcolor = SetTextColor(hDC, textcolor); + } + SetBkMode(hDC, bgmode); + if (made_font) { + SelectObject(hDC, oldfont); + DeleteObject(hfont); + } + + /* In this case, the return value is the height of the text. */ + sprintf(msgbuf, "%d", retval); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_OK; +} + /* *---------------------------------------------------------------------- * * GdiGetHdcInfo -- * - * Gets salient characteristics of the CTM. + * Gets salient characteristics of the CTM. * * Results: - * The return value is 0 if any failure occurs--in which case - * none of the other values are meaningful. - * Otherwise the return value is the current mapping mode. - + * The return value is 0 if any failure occurs--in which case none of the + * other values are meaningful. Otherwise the return value is the + * current mapping mode. * *---------------------------------------------------------------------- */ -static int GdiGetHdcInfo( HDC hdc, - LPPOINT worigin, LPSIZE wextent, - LPPOINT vorigin, LPSIZE vextent) +static int GdiGetHdcInfo( + HDC hdc, + LPPOINT worigin, + LPSIZE wextent, + LPPOINT vorigin, + LPSIZE vextent) { int mapmode; int retval; - memset (worigin, 0, sizeof(POINT)); - memset (vorigin, 0, sizeof(POINT)); - memset (wextent, 0, sizeof(SIZE)); - memset (vextent, 0, sizeof(SIZE)); + memset(worigin, 0, sizeof(POINT)); + memset(vorigin, 0, sizeof(POINT)); + memset(wextent, 0, sizeof(SIZE)); + memset(vextent, 0, sizeof(SIZE)); - if ( (mapmode = GetMapMode(hdc)) == 0 ) - { - /* Failed! */ - retval=0; - } - else + if ((mapmode = GetMapMode(hdc)) == 0) { + /* Failed! */ + retval = 0; + } else { retval = mapmode; + } - if ( GetWindowExtEx(hdc, wextent) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetViewportExtEx (hdc, vextent) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetWindowOrgEx(hdc, worigin) == FALSE ) - { - /* Failed! */ - retval = 0; - } - if ( GetViewportOrgEx(hdc, vorigin) == FALSE ) - { - /* Failed! */ - retval = 0; - } + if (GetWindowExtEx(hdc, wextent) == FALSE) { + /* Failed! */ + retval = 0; + } + if (GetViewportExtEx(hdc, vextent) == FALSE) { + /* Failed! */ + retval = 0; + } + if (GetWindowOrgEx(hdc, worigin) == FALSE) { + /* Failed! */ + retval = 0; + } + if (GetViewportOrgEx(hdc, vorigin) == FALSE) { + /* Failed! */ + retval = 0; + } return retval; } - - + /* *---------------------------------------------------------------------- * * GdiNameToMode -- * - * Converts Windows mapping mode names. + * Converts Windows mapping mode names. * * Results: * Mapping modes are delineated. - * *---------------------------------------------------------------------- */ -static int GdiNameToMode(const char *name) +static int GdiNameToMode( + const char *name) { static const struct gdimodes { int mode; @@ -1906,29 +1846,29 @@ static int GdiNameToMode(const char *name) }; size_t i; - for (i=0; i < sizeof(modes) / sizeof(struct gdimodes); i++) - { - if ( strcmp(modes[i].name, name) == 0 ) - return modes[i].mode; + for (i=0; i < sizeof(modes) / sizeof(struct gdimodes); i++) { + if (strcmp(modes[i].name, name) == 0) { + return modes[i].mode; } + } return atoi(name); } - + /* *---------------------------------------------------------------------- * - * GdiNameToMode -- + * GdiModeToName -- * - * Converts the mode number to a printable form. + * Converts the mode number to a printable form. * * Results: * Mapping numbers are delineated. - * *---------------------------------------------------------------------- */ -static const char *GdiModeToName(int mode) +static const char *GdiModeToName( + int mode) { static const struct gdi_modes { int mode; @@ -1945,44 +1885,42 @@ static const char *GdiModeToName(int mode) }; size_t i; - for (i=0; i < sizeof(modes) / sizeof(struct gdi_modes); i++) - { - if ( modes[i].mode == mode ) - return modes[i].name; + for (i=0; i < sizeof(modes) / sizeof(struct gdi_modes); i++) { + if (modes[i].mode == mode) { + return modes[i].name; } + } return "Unknown"; } - + /* *---------------------------------------------------------------------- * * GdiMap -- * - * Sets mapping mode between logical and physical device space. + * Sets mapping mode between logical and physical device space. * * Results: * Bridges map modes. - * *---------------------------------------------------------------------- */ static int GdiMap( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { static const char usage_message[] = "::tk::print::_gdi map hdc " "[-logical x[y]] [-physical x[y]] " - "[-offset {x y} ] [-default] [-mode mode]" - ; + "[-offset {x y} ] [-default] [-mode mode]"; HDC hdc; - int mapmode; /* Mapping mode. */ - SIZE wextent; /* Device extent. */ - SIZE vextent; /* Viewport extent. */ - POINT worigin; /* Device origin. */ - POINT vorigin; /* Viewport origin. */ + int mapmode; /* Mapping mode. */ + SIZE wextent; /* Device extent. */ + SIZE vextent; /* Viewport extent. */ + POINT worigin; /* Device origin. */ + POINT vorigin; /* Viewport origin. */ int argno; /* Keep track of what parts of the function need to be executed. */ @@ -1994,195 +1932,178 @@ static int GdiMap( int use_mode = 0; /* Required parameter: HDC for printer. */ - if ( argc >= 1 ) - { - - hdc = printDC; + if (argc < 1) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - if ( (mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0 ) - { - /* Failed!. */ - Tcl_AppendResult(interp, "Cannot get current HDC info", NULL); - return TCL_ERROR; - } + hdc = printDC; - /* Parse remaining arguments. */ - for (argno = 1; argno < argc; argno++) - { - if ( strcmp(argv[argno], "-default") == 0 ) - { - vextent.cx = vextent.cy = wextent.cx = wextent.cy = 1; - vorigin.x = vorigin.y = worigin.x = worigin.y = 0; - mapmode = MM_TEXT; - use_default = 1; - } - else if ( strcmp (argv[argno], "-mode" ) == 0 ) - { - if ( argno + 1 >= argc ) - need_usage = 1; - else - { - mapmode = GdiNameToMode(argv[argno+1]); - use_mode = 1; - argno++; - } - } - else if ( strcmp (argv[argno], "-offset") == 0 ) - { - if (argno + 1 >= argc) - need_usage = 1; - else - { - /* It would be nice if this parsed units as well.... */ - if ( sscanf(argv[argno+1], "%ld%ld", &vorigin.x, &vorigin.y) == 2 ) - use_offset = 1; - else - need_usage = 1; - argno ++; - } - } - else if ( strcmp (argv[argno], "-logical") == 0 ) - { - if ( argno+1 >= argc) - need_usage = 1; - else - { - int count; - argno++; - /* In "real-life", this should parse units as well.. */ - if ( (count = sscanf(argv[argno], "%ld%ld", &wextent.cx, &wextent.cy)) != 2 ) - { - if ( count == 1 ) - { - mapmode = MM_ISOTROPIC; - use_logical = 1; - wextent.cy = wextent.cx; /* Make them the same. */ - } - else - need_usage = 1; - } - else - { - mapmode = MM_ANISOTROPIC; - use_logical = 2; - } - } - } - else if ( strcmp (argv[argno], "-physical") == 0 ) - { - if ( argno+1 >= argc) - need_usage = 1; - else - { - int count; - - argno++; - /* In "real-life", this should parse units as well.. */ - if ( (count = sscanf(argv[argno], "%ld%ld", &vextent.cx, &vextent.cy)) != 2 ) - { - if ( count == 1 ) - { - mapmode = MM_ISOTROPIC; - use_physical = 1; - vextent.cy = vextent.cx; /* Make them the same. */ - } - else - need_usage = 1; - } - else - { - mapmode = MM_ANISOTROPIC; - use_physical = 2; - } - } - } - } + if ((mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent)) == 0) { + /* Failed!. */ + Tcl_AppendResult(interp, "Cannot get current HDC info", NULL); + return TCL_ERROR; + } - /* Check for any impossible combinations. */ - if ( use_logical != use_physical ) + /* Parse remaining arguments. */ + for (argno = 1; argno < argc; argno++) { + if (strcmp(argv[argno], "-default") == 0) { + vextent.cx = vextent.cy = wextent.cx = wextent.cy = 1; + vorigin.x = vorigin.y = worigin.x = worigin.y = 0; + mapmode = MM_TEXT; + use_default = 1; + } else if (strcmp(argv[argno], "-mode") == 0) { + if (argno + 1 >= argc) { need_usage = 1; - if ( use_default && (use_logical || use_offset || use_mode ) ) + } else { + mapmode = GdiNameToMode(argv[argno + 1]); + use_mode = 1; + argno++; + } + } else if (strcmp(argv[argno], "-offset") == 0) { + if (argno + 1 >= argc) { + need_usage = 1; + } else { + /* It would be nice if this parsed units as well.... */ + if (sscanf(argv[argno + 1], "%ld%ld", + &vorigin.x, &vorigin.y) == 2) { + use_offset = 1; + } else { + need_usage = 1; + } + argno++; + } + } else if (strcmp(argv[argno], "-logical") == 0) { + if (argno + 1 >= argc) { need_usage = 1; - if ( use_mode && use_logical && - (mapmode != MM_ISOTROPIC && mapmode != MM_ANISOTROPIC) - ) + } else { + int count; + argno++; + /* In "real-life", this should parse units as well.. */ + if ((count = sscanf(argv[argno], "%ld%ld", + &wextent.cx, &wextent.cy)) != 2) { + if (count == 1) { + mapmode = MM_ISOTROPIC; + use_logical = 1; + wextent.cy = wextent.cx; /* Make them the same. */ + } else { + need_usage = 1; + } + } else { + mapmode = MM_ANISOTROPIC; + use_logical = 2; + } + } + } else if (strcmp(argv[argno], "-physical") == 0) { + if (argno + 1 >= argc) { need_usage = 1; + } else { + int count; + + argno++; + /* In "real-life", this should parse units as well.. */ + if ((count = sscanf(argv[argno], "%ld%ld", + &vextent.cx, &vextent.cy)) != 2) { + if (count == 1) { + mapmode = MM_ISOTROPIC; + use_physical = 1; + vextent.cy = vextent.cx; /* Make them the same. */ + } else { + need_usage = 1; + } + } else { + mapmode = MM_ANISOTROPIC; + use_physical = 2; + } + } + } + } - if ( need_usage == 0 ) - { - /* Call Windows CTM functions. */ - if ( use_logical || use_default || use_mode ) /* Don't call for offset only. */ - { - SetMapMode(hdc, mapmode); - } + /* Check for any impossible combinations. */ + if (use_logical != use_physical) { + need_usage = 1; + } + if (use_default && (use_logical || use_offset || use_mode)) { + need_usage = 1; + } + if (use_mode && use_logical && + (mapmode != MM_ISOTROPIC && mapmode != MM_ANISOTROPIC)) { + need_usage = 1; + } - if ( use_offset || use_default ) - { - POINT oldorg; - SetViewportOrgEx (hdc, vorigin.x, vorigin.y, &oldorg); - SetWindowOrgEx (hdc, worigin.x, worigin.y, &oldorg); - } + if (need_usage) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } - if ( use_logical ) /* Same as use_physical. */ - { - SIZE oldsiz; - SetWindowExtEx (hdc, wextent.cx, wextent.cy, &oldsiz); - SetViewportExtEx (hdc, vextent.cx, vextent.cy, &oldsiz); - } + /* Call Windows CTM functions. */ + if (use_logical || use_default || use_mode) { /* Don't call for offset only. */ + SetMapMode(hdc, mapmode); + } - /* - * Since we may not have set up every parameter, get them again for - * the report. - */ - mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent); - - /* - * Output current CTM info. - * Note: This should really be in terms that can be used in a ::tk::print::_gdi map command! - */ - sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " - "Origin: \"(%ld, %ld)\" " - "MappingMode: \"%s\"", - vextent.cx, vextent.cy, wextent.cx, wextent.cy, - vorigin.x, vorigin.y, - GdiModeToName(mapmode)); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_OK; - } - } + if (use_offset || use_default) { + POINT oldorg; + SetViewportOrgEx(hdc, vorigin.x, vorigin.y, &oldorg); + SetWindowOrgEx(hdc, worigin.x, worigin.y, &oldorg); + } - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; -} + if (use_logical) { /* Same as use_physical. */ + SIZE oldsiz; + SetWindowExtEx(hdc, wextent.cx, wextent.cy, &oldsiz); + SetViewportExtEx(hdc, vextent.cx, vextent.cy, &oldsiz); + } + /* + * Since we may not have set up every parameter, get them again for the + * report. + */ + mapmode = GdiGetHdcInfo(hdc, &worigin, &wextent, &vorigin, &vextent); + + /* + * Output current CTM info. + * Note: This should really be in terms that can be used in a + * ::tk::print::_gdi map command! + */ + sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " + "Origin: \"(%ld, %ld)\" " + "MappingMode: \"%s\"", + vextent.cx, vextent.cy, wextent.cx, wextent.cy, + vorigin.x, vorigin.y, + GdiModeToName(mapmode)); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_OK; +} + /* *---------------------------------------------------------------------- * * GdiCopyBits -- * - * Copies window bits from source to destination. + * Copies window bits from source to destination. * * Results: * Copies window bits. - * *---------------------------------------------------------------------- */ -static int GdiCopyBits ( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int argc, - const char **argv) +static int GdiCopyBits( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int argc, + const char **argv) { /* Goal: get the Tk_Window from the top-level * convert it to an HWND * get the HDC * Do a bitblt to the given hdc - * Use an optional parameter to point to an arbitrary window instead of the main - * Use optional parameters to map to the width and height required for the dest. + * Use an optional parameter to point to an arbitrary window instead of + * the main + * Use optional parameters to map to the width and height required for the + * dest. */ - static const char usage_message[] = "::tk::print::_gdi copybits hdc [-window w|-screen] [-client] " + static const char usage_message[] = + "::tk::print::_gdi copybits hdc [-window w|-screen] [-client] " "[-source \"a b c d\"] " "[-destination \"a b c d\"] [-scale number] [-calc]"; @@ -2203,251 +2124,207 @@ static int GdiCopyBits ( long errcode; /* Variables to remember what we saw in the arguments. */ - int do_window=0; - int do_screen=0; - int do_scale=0; - int do_print=1; + int do_window = 0; + int do_screen = 0; + int do_scale = 0; + int do_print = 1; /* Variables to remember the values in the arguments. */ const char *window_spec; - double scale=1.0; - int src_x=0, src_y=0, src_w=0, src_h=0; - int dst_x=0, dst_y=0, dst_w=0, dst_h=0; + double scale = 1.0; + int src_x = 0, src_y = 0, src_w = 0, src_h = 0; + int dst_x = 0, dst_y = 0, dst_w = 0, dst_h = 0; int is_toplevel = 0; /* * The following steps are peculiar to the top level window. - * There is likely a clever way to do the mapping of a - * widget pathname to the proper window, to support the idea of - * using a parameter for this purpose. + * There is likely a clever way to do the mapping of a widget pathname to + * the proper window, to support the idea of using a parameter for this + * purpose. */ - if ( (workwin = mainWin = Tk_MainWindow(interp)) == 0 ) - { - Tcl_AppendResult(interp, "Can't find main Tk window", NULL); - return TCL_ERROR; - } + if ((workwin = mainWin = Tk_MainWindow(interp)) == 0) { + Tcl_AppendResult(interp, "Can't find main Tk window", NULL); + return TCL_ERROR; + } /* - * Parse the arguments. + * Parse the arguments. */ /* HDC is required. */ - if ( argc < 1 ) - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } + if (argc < 1) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } dst = printDC; /* - * Next, check to see if 'dst' can support BitBlt. - * If not, raise an error. + * Next, check to see if 'dst' can support BitBlt. If not, raise an + * error. */ - if ( ( GetDeviceCaps (dst, RASTERCAPS) & RC_BITBLT ) == 0 ) - { - printf(msgbuf, "Can't do bitmap operations on device context\n"); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_ERROR; - } + if ((GetDeviceCaps(dst, RASTERCAPS) & RC_BITBLT) == 0) { + printf(msgbuf, "Can't do bitmap operations on device context\n"); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_ERROR; + } /* Loop through the remaining arguments. */ { int k; - for (k=1; k= 100.0 ) - { - sprintf(msgbuf, "Unreasonable scale specification %s", argv[k]); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_ERROR; - } - do_scale = 1; - } + } + } else if (strcmp(argv[k], "-screen") == 0) { + do_screen = 1; + wintype = PTScreen; + } else if (strcmp(argv[k], "-client") == 0) { + wintype = PTClient; + } else if (strcmp(argv[k], "-source") == 0) { + float a, b, c, d; + int count; + count = sscanf(argv[++k], "%f%f%f%f", &a, &b, &c, &d); + if (count < 2) { /* Can't make heads or tails of it.... */ + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } + src_x = (int)a; + src_y = (int)b; + if (count == 4) { + src_w = (int)c; + src_h = (int)d; + } + } else if (strcmp(argv[k], "-destination") == 0) { + float a, b, c, d; + int count; + + count = sscanf(argv[++k], "%f%f%f%f", &a, &b, &c, &d); + if (count < 2) { /* Can't make heads or tails of it.... */ + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } + dst_x = (int)a; + dst_y = (int)b; + if (count == 3) { + dst_w = (int)c; + dst_h = -1; + } else if (count == 4) { + dst_w = (int)c; + dst_h = (int)d; + } + } else if (strcmp(argv[k], "-scale") == 0) { + if (argv[++k]) { + scale = strtod(argv[k], &strend); + if (strend == 0 || strend == argv[k]) { + sprintf(msgbuf, "Can't understand scale specification %s", argv[k]); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_ERROR; } - else if ( strcmp(argv[k], "-noprint") == 0 || strncmp(argv[k], "-calc", 5) == 0 ) - { - /* This option suggested by Pascal Bouvier to get sizes without printing. */ - do_print = 0; + if (scale <= 0.01 || scale >= 100.0) { + sprintf(msgbuf, "Unreasonable scale specification %s", argv[k]); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_ERROR; } + do_scale = 1; + } + } else if (strcmp(argv[k], "-noprint") == 0 + || strncmp(argv[k], "-calc", 5) == 0) { + /* This option suggested by Pascal Bouvier to get sizes without + * printing. */ + do_print = 0; } + } } /* * Check to ensure no incompatible arguments were used. */ - if ( do_window && do_screen ) - { - Tcl_AppendResult(interp, usage_message, NULL); - return TCL_ERROR; - } + if (do_window && do_screen) { + Tcl_AppendResult(interp, usage_message, NULL); + return TCL_ERROR; + } /* - * Get the MS Window we want to copy. - * Given the HDC, we can get the "Window". + * Get the MS Window we want to copy. Given the HDC, we can get the + * "Window". */ - if (hwnd == 0 ) - { - if ( Tk_IsTopLevel(workwin) ) - is_toplevel = 1; - - if ( (wnd = Tk_WindowId(workwin)) == 0 ) - { - Tcl_AppendResult(interp, "Can't get id for Tk window", NULL); - return TCL_ERROR; - } - - /* Given the "Window" we can get a Microsoft Windows HWND. */ - - if ( (hwnd = Tk_GetHWND(wnd)) == 0 ) - { - Tcl_AppendResult(interp, "Can't get Windows handle for Tk window", NULL); - return TCL_ERROR; - } + if (hwnd == 0) { + if (Tk_IsTopLevel(workwin)) { + is_toplevel = 1; + } - /* - * If it's a toplevel, give it special treatment: Get the top-level window instead. - * If the user only wanted the client, the -client flag will take care of it. - * This uses "windows" tricks rather than Tk since the obvious method of - * getting the wrapper window didn't seem to work. - */ - if ( is_toplevel ) - { - HWND tmpWnd = hwnd; - while ( (tmpWnd = GetParent( tmpWnd ) ) != 0 ) - hwnd = tmpWnd; - } + if ((wnd = Tk_WindowId(workwin)) == 0) { + Tcl_AppendResult(interp, "Can't get id for Tk window", NULL); + return TCL_ERROR; } - /* Given the HWND, we can get the window's device context. */ - if ( (src = GetWindowDC(hwnd)) == 0 ) - { - Tcl_AppendResult(interp, "Can't get device context for Tk window", NULL); + /* Given the "Window" we can get a Microsoft Windows HWND. */ + + if ((hwnd = Tk_GetHWND(wnd)) == 0) { + Tcl_AppendResult(interp, "Can't get Windows handle for Tk window", + NULL); return TCL_ERROR; } - if ( do_screen ) - { - LONG w, h; - GetDisplaySize(&w, &h); - wid = w; - hgt = h; + /* + * If it's a toplevel, give it special treatment: Get the top-level + * window instead. If the user only wanted the client, the -client + * flag will take care of it. This uses "windows" tricks rather than + * Tk since the obvious method of getting the wrapper window didn't + * seem to work. + */ + if (is_toplevel) { + HWND tmpWnd = hwnd; + while ((tmpWnd = GetParent(tmpWnd)) != 0) { + hwnd = tmpWnd; + } } - else if ( is_toplevel ) - { - RECT tl; - GetWindowRect(hwnd, &tl); - wid = tl.right - tl.left; - hgt = tl.bottom - tl.top; + } + + /* Given the HWND, we can get the window's device context. */ + if ((src = GetWindowDC(hwnd)) == 0) { + Tcl_AppendResult(interp, "Can't get device context for Tk window", NULL); + return TCL_ERROR; + } + + if (do_screen) { + LONG w, h; + GetDisplaySize(&w, &h); + wid = w; + hgt = h; + } else if (is_toplevel) { + RECT tl; + GetWindowRect(hwnd, &tl); + wid = tl.right - tl.left; + hgt = tl.bottom - tl.top; + } else { + if ((hgt = Tk_Height(workwin)) <= 0) { + Tcl_AppendResult(interp, "Can't get height of Tk window", NULL); + ReleaseDC(hwnd,src); + return TCL_ERROR; } - else - { - if ( (hgt = Tk_Height(workwin)) <= 0 ) - { - Tcl_AppendResult(interp, "Can't get height of Tk window", NULL); - ReleaseDC(hwnd,src); - return TCL_ERROR; - } - if ( (wid = Tk_Width(workwin)) <= 0 ) - { - Tcl_AppendResult(interp, "Can't get width of Tk window", NULL); - ReleaseDC(hwnd,src); - return TCL_ERROR; - } + if ((wid = Tk_Width(workwin)) <= 0) { + Tcl_AppendResult(interp, "Can't get width of Tk window", NULL); + ReleaseDC(hwnd,src); + return TCL_ERROR; } + } /* * Ensure all the widths and heights are set up right @@ -2455,89 +2332,92 @@ static int GdiCopyBits ( * B: No dimensions exceed the maximums * C: The dimensions don't lead to a 0 width or height image. */ - if ( src_x < 0 ) + if (src_x < 0) { src_x = 0; - if ( src_y < 0 ) + } + if (src_y < 0) { src_y = 0; - if ( dst_x < 0 ) + } + if (dst_x < 0) { dst_x = 0; - if ( dst_y < 0 ) + } + if (dst_y < 0) { dst_y = 0; + } - if ( src_w > wid || src_w <= 0 ) + if (src_w > wid || src_w <= 0) { src_w = wid; + } - if ( src_h > hgt || src_h <= 0 ) + if (src_h > hgt || src_h <= 0) { src_h = hgt; + } - if ( do_scale && dst_w == 0 ) - { - /* Calculate destination width and height based on scale. */ - dst_w = (int)(scale * src_w); - dst_h = (int)(scale * src_h); - } + if (do_scale && dst_w == 0) { + /* Calculate destination width and height based on scale. */ + dst_w = (int)(scale * src_w); + dst_h = (int)(scale * src_h); + } - if ( dst_h == -1 ) + if (dst_h == -1) { dst_h = (int) (((long)src_h * dst_w) / (src_w + 1)) + 1; + } - if ( dst_h == 0 || dst_w == 0 ) - { - dst_h = src_h; - dst_w = src_w; - } + if (dst_h == 0 || dst_w == 0) { + dst_h = src_h; + dst_w = src_w; + } - if ( do_print ) - { - /* - * Based on notes from Heiko Schock and Arndt Roger Schneider, - * create this as a DIBitmap, to allow output to a greater range of - * devices. This approach will also allow selection of - * a) Whole screen - * b) Whole window - * c) Client window only - * for the "grab" - */ - hDib = CopyToDIB( hwnd, wintype ); + if (do_print) { + /* + * Based on notes from Heiko Schock and Arndt Roger Schneider, create + * this as a DIBitmap, to allow output to a greater range of devices. + * This approach will also allow selection of + * a) Whole screen + * b) Whole window + * c) Client window only + * for the "grab" + */ + hDib = CopyToDIB(hwnd, wintype); - /* GdiFlush();. */ + /* GdiFlush();. */ - if (!hDib) { - Tcl_AppendResult(interp, "Can't create DIB", NULL); - ReleaseDC(hwnd,src); - return TCL_ERROR; - } + if (!hDib) { + Tcl_AppendResult(interp, "Can't create DIB", NULL); + ReleaseDC(hwnd,src); + return TCL_ERROR; + } - lpDIBHdr = (LPBITMAPINFOHEADER)GlobalLock(hDib); - if (!lpDIBHdr) { - Tcl_AppendResult(interp, "Can't get DIB header", NULL); - ReleaseDC(hwnd,src); - return TCL_ERROR; - } + lpDIBHdr = (LPBITMAPINFOHEADER) GlobalLock(hDib); + if (!lpDIBHdr) { + Tcl_AppendResult(interp, "Can't get DIB header", NULL); + ReleaseDC(hwnd,src); + return TCL_ERROR; + } - lpBits = (LPSTR)lpDIBHdr + lpDIBHdr->biSize + DIBNumColors(lpDIBHdr) * sizeof(RGBQUAD); - - /* stretch the DIBbitmap directly in the target device. */ - - if (StretchDIBits(dst, - dst_x, dst_y, dst_w, dst_h, - src_x, src_y, src_w, src_h, - lpBits, (LPBITMAPINFO)lpDIBHdr, DIB_RGB_COLORS, - SRCCOPY) == (int)GDI_ERROR) - { - errcode = GetLastError(); - GlobalUnlock(hDib); - GlobalFree(hDib); - ReleaseDC(hwnd,src); - sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_ERROR; - } + lpBits = (LPSTR) lpDIBHdr + lpDIBHdr->biSize + DIBNumColors(lpDIBHdr) * sizeof(RGBQUAD); - /* free allocated memory. */ + /* stretch the DIBbitmap directly in the target device. */ + + if (StretchDIBits(dst, + dst_x, dst_y, dst_w, dst_h, + src_x, src_y, src_w, src_h, + lpBits, (LPBITMAPINFO)lpDIBHdr, DIB_RGB_COLORS, + SRCCOPY) == (int)GDI_ERROR) { + errcode = GetLastError(); GlobalUnlock(hDib); GlobalFree(hDib); + ReleaseDC(hwnd,src); + sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); + Tcl_AppendResult(interp, msgbuf, NULL); + return TCL_ERROR; } + /* free allocated memory. */ + GlobalUnlock(hDib); + GlobalFree(hDib); + } + ReleaseDC(hwnd,src); /* @@ -2549,13 +2429,13 @@ static int GdiCopyBits ( return TCL_OK; } - + /* *---------------------------------------------------------------------- * * DIBNumColors -- * - * Computes the number of colors required for a DIB palette. + * Computes the number of colors required for a DIB palette. * * Results: * Returns number of colors. @@ -2564,48 +2444,45 @@ static int GdiCopyBits ( *---------------------------------------------------------------------- */ -static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) +static int DIBNumColors( + LPBITMAPINFOHEADER lpDIB) { - WORD wBitCount; /* DIB bit count. */ + WORD wBitCount; /* DIB bit count. */ DWORD dwClrUsed; /* - * If this is a Windows-style DIB, the number of colors in the - * color table can be less than the number of bits per pixel. - * allows for (i.e. lpbi->biClrUsed can be set to some value). - * If this is the case, return the appropriate value.. + * If this is a Windows-style DIB, the number of colors in the color table + * can be less than the number of bits per pixel allows for (i.e. + * lpbi->biClrUsed can be set to some value). If this is the case, return + * the appropriate value.. */ - - dwClrUsed = (lpDIB)->biClrUsed; - if (dwClrUsed) - return (WORD)dwClrUsed; + dwClrUsed = lpDIB->biClrUsed; + if (dwClrUsed) { + return (WORD) dwClrUsed; + } /* * Calculate the number of colors in the color table based on. * The number of bits per pixel for the DIB. */ - wBitCount = (lpDIB)->biBitCount; + wBitCount = lpDIB->biBitCount; /* Return number of colors based on bits per pixel. */ - switch (wBitCount) - { - case 1: - return 2; - - case 4: - return 16; - - case 8: - return 256; - - default: - return 0; - } + switch (wBitCount) { + case 1: + return 2; + case 4: + return 16; + case 8: + return 256; + default: + return 0; + } } - + /* * Helper functions */ @@ -2622,9 +2499,9 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) * * GdiParseFontWords -- * - * Converts various keywords to modifiers of a font specification. - * For all words, later occurrences override earlier occurrences. - * Overstrike and underline cannot be "undone" by other words + * Converts various keywords to modifiers of a font specification. For + * all words, later occurrences override earlier occurrences. Overstrike + * and underline cannot be "undone" by other words * * Results: * Keywords converted to modifiers. @@ -2633,96 +2510,94 @@ static int DIBNumColors(LPBITMAPINFOHEADER lpDIB) */ static int GdiParseFontWords( - TCL_UNUSED(Tcl_Interp *), - LOGFONTW *lf, - const char *str[], - int numargs) + TCL_UNUSED(Tcl_Interp *), + LOGFONTW *lf, + const char *str[], + int numargs) { int i; int retval = 0; /* Number of words that could not be parsed. */ - for (i=0; ilfWeight = wt; - else if ( strcmp(str[i], "roman") == 0 ) - lf->lfItalic = FALSE; - else if ( strcmp(str[i], "italic") == 0 ) - lf->lfItalic = TRUE; - else if ( strcmp(str[i], "underline") == 0 ) - lf->lfUnderline = TRUE; - else if ( strcmp(str[i], "overstrike") == 0 ) - lf->lfStrikeOut = TRUE; - else - retval++; - } + + for (i=0; ilfWeight = wt; + } else if (strcmp(str[i], "roman") == 0) { + lf->lfItalic = FALSE; + } else if (strcmp(str[i], "italic") == 0) { + lf->lfItalic = TRUE; + } else if (strcmp(str[i], "underline") == 0) { + lf->lfUnderline = TRUE; + } else if (strcmp(str[i], "overstrike") == 0) { + lf->lfStrikeOut = TRUE; + } else { + retval++; + } } + } return retval; } - - + /* *---------------------------------------------------------------------- * - * GdiWordToWeight -- + * GdiWordToWeight -- * - * Converts keywords to font weights. + * Converts keywords to font weights. * * Results: - * Helps set the proper font for GDI rendering. + * Helps set the proper font for GDI rendering. * *---------------------------------------------------------------------- */ -static int GdiWordToWeight(const char *str) +static int GdiWordToWeight( + const char *str) { int retval = -1; size_t i; - static const struct font_weight - { + static const struct font_weight { const char *name; int weight; - } font_weights[] = - { - { "thin", FW_THIN }, - { "extralight", FW_EXTRALIGHT }, - { "ultralight", FW_EXTRALIGHT }, - { "light", FW_LIGHT }, - { "normal", FW_NORMAL }, - { "regular", FW_NORMAL }, - { "medium", FW_MEDIUM }, - { "semibold", FW_SEMIBOLD }, - { "demibold", FW_SEMIBOLD }, - { "bold", FW_BOLD }, - { "extrabold", FW_EXTRABOLD }, - { "ultrabold", FW_EXTRABOLD }, - { "heavy", FW_HEAVY }, - { "black", FW_HEAVY }, - }; - - if ( str == 0 ) + } font_weights[] = { + { "thin", FW_THIN }, + { "extralight", FW_EXTRALIGHT }, + { "ultralight", FW_EXTRALIGHT }, + { "light", FW_LIGHT }, + { "normal", FW_NORMAL }, + { "regular", FW_NORMAL }, + { "medium", FW_MEDIUM }, + { "semibold", FW_SEMIBOLD }, + { "demibold", FW_SEMIBOLD }, + { "bold", FW_BOLD }, + { "extrabold", FW_EXTRABOLD }, + { "ultrabold", FW_EXTRABOLD }, + { "heavy", FW_HEAVY }, + { "black", FW_HEAVY }, + }; + + if (str == 0) { return -1; + } - for (i=0; ilfWeight = FW_NORMAL; lf->lfCharSet = DEFAULT_CHARSET; lf->lfOutPrecision = OUT_DEFAULT_PRECIS; @@ -2745,136 +2624,134 @@ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, LOGFONTW *lf, HDC lf->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; /* The cast to (char *) is silly, based on prototype of Tcl_SplitList. */ - if ( Tcl_SplitList(interp, str, &count, &list) != TCL_OK ) + if (Tcl_SplitList(interp, str, &count, &list) != TCL_OK) { return 0; + } /* Now we have the font structure broken into name, size, weight. */ - if ( count >= 1 ) { + if (count >= 1) { Tcl_DString ds; + Tcl_DStringInit(&ds); - wcsncpy(lf->lfFaceName, Tcl_UtfToWCharDString(list[0], -1, &ds), sizeof(lf->lfFaceName) - 1); + wcsncpy(lf->lfFaceName, Tcl_UtfToWCharDString(list[0], -1, &ds), + sizeof(lf->lfFaceName) - 1); Tcl_DStringFree(&ds); } else { return 0; } - if ( count >= 2 ) - { - int siz; - char *strend; - siz = strtol(list[1], &strend, 0); + if (count >= 2) { + int siz; + char *strend; + siz = strtol(list[1], &strend, 0); - /* - * Assumptions: - * 1) Like canvas, if a positive number is specified, it's in points. - * 2) Like canvas, if a negative number is specified, it's in pixels. - */ - if ( strend > list[1] ) /* If it looks like a number, it is a number.... */ - { - if ( siz > 0 ) /* Size is in points. */ - { - SIZE wextent, vextent; - POINT worigin, vorigin; - double factor; - - switch ( GdiGetHdcInfo(hDC, &worigin, &wextent, &vorigin, &vextent) ) - { - case MM_ISOTROPIC: - if ( vextent.cy < -1 || vextent.cy > 1 ) - { - factor = (double)wextent.cy / vextent.cy; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else if ( vextent.cx < -1 || vextent.cx > 1 ) - { - factor = (double)wextent.cx / vextent.cx; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else - lf->lfHeight = -siz; /* This is bad news.... */ - break; - case MM_ANISOTROPIC: - if ( vextent.cy != 0 ) - { - factor = (double)wextent.cy / vextent.cy; - if ( factor < 0.0 ) - factor = - factor; - lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); - } - else - lf->lfHeight = -siz; /* This is bad news.... */ - break; - case MM_TEXT: - default: - /* If mapping mode is MM_TEXT, use the documented formula. */ - lf->lfHeight = -MulDiv(siz, GetDeviceCaps(hDC, LOGPIXELSY), 72); - break; - case MM_HIENGLISH: - lf->lfHeight = -MulDiv(siz, 1000, 72); - break; - case MM_LOENGLISH: - lf->lfHeight = -MulDiv(siz, 100, 72); - break; - case MM_HIMETRIC: - lf->lfHeight = -MulDiv(siz, (int)(1000*2.54), 72); - break; - case MM_LOMETRIC: - lf->lfHeight = -MulDiv(siz, (int)(100*2.54), 72); - break; - case MM_TWIPS: - lf->lfHeight = -MulDiv(siz, 1440, 72); - break; - } + /* + * Assumptions: + * 1) Like canvas, if a positive number is specified, it's in points. + * 2) Like canvas, if a negative number is specified, it's in pixels. + */ + if (strend > list[1]) { /* If it looks like a number, it is a number.... */ + if (siz > 0) { /* Size is in points. */ + SIZE wextent, vextent; + POINT worigin, vorigin; + double factor; + + switch (GdiGetHdcInfo(hDC, &worigin, &wextent, &vorigin, &vextent)) { + case MM_ISOTROPIC: + if (vextent.cy < -1 || vextent.cy > 1) { + factor = (double)wextent.cy / vextent.cy; + if (factor < 0.0) { + factor = -factor; } - else if ( siz == 0 ) /* Use default size of 12 points. */ - lf->lfHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72); - else /* Use pixel size. */ - { - lf->lfHeight = siz; /* Leave this negative. */ + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } else if (vextent.cx < -1 || vextent.cx > 1) { + factor = (double)wextent.cx / vextent.cx; + if (factor < 0.0) { + factor = -factor; } + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } else { + lf->lfHeight = -siz; /* This is bad news.... */ + } + break; + case MM_ANISOTROPIC: + if (vextent.cy != 0) { + factor = (double)wextent.cy / vextent.cy; + if (factor < 0.0) { + factor = -factor; + } + lf->lfHeight = (int)(-siz * GetDeviceCaps(hDC, LOGPIXELSY) * factor / 72.0); + } else { + lf->lfHeight = -siz; /* This is bad news.... */ + } + break; + case MM_TEXT: + default: + /* If mapping mode is MM_TEXT, use the documented + * formula. */ + lf->lfHeight = -MulDiv(siz, GetDeviceCaps(hDC, LOGPIXELSY), 72); + break; + case MM_HIENGLISH: + lf->lfHeight = -MulDiv(siz, 1000, 72); + break; + case MM_LOENGLISH: + lf->lfHeight = -MulDiv(siz, 100, 72); + break; + case MM_HIMETRIC: + lf->lfHeight = -MulDiv(siz, (int)(1000*2.54), 72); + break; + case MM_LOMETRIC: + lf->lfHeight = -MulDiv(siz, (int)(100*2.54), 72); + break; + case MM_TWIPS: + lf->lfHeight = -MulDiv(siz, 1440, 72); + break; } - else - GdiParseFontWords(interp, lf, list+1, count-1); + } else if (siz == 0) { /* Use default size of 12 points. */ + lf->lfHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72); + } else { /* Use pixel size. */ + lf->lfHeight = siz; /* Leave this negative. */ + } + } else { + GdiParseFontWords(interp, lf, list+1, count-1); } + } - if ( count >= 3 ) + if (count >= 3) { GdiParseFontWords(interp, lf, list+2, count-2); + } Tcl_Free((char *)list); return 1; } - + /* *---------------------------------------------------------------------- * * GdiMakePen -- * - * Creates a logical pen based on input parameters and selects it into the hDC. + * Creates a logical pen based on input parameters and selects it into + * the hDC. * * Results: - * Sets rendering pen. + * Sets rendering pen. * *---------------------------------------------------------------------- */ static int GdiMakePen( - Tcl_Interp *interp, - int width, - int dashstyle, - const char *dashstyledata, - TCL_UNUSED(int), /* Ignored for now. */ - TCL_UNUSED(int), /* Ignored for now. */ - TCL_UNUSED(int), - TCL_UNUSED(const char *), /* Ignored for now. */ - unsigned long color, - HDC hDC, - HGDIOBJ *oldPen) + Tcl_Interp *interp, + int width, + int dashstyle, + const char *dashstyledata, + TCL_UNUSED(int), /* Ignored for now. */ + TCL_UNUSED(int), /* Ignored for now. */ + TCL_UNUSED(int), + TCL_UNUSED(const char *), /* Ignored for now. */ + unsigned long color, + HDC hDC, + HGDIOBJ *oldPen) { - /* * The LOGPEN structure takes the following dash options: * PS_SOLID: a solid pen @@ -2883,10 +2760,11 @@ static int GdiMakePen( * PS_DASHDOT: a pen with a dash followed by a dot * PS_DASHDOTDOT: a pen with a dash followed by 2 dots * - * It seems that converting to ExtCreatePen may be more advantageous, as it matches - * the Tk canvas pens much better--but not for Win95, which does not support PS_USERSTYLE - * An explicit test (or storage in a static after first failure) may suffice for working - * around this. The ExtCreatePen is not supported at all under Win32. + * It seems that converting to ExtCreatePen may be more advantageous, as + * it matches the Tk canvas pens much better--but not for Win95, which + * does not support PS_USERSTYLE. An explicit test (or storage in a static + * after first failure) may suffice for working around this. The + * ExtCreatePen is not supported at all under Win32. */ HPEN hPen; @@ -2898,61 +2776,67 @@ static int GdiMakePen( DWORD *styleArray = 0; /* - * To limit the propagation of allocated memory, the dashes will have a maximum here. - * If one wishes to remove the static allocation, please be sure to update GdiFreePen - * and ensure that the array is NOT freed if the LOGPEN option is used. + * To limit the propagation of allocated memory, the dashes will have a + * maximum here. If one wishes to remove the static allocation, please be + * sure to update GdiFreePen and ensure that the array is NOT freed if the + * LOGPEN option is used. */ static DWORD pStyleData[24]; - if ( dashstyle != 0 && dashstyledata != 0 ) - { - const char *cp; - size_t i; - char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); - if (dup) - strcpy(dup, dashstyledata); - /* DEBUG. */ - Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", dashstyledata, "|\n", NULL); - - /* Parse the dash spec. */ - if ( isdigit(dashstyledata[0]) ) { - cp = strtok(dup, " \t,;"); - for ( i = 0; cp && i < sizeof(pStyleData) / sizeof (DWORD); i++ ) { - pStyleData[styleCount++] = atoi(cp); - cp = strtok(NULL, " \t,;"); - } - } else { - for (i=0; dashstyledata[i] != '\0' && i< sizeof(pStyleData) / sizeof(DWORD); i++ ) { - switch ( dashstyledata[i] ) { - case ' ': - pStyleData[styleCount++] = 8; - break; - case ',': - pStyleData[styleCount++] = 4; - break; - case '_': - pStyleData[styleCount++] = 6; - break; - case '-': - pStyleData[styleCount++] = 4; - break; - case '.': - pStyleData[styleCount++] = 2; - break; - default: - break; - } + if (dashstyle != 0 && dashstyledata != 0) { + const char *cp; + size_t i; + char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); + if (dup) { + /* TODO: always reachable */ + strcpy(dup, dashstyledata); + } + /* DEBUG. */ + Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", + dashstyledata, "|\n", NULL); + + /* Parse the dash spec. */ + if (isdigit(dashstyledata[0])) { + cp = strtok(dup, " \t,;"); + for (i = 0; cp && i < sizeof(pStyleData) / sizeof(DWORD); i++) { + pStyleData[styleCount++] = atoi(cp); + cp = strtok(NULL, " \t,;"); + } + } else { + for (i=0; dashstyledata[i] != '\0' && i< sizeof(pStyleData) / sizeof(DWORD); i++) { + switch (dashstyledata[i]) { + case ' ': + pStyleData[styleCount++] = 8; + break; + case ',': + pStyleData[styleCount++] = 4; + break; + case '_': + pStyleData[styleCount++] = 6; + break; + case '-': + pStyleData[styleCount++] = 4; + break; + case '.': + pStyleData[styleCount++] = 2; + break; + default: + break; } } - if ( styleCount > 0 ) - styleArray = pStyleData; - else - dashstyle = 0; - if (dup) - Tcl_Free(dup); } + if (styleCount > 0) { + styleArray = pStyleData; + } else { + dashstyle = 0; + } + if (dup) { + Tcl_Free(dup); + } + } - if ( dashstyle != 0 ) + if (dashstyle != 0) { pStyle = PS_USERSTYLE; + } /* -stipple could affect this.... */ lBrush.lbStyle = BS_SOLID; @@ -2960,61 +2844,59 @@ static int GdiMakePen( lBrush.lbHatch = 0; /* We only use geometric pens, even for 1-pixel drawing. */ - hPen = ExtCreatePen ( PS_GEOMETRIC|pStyle|endStyle|joinStyle, - width, - &lBrush, - styleCount, - styleArray); + hPen = ExtCreatePen(PS_GEOMETRIC|pStyle|endStyle|joinStyle, + width, &lBrush, styleCount, styleArray); - if ( hPen == 0 ) { /* Failed for some reason...Fall back on CreatePenIndirect. */ + if (hPen == 0) { /* Failed for some reason...Fall back on CreatePenIndirect. */ LOGPEN lf; lf.lopnWidth.x = width; - lf.lopnWidth.y = 0; /* Unused in LOGPEN. */ - if ( dashstyle == 0 ) - lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future. */ - else - lf.lopnStyle = PS_DASH; /* REALLLLY simple for now. */ - lf.lopnColor = color; /* Assume we're getting a COLORREF. */ - /* Now we have a logical pen. Create the "real" pen and put it in the hDC. */ + lf.lopnWidth.y = 0; /* Unused in LOGPEN. */ + if (dashstyle == 0) { + lf.lopnStyle = PS_SOLID; /* For now...convert 'style' in the future. */ + } else { + lf.lopnStyle = PS_DASH; /* REALLLLY simple for now. */ + } + lf.lopnColor = color; /* Assume we're getting a COLORREF. */ + /* Now we have a logical pen. Create the "real" pen and put it in the + * hDC. */ hPen = CreatePenIndirect(&lf); } *oldPen = SelectObject(hDC, hPen); return 1; } - + /* *---------------------------------------------------------------------- * * GdiFreePen -- * - * Wraps the protocol to delete a created pen. + * Wraps the protocol to delete a created pen. * * Results: - * Deletes pen. + * Deletes pen. * *---------------------------------------------------------------------- */ static int GdiFreePen( - TCL_UNUSED(Tcl_Interp *), - HDC hDC, - HGDIOBJ oldPen) + TCL_UNUSED(Tcl_Interp *), + HDC hDC, + HGDIOBJ oldPen) { - HGDIOBJ gonePen; - gonePen = SelectObject (hDC, oldPen); - DeleteObject (gonePen); + HGDIOBJ gonePen = SelectObject(hDC, oldPen); + + DeleteObject(gonePen); return 1; } - - + /* *---------------------------------------------------------------------- * * GdiMakeBrush-- * - * Creates a logical brush based on input parameters, - * and selects it into the hdc. + * Creates a logical brush based on input parameters, and selects it into + * the hdc. * * Results: * Creates brush. @@ -3023,30 +2905,32 @@ static int GdiFreePen( */ static int GdiMakeBrush( - TCL_UNUSED(Tcl_Interp *), - TCL_UNUSED(unsigned int), - unsigned long color, - long hatch, - LOGBRUSH *lb, - HDC hDC, - HGDIOBJ *oldBrush) + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(unsigned int), + unsigned long color, + long hatch, + LOGBRUSH *lb, + HDC hDC, + HGDIOBJ *oldBrush) { HBRUSH hBrush; lb->lbStyle = BS_SOLID; /* Support other styles later. */ lb->lbColor = color; /* Assume this is a COLORREF. */ lb->lbHatch = hatch; /* Ignored for now, given BS_SOLID in the Style. */ - /* Now we have the logical brush. Create the "real" brush and put it in the hDC. */ + + /* Now we have the logical brush. Create the "real" brush and put it in + * the hDC. */ hBrush = CreateBrushIndirect(lb); *oldBrush = SelectObject(hDC, hBrush); return 1; } - + /* *---------------------------------------------------------------------- * * GdiFreeBrush -- * - * Wraps the protocol to delete a created brush. + * Wraps the protocol to delete a created brush. * * Results: * Deletes brush. @@ -3054,20 +2938,21 @@ static int GdiMakeBrush( *---------------------------------------------------------------------- */ static int GdiFreeBrush( - TCL_UNUSED(Tcl_Interp *), - HDC hDC, - HGDIOBJ oldBrush) + TCL_UNUSED(Tcl_Interp *), + HDC hDC, + HGDIOBJ oldBrush) { HGDIOBJ goneBrush; - goneBrush = SelectObject (hDC, oldBrush); + + goneBrush = SelectObject(hDC, oldBrush); DeleteObject(goneBrush); return 1; } - + /* * Utility functions from elsewhere in Tcl. - * Functions have removed reliance on X and Tk libraries, - * as well as removing the need for TkWindows. + * Functions have removed reliance on X and Tk libraries, as well as removing + * the need for TkWindows. * GdiGetColor is a copy of a TkpGetColor from tkWinColor.c * GdiParseColor is a copy of XParseColor from xcolors.c */ @@ -3076,7 +2961,6 @@ typedef struct { int index; } SystemColorEntry; - static const SystemColorEntry sysColors[] = { {"3dDarkShadow", COLOR_3DDKSHADOW}, {"3dLight", COLOR_3DLIGHT}, @@ -3115,7 +2999,7 @@ typedef struct { unsigned char blue; } XColorEntry; -static const XColorEntry xColors[] = { +static const XColorEntry xColors[] = { {"alice blue", 240, 248, 255}, {"AliceBlue", 240, 248, 255}, {"antique white", 250, 235, 215}, @@ -3856,14 +3740,14 @@ static const XColorEntry xColors[] = { {"YellowGreen", 154, 205, 50}, }; -static int numxcolors=0; - +static int numxcolors = 0; + /* *---------------------------------------------------------------------- * * GdiGetColor -- * - * Convert color name to color specification. + * Convert color name to color specification. * * Results: * Color name converted. @@ -3871,119 +3755,126 @@ static int numxcolors=0; *---------------------------------------------------------------------- */ -static int GdiGetColor(const char *name, unsigned long *color) +static int GdiGetColor( + const char *name, + unsigned long *color) { - if ( numsyscolors == 0 ) - numsyscolors = sizeof ( sysColors ) / sizeof (SystemColorEntry); - if ( _strnicmp(name, "system", 6) == 0 ) - { - int i, l, u, r; - l = 0; - u = numsyscolors; - while ( l <= u ) - { - i = (l + u) / 2; - if ( (r = _strcmpi(name+6, sysColors[i].name)) == 0 ) - break; - if ( r < 0 ) - u = i - 1; - else - l = i + 1; - } - if ( l > u ) - return 0; - *color = GetSysColor(sysColors[i].index); - return 1; + if (numsyscolors == 0) { + numsyscolors = sizeof(sysColors) / sizeof(SystemColorEntry); + } + if (_strnicmp(name, "system", 6) == 0) { + int i, l, u, r; + + l = 0; + u = numsyscolors; + while (l <= u) { + i = (l + u) / 2; + if ((r = _strcmpi(name+6, sysColors[i].name)) == 0) { + break; + } + if (r < 0) { + u = i - 1; + } else { + l = i + 1; + } + } + if (l > u) { + return 0; } - else + *color = GetSysColor(sysColors[i].index); + return 1; + } else { return GdiParseColor(name, color); + } } - + /* *---------------------------------------------------------------------- * * GdiParseColor -- * - * Convert color specification string (which could be an RGB string) - * to a color RGB triple. + * Convert color specification string (which could be an RGB string) + * to a color RGB triple. * * Results: - * Color specification converted. + * Color specification converted. * *---------------------------------------------------------------------- */ - -static int GdiParseColor (const char *name, unsigned long *color) +static int GdiParseColor( + const char *name, + unsigned long *color) { - if ( name[0] == '#' ) - { - char fmt[40]; - int i; - unsigned red, green, blue; - - if ( (i = strlen(name+1))%3 != 0 || i > 12 || i < 3) - return 0; - i /= 3; - sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i); - if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { - return 0; + if (name[0] == '#') { + char fmt[40]; + int i; + unsigned red, green, blue; + + if ((i = strlen(name+1))%3 != 0 || i > 12 || i < 3) { + return 0; + } + i /= 3; + sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i); + if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { + return 0; + } + /* Now this is Windows-specific -- each component is at most 8 bits. */ + switch (i) { + case 1: + red <<= 4; + green <<= 4; + blue <<= 4; + break; + case 2: + break; + case 3: + red >>= 4; + green >>= 4; + blue >>= 4; + break; + case 4: + red >>= 8; + green >>= 8; + blue >>= 8; + break; + } + *color = RGB(red, green, blue); + return 1; + } else { + int i, u, r, l; + + if (numxcolors == 0) { + numxcolors = sizeof(xColors) / sizeof(XColorEntry); + } + l = 0; + u = numxcolors; + + while (l <= u) { + i = (l + u) / 2; + if ((r = _strcmpi(name, xColors[i].name)) == 0) { + break; + } + if (r < 0) { + u = i - 1; + } else { + l = i + 1; } - /* Now this is Windows-specific -- each component is at most 8 bits. */ - switch ( i ) - { - case 1: - red <<= 4; - green <<= 4; - blue <<= 4; - break; - case 2: - break; - case 3: - red >>= 4; - green >>= 4; - blue >>= 4; - break; - case 4: - red >>= 8; - green >>= 8; - blue >>= 8; - break; - } - *color = RGB(red, green, blue); - return 1; } - else - { - int i, u, r, l; - if ( numxcolors == 0 ) - numxcolors = sizeof(xColors) / sizeof(XColorEntry); - l = 0; - u = numxcolors; - - while ( l <= u) - { - i = (l + u) / 2; - if ( (r = _strcmpi(name, xColors[i].name)) == 0 ) - break; - if ( r < 0 ) - u = i-1; - else - l = i+1; - } - if ( l > u ) - return 0; - *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); - return 1; + if (l > u) { + return 0; } + *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); + return 1; + } } - + /* * Beginning of functions for screen-to-dib translations. - * Several of these functions are based on those in the WINCAP32 - * program provided as a sample by Microsoft on the VC++ 5.0 - * disk. The copyright on these functions is retained, even for - * those with significant changes. + * + * Several of these functions are based on those in the WINCAP32 program + * provided as a sample by Microsoft on the VC++ 5.0 disk. The copyright on + * these functions is retained, even for those with significant changes. */ /* @@ -3991,7 +3882,7 @@ static int GdiParseColor (const char *name, unsigned long *color) * * CopyToDIB -- * - * Copy window bits to a DIB. + * Copy window bits to a DIB. * * Results: * Color specification converted. @@ -3999,163 +3890,166 @@ static int GdiParseColor (const char *name, unsigned long *color) *---------------------------------------------------------------------- */ -static HANDLE CopyToDIB ( HWND hWnd, enum PrintType type ) +static HANDLE CopyToDIB( + HWND hWnd, + enum PrintType type) { - HANDLE hDIB; - HBITMAP hBitmap; + HANDLE hDIB; + HBITMAP hBitmap; HPALETTE hPalette; /* Check for a valid window handle. */ - if (!hWnd) + if (!hWnd) { return NULL; + } - switch (type) - { - case PTWindow: /* Copy entire window. */ - { - RECT rectWnd; + switch (type) { + case PTWindow: { /* Copy entire window. */ + RECT rectWnd; - /* Get the window rectangle. */ + /* Get the window rectangle. */ - GetWindowRect(hWnd, &rectWnd); + GetWindowRect(hWnd, &rectWnd); - /* - * Get the DIB of the window by calling - * CopyScreenToDIB and passing it the window rect. - */ + /* + * Get the DIB of the window by calling CopyScreenToDIB and passing it + * the window rect. + */ - hDIB = CopyScreenToDIB(&rectWnd); - break; - } + hDIB = CopyScreenToDIB(&rectWnd); + break; + } - case PTClient: /* Copy client area. */ - { - RECT rectClient; - POINT pt1, pt2; + case PTClient: { /* Copy client area. */ + RECT rectClient; + POINT pt1, pt2; - /* Get the client area dimensions. */ + /* Get the client area dimensions. */ - GetClientRect(hWnd, &rectClient); + GetClientRect(hWnd, &rectClient); - /* Convert client coords to screen coords. */ + /* Convert client coords to screen coords. */ - pt1.x = rectClient.left; - pt1.y = rectClient.top; - pt2.x = rectClient.right; - pt2.y = rectClient.bottom; - ClientToScreen(hWnd, &pt1); - ClientToScreen(hWnd, &pt2); - rectClient.left = pt1.x; - rectClient.top = pt1.y; - rectClient.right = pt2.x; - rectClient.bottom = pt2.y; + pt1.x = rectClient.left; + pt1.y = rectClient.top; + pt2.x = rectClient.right; + pt2.y = rectClient.bottom; + ClientToScreen(hWnd, &pt1); + ClientToScreen(hWnd, &pt2); + rectClient.left = pt1.x; + rectClient.top = pt1.y; + rectClient.right = pt2.x; + rectClient.bottom = pt2.y; - /* - * Get the DIB of the client area by calling - * CopyScreenToDIB and passing it the client rect. - */ + /* + * Get the DIB of the client area by calling CopyScreenToDIB and + * passing it the client rect. + */ - hDIB = CopyScreenToDIB(&rectClient); - break; - } + hDIB = CopyScreenToDIB(&rectClient); + break; + } - case PTScreen: /* Entire screen. */ - { - RECT Rect; + case PTScreen: { /* Entire screen. */ + RECT Rect; - /* - * Get the device-dependent bitmap in lpRect by calling - * CopyScreenToBitmap and passing it the rectangle to grab. - */ - Rect.top = Rect.left = 0; - GetDisplaySize(&Rect.right, &Rect.bottom); + /* + * Get the device-dependent bitmap in lpRect by calling + * CopyScreenToBitmap and passing it the rectangle to grab. + */ + Rect.top = Rect.left = 0; + GetDisplaySize(&Rect.right, &Rect.bottom); - hBitmap = CopyScreenToBitmap(&Rect); + hBitmap = CopyScreenToBitmap(&Rect); - /* Check for a valid bitmap handle. */ + /* Check for a valid bitmap handle. */ - if (!hBitmap) - return NULL; + if (!hBitmap) { + return NULL; + } - /* Get the current palette. */ + /* Get the current palette. */ - hPalette = GetSystemPalette(); + hPalette = GetSystemPalette(); - /* Convert the bitmap to a DIB. */ + /* Convert the bitmap to a DIB. */ - hDIB = BitmapToDIB(hBitmap, hPalette); + hDIB = BitmapToDIB(hBitmap, hPalette); - /* Clean up. */ + /* Clean up. */ - DeleteObject(hPalette); - DeleteObject(hBitmap); + DeleteObject(hPalette); + DeleteObject(hBitmap); - /* Return handle to the packed-DIB. */ - } - break; - default: /* Invalid print area. */ - return NULL; - } + /* Return handle to the packed-DIB. */ + break; + } + default: /* Invalid print area. */ + return NULL; + } /* Return the handle to the DIB. */ return hDIB; } - + /* *---------------------------------------------------------------------- * * GetDisplaySize-- * - * GetDisplaySize does just that. There may be an easier way, but it is not apparent. + * GetDisplaySize does just that. There may be an easier way, but it is + * not apparent. * * Results: - * Returns display size. + * Returns display size. * *---------------------------------------------------------------------- */ - -static void GetDisplaySize (LONG *width, LONG *height) +static void GetDisplaySize( + LONG *width, + LONG *height) { HDC hDC; hDC = CreateDCW(L"DISPLAY", 0, 0, 0); - *width = GetDeviceCaps (hDC, HORZRES); - *height = GetDeviceCaps (hDC, VERTRES); + *width = GetDeviceCaps(hDC, HORZRES); + *height = GetDeviceCaps(hDC, VERTRES); DeleteDC(hDC); } - - + /* *---------------------------------------------------------------------- * * CopyScreenToBitmap-- * - * Copies screen to bitmap. + * Copies screen to bitmap. * * Results: - * Screen is copied. + * Screen is copied. * *---------------------------------------------------------------------- */ -static HBITMAP CopyScreenToBitmap(LPRECT lpRect) +static HBITMAP CopyScreenToBitmap( + LPRECT lpRect) { - HDC hScrDC, hMemDC; /* Screen DC and memory DC. */ - HBITMAP hBitmap, hOldBitmap; /* Handles to deice-dependent bitmaps. */ - int nX, nY, nX2, nY2; /* Coordinates of rectangle to grab. */ - int nWidth, nHeight; /* DIB width and height */ - int xScrn, yScrn; /* Screen resolution. */ + HDC hScrDC, hMemDC; /* Screen DC and memory DC. */ + HBITMAP hBitmap, hOldBitmap; /* Handles to deice-dependent bitmaps. */ + int nX, nY, nX2, nY2; /* Coordinates of rectangle to grab. */ + int nWidth, nHeight; /* DIB width and height */ + int xScrn, yScrn; /* Screen resolution. */ /* Check for an empty rectangle. */ - if (IsRectEmpty(lpRect)) + if (IsRectEmpty(lpRect)) { return NULL; + } /* - * Create a DC for the screen and create - * a memory DC compatible to screen DC. + * Create a DC for the screen and create a memory DC compatible to screen + * DC. */ hScrDC = CreateDCW(L"DISPLAY", NULL, NULL, NULL); @@ -4175,14 +4069,18 @@ static HBITMAP CopyScreenToBitmap(LPRECT lpRect) /* Make sure bitmap rectangle is visible. */ - if (nX < 0) + if (nX < 0) { nX = 0; - if (nY < 0) + } + if (nY < 0) { nY = 0; - if (nX2 > xScrn) + } + if (nX2 > xScrn) { nX2 = xScrn; - if (nY2 > yScrn) + } + if (nY2 > yScrn) { nY2 = yScrn; + } nWidth = nX2 - nX; nHeight = nY2 - nY; @@ -4197,8 +4095,8 @@ static HBITMAP CopyScreenToBitmap(LPRECT lpRect) BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY); /* - * Select old bitmap back into memory DC and get handle to - * bitmap of the screen. + * Select old bitmap back into memory DC and get handle to bitmap of the + * screen. */ hBitmap = SelectObject(hMemDC, hOldBitmap); @@ -4212,21 +4110,23 @@ static HBITMAP CopyScreenToBitmap(LPRECT lpRect) return hBitmap; } - - + /* *---------------------------------------------------------------------- * * BitmapToDIB-- * - * Converts bitmap to DIB. + * Converts bitmap to DIB. * * Results: - * Bitmap converted. + * Bitmap converted. * *---------------------------------------------------------------------- */ -static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) + +static HANDLE BitmapToDIB( + HBITMAP hBitmap, + HPALETTE hPal) { BITMAP bm; BITMAPINFOHEADER bi; @@ -4239,18 +4139,21 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) /* Check if bitmap handle is valid. */ - if (!hBitmap) + if (!hBitmap) { return NULL; + } /* Fill in BITMAP structure, return NULL if it didn't work. */ - if (!GetObjectW(hBitmap, sizeof(bm), (LPWSTR)&bm)) + if (!GetObjectW(hBitmap, sizeof(bm), (LPWSTR)&bm)) { return NULL; + } /* Ff no palette is specified, use default palette. */ - if (hPal == NULL) + if (hPal == NULL) { hPal = GetStockObject(DEFAULT_PALETTE); + } /* Calculate bits per pixel. */ @@ -4258,14 +4161,15 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) /* Make sure bits per pixel is valid. */ - if (biBits <= 1) + if (biBits <= 1) { biBits = 1; - else if (biBits <= 4) + } else if (biBits <= 4) { biBits = 4; - else if (biBits <= 8) + } else if (biBits <= 8) { biBits = 8; - else /* If greater than 8-bit, force to 24-bit. */ + } else { /* If greater than 8-bit, force to 24-bit. */ biBits = 24; + } /* Initialize BITMAPINFOHEADER. */ @@ -4300,15 +4204,14 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) /* If we couldn't get memory block. */ - if (!hDIB) - { - /* clean up and return NULL. */ + if (!hDIB) { + /* clean up and return NULL. */ - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } /* Lock memory and get pointer to it. */ @@ -4323,33 +4226,34 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) */ GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, NULL, (LPBITMAPINFO)lpbi, - DIB_RGB_COLORS); + DIB_RGB_COLORS); /* get the info. returned by GetDIBits and unlock memory block. */ bi = *lpbi; GlobalUnlock(hDIB); - /* If the driver did not fill in the biSizeImage field, make one up. */ - if (bi.biSizeImage == 0) - bi.biSizeImage = (((((DWORD)bm.bmWidth * biBits) + 31) / 32) * 4) * bm.bmHeight; + /* If the driver did not fill in the biSizeImage field, make one up. */ + if (bi.biSizeImage == 0) { + bi.biSizeImage = (((((DWORD)bm.bmWidth * biBits) + 31) / 32) * 4) + * bm.bmHeight; + } /* Realloc the buffer big enough to hold all the bits. */ dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD) + bi.biSizeImage; - if ((h = GlobalReAlloc(hDIB, dwLen, 0)) != 0) + if ((h = GlobalReAlloc(hDIB, dwLen, 0)) != 0) { hDIB = h; - else - { - /* Clean up and return NULL. */ - - GlobalFree(hDIB); - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } + } else { + /* Clean up and return NULL. */ + + GlobalFree(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } /* Lock memory block and get pointer to it. */ @@ -4360,21 +4264,20 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) */ if (GetDIBits(hDC, hBitmap, 0, (UINT)bi.biHeight, (LPSTR)lpbi + - (WORD)lpbi->biSize + DIBNumColors(lpbi) * sizeof(RGBQUAD), (LPBITMAPINFO)lpbi, - DIB_RGB_COLORS) == 0) - { - /* Clean up and return NULL. */ - - GlobalUnlock(hDIB); - SelectPalette(hDC, hPal, TRUE); - RealizePalette(hDC); - ReleaseDC(NULL, hDC); - return NULL; - } + (WORD)lpbi->biSize + DIBNumColors(lpbi) * sizeof(RGBQUAD), + (LPBITMAPINFO)lpbi, DIB_RGB_COLORS) == 0) { + /* Clean up and return NULL. */ + + GlobalUnlock(hDIB); + SelectPalette(hDC, hPal, TRUE); + RealizePalette(hDC); + ReleaseDC(NULL, hDC); + return NULL; + } bi = *lpbi; - /* Clean up. */ + /* Clean up. */ GlobalUnlock(hDIB); SelectPalette(hDC, hPal, TRUE); RealizePalette(hDC); @@ -4383,37 +4286,39 @@ static HANDLE BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal) /* Return handle to the DIB. */ return hDIB; } - + /* *---------------------------------------------------------------------- * * CopyScreenToDIB-- * - * Copies screen to DIB. + * Copies screen to DIB. * * Results: - * Screen copied. + * Screen copied. * *---------------------------------------------------------------------- */ -static HANDLE CopyScreenToDIB(LPRECT lpRect) +static HANDLE CopyScreenToDIB( + LPRECT lpRect) { HBITMAP hBitmap; HPALETTE hPalette; HANDLE hDIB; /* - * Get the device-dependent bitmap in lpRect by calling - * CopyScreenToBitmap and passing it the rectangle to grab. + * Get the device-dependent bitmap in lpRect by calling CopyScreenToBitmap + * and passing it the rectangle to grab. */ hBitmap = CopyScreenToBitmap(lpRect); /* Check for a valid bitmap handle. */ - if (!hBitmap) + if (!hBitmap) { return NULL; + } /* Get the current palette. */ @@ -4423,7 +4328,7 @@ static HANDLE CopyScreenToDIB(LPRECT lpRect) hDIB = BitmapToDIB(hBitmap, hPalette); - /* Clean up. */ + /* Clean up. */ DeleteObject(hPalette); DeleteObject(hBitmap); @@ -4431,16 +4336,16 @@ static HANDLE CopyScreenToDIB(LPRECT lpRect) /* Return handle to the packed-DIB. */ return hDIB; } - + /* *---------------------------------------------------------------------- * * GetSystemPalette-- * - * Obtains the system palette. + * Obtains the system palette. * * Results: - * Returns palette. + * Returns palette. * *---------------------------------------------------------------------- */ @@ -4456,21 +4361,21 @@ static HPALETTE GetSystemPalette(void) /* Find out how many palette entries we want.. */ hDC = GetDC(NULL); - - if (!hDC) + if (!hDC) { return NULL; + } nColors = PalEntriesOnDevice(hDC); /* Number of palette entries. */ /* Allocate room for the palette and lock it.. */ hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + nColors * - sizeof(PALETTEENTRY)); - - /* If we didn't get a logical palette, return NULL. */ + sizeof(PALETTEENTRY)); + if (!hLogPal) { + /* If we didn't get a logical palette, return NULL. */ - if (!hLogPal) return NULL; + } /* get a pointer to the logical palette. */ @@ -4484,11 +4389,11 @@ static HPALETTE GetSystemPalette(void) /* Copy the current system palette into our logical palette. */ GetSystemPaletteEntries(hDC, 0, nColors, - (LPPALETTEENTRY)(lpLogPal->palPalEntry)); + (LPPALETTEENTRY) lpLogPal->palPalEntry); /* - * Go ahead and create the palette. Once it's created, - * we no longer need the LOGPALETTE, so free it. + * Go ahead and create the palette. Once it's created, we no longer need + * the LOGPALETTE, so free it. */ hPal = CreatePalette(lpLogPal); @@ -4501,26 +4406,26 @@ static HPALETTE GetSystemPalette(void) return hPal; } - + /* *---------------------------------------------------------------------- * * PalEntriesOnDevice-- * - * Returns the palettes on the device. + * Returns the palettes on the device. * * Results: - * Returns palettes. + * Returns palettes. * *---------------------------------------------------------------------- */ -static int PalEntriesOnDevice(HDC hDC) +static int PalEntriesOnDevice( + HDC hDC) { return (1 << (GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES))); } - - + /* *-------------------------------------------------------------- * @@ -4534,40 +4439,47 @@ static int PalEntriesOnDevice(HDC hDC) *-------------------------------------------------------------- */ -int Gdi_Init(Tcl_Interp *interp) +int Gdi_Init( + Tcl_Interp *interp) { - Tcl_CreateCommand(interp, "::tk::print::_gdi", TkWinGDI, - (ClientData)0, (Tcl_CmdDeleteProc *)0); + (ClientData) 0, (Tcl_CmdDeleteProc *) 0); return TCL_OK; } - + /* * -------------------------------------------------------------------------- * * Winprint_Init-- * - * Initializes printing module on Windows. + * Initializes printing module on Windows. * * Results: - * Module initialized. + * Module initialized. * * ------------------------------------------------------------------------- */ -int Winprint_Init(Tcl_Interp * interp) +int Winprint_Init( + Tcl_Interp * interp) { - Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", PrintSelectPrinter, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_openprinter", PrintOpenPrinter, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_closeprinter", PrintClosePrinter, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_opendoc", PrintOpenDoc, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_closedoc", PrintCloseDoc, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_openpage", PrintOpenPage, NULL, NULL); - Tcl_CreateObjCommand(interp, "::tk::print::_closepage", PrintClosePage, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_selectprinter", + PrintSelectPrinter, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_openprinter", + PrintOpenPrinter, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_closeprinter", + PrintClosePrinter, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_opendoc", + PrintOpenDoc, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_closedoc", + PrintCloseDoc, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_openpage", + PrintOpenPage, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tk::print::_closepage", + PrintClosePage, NULL, NULL); return TCL_OK; } - - + /* * The following functions are adapted from tkTrig.c. */ @@ -4577,15 +4489,15 @@ int Winprint_Init(Tcl_Interp * interp) * * TkGdiBezierScreenPoints -- * - * Given four control points, create a larger set of XPoints - * for a Bezier spline based on the points. + * Given four control points, create a larger set of XPoints for a Bezier + * spline based on the points. * * Results: * The array at *xPointPtr gets filled in with numSteps XPoints - * corresponding to the Bezier spline defined by the four - * control points. Note: no output point is generated for the - * first input point, but an output point *is* generated for - * the last input point. + * corresponding to the Bezier spline defined by the four control points. + * + * Note: no output point is generated for the first input point, but an + * output point *is* generated for the last input point. * * Side effects: * None. @@ -4594,15 +4506,12 @@ int Winprint_Init(Tcl_Interp * interp) */ static void -TkGdiBezierScreenPoints(canvas, control, numSteps, xPointPtr) - Tk_Canvas canvas; /* Canvas in which curve is to be - * drawn.. */ - double control[]; /* Array of coordinates for four - * control points: x0, y0, x1, y1, - * ... x3 y3.. */ - int numSteps; /* Number of curve points to - * generate. */ - register XPoint *xPointPtr; /* Where to put new points.. */ +TkGdiBezierScreenPoints( + Tk_Canvas canvas, /* Canvas in which curve is to be drawn.. */ + double control[], /* Array of coordinates for four control + * points: x0, y0, x1, y1, ... x3 y3.. */ + int numSteps, /* Number of curve points to generate. */ + register XPoint *xPointPtr) /* Where to put new points.. */ { int i; double u, u2, u3, t, t2, t3; @@ -4615,28 +4524,29 @@ TkGdiBezierScreenPoints(canvas, control, numSteps, xPointPtr) u2 = u*u; u3 = u2*u; Tk_CanvasDrawableCoords(canvas, - (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) - + control[6]*t3), - (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) - + control[7]*t3), - &xPointPtr->x, &xPointPtr->y); + (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + + control[6]*t3), + (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + + control[7]*t3), + &xPointPtr->x, &xPointPtr->y); } } - + /* *-------------------------------------------------------------- * * TkGdiBezierPoints -- * - * Given four control points, create a larger set of points - * for a Bezier spline based on the points. + * Given four control points, create a larger set of points for a Bezier + * spline based on the points. * * Results: - * The array at *coordPtr gets filled in with 2*numSteps - * coordinates, which correspond to the Bezier spline defined - * by the four control points. Note: no output point is - * generated for the first input point, but an output point - * *is* generated for the last input point. + * The array at *coordPtr gets filled in with 2*numSteps coordinates, + * which correspond to the Bezier spline defined by the four control + * points. + * + * Note: no output point is generated for the first input point, but an + * output point *is* generated for the last input point. * * Side effects: * None. @@ -4645,13 +4555,11 @@ TkGdiBezierScreenPoints(canvas, control, numSteps, xPointPtr) */ static void -TkGdiBezierPoints(control, numSteps, coordPtr) - double control[]; /* Array of coordinates for four - * control points: x0, y0, x1, y1, - * ... x3 y3.. */ - int numSteps; /* Number of curve points to - * generate. */ - register double *coordPtr; /* Where to put new points.. */ +TkGdiBezierPoints( + double control[], /* Array of coordinates for four control + * points: x0, y0, x1, y1, ... x3 y3.. */ + int numSteps, /* Number of curve points to generate. */ + register double *coordPtr) /* Where to put new points.. */ { int i; double u, u2, u3, t, t2, t3; @@ -4664,31 +4572,32 @@ TkGdiBezierPoints(control, numSteps, coordPtr) u2 = u*u; u3 = u2*u; coordPtr[0] = control[0]*u3 - + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; + + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; coordPtr[1] = control[1]*u3 - + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; + + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; } } - + /* *-------------------------------------------------------------- * * TkGdiMakeBezierCurve -- * - * Given a set of points, create a new set of points that fit - * parabolic splines to the line segments connecting the original - * points. Produces output points in either of two forms. + * Given a set of points, create a new set of points that fit parabolic + * splines to the line segments connecting the original points. Produces + * output points in either of two forms. * - * Note: in spite of this procedure's name, it does *not* generate - * Bezier curves. Since only three control points are used for - * each curve segment, not four, the curves are actually just - * parabolic. + * Note: in spite of this procedure's name, it does *not* generate Bezier + * curves. Since only three control points are used for each curve + * segment, not four, the curves are actually just parabolic. * * Results: - * Either or both of the xPoints or dblPoints arrays are filled - * in. The return value is the number of points placed in the - * arrays. Note: if the first and last points are the same, then - * a closed curve is generated. + * + * Either or both of the xPoints or dblPoints arrays are filled in. The + * return value is the number of points placed in the arrays. + * + * Note: if the first and last points are the same, then a closed curve + * is generated. * * Side effects: * None. @@ -4697,12 +4606,15 @@ TkGdiBezierPoints(control, numSteps, coordPtr) */ static int TkGdiMakeBezierCurve( - Tk_Canvas canvas, /* Canvas in which curve is to be drawn.*/ - double *pointPtr, /* Array of input coordinates: x0, y0, x1, y1, etc... */ - int numPoints, /* Number of points at pointPtr.. */ - int numSteps, /* Number of steps to use for each spline segments. */ - XPoint xPoints[], /* Array of XPoints to fill in. */ - double dblPoints[]) /* Array of points to fill in as doubles, in the form x0, y0, x1, y1. */ + Tk_Canvas canvas, /* Canvas in which curve is to be drawn.*/ + double *pointPtr, /* Array of input coordinates: + * x0, y0, x1, y1, etc... */ + int numPoints, /* Number of points at pointPtr.. */ + int numSteps, /* Number of steps to use for each spline + * segments. */ + XPoint xPoints[], /* Array of XPoints to fill in. */ + double dblPoints[]) /* Array of points to fill in as doubles, in + * the form x0, y0, x1, y1. */ { int closed, outputPoints, i; @@ -4710,24 +4622,23 @@ TkGdiMakeBezierCurve( double control[8]; /* - * If the curve is a closed one then generate a special spline - * that spans the last points and the first ones. Otherwise - * just put the first point into the output. + * If the curve is a closed one then generate a special spline that spans + * the last points and the first ones. Otherwise just put the first point + * into the output. */ if (!pointPtr) { /* - * Of pointPtr == NULL, this function returns an upper limit. - * of the array size to store the coordinates. This can be - * used to allocate storage, before the actual coordinates - * are calculated. + * Of pointPtr == NULL, this function returns an upper limit of the + * array size to store the coordinates. This can be used to allocate + * storage, before the actual coordinates are calculated. */ return 1 + numPoints * numSteps; } outputPoints = 0; if ((pointPtr[0] == pointPtr[numCoords-2]) - && (pointPtr[1] == pointPtr[numCoords-1])) { + && (pointPtr[1] == pointPtr[numCoords-1])) { closed = 1; control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0]; control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1]; @@ -4739,7 +4650,7 @@ TkGdiMakeBezierCurve( control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; if (xPoints != NULL) { Tk_CanvasDrawableCoords(canvas, control[0], control[1], - &xPoints->x, &xPoints->y); + &xPoints->x, &xPoints->y); TkGdiBezierScreenPoints(canvas, control, numSteps, xPoints+1); xPoints += numSteps+1; } @@ -4754,7 +4665,7 @@ TkGdiMakeBezierCurve( closed = 0; if (xPoints != NULL) { Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1], - &xPoints->x, &xPoints->y); + &xPoints->x, &xPoints->y); xPoints += 1; } if (dblPoints != NULL) { @@ -4767,9 +4678,8 @@ TkGdiMakeBezierCurve( for (i = 2; i < numPoints; i++, pointPtr += 2) { /* - * Set up the first two control points. This is done - * differently for the first spline of an open curve - * than for other cases. + * Set up the first two control points. This is done differently for + * the first spline of an open curve than for other cases. */ if ((i == 2) && !closed) { @@ -4785,10 +4695,9 @@ TkGdiMakeBezierCurve( } /* - * Set up the last two control points. This is done - * differently for the last spline of an open curve - * than for other cases. - . */ + * Set up the last two control points. This is done differently for + * the last spline of an open curve than for other cases. + */ if ((i == (numPoints-1)) && !closed) { control[4] = .667*pointPtr[2] + .333*pointPtr[4]; @@ -4803,18 +4712,17 @@ TkGdiMakeBezierCurve( } /* - * If the first two points coincide, or if the last - * two points coincide, then generate a single - * straight-line segment by outputting the last control - * point. - . */ + * If the first two points coincide, or if the last two points + * coincide, then generate a single straight-line segment by + * outputting the last control point. + */ if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3])) - || ((pointPtr[2] == pointPtr[4]) - && (pointPtr[3] == pointPtr[5]))) { + || ((pointPtr[2] == pointPtr[4]) + && (pointPtr[3] == pointPtr[5]))) { if (xPoints != NULL) { Tk_CanvasDrawableCoords(canvas, control[6], control[7], - &xPoints[0].x, &xPoints[0].y); + &xPoints[0].x, &xPoints[0].y); xPoints++; } if (dblPoints != NULL) { @@ -4830,7 +4738,6 @@ TkGdiMakeBezierCurve( * Generate a Bezier spline using the control points. */ - if (xPoints != NULL) { TkGdiBezierScreenPoints(canvas, control, numSteps, xPoints); xPoints += numSteps; @@ -4843,22 +4750,26 @@ TkGdiMakeBezierCurve( } return outputPoints; } - -/* Print API functions. */ + +/* Print API functions. */ /*---------------------------------------------------------------------- * * PrintSelectPrinter-- * - * Main dialog for selecting printer and initializing data for print job. + * Main dialog for selecting printer and initializing data for print job. * * Results: - * Printer selected. + * Printer selected. * *---------------------------------------------------------------------- */ -static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +static int PrintSelectPrinter( + ClientData clientData, + Tcl_Interp *interp, + int argc, + Tcl_Obj *const objv[]) { LPCWSTR printerName = NULL; PDEVMODEW returnedDevmode = NULL; @@ -4875,86 +4786,82 @@ static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int arg /* Set up print dialog and initalize property structure. */ - ZeroMemory( &pd, sizeof(pd)); + ZeroMemory(&pd, sizeof(pd)); pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); - pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; + pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; if (PrintDlgW(&pd) == TRUE) { - /*Get document info.*/ - ZeroMemory( &di, sizeof(di)); + ZeroMemory(&di, sizeof(di)); di.cbSize = sizeof(di); di.lpszDocName = L"Tk Print Output"; - /* Copy print attributes to local structure. */ - returnedDevmode = (PDEVMODEW)GlobalLock(pd.hDevMode); - devnames = (LPDEVNAMES)GlobalLock(pd.hDevNames); - printerName = (LPCWSTR)devnames + devnames->wDeviceOffset; - localDevmode = (LPDEVMODEW)HeapAlloc(GetProcessHeap(), - HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, - returnedDevmode->dmSize); - - if (localDevmode !=NULL) - { - memcpy((LPVOID)localDevmode, - (LPVOID)returnedDevmode, - returnedDevmode->dmSize); - - /* Get values from user-set and built-in properties. */ - localPrinterName = localDevmode->dmDeviceName; - dpi_y = localDevmode->dmYResolution; - dpi_x = localDevmode->dmPrintQuality; - paper_height = (int) localDevmode->dmPaperLength / 0.254; /*Convert to logical points.*/ - paper_width = (int) localDevmode->dmPaperWidth / 0.254; /* Convert to logical points.*/ - copies = pd.nCopies; - /*Set device context here for all GDI printing operations.*/ - printDC = CreateDCW( - L"WINSPOOL", - printerName, - NULL, - localDevmode); - } - else - { - localDevmode = NULL; - } - } - if (pd.hDevMode !=NULL) - { - GlobalFree(pd.hDevMode); + returnedDevmode = (PDEVMODEW) GlobalLock(pd.hDevMode); + devnames = (LPDEVNAMES) GlobalLock(pd.hDevNames); + printerName = (LPCWSTR) devnames + devnames->wDeviceOffset; + localDevmode = (LPDEVMODEW) HeapAlloc(GetProcessHeap(), + HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, + returnedDevmode->dmSize); + + if (localDevmode != NULL) { + memcpy((LPVOID)localDevmode, (LPVOID)returnedDevmode, + returnedDevmode->dmSize); + + /* Get values from user-set and built-in properties. */ + localPrinterName = localDevmode->dmDeviceName; + dpi_y = localDevmode->dmYResolution; + dpi_x = localDevmode->dmPrintQuality; + /* Convert height and width to logical points. */ + paper_height = (int) localDevmode->dmPaperLength / 0.254; + paper_width = (int) localDevmode->dmPaperWidth / 0.254; + copies = pd.nCopies; + /* Set device context here for all GDI printing operations. */ + printDC = CreateDCW(L"WINSPOOL", printerName, NULL, localDevmode); + } else { + localDevmode = NULL; } + } + if (pd.hDevMode != NULL) { + GlobalFree(pd.hDevMode); + } /* - * Store print properties and link variables - * so they can be accessed from script level. + * Store print properties and link variables so they can be accessed from + * script level. */ - WCHAR *varlink1 = (WCHAR *)Tcl_Alloc(100 * sizeof(char)); - WCHAR **varlink2 = (WCHAR **)Tcl_Alloc(sizeof(char *)); + WCHAR *varlink1 = (WCHAR *) Tcl_Alloc(100 * sizeof(char)); + WCHAR **varlink2 = (WCHAR **) Tcl_Alloc(sizeof(char *)); *varlink2 = varlink1; - wcscpy (varlink1, localPrinterName); - - Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::dpi_x", (char *)&dpi_x, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, TCL_LINK_INT | TCL_LINK_READ_ONLY); + wcscpy(varlink1, localPrinterName); + + Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, + TCL_LINK_STRING | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::dpi_x", (char *)&dpi_x, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, + TCL_LINK_INT | TCL_LINK_READ_ONLY); return TCL_OK; } - + /* * -------------------------------------------------------------------------- * * PrintOpenPrinter-- * - * Open the given printer. + * Open the given printer. * * Results: - * Opens the selected printer. + * Opens the selected printer. * * ------------------------------------------------------------------------- */ @@ -4973,8 +4880,7 @@ int PrintOpenPrinter( } /*Start an individual page.*/ - if ( StartPage(printDC) <= 0) { - + if (StartPage(printDC) <= 0) { return TCL_ERROR; } @@ -4986,7 +4892,8 @@ int PrintOpenPrinter( } Tcl_DStringInit(&ds); - if ((OpenPrinterW(Tcl_UtfToWCharDString(printer, -1, &ds), (LPHANDLE)&printDC, NULL)) == FALSE) { + if ((OpenPrinterW(Tcl_UtfToWCharDString(printer, -1, &ds), + (LPHANDLE)&printDC, NULL)) == FALSE) { Tcl_AppendResult(interp, "unable to open printer", NULL); Tcl_DStringFree(&ds); return TCL_ERROR; @@ -4995,21 +4902,25 @@ int PrintOpenPrinter( Tcl_DStringFree(&ds); return TCL_OK; } - + /* * -------------------------------------------------------------------------- * * PrintClosePrinter-- * - * Closes the given printer. + * Closes the given printer. * * Results: - * Printer closed. + * Printer closed. * * ------------------------------------------------------------------------- */ -int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +int PrintClosePrinter( + ClientData clientData, + Tcl_Interp *interp, + int argc, + Tcl_Obj *const objv[]) { (void) clientData; (void) argc; @@ -5023,7 +4934,7 @@ int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_O ClosePrinter(printDC); return TCL_OK; } - + /* * -------------------------------------------------------------------------- * @@ -5037,7 +4948,11 @@ int PrintClosePrinter(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_O * ------------------------------------------------------------------------- */ -int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +int PrintOpenDoc( + ClientData clientData, + Tcl_Interp *interp, + int argc, + Tcl_Obj *const objv[]) { (void) clientData; @@ -5062,22 +4977,25 @@ int PrintOpenDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *c return TCL_OK; } - + /* * -------------------------------------------------------------------------- * * PrintCloseDoc-- * - * Closes the document for printing. + * Closes the document for printing. * * Results: - * Closes the print document. + * Closes the print document. * * ------------------------------------------------------------------------- */ - -int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +int PrintCloseDoc( + ClientData clientData, + Tcl_Interp *interp, + int argc, + Tcl_Obj *const objv[]) { (void) clientData; @@ -5089,15 +5007,14 @@ int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * return TCL_ERROR; } - - if ( EndDoc(printDC) <= 0) { + if (EndDoc(printDC) <= 0) { Tcl_AppendResult(interp, "unable to establish close document", NULL); return TCL_ERROR; } DeleteDC(printDC); return TCL_OK; } - + /* * -------------------------------------------------------------------------- * @@ -5111,9 +5028,12 @@ int PrintCloseDoc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * * ------------------------------------------------------------------------- */ -int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +int PrintOpenPage( + ClientData clientData, + Tcl_Interp *interp, + int argc, + Tcl_Obj *const objv[]) { - (void) clientData; (void) argc; (void) objv; @@ -5123,32 +5043,34 @@ int PrintOpenPage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * return TCL_ERROR; } - /*Start an individual page.*/ - if ( StartPage(printDC) <= 0) { + if (StartPage(printDC) <= 0) { Tcl_AppendResult(interp, "unable to start page", NULL); return TCL_ERROR; } return TCL_OK; } - + /* * -------------------------------------------------------------------------- * * PrintClosePage-- * - * Closes the printed page. + * Closes the printed page. * * Results: - * Closes the page. + * Closes the page. * * ------------------------------------------------------------------------- */ -int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) +int PrintClosePage( + ClientData clientData, + Tcl_Interp *interp, + int argc, + Tcl_Obj *const objv[]) { - (void) clientData; (void) argc; (void) objv; @@ -5158,15 +5080,13 @@ int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj return TCL_ERROR; } - - if ( EndPage(printDC) <= 0) { + if (EndPage(printDC) <= 0) { Tcl_AppendResult(interp, "unable to close page", NULL); return TCL_ERROR; } return TCL_OK; } - - + /* * Local Variables: * mode: c @@ -5174,5 +5094,3 @@ int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * fill-column: 78 * End: */ - - -- cgit v0.12 From 912b71a157b9702460e7823d001f5ba550376388 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 7 Jul 2021 20:14:10 +0000 Subject: Unbreak my mistakes, and tighten up the code further. --- library/print.tcl | 381 +++++++++++++++++++++++++++--------------------------- 1 file changed, 191 insertions(+), 190 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 2607247..eb89a98 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -14,16 +14,25 @@ namespace eval ::tk::print { namespace import -force ::tk::msgcat::* - if {[tk windowingsystem] eq "win32"} { + proc makeTempFile {filename contents} { + set f [file tempfile filename $filename] + try { + puts $f $contents + return $filename + } finally { + close $f + } + } - variable ::tk::print::printer_name - variable ::tk::print::copies - variable ::tk::print::dpi_x - variable ::tk::print::dpi_y - variable ::tk::print::paper_width - variable ::tk::print::paper_height - variable ::tk::print::margin_left - variable ::tk::print::margin_top + if {[tk windowingsystem] eq "win32"} { + variable printer_name + variable copies + variable dpi_x + variable dpi_y + variable paper_width + variable paper_height + variable margin_left + variable margin_top variable printargs array set printargs {} @@ -36,11 +45,17 @@ namespace eval ::tk::print { # proc _set_dc {} { variable printargs + variable printer_name + variable paper_width + variable paper_height + variable dpi_x + variable dpi_y + variable copies #First, we select the printer. - ::tk::print::_selectprinter + _selectprinter - if {$::tk::print::printer_name eq ""} { + if {$printer_name eq ""} { #they pressed cancel return } @@ -48,17 +63,17 @@ namespace eval ::tk::print { #Next, set values. Some are taken from the printer, #some are sane defaults. - set printargs(hDC) $::tk::print::printer_name - set printargs(pw) $::tk::print::paper_width - set printargs(pl) $::tk::print::paper_height + set printargs(hDC) $printer_name + set printargs(pw) $paper_width + set printargs(pl) $paper_height set printargs(lm) 1000 set printargs(tm) 1000 set printargs(rm) 1000 set printargs(bm) 1000 - set printargs(resx) $::tk::print::dpi_x - set printargs(resy) $::tk::print::dpi_y - set printargs(copies) $::tk::print::copies - set printargs(resolution) [list $::tk::print::dpi_x $::tk::print::dpi_y] + set printargs(resx) $dpi_x + set printargs(resy) $dpi_y + set printargs(copies) $copies + set printargs(resolution) [list $dpi_x $dpi_y] } # _print_data @@ -69,34 +84,33 @@ namespace eval ::tk::print { # breaklines - If non-zero, keep newlines in the string as # newlines in the output. # font - Font for printing - proc _print_data {data {breaklines 1 } {font ""}} { + proc _print_data {data {breaklines 1} {font ""}} { variable printargs _set_dc - if { $font eq "" } { - ::tk::print::_gdi characters $printargs(hDC) -array printcharwid + if {$font eq ""} { + _gdi characters $printargs(hDC) -array printcharwid } else { - ::tk::print::_gdi characters $printargs(hDC) -font $font \ - -array printcharwid + _gdi characters $printargs(hDC) -font $font -array printcharwid } - set pagewid [expr {( $printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx) }] - set pagehgt [expr {( $printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy) }] - set totallen [ string length $data ] + set pagewid [expr {($printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx)}] + set pagehgt [expr {($printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy)}] + set totallen [string length $data] set curlen 0 - set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000 }] + set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000}] - ::tk::print::_opendoc - ::tk::print::_openpage + _opendoc + _openpage - while { $curlen < $totallen } { - set linestring [ string range $data $curlen end ] - if { $breaklines } { - set endind [ string first "\n" $linestring ] - if { $endind != -1 } { - set linestring [ string range $linestring 0 $endind ] + while {$curlen < $totallen} { + set linestring [string range $data $curlen end] + if {$breaklines} { + set endind [string first "\n" $linestring] + if {$endind != -1} { + set linestring [string range $linestring 0 $endind] # handle blank lines.... - if { $linestring eq "" } { + if {$linestring eq ""} { set linestring " " } } @@ -106,15 +120,15 @@ namespace eval ::tk::print { printcharwid printargs $curhgt $font] incr curlen [lindex $result 0] incr curhgt [lindex $result 1] - if { $curhgt + [lindex $result 1] > $pagehgt } { - ::tk::print::_closepage - ::tk::print::_openpage - set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000 }] + if {$curhgt + [lindex $result 1] > $pagehgt} { + _closepage + _openpage + set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000}] } } - ::tk::print::_closepage - ::tk::print::_closedoc + _closepage + _closedoc } # _print_file @@ -144,7 +158,7 @@ namespace eval ::tk::print { # cdata - Array of values for character widths # y - Y value to begin printing at # font - if non-empty specifies a font to draw the line in - proc _print_page_nextline { string carray parray y font } { + proc _print_page_nextline {string carray parray y font} { upvar #0 $carray charwidths upvar #0 $parray printargs @@ -155,8 +169,8 @@ namespace eval ::tk::print { set maxwidth [expr { (($printargs(pw) - $printargs(rm)) / 1000) * $printargs(resx) }] - set maxstring [ string length $string ] - set lm [expr {$printargs(lm) * $printargs(resx) / 1000 }] + set maxstring [string length $string] + set lm [expr {$printargs(lm) * $printargs(resx) / 1000}] for {set i 0} {($i < $maxstring) && ($totwidth < $maxwidth)} {incr i} { incr totwidth $charwidths([string index $string $i]) @@ -166,30 +180,30 @@ namespace eval ::tk::print { set endindex $i set startindex $endindex - if { $i < $maxstring } { + if {$i < $maxstring} { # In this case, the whole data string is not used up, and we # wish to break on a word. Since we have all the partial # widths calculated, this should be easy. - set endindex [expr {[string wordstart $string $endindex] - 1 }] - set startindex [expr {$endindex + 1 }] + set endindex [expr {[string wordstart $string $endindex] - 1}] + set startindex [expr {$endindex + 1}] # If the line is just too long (no word breaks), print as much # as you can.... - if { $endindex <= 1 } { + if {$endindex <= 1} { set endindex $i set startindex $i } } set txt [string trim [string range $string 0 $endindex] "\r\n"] - if { $font ne "" } { - set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ + if {$font ne ""} { + set result [_gdi text $printargs(hDC) $lm $y \ -anchor nw -justify left \ - -text $txt -font $font ] + -text $txt -font $font] } else { - set result [ ::tk::print::_gdi text $printargs(hDC) $lm $y \ - -anchor nw -justify left -text $txt ] + set result [_gdi text $printargs(hDC) $lm $y \ + -anchor nw -justify left -text $txt] } return "$startindex $result" } @@ -200,7 +214,7 @@ namespace eval ::tk::print { variable option variable vtgPrint - proc _init_print_canvas { } { + proc _init_print_canvas {} { variable option variable vtgPrint variable printargs @@ -211,7 +225,7 @@ namespace eval ::tk::print { proc _is_win {} { variable printargs - return [ info exist tk_patchLevel ] + return [info exist tk_patchLevel] } # _print_widget @@ -227,8 +241,8 @@ namespace eval ::tk::print { _set_dc - ::tk::print::_opendoc - ::tk::print::_openpage + _opendoc + _openpage # Here is where any scaling/gdi mapping should take place # For now, scale so the dimensions of the window are sized to the @@ -236,19 +250,19 @@ namespace eval ::tk::print { # For normal windows, this may be fine--but for a canvas, one # wants the canvas dimensions, and not the WINDOW dimensions. - if { [winfo class $wid] eq "Canvas" } { - set sc [ $wid cget -scrollregion ] + if {[winfo class $wid] eq "Canvas"} { + set sc [$wid cget -scrollregion] # if there is no scrollregion, use width and height. - if { $sc eq "" } { - set window_x [ $wid cget -width ] - set window_y [ $wid cget -height ] + if {$sc eq ""} { + set window_x [$wid cget -width] + set window_y [$wid cget -height] } else { - set window_x [ lindex $sc 2 ] - set window_y [ lindex $sc 3 ] + set window_x [lindex $sc 2] + set window_y [lindex $sc 3] } } else { - set window_x [ winfo width $wid ] - set window_y [ winfo height $wid ] + set window_x [winfo width $wid] + set window_y [winfo height $wid] } set printer_x [expr { @@ -259,10 +273,10 @@ namespace eval ::tk::print { ( $printargs(pl) - $printargs(tm) - $printargs(bm) ) * $printargs(resy) / 1000.0 }] - set factor_x [expr {$window_x / $printer_x} ] - set factor_y [expr {$window_y / $printer_y} ] + set factor_x [expr {$window_x / $printer_x}] + set factor_y [expr {$window_y / $printer_y}] - if { $factor_x < $factor_y } { + if {$factor_x < $factor_y} { set lo $window_y set ph $printer_y } else { @@ -270,7 +284,7 @@ namespace eval ::tk::print { set ph $printer_x } - ::tk::print::_gdi map $printargs(hDC) -logical $lo -physical $ph \ + _gdi map $printargs(hDC) -logical $lo -physical $ph \ -offset $printargs(resolution) # Handling of canvas widgets. @@ -284,8 +298,8 @@ namespace eval ::tk::print { } # End printing process. - ::tk::print::_closepage - ::tk::print::_closedoc + _closepage + _closedoc } # _print_canvas @@ -304,7 +318,7 @@ namespace eval ::tk::print { # Re-write each widget from cw to printer foreach id [$cw find all] { set type [$cw type $id] - if { [ info commands _print_canvas.$type ] eq "_print_canvas.$type" } { + if {[info commands _print_canvas.$type] eq "_print_canvas.$type"} { _print_canvas.[$cw type $id] $printargs(hDC) $cw $id } else { puts "Omitting canvas item of type $type since there is no handler registered for it" @@ -337,28 +351,28 @@ namespace eval ::tk::print { set arrow [$cw itemcget $id -arrow] set arwshp [$cw itemcget $id -arrowshape] set dash [$cw itemcget $id -dash] - set smooth [$cw itemcget $id -smooth ] - set splinesteps [ $cw itemcget $id -splinesteps ] + set smooth [$cw itemcget $id -smooth] + set splinesteps [$cw itemcget $id -splinesteps] set cmdargs {} - if { $wdth > 1 } { + if {$wdth > 1} { lappend cmdargs -width $wdth } - if { $dash ne "" } { + if {$dash ne ""} { lappend cmdargs -dash $dash } - if { $smooth ne "" } { + if {$smooth ne ""} { lappend cmdargs -smooth $smooth } - if { $splinesteps ne "" } { + if {$splinesteps ne ""} { lappend cmdargs -splinesteps $splinesteps } - set result [::tk::print::_gdi line $hdc {*}$coords \ + set result [_gdi line $hdc {*}$coords \ -fill $color -arrow $arrow -arrowshape $arwshp \ {*}$cmdargs] - if { $result ne "" } { + if {$result ne ""} { puts $result } } @@ -374,25 +388,25 @@ namespace eval ::tk::print { variable printargs set color [_print_canvas.TransColor [$cw itemcget $id -outline]] - if { [string match $vtgPrint(printer.bg) $color] } { + if {[string match $vtgPrint(printer.bg) $color]} { return } set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - set style [ $cw itemcget $id -style ] - set start [ $cw itemcget $id -start ] - set extent [ $cw itemcget $id -extent ] - set fill [ $cw itemcget $id -fill ] + set style [$cw itemcget $id -style] + set start [$cw itemcget $id -start] + set extent [$cw itemcget $id -extent] + set fill [$cw itemcget $id -fill] set cmdargs {} - if { $wdth > 1 } { + if {$wdth > 1} { lappend cmdargs -width $wdth } - if { $fill ne "" } { + if {$fill ne ""} { lappend cmdargs -fill $fill } - ::tk::print::_gdi arc $hdc {*}$coords \ + _gdi arc $hdc {*}$coords \ -outline $color -style $style -start $start -extent $extent \ {*}$cmdargs } @@ -408,27 +422,27 @@ namespace eval ::tk::print { variable printargs set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] - if { $fcolor eq "" } { + if {$fcolor eq ""} { set fcolor $vtgPrint(printer.bg) } set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] - if { $ocolor eq "" } { + if {$ocolor eq ""} { set ocolor $vtgPrint(printer.bg) } set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - set smooth [$cw itemcget $id -smooth ] - set splinesteps [ $cw itemcget $id -splinesteps ] + set smooth [$cw itemcget $id -smooth] + set splinesteps [$cw itemcget $id -splinesteps] set cmdargs {} - if { $smooth ne "" } { + if {$smooth ne ""} { lappend cmdargs -smooth $smooth } - if { $splinesteps ne "" } { + if {$splinesteps ne ""} { lappend cmdargs -splinesteps $splinesteps } - ::tk::print::_gdi polygon $hdc {*}$coords \ + _gdi polygon $hdc {*}$coords \ -width $wdth -fill $fcolor -outline $ocolor {*}$cmdargs } @@ -438,21 +452,21 @@ namespace eval ::tk::print { # hdc - The printer handle. # cw - The canvas widget. # id - The id of the canvas item. - proc _print_canvas.oval { hdc cw id } { + proc _print_canvas.oval {hdc cw id} { variable vtgPrint set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] - if { $fcolor eq "" } { + if {$fcolor eq ""} { set fcolor $vtgPrint(printer.bg) } set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] - if { $ocolor eq "" } { + if {$ocolor eq ""} { set ocolor $vtgPrint(printer.bg) } set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - ::tk::print::_gdi oval $hdc {*}$coords \ + _gdi oval $hdc {*}$coords \ -width $wdth -fill $fcolor -outline $ocolor } @@ -466,17 +480,17 @@ namespace eval ::tk::print { variable vtgPrint set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] - if { $fcolor eq "" } { + if {$fcolor eq ""} { set fcolor $vtgPrint(printer.bg) } set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] - if { $ocolor eq "" } { + if {$ocolor eq ""} { set ocolor $vtgPrint(printer.bg) } set coords [$cw coords $id] set wdth [$cw itemcget $id -width] - ::tk::print::_gdi rectangle $hdc {*}$coords \ + _gdi rectangle $hdc {*}$coords \ -width $wdth -fill $fcolor -outline $ocolor } @@ -491,10 +505,10 @@ namespace eval ::tk::print { variable printargs set color [_print_canvas.TransColor [$cw itemcget $id -fill]] - # if { "white" eq [string tolower $color] } {return} + # if {"white" eq [string tolower $color]} {return} # set color black set txt [$cw itemcget $id -text] - if { $txt eq "" } { + if {$txt eq ""} { return } set coords [$cw coords $id] @@ -509,12 +523,12 @@ namespace eval ::tk::print { # suitable for printer name extraction. set font [font create {*}[font actual [$cw itemcget $id -font]]] - # Just get the name and family, or some of the ::tk::print::_gdi - # commands will fail. + # Just get the name and family, or some of the _gdi commands will + # fail. set font [list [font configure $font -family] \ - -[font configure $font -size] ] + -[font configure $font -size]] - ::tk::print::_gdi text $hdc {*}$coords \ + _gdi text $hdc {*}$coords \ -fill $color -text $txt -font $font \ -anchor $anchr -width $wdth -justify $just } @@ -527,17 +541,17 @@ namespace eval ::tk::print { # id - The id of the canvas item. proc _print_canvas.image {hdc cw id} { # First, we have to get the image name. - set imagename [ $cw itemcget $id -image] + set imagename [$cw itemcget $id -image] # Now we get the size. - set wid [ image width $imagename] - set hgt [ image height $imagename ] + set wid [image width $imagename] + set hgt [image height $imagename] # Next, we get the location and anchor - set anchor [ $cw itemcget $id -anchor ] - set coords [ $cw coords $id ] + set anchor [$cw itemcget $id -anchor] + set coords [$cw coords $id] - ::tk::print::_gdi photo $hdc -destination $coords -photo $imagename + _gdi photo $hdc -destination $coords -photo $imagename } # _print_canvas.bitmap @@ -551,30 +565,30 @@ namespace eval ::tk::print { variable vtgPrint # First, we have to get the bitmap name. - set imagename [ $cw itemcget $id -image] + set imagename [$cw itemcget $id -image] # Now we get the size. - set wid [ image width $imagename] - set hgt [ image height $imagename ] + set wid [image width $imagename] + set hgt [image height $imagename] #Next, we get the location and anchor. - set anchor [ $cw itemcget $id -anchor ] - set coords [ $cw coords $id ] + set anchor [$cw itemcget $id -anchor] + set coords [$cw coords $id] # Since the GDI commands don't yet support images and bitmaps, # and since this represents a rendered bitmap, we CAN use # copybits IF we create a new temporary toplevel to hold the beast. # If this is too ugly, change the option! - if { [ info exist option(use_copybits) ] } { + if {[info exist option(use_copybits)]} { set firstcase $option(use_copybits) } else { set firstcase 0 } - if { $firstcase > 0 } { - set tl [toplevel .tmptop[expr {int( rand() * 65535 )} ] \ + if {$firstcase > 0} { + set tl [toplevel .tmptop[expr {int( rand() * 65535 )}] \ -height $hgt -width $wid \ - -background $vtgPrint(canvas.bg) ] + -background $vtgPrint(canvas.bg)] canvas $tl.canvas -width $wid -height $hgt $tl.canvas create image 0 0 -image $imagename -anchor nw pack $tl.canvas -side left -expand false -fill none @@ -582,11 +596,11 @@ namespace eval ::tk::print { update set srccoords [list 0 0 [expr {$wid - 1}] [expr {$hgt - 1}]] set dstcoords [list [lindex $coords 0] [lindex $coords 1] [expr {$wid - 1}] [expr {$hgt - 1}]] - ::tk::print::_gdi copybits $hdc -window $tl -client \ + _gdi copybits $hdc -window $tl -client \ -source $srccoords -destination $dstcoords destroy $tl } else { - ::tk::print::_gdi bitmap $hdc {*}$coords \ + _gdi bitmap $hdc {*}$coords \ -anchor $anchor -bitmap $imagename } } @@ -668,6 +682,7 @@ namespace eval ::tk::print { variable printcmd variable chooseprinter variable printcopies + variable printorientation variable choosepaper variable color variable p @@ -692,7 +707,8 @@ namespace eval ::tk::print { pack $p.frame.printframe -side top -fill x -expand no label $p.frame.printframe.printlabel -text [mc "Printer:"] - ttk::combobox $p.frame.printframe.mb -textvariable chooseprinter \ + ttk::combobox $p.frame.printframe.mb \ + -textvariable [namespace which -variable chooseprinter] \ -state readonly -values [lsort -unique $printlist] pack $p.frame.printframe.printlabel $p.frame.printframe.mb \ -side left -fill x -expand no @@ -704,16 +720,11 @@ namespace eval ::tk::print { set paperlist [list [mc Letter] [mc Legal] [mc A4]] set colorlist [list [mc Grayscale] [mc RGB]] - #Initialize with sane defaults. Because some of these variables - #are tied to tk_optionMenu, they are global and cannot be tied - #to the ::tk::print namespace. To minimize name collision, we have - #given them similar names to the current namespace. And wherever - #possible, we are using namespaced variables. - + #Initialize with sane defaults. set printcopies 1 - set ::tkprint_choosepaper [mc A4] - set ::tkprint_color [mc RGB] - set ::tkprint_orientation portrait + set choosepaper [mc A4] + set color [mc RGB] + set printorientation portrait set percentlist {100 90 80 70 60 50 40 30 20 10} @@ -726,7 +737,7 @@ namespace eval ::tk::print { label $p.frame.copyframe.l.copylabel -text [mc "Copies:"] spinbox $p.frame.copyframe.l.field -from 1 -to 1000 \ - -textvariable printcopies -width 5 + -textvariable [namespace which -variable printcopies] -width 5 pack $p.frame.copyframe.l.copylabel $p.frame.copyframe.l.field \ -side left -fill x -expand no @@ -737,7 +748,8 @@ namespace eval ::tk::print { pack $p.frame.copyframe.r -fill x -expand no label $p.frame.copyframe.r.paper -text [mc "Paper:"] - tk_optionMenu $p.frame.copyframe.r.menu ::tkprint_choosepaper \ + tk_optionMenu $p.frame.copyframe.r.menu \ + [namespace which -variable choosepaper] \ {*}$paperlist pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu \ @@ -750,7 +762,8 @@ namespace eval ::tk::print { pack $p.frame.copyframe.z -fill x -expand no label $p.frame.copyframe.z.zlabel -text [mc "Scale %:"] - tk_optionMenu $p.frame.copyframe.z.zentry ::tkprint_zoomnumber \ + tk_optionMenu $p.frame.copyframe.z.zentry \ + [namespace which -variable zoomnumber] \ {*}$percentlist pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry \ @@ -761,11 +774,11 @@ namespace eval ::tk::print { label $p.frame.copyframe.orient.text -text [mc "Orientation:"] radiobutton $p.frame.copyframe.orient.v -text [mc "Portrait"] \ - -value portrait -variable ::tkprint_printorientation \ - -compound left + -value portrait -compound left \ + -variable [namespace which -variable printorientation] radiobutton $p.frame.copyframe.orient.h -text [mc "Landscape"] \ - -value landscape -variable ::tkprint_printorientation \ - -compound left + -value landscape -compound left \ + -variable [namespace which -variable printorientation] pack $p.frame.copyframe.orient.text \ $p.frame.copyframe.orient.v $p.frame.copyframe.orient.h \ @@ -775,7 +788,8 @@ namespace eval ::tk::print { pack $p.frame.copyframe.c -fill x -expand no label $p.frame.copyframe.c.l -text [mc "Output:"] - tk_optionMenu $p.frame.copyframe.c.c ::tkprint_color \ + tk_optionMenu $p.frame.copyframe.c.c \ + [namespace which -variable color] \ {*}$colorlist pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left \ -fill x -expand no @@ -786,7 +800,7 @@ namespace eval ::tk::print { pack $p.frame.buttonframe -fill x -expand no -side bottom button $p.frame.buttonframe.printbutton -text [mc "Print"] \ - -command "::tk::print::_runprint $w" + -command [namespace code [list _runprint $w]] button $p.frame.buttonframe.cancel -text [mc "Cancel"] \ -command {destroy ._print} @@ -802,11 +816,14 @@ namespace eval ::tk::print { # w - widget with contents to print. # proc _runprint {w} { - variable printlist variable printcmd + variable choosepaper variable chooseprinter + variable color variable printcopies + variable printorientation + variable zoomnumber variable p #First, generate print file. @@ -821,23 +838,21 @@ namespace eval ::tk::print { if {[winfo class $w] eq "Canvas"} { set file /tmp/tk_canvas.ps - if {$::tkprint_color eq [mc "RGB"]} { + if {$color eq [mc "RGB"]} { set colormode color } else { set colormode gray } - if {$::tkprint_printorientation eq "landscape"} { + if {$printorientation eq "landscape"} { set willrotate "1" } else { set willrotate "0" } #Scale based on size of widget, not size of paper. - set printwidth [expr { - ($::tkprint_zoomnumber / 100.00) * [winfo width $w] - }] - $w postscript -file $file -colormode $colormode \ + set printwidth [expr {$zoomnumber / 100.00 * [winfo width $w]}] + $w postscript -file $file -colormode $colormode \ -rotate $willrotate -pagewidth $printwidth } @@ -852,8 +867,7 @@ namespace eval ::tk::print { } after 500 - exec $printcmd {*}$printargs -o PageSize=$::tkprint_choosepaper \ - $file + exec $printcmd {*}$printargs -o PageSize=$choosepaper $file after 500 destroy ._print @@ -863,15 +877,6 @@ namespace eval ::tk::print { #begin macOS Aqua procedures if {[tk windowingsystem] eq "aqua"} { - proc makeTempFile {filename contents} { - # TODO: Tcl 8.6 has better ways to make temporary files! - set filename /tmp/$filename - set f [open $filename w] - puts $f $contents - close $f - return $filename - } - proc makePDF {inFilename outFilename} { catch {exec /usr/sbin/cupsfilter $inFilename > $outFilename} } @@ -888,43 +893,39 @@ namespace eval ::tk::print { # Arguments: # w: Widget to print. proc ::tk::print {w} { - if {[winfo class $w] eq "Canvas"} { - if {[tk windowingsystem] eq "win32"} { ::tk::print::_print_widget $w 0 "Tk Print Output" - } - if {[tk windowingsystem] eq "x11"} { + } elseif {[tk windowingsystem] eq "x11"} { ::tk::print::_print $w - } - if {[tk windowingsystem] eq "aqua"} { - set file [_make_temp_file tk_canvas.ps ""] - $w postscript -file $file - set printfile [_make_temp_file tk_canvas.pdf ""] - makePDF $file $printfile - ::tk::print::_print $printfile + } elseif {[tk windowingsystem] eq "aqua"} { + set psfile [::tk::print::makeTempFile tk_canvas.ps ""] + try { + $w postscript -file $psfile + set printfile [::tk::print::makeTempFile tk_canvas.pdf ""] + ::tk::print::makePDF $psfile $printfile + ::tk::print::_print $printfile + } finally { + file delete $psfile + } } } if {[winfo class $w] eq "Text"} { - if {[tk windowingsystem] eq "win32"} { - set txt [$w get 1.0 end] - set x [file join $::env(TEMP) tk_output.txt] - set print_txt [open $x w] - puts $print_txt $txt - close $print_txt + set x [::tk::print::makeTempFile tk_output.txt [$w get 1.0 end]] ::tk::print::_print_file $x 1 {Arial 12} - } - if {[tk windowingsystem] eq "x11"} { + } elseif {[tk windowingsystem] eq "x11"} { ::tk::print::_print $w - } - if {[tk windowingsystem] eq "aqua"} { - set txt [$w get 1.0 end] - set file [_make_temp_file tk_text.txt $txt] - set printfile [_make_temp_file tk_text.pdf ""] - makePDF $file $printfile - ::tk::print::_print $printfile + } elseif {[tk windowingsystem] eq "aqua"} { + set txtfile [::tk::print::makeTempFile tk_text.txt [$w get 1.0 end]] + try { + set printfile [::tk::print::makeTempFile tk_text.pdf ""] + ::tk::print::makePDF $txtfile $printfile + ::tk::print::_print $printfile + } finally { + file delete $txtfile + } } } } -- cgit v0.12 From b3c65cadd75f78ba5073a7fe7db4547f66685f77 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 8 Jul 2021 08:59:21 +0000 Subject: Tighten up the printing script further; blind [catch] is not encouraged --- library/print.tcl | 99 +++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 63 insertions(+), 36 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index eb89a98..1717ade 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -14,10 +14,18 @@ namespace eval ::tk::print { namespace import -force ::tk::msgcat::* - proc makeTempFile {filename contents} { + # makeTempFile: + # Create a temporary file and populate its contents + # Arguments: + # filename - base of the name of the file to create + # contents - what to put in the file; defaults to empty + # Returns: + # Full filename for created file + # + proc makeTempFile {filename {contents ""}} { set f [file tempfile filename $filename] try { - puts $f $contents + puts -nonewline $f $contents return $filename } finally { close $f @@ -636,16 +644,12 @@ namespace eval ::tk::print { # canvas postscript command. if {[tk windowingsystem] eq "x11"} { - - variable printcmd - variable printlist + variable printcmd "" + variable printlist {} variable choosepaper + variable chooseprinter {} variable p - set printmcd "" - set chooseprinter "" - set printlist {} - # _setprintenv # Set the print environtment - print command, and list of printers. # Arguments: @@ -692,7 +696,6 @@ namespace eval ::tk::print { set chooseprinter [lindex $printlist 0] set p ._print - catch {destroy $p} toplevel $p @@ -829,15 +832,10 @@ namespace eval ::tk::print { #First, generate print file. if {[winfo class $w] eq "Text"} { - set txt [$w get 1.0 end] - set file /tmp/tk_text.txt - set print_txt [open $file w] - puts $print_txt $txt - close $print_txt + set file [makeTempFile tk_text.txt [$w get 1.0 end]] } if {[winfo class $w] eq "Canvas"} { - set file /tmp/tk_canvas.ps if {$color eq [mc "RGB"]} { set colormode color } else { @@ -852,6 +850,7 @@ namespace eval ::tk::print { #Scale based on size of widget, not size of paper. set printwidth [expr {$zoomnumber / 100.00 * [winfo width $w]}] + set file [makeTempFile tk_canvas.ps] $w postscript -file $file -colormode $colormode \ -rotate $willrotate -pagewidth $printwidth } @@ -877,8 +876,31 @@ namespace eval ::tk::print { #begin macOS Aqua procedures if {[tk windowingsystem] eq "aqua"} { + # makePDF - + # Convert a file to PDF + # Arguments: + # inFilename - file containing the data to convert; format is + # autodetected. + # outFilename - base for filename to write to; conventionally should + # have .pdf as suffix + # Returns: + # The full pathname of the generated PDF. + # proc makePDF {inFilename outFilename} { - catch {exec /usr/sbin/cupsfilter $inFilename > $outFilename} + set out [::tk::print::makeTempFile $outFilename] + try { + exec /usr/sbin/cupsfilter $inFilename > $out + } trap NONE {msg} { + # cupsfilter produces a lot of debugging output, which we + # don't want. + regsub -all -line {^(?:DEBUG|INFO):.*$} $msg "" msg + set msg [string trimleft [regsub -all {\n+} $msg "\n"] "\n"] + if {$msg ne ""} { + # Lines should be prefixed with WARN or ERROR now + puts $msg + } + } + return $out } } #end macOS Aqua procedures @@ -893,40 +915,45 @@ namespace eval ::tk::print { # Arguments: # w: Widget to print. proc ::tk::print {w} { - if {[winfo class $w] eq "Canvas"} { - if {[tk windowingsystem] eq "win32"} { - ::tk::print::_print_widget $w 0 "Tk Print Output" - } elseif {[tk windowingsystem] eq "x11"} { - ::tk::print::_print $w - } elseif {[tk windowingsystem] eq "aqua"} { - set psfile [::tk::print::makeTempFile tk_canvas.ps ""] + switch [winfo class $w],[tk windowingsystem] { + "Canvas,win32" { + tailcall ::tk::print::_print_widget $w 0 "Tk Print Output" + } + "Canvas,x11" { + tailcall ::tk::print::_print $w + } + "Canvas,aqua" { + set psfile [::tk::print::makeTempFile tk_canvas.ps] try { $w postscript -file $psfile - set printfile [::tk::print::makeTempFile tk_canvas.pdf ""] - ::tk::print::makePDF $psfile $printfile + set printfile [::tk::print::makePDF $psfile tk_canvas.pdf] ::tk::print::_print $printfile } finally { file delete $psfile } } - } - if {[winfo class $w] eq "Text"} { - if {[tk windowingsystem] eq "win32"} { - set x [::tk::print::makeTempFile tk_output.txt [$w get 1.0 end]] - ::tk::print::_print_file $x 1 {Arial 12} - } elseif {[tk windowingsystem] eq "x11"} { - ::tk::print::_print $w - } elseif {[tk windowingsystem] eq "aqua"} { + "Text,win32" { + tailcall ::tk::print::_print_data [$w get 1.0 end] 1 {Arial 12} + } + "Text,x11" { + tailcall ::tk::print::_print $w + } + "Text,aqua" { set txtfile [::tk::print::makeTempFile tk_text.txt [$w get 1.0 end]] try { - set printfile [::tk::print::makeTempFile tk_text.pdf ""] - ::tk::print::makePDF $txtfile $printfile + set printfile [::tk::print::makePDF $txtfile tk_text.pdf] ::tk::print::_print $printfile } finally { file delete $txtfile } } + + default { + return -code error -errorcode {TK PRINT CLASS_UNSUPPORTED} \ + "widgets of class [winfo class $w] are not supported on\ + this platform" + } } } -- cgit v0.12 From cc93483fc274c4cb374edfbc67ec2dbc2e3806f1 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 9 Jul 2021 12:55:52 +0000 Subject: Bail on X11 printing if lpstat not found - print error and return --- library/print.tcl | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/library/print.tcl b/library/print.tcl index 1717ade..25b408f 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -659,6 +659,16 @@ namespace eval ::tk::print { variable printcmd variable printlist + #Test for existence of lpstat command to obtain list of printers. Return error + #if not found. + + catch {exec lpstat -a} msg + set notfound "command not found" + if {[string first $notfound $msg != -1} { + error "Unable to obtain list of printers. Please install the CUPS package for your system." + return + } + # Select print command. We prefer lpr, but will fall back to lp if # necessary. if {[auto_execok lpr] ne ""} { -- cgit v0.12 From b694dd616c94a16a96ca8ead30f8b9fa58fe1ced Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 9 Jul 2021 14:19:57 +0000 Subject: Tweak lineation --- library/print.tcl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/library/print.tcl b/library/print.tcl index 25b408f..0332b25 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -665,7 +665,8 @@ namespace eval ::tk::print { catch {exec lpstat -a} msg set notfound "command not found" if {[string first $notfound $msg != -1} { - error "Unable to obtain list of printers. Please install the CUPS package for your system." + error "Unable to obtain list of printers. Please install the CUPS package \ + for your system." return } -- cgit v0.12 From 357adcd19518cd05a18e1c5a0d90ea89ee6df47c Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 10 Jul 2021 09:48:17 +0000 Subject: Improve french translations --- library/msgs/fr.msg | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg index 570138d..0d3ef08 100644 --- a/library/msgs/fr.msg +++ b/library/msgs/fr.msg @@ -78,11 +78,11 @@ namespace eval ::tk { ::msgcat::mcset fr "Legal " "Légal" ::msgcat::mcset fr "A4" "A4" ::msgcat::mcset fr "Grayscale" "Niveaux de Gris" - ::msgcat::mcset fr "RGB" "Rvb" + ::msgcat::mcset fr "RGB" "RVB" ::msgcat::mcset fr "Options" "Options" - ::msgcat::mcset fr "Copies" "Copies" + ::msgcat::mcset fr "Copies" "Nombre d'exemplaires" ::msgcat::mcset fr "Paper" "Papier" - ::msgcat::mcset fr "Scale" "Écaille" + ::msgcat::mcset fr "Scale" "Échelle" ::msgcat::mcset fr "Orientation" "Orientation" ::msgcat::mcset fr "Portrait" "Portrait" ::msgcat::mcset fr "Landscape" "Paysage" -- cgit v0.12 From fe58f67fd52055fe7c5fe5583957514929e38933 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 10 Jul 2021 11:36:02 +0000 Subject: Fix missing bracket error in print.tcl --- library/print.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/print.tcl b/library/print.tcl index 0332b25..76a4a3a 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -664,7 +664,7 @@ namespace eval ::tk::print { catch {exec lpstat -a} msg set notfound "command not found" - if {[string first $notfound $msg != -1} { + if {[string first $notfound $msg] != -1} { error "Unable to obtain list of printers. Please install the CUPS package \ for your system." return -- cgit v0.12 From 19a885fd412f65d62de849a677bb1055a6e03964 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 11 Jul 2021 11:15:45 +0000 Subject: Starting to reduce number of bad practices --- win/tkWinGDI.c | 387 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 189 insertions(+), 198 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index bb0cfda..46445fd 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -27,14 +27,21 @@ #include "tkWinInt.h" +/* + * Create a standard "DrawFunc" to make this more workable.... + */ +#ifdef _MSC_VER +typedef BOOL (WINAPI *DrawFunc) ( + HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie. */ +#else +typedef BOOL WINAPI (*DrawFunc) ( + HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie. */ +#endif + /* Main dispatcher for commands. */ static int TkWinGDI(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -/* Main dispatcher for subcommands. */ -static int TkWinGDISubcmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); - /* Real functions. */ static int GdiArc(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); @@ -129,43 +136,12 @@ static const char gdi_usage_message[] = * Global state. */ -static char msgbuf[1024]; static PRINTDLGW pd; static DOCINFOW di; static WCHAR *localPrinterName = NULL; static int copies, paper_width, paper_height, dpi_x, dpi_y; static LPDEVNAMES devnames; static HDC printDC; - -/* - *---------------------------------------------------------------------- - * - * TkWinGDI -- - * - * Top-level routine for the ::tk::print::_gdi command. - * - * Results: - * It strips off the first word of the command (::tk::print::_gdi) and - * sends the result to a subcommand parser. - * - *---------------------------------------------------------------------- - */ - -static int TkWinGDI( - ClientData clientData, - Tcl_Interp *interp, - int argc, - const char **argv) -{ - if (argc > 1 && strcmp(argv[0], "::tk::print::_gdi") == 0) { - argc--; - argv++; - return TkWinGDISubcmd(clientData, interp, argc, argv); - } - - Tcl_AppendResult(interp, gdi_usage_message, NULL); - return TCL_ERROR; -} /* * To make the "subcommands" follow a standard convention, add them to this @@ -194,27 +170,35 @@ static const struct gdi_command { /* *---------------------------------------------------------------------- * - * TkWinGDISubcmd -- + * TkWinGDI -- * - * This is the GDI subcommand dispatcher. + * Top-level routine for the ::tk::print::_gdi command. * * Results: - * Parses and executes subcommands to ::tk::print::_gdi. + * It strips off the first two words of the command (::tk::print::_gdi + * subcommand) and dispatches to a subcommand implementation. * *---------------------------------------------------------------------- */ -static int TkWinGDISubcmd( +static int TkWinGDI( ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) { size_t i; + static const size_t numCommands = + sizeof(gdi_commands) / sizeof(struct gdi_command); - for (i=0; i 1 && strcmp(argv[0], "::tk::print::_gdi") == 0) { + for (i=0; i 4) { + /* Destination must provide at least 2 arguments. */ + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-destination requires a list of 2 to 4 numbers\n%s", + usage_message)); return TCL_ERROR; } @@ -532,17 +525,17 @@ static int GdiPhoto( } if (photoname == 0) { /* No photo provided. */ - Tcl_AppendResult(interp, - "No photo name provided to ::tk::print::_gdi photo\n", - usage_message, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "No photo name provided to ::tk::print::_gdi photo\n%s", + usage_message)); return TCL_ERROR; } photo_handle = Tk_FindPhoto(interp, photoname); if (photo_handle == 0) { - Tcl_AppendResult(interp, - "::tk::print::_gdi photo: Photo name ", photoname, - " can't be located\n", usage_message, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "::tk::print::_gdi photo: Photo name %s can't be located\n%s", + photoname, usage_message)); return TCL_ERROR; } Tk_PhotoGetImage(photo_handle, &img_block); @@ -551,9 +544,13 @@ static int GdiPhoto( ny = img_block.height; sll = ((3*nx + 3) / 4)*4; /* Must be multiple of 4. */ - pbuf = (char *) Tcl_Alloc(sll * ny * sizeof(char)); + /* + * Buffer is potentially large enough that failure to allocate might be + * recoverable. + */ + + pbuf = (char *) Tcl_AttemptAlloc(sll * ny * sizeof(char)); if (pbuf == 0) { /* Memory allocation failure. */ - /* TODO: unreachable */ Tcl_AppendResult(interp, "::tk::print::_gdi photo failed--out of memory", NULL); return TCL_ERROR; @@ -603,13 +600,11 @@ static int GdiPhoto( if (StretchDIBits(dst, dst_x, dst_y, dst_w, dst_h, 0, 0, nx, ny, pbuf, &bitmapinfo, DIB_RGB_COLORS, SRCCOPY) == (int)GDI_ERROR) { - int errcode; + int errcode = GetLastError(); - errcode = GetLastError(); - sprintf(msgbuf, - "::tk::print::_gdi photo internal failure: StretchDIBits error code %d", - errcode); - Tcl_AppendResult(interp, msgbuf, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "::tk::print::_gdi photo internal failure: " + "StretchDIBits error code %d", errcode)); retval = TCL_ERROR; } @@ -622,8 +617,8 @@ static int GdiPhoto( Tcl_Free(pbuf); if (retval == TCL_OK) { - sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); - Tcl_AppendResult(interp, msgbuf, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%d %d %d %d", dst_x, dst_y, dst_w, dst_h)); } return retval; @@ -655,7 +650,7 @@ int Bezierize( int nbpoints = 0; POINT* bpoints; - inPointList = (double *) Tcl_Alloc(2 * sizeof(double) * npoly); + inPointList = (double *) Tcl_AttemptAlloc(2 * sizeof(double) * npoly); if (inPointList == 0) { /* TODO: unreachable */ return nbpoints; /* 0. */ @@ -663,14 +658,14 @@ int Bezierize( for (n=0; n 0 && a2 > 0 && a3 > 0) { - arrowshape[0] = a1; - arrowshape[1] = a2; - arrowshape[2] = a3; - } - /* Else the numbers are bad. */ + if (sscanf(argv[1], "%d%d%d%c", &a1, &a2, &a3, &dummy) == 3 + && a1 > 0 && a2 > 0 && a3 > 0) { + arrowshape[0] = a1; + arrowshape[1] = a2; + arrowshape[2] = a3; } /* Else the argument was bad. */ @@ -1007,7 +1001,8 @@ static int GdiOval( int argc, const char **argv) { - static const char usage_message[] = "::tk::print::_gdi oval hdc x1 y1 x2 y2 -fill color -outline color " + static const char usage_message[] = + "::tk::print::_gdi oval hdc x1 y1 x2 y2 -fill color -outline color " "-stipple bitmap -width linewid"; int x1, y1, x2, y2; HDC hDC; @@ -1121,7 +1116,8 @@ static int GdiPolygon( int argc, const char **argv) { - static const char usage_message[] = "::tk::print::_gdi polygon hdc x1 y1 ... xn yn " + static const char usage_message[] = + "::tk::print::_gdi polygon hdc x1 y1 ... xn yn " "-fill color -outline color -smooth [true|false|bezier] " "-splinesteps number -stipple bitmap -width linewid"; @@ -1151,7 +1147,7 @@ static int GdiPolygon( hDC = printDC; - if ((polypoints = (POINT *)Tcl_Alloc(argc * sizeof(POINT))) == 0) { + if ((polypoints = (POINT *) Tcl_AttemptAlloc(argc * sizeof(POINT))) == 0) { /* TODO: unreachable */ Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); return TCL_ERROR; @@ -1477,11 +1473,9 @@ static int GdiCharWidths( */ if (retval == FALSE) { DWORD val = GetLastError(); - char intstr[12+1]; - sprintf(intstr, "%ld", val); - Tcl_AppendResult(interp, - "::tk::print::_gdi character failed with code ", intstr, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "::tk::print::_gdi character failed with code %ld", intstr)); if (made_font) { SelectObject(hDC, oldfont); DeleteObject(hfont); @@ -1491,15 +1485,14 @@ static int GdiCharWidths( { int i; - char numbuf[11+1]; char ind[2]; ind[1] = '\0'; for (i = 0; i < 255; i++) { - /* May need to convert the widths here(?). */ - sprintf(numbuf, "%d", widths[i]); + /* TODO: use a bytearray for the index name so NUL works */ ind[0] = i; - Tcl_SetVar2(interp, aryvarname, ind, numbuf, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, aryvarname, ind, Tcl_NewIntObj(widths[i]), + TCL_GLOBAL_ONLY); } } /* Now, remove the font if we created it only for this function. */ @@ -1753,8 +1746,7 @@ int GdiText( } /* In this case, the return value is the height of the text. */ - sprintf(msgbuf, "%d", retval); - Tcl_AppendResult(interp, msgbuf, NULL); + Tcl_SetObjResult(interp, Tcl_NewIntObj(retval)); return TCL_OK; } @@ -2064,13 +2056,13 @@ static int GdiMap( * Note: This should really be in terms that can be used in a * ::tk::print::_gdi map command! */ - sprintf(msgbuf, "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Transform: \"(%ld, %ld) -> (%ld, %ld)\" " "Origin: \"(%ld, %ld)\" " "MappingMode: \"%s\"", vextent.cx, vextent.cy, wextent.cx, wextent.cy, vorigin.x, vorigin.y, - GdiModeToName(mapmode)); - Tcl_AppendResult(interp, msgbuf, NULL); + GdiModeToName(mapmode))); return TCL_OK; } @@ -2122,6 +2114,7 @@ static int GdiCopyBits( int hgt, wid; char *strend; long errcode; + int k; /* Variables to remember what we saw in the arguments. */ int do_window = 0; @@ -2163,91 +2156,91 @@ static int GdiCopyBits( * error. */ if ((GetDeviceCaps(dst, RASTERCAPS) & RC_BITBLT) == 0) { - printf(msgbuf, "Can't do bitmap operations on device context\n"); - Tcl_AppendResult(interp, msgbuf, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Can't do bitmap operations on device context\n")); return TCL_ERROR; } /* Loop through the remaining arguments. */ - { - int k; - for (k=1; k= 100.0) { - sprintf(msgbuf, "Unreasonable scale specification %s", argv[k]); - Tcl_AppendResult(interp, msgbuf, NULL); - return TCL_ERROR; - } - do_scale = 1; + if (scale <= 0.01 || scale >= 100.0) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Unreasonable scale specification %s", argv[k])); + return TCL_ERROR; } - } else if (strcmp(argv[k], "-noprint") == 0 - || strncmp(argv[k], "-calc", 5) == 0) { - /* This option suggested by Pascal Bouvier to get sizes without - * printing. */ - do_print = 0; + do_scale = 1; } + } else if (strcmp(argv[k], "-noprint") == 0 + || strncmp(argv[k], "-calc", 5) == 0) { + /* This option suggested by Pascal Bouvier to get sizes without + * printing. */ + do_print = 0; } } @@ -2408,8 +2401,8 @@ static int GdiCopyBits( GlobalUnlock(hDib); GlobalFree(hDib); ReleaseDC(hwnd,src); - sprintf(msgbuf, "StretchDIBits failed with code %ld", errcode); - Tcl_AppendResult(interp, msgbuf, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "StretchDIBits failed with code %ld", errcode)); return TCL_ERROR; } @@ -2424,9 +2417,8 @@ static int GdiCopyBits( * The return value should relate to the size in the destination space. * At least the height should be returned (for page layout purposes). */ - sprintf(msgbuf, "%d %d %d %d", dst_x, dst_y, dst_w, dst_h); - Tcl_AppendResult(interp, msgbuf, NULL); - + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%d %d %d %d", dst_x, dst_y, dst_w, dst_h)); return TCL_OK; } @@ -2786,13 +2778,11 @@ static int GdiMakePen( const char *cp; size_t i; char *dup = (char *)Tcl_Alloc(strlen(dashstyledata) + 1); - if (dup) { - /* TODO: always reachable */ - strcpy(dup, dashstyledata); - } + strcpy(dup, dashstyledata); /* DEBUG. */ - Tcl_AppendResult(interp,"DEBUG: Found a dash spec of |", - dashstyledata, "|\n", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "DEBUG: Found a dash spec of |%s|\n", + dashstyledata)); /* Parse the dash spec. */ if (isdigit(dashstyledata[0])) { @@ -2974,16 +2964,16 @@ static const SystemColorEntry sysColors[] = { {"ButtonText", COLOR_BTNTEXT}, {"CaptionText", COLOR_CAPTIONTEXT}, {"DisabledText", COLOR_GRAYTEXT}, - {"GrayText", COLOR_GRAYTEXT}, + {"GrayText", COLOR_GRAYTEXT}, {"Highlight", COLOR_HIGHLIGHT}, {"HighlightText", COLOR_HIGHLIGHTTEXT}, {"InactiveBorder", COLOR_INACTIVEBORDER}, {"InactiveCaption", COLOR_INACTIVECAPTION}, {"InactiveCaptionText", COLOR_INACTIVECAPTIONTEXT}, {"InfoBackground", COLOR_INFOBK}, - {"InfoText", COLOR_INFOTEXT}, + {"InfoText", COLOR_INFOTEXT}, {"Menu", COLOR_MENU}, - {"MenuText", COLOR_MENUTEXT}, + {"MenuText", COLOR_MENUTEXT}, {"Scrollbar", COLOR_SCROLLBAR}, {"Window", COLOR_WINDOW}, {"WindowFrame", COLOR_WINDOWFRAME}, @@ -3806,6 +3796,7 @@ static int GdiParseColor( const char *name, unsigned long *color) { + /* TODO: replace with XParseColor, used by rest of Tk */ if (name[0] == '#') { char fmt[40]; int i; -- cgit v0.12 From 6bf09eec7f9148f13d8263eb1dc56efa722a369d Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 11 Jul 2021 22:35:10 +0000 Subject: Fix variable error in print.tcl --- library/print.tcl | 1 + 1 file changed, 1 insertion(+) diff --git a/library/print.tcl b/library/print.tcl index 76a4a3a..305888e 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -701,6 +701,7 @@ namespace eval ::tk::print { variable choosepaper variable color variable p + variable zoomnumber _setprintenv -- cgit v0.12 From 450b760fec0469f2ede4aba2ad0a1482b2b7ff85 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 11 Jul 2021 23:34:48 +0000 Subject: Remove build error --- win/tkWinGDI.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 46445fd..f79af42 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1475,7 +1475,7 @@ static int GdiCharWidths( DWORD val = GetLastError(); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "::tk::print::_gdi character failed with code %ld", intstr)); + "::tk::print::_gdi character failed with code %ld", val)); if (made_font) { SelectObject(hDC, oldfont); DeleteObject(hfont); -- cgit v0.12 From e22af4d464243b47575c487d2c6e12e8f640bd31 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 12 Jul 2021 03:47:56 +0000 Subject: Add print to tk(n) man page; fix corrupted postscript export from macOS print dialog --- doc/tk.n | 10 ++++++++-- macosx/tkMacOSXPrint.c | 11 ++++++++--- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/doc/tk.n b/doc/tk.n index 18eb6a7..f6d0704 100644 --- a/doc/tk.n +++ b/doc/tk.n @@ -111,6 +111,12 @@ is undefined whether existing widgets will resize themselves dynamically to accommodate the new scaling factor. .RE .TP +\fBtk print \fIwindow\fR +. +The \fBtk print\fR command posts a dialog that allows users to print output +from the \fBcanvas\fR and \fBtext\fR widgets. The printing will be done using +platform-native APIs and dialogs where available. +.TP \fBtk sysnotify \fP \fItitle\fP? \fImessage\fP? . The \fBtk sysnotify\fP command creates a platform-specific system @@ -139,9 +145,9 @@ Returns the current Tk windowing system, one of \fBx11\fR (X11-based), \fBwin32\fR (MS Windows), or \fBaqua\fR (Mac OS X Aqua). .SH "SEE ALSO" -busy(n), fontchooser(n), send(n), sysnotify(n), systray(n), winfo(n) +busy(n), fontchooser(n), print(n), send(n), sysnotify(n), systray(n), winfo(n) .SH KEYWORDS -application name, send, sysnotify, systray +application name, print, send, sysnotify, systray '\" Local Variables: '\" mode: nroff '\" End: diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index 4ad40f2..bad105c 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -231,14 +231,15 @@ FinishPrint( NSString * sourcePath = (NSString * ) sourceFile; NSString * finalPath = (NSString * ) savePath; NSString * pathExtension = [finalPath pathExtension]; - + NSFileManager * fileManager = [NSFileManager defaultManager]; + NSError * error = nil; + /* * Is the target file a PDF? If so, copy print file * to output location. */ if ([pathExtension isEqualToString: @ "pdf"]) { - NSFileManager * fileManager = [NSFileManager defaultManager]; - NSError * error = nil; + /*Make sure no file conflict exists.*/ if ([fileManager fileExistsAtPath: finalPath]) { [fileManager removeItemAtPath: finalPath error: &error]; @@ -260,6 +261,10 @@ FinishPrint( char target[5012]; [sourcePath getCString: source maxLength: (sizeof source) encoding: NSUTF8StringEncoding]; [finalPath getCString: target maxLength: (sizeof target) encoding: NSUTF8StringEncoding]; + /*Make sure no file conflict exists.*/ + if ([fileManager fileExistsAtPath: finalPath]) { + [fileManager removeItemAtPath: finalPath error: &error]; + } /* * Fork and start new process with command string. Thanks to Peter da Silva -- cgit v0.12 From bc32d447cc32a54af55bb6dfeb42bba358cc070e Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 12 Jul 2021 03:53:34 +0000 Subject: Remove extraneous characters to ensure text matches message catalog --- library/print.tcl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 305888e..1edc334 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -750,7 +750,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.l -padx 5 -pady 5 pack $p.frame.copyframe.l -side top -fill x -expand no - label $p.frame.copyframe.l.copylabel -text [mc "Copies:"] + label $p.frame.copyframe.l.copylabel -text [mc "Copies"] spinbox $p.frame.copyframe.l.field -from 1 -to 1000 \ -textvariable [namespace which -variable printcopies] -width 5 @@ -762,7 +762,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.r -padx 5 -pady 5 pack $p.frame.copyframe.r -fill x -expand no - label $p.frame.copyframe.r.paper -text [mc "Paper:"] + label $p.frame.copyframe.r.paper -text [mc "Paper"] tk_optionMenu $p.frame.copyframe.r.menu \ [namespace which -variable choosepaper] \ {*}$paperlist @@ -776,7 +776,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.z -padx 5 -pady 5 pack $p.frame.copyframe.z -fill x -expand no - label $p.frame.copyframe.z.zlabel -text [mc "Scale %:"] + label $p.frame.copyframe.z.zlabel -text [mc "Scale"] tk_optionMenu $p.frame.copyframe.z.zentry \ [namespace which -variable zoomnumber] \ {*}$percentlist @@ -787,7 +787,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.orient -padx 5 -pady 5 pack $p.frame.copyframe.orient -fill x -expand no - label $p.frame.copyframe.orient.text -text [mc "Orientation:"] + label $p.frame.copyframe.orient.text -text [mc "Orientation"] radiobutton $p.frame.copyframe.orient.v -text [mc "Portrait"] \ -value portrait -compound left \ -variable [namespace which -variable printorientation] @@ -802,7 +802,7 @@ namespace eval ::tk::print { frame $p.frame.copyframe.c -padx 5 -pady 5 pack $p.frame.copyframe.c -fill x -expand no - label $p.frame.copyframe.c.l -text [mc "Output:"] + label $p.frame.copyframe.c.l -text [mc "Output"] tk_optionMenu $p.frame.copyframe.c.c \ [namespace which -variable color] \ {*}$colorlist -- cgit v0.12 From e94c58052e80a6675810ae948c48a297c33e1a30 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 12 Jul 2021 19:52:08 +0000 Subject: =?UTF-8?q?Remove=20compiler=20warning:=20./unix/tkUnix.c:=20In=20?= =?UTF-8?q?function=20=E2=80=98Tk=5FGetUserInactiveTime=E2=80=99:=20./unix?= =?UTF-8?q?/tkUnix.c:207:14:=20warning:=20unused=20parameter=20=E2=80=98dp?= =?UTF-8?q?y=E2=80=99=20[-Wunused-parameter]=20=20=20=20=20=20Display=20*d?= =?UTF-8?q?py)=20=20/*=20The=20display=20for=20which=20to=20query=20the=20?= =?UTF-8?q?inactive=20=20=20=20=20=20~~~~~~~~~^~~=20(This=20can=20be=20see?= =?UTF-8?q?n=20with=20the=20main=20branch).?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- unix/tkUnix.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/unix/tkUnix.c b/unix/tkUnix.c index 2de6e98..ed024d1 100644 --- a/unix/tkUnix.c +++ b/unix/tkUnix.c @@ -199,8 +199,12 @@ TkpBuildRegionFromAlphaData( long Tk_GetUserInactiveTime( - Display *dpy) /* The display for which to query the inactive + #ifdef HAVE_XSS + Display *dpy) /* The display for which to query the inactive * time. */ +#else + TCL_UNUSED(Display *)) +#endif /* HAVE_XSS */ { long inactiveTime = -1; #ifdef HAVE_XSS -- cgit v0.12 From 31d8e97bb4db55efe1e74fa77ad7174b24871de4 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 12 Jul 2021 20:40:37 +0000 Subject: Respect alphabetical order of commands in tk.n, and link to the 'print' man page. --- doc/tk.n | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/doc/tk.n b/doc/tk.n index f6d0704..03f9723 100644 --- a/doc/tk.n +++ b/doc/tk.n @@ -86,6 +86,13 @@ error if tried. Controls the Tk font selection dialog. For more details see the \fBfontchooser\fR manual page. .TP +\fBtk print \fIwindow\fR +. +The \fBtk print\fR command posts a dialog that allows users to print output +from the \fBcanvas\fR and \fBtext\fR widgets. The printing will be done using +platform-native APIs and dialogs where available. For more details see the +\fBprint\fR manual page. +.TP \fBtk scaling \fR?\fB\-displayof \fIwindow\fR? ?\fInumber\fR? . Sets and queries the current scaling factor used by Tk to convert between @@ -111,12 +118,6 @@ is undefined whether existing widgets will resize themselves dynamically to accommodate the new scaling factor. .RE .TP -\fBtk print \fIwindow\fR -. -The \fBtk print\fR command posts a dialog that allows users to print output -from the \fBcanvas\fR and \fBtext\fR widgets. The printing will be done using -platform-native APIs and dialogs where available. -.TP \fBtk sysnotify \fP \fItitle\fP? \fImessage\fP? . The \fBtk sysnotify\fP command creates a platform-specific system -- cgit v0.12 From 8c375579e5fc04ab7ae7638228a52f971819097e Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 12 Jul 2021 20:41:25 +0000 Subject: Fix typos in tk.n --- doc/tk.n | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/tk.n b/doc/tk.n index 18eb6a7..74afcbf 100644 --- a/doc/tk.n +++ b/doc/tk.n @@ -116,12 +116,12 @@ accommodate the new scaling factor. The \fBtk sysnotify\fP command creates a platform-specific system notification alert. Its intent is to provide a brief, unobtrusive notification to the user by popping up a window that briefly appears in a -corner of the screen. For more details see the see the \fBsysnotify\fR manual page. +corner of the screen. For more details see the \fBsysnotify\fR manual page. .TP \fBtk systray create\fP \fIsubcommand...\fP . The \fBtk systray\fP command creates an icon in the platform-specific -tray. For more details see the see the \fBsystray\fR manual page. +tray. For more details see the \fBsystray\fR manual page. .TP \fBtk useinputmethods \fR?\fB\-displayof \fIwindow\fR? ?\fIboolean\fR? . -- cgit v0.12 From 45407c25f416e38c345a4a2cc57c50b49ca353fb Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 12 Jul 2021 20:56:33 +0000 Subject: Remove extraneous characters to ensure text matches message catalog (same as [52d1d59b]). --- library/print.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/print.tcl b/library/print.tcl index 1edc334..ef0399d 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -721,7 +721,7 @@ namespace eval ::tk::print { frame $p.frame.printframe -padx 5 -pady 5 pack $p.frame.printframe -side top -fill x -expand no - label $p.frame.printframe.printlabel -text [mc "Printer:"] + label $p.frame.printframe.printlabel -text [mc "Printer"] ttk::combobox $p.frame.printframe.mb \ -textvariable [namespace which -variable chooseprinter] \ -state readonly -values [lsort -unique $printlist] -- cgit v0.12 From cb41feaf446ee24af2edd10f5ed44439ede30238 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 13 Jul 2021 02:44:49 +0000 Subject: Possible fix for crash after print cancel button on win; additional error testing on X11 --- library/print.tcl | 24 +++++++++++++++++++++--- win/tkWinGDI.c | 10 +++++++++- 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index ef0399d..7ee7146 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -60,6 +60,9 @@ namespace eval ::tk::print { variable dpi_y variable copies + set printer_name "" + puts "selecting prnter" + #First, we select the printer. _selectprinter @@ -94,8 +97,13 @@ namespace eval ::tk::print { # font - Font for printing proc _print_data {data {breaklines 1} {font ""}} { variable printargs - + variable printer_name + + set printer_name "" _set_dc + if {$printer_name eq ""} { + return + } if {$font eq ""} { _gdi characters $printargs(hDC) -array printcharwid @@ -246,9 +254,14 @@ namespace eval ::tk::print { proc _print_widget {wid {printer default} {name "Tk Print Output"}} { variable printargs + variable printer_name - _set_dc - + set printer_name "" + _set_dc + if {$printer_name eq ""} { + return + } + _opendoc _openpage @@ -669,6 +682,11 @@ namespace eval ::tk::print { for your system." return } + set notfound "No destinations added" + if {[string first $notfound $msg] != -1} { + error "Please check or update your CUPS installation." + return + } # Select print command. We prefer lpr, but will fall back to lp if # necessary. diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index f79af42..1b95eff 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4781,8 +4781,15 @@ static int PrintSelectPrinter( pd.lStructSize = sizeof(pd); pd.hwndOwner = GetDesktopWindow(); pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; - + + /* Handle user cancellation. */ + if (PrintDlgW(&pd) == 0){ + Tcl_AppendResult(interp, "User cancelled", NULL); + return TCL_OK; + } + if (PrintDlgW(&pd) == TRUE) { + /*Get document info.*/ ZeroMemory(&di, sizeof(di)); di.cbSize = sizeof(di); @@ -4814,6 +4821,7 @@ static int PrintSelectPrinter( localDevmode = NULL; } } + if (pd.hDevMode != NULL) { GlobalFree(pd.hDevMode); } -- cgit v0.12 From 53881f906ac49f98ad4dc1061eac424f55fde3af Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 14 Jul 2021 02:23:18 +0000 Subject: Remove debugging statement --- library/print.tcl | 1 - 1 file changed, 1 deletion(-) diff --git a/library/print.tcl b/library/print.tcl index 7ee7146..e7a5de6 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -61,7 +61,6 @@ namespace eval ::tk::print { variable copies set printer_name "" - puts "selecting prnter" #First, we select the printer. _selectprinter -- cgit v0.12 From 339b9903f1039dc566f9661f8f3ef6597a6ca244 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 14 Jul 2021 07:50:36 +0000 Subject: Rewrite to use an actual ensemble instead of a homebrew version. --- win/tkWinGDI.c | 209 +++++++++++++++++++++++--------------------------------- win/tkWinInit.c | 1 - win/tkWinInt.h | 7 -- 3 files changed, 85 insertions(+), 132 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 1b95eff..9f04187 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -38,10 +38,6 @@ typedef BOOL WINAPI (*DrawFunc) ( HDC, int, int, int, int, int, int, int, int); /* Arc, Chord, Pie. */ #endif -/* Main dispatcher for commands. */ -static int TkWinGDI(ClientData clientData, Tcl_Interp *interp, - int argc, const char **argv); - /* Real functions. */ static int GdiArc(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); @@ -127,11 +123,6 @@ static int PrintClosePage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -static const char gdi_usage_message[] = - "::tk::print::_gdi [arc|characters|copybits|line|map|oval|" - "photo|polygon|rectangle|text|version]\n" - "\thdc parameters can be generated by the printer extension"; - /* * Global state. */ @@ -170,45 +161,6 @@ static const struct gdi_command { /* *---------------------------------------------------------------------- * - * TkWinGDI -- - * - * Top-level routine for the ::tk::print::_gdi command. - * - * Results: - * It strips off the first two words of the command (::tk::print::_gdi - * subcommand) and dispatches to a subcommand implementation. - * - *---------------------------------------------------------------------- - */ - -static int TkWinGDI( - ClientData clientData, - Tcl_Interp *interp, - int argc, - const char **argv) -{ - size_t i; - static const size_t numCommands = - sizeof(gdi_commands) / sizeof(struct gdi_command); - - /* EXACT command name check? REALLY? */ - - if (argc > 1 && strcmp(argv[0], "::tk::print::_gdi") == 0) { - for (i=0; i= 2) { if (strcmp(argv[0], "-extent") == 0) { extent = atof(argv[1]); @@ -379,7 +331,8 @@ static int GdiBitmap( TCL_UNUSED(int), TCL_UNUSED(const char **)) { - static const char usage_message[] = "::tk::print::_gdi bitmap hdc x y " + static const char usage_message[] = + "::tk::print::_gdi bitmap hdc x y " "-anchor [center|n|e|s|w] -background color " "-bitmap bitmap -foreground color\n" "Not implemented yet. Sorry!"; @@ -471,7 +424,7 @@ static int GdiPhoto( */ /* HDC is required. */ - if (argc < 1) { + if (argc < 2) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } @@ -486,12 +439,12 @@ static int GdiPhoto( if ((GetDeviceCaps(dst, RASTERCAPS) & RC_STRETCHDIB) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "::tk::print::_gdi photo not supported on device context (0x%s)", - argv[0])); + argv[1])); return TCL_ERROR; } /* Parse the command line arguments. */ - for (j = 1; j < argc; j++) { + for (j = 2; j < argc; j++) { if (strcmp(argv[j], "-destination") == 0) { double x, y, w, h; int count = 0; @@ -742,23 +695,24 @@ static int GdiLine( arrowshape[2] = 3; /* Verrrrrry simple for now.... */ - if (argc < 5) { + if (argc < 6) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } hDC = printDC; - if ((polypoints = (POINT *) Tcl_AttemptAlloc(argc * sizeof(POINT))) == 0) { + polypoints = (POINT *) Tcl_AttemptAlloc((argc - 1) * sizeof(POINT)); + if (polypoints == 0) { Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); return TCL_ERROR; } - polypoints[0].x = atol(argv[1]); - polypoints[0].y = atol(argv[2]); - polypoints[1].x = atol(argv[3]); - polypoints[1].y = atol(argv[4]); - argc -= 5; - argv += 5; + polypoints[0].x = atol(argv[2]); + polypoints[0].y = atol(argv[3]); + polypoints[1].x = atol(argv[4]); + polypoints[1].y = atol(argv[5]); + argc -= 6; + argv += 6; npoly = 2; while (argc >= 2) { @@ -1018,17 +972,17 @@ static int GdiOval( const char *dashdata = 0; /* Verrrrrry simple for now.... */ - if (argc < 5) { + if (argc < 6) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } hDC = printDC; - x1 = atol(argv[1]); - y1 = atol(argv[2]); - x2 = atol(argv[3]); - y2 = atol(argv[4]); + x1 = atol(argv[2]); + y1 = atol(argv[3]); + x2 = atol(argv[4]); + y2 = atol(argv[5]); if (x1 > x2) { int x3 = x1; x1 = x2; @@ -1039,8 +993,8 @@ static int GdiOval( y1 = y2; y2 = y3; } - argc -= 5; - argv += 5; + argc -= 6; + argv += 6; while (argc > 0) { /* Now handle any other arguments that occur. */ @@ -1140,24 +1094,25 @@ static int GdiPolygon( const char *dashdata = 0; /* Verrrrrry simple for now.... */ - if (argc < 5) { + if (argc < 6) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } hDC = printDC; - if ((polypoints = (POINT *) Tcl_AttemptAlloc(argc * sizeof(POINT))) == 0) { + polypoints = (POINT *) Tcl_AttemptAlloc((argc - 1) * sizeof(POINT)); + if (polypoints == 0) { /* TODO: unreachable */ Tcl_AppendResult(interp, "Out of memory in GdiLine", NULL); return TCL_ERROR; } - polypoints[0].x = atol(argv[1]); - polypoints[0].y = atol(argv[2]); - polypoints[1].x = atol(argv[3]); - polypoints[1].y = atol(argv[4]); - argc -= 5; - argv += 5; + polypoints[0].x = atol(argv[2]); + polypoints[0].y = atol(argv[3]); + polypoints[1].x = atol(argv[4]); + polypoints[1].y = atol(argv[5]); + argc -= 6; + argv += 6; npoly = 2; while (argc >= 2) { @@ -1304,17 +1259,17 @@ static int GdiRectangle( const char *dashdata = 0; /* Verrrrrry simple for now.... */ - if (argc < 5) { + if (argc < 6) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } hDC = printDC; - x1 = atol(argv[1]); - y1 = atol(argv[2]); - x2 = atol(argv[3]); - y2 = atol(argv[4]); + x1 = atol(argv[2]); + y1 = atol(argv[3]); + x2 = atol(argv[4]); + y2 = atol(argv[5]); if (x1 > x2) { int x3 = x1; x1 = x2; @@ -1325,8 +1280,8 @@ static int GdiRectangle( y1 = y2; y2 = y3; } - argc -= 5; - argv += 5; + argc -= 6; + argv += 6; /* Now handle any other arguments that occur. */ while (argc > 1) { @@ -1429,15 +1384,15 @@ static int GdiCharWidths( int widths[256]; int retval; - if (argc < 1) { + if (argc < 2) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } hDC = printDC; - argc--; - argv++; + argc -= 2; + argv += 2; while (argc > 0) { if (strcmp(argv[0], "-font") == 0) { @@ -1564,10 +1519,10 @@ int GdiText( hDC = printDC; - x = atol(argv[1]); - y = atol(argv[2]); - argc -= 3; - argv += 3; + x = atol(argv[2]); + y = atol(argv[3]); + argc -= 4; + argv += 4; sizerect.left = sizerect.right = x; sizerect.top = sizerect.bottom = y; @@ -1904,7 +1859,8 @@ static int GdiMap( int argc, const char **argv) { - static const char usage_message[] = "::tk::print::_gdi map hdc " + static const char usage_message[] = + "::tk::print::_gdi map hdc " "[-logical x[y]] [-physical x[y]] " "[-offset {x y} ] [-default] [-mode mode]"; HDC hdc; @@ -1924,7 +1880,7 @@ static int GdiMap( int use_mode = 0; /* Required parameter: HDC for printer. */ - if (argc < 1) { + if (argc < 2) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } @@ -1938,7 +1894,7 @@ static int GdiMap( } /* Parse remaining arguments. */ - for (argno = 1; argno < argc; argno++) { + for (argno = 2; argno < argc; argno++) { if (strcmp(argv[argno], "-default") == 0) { vextent.cx = vextent.cy = wextent.cx = wextent.cy = 1; vorigin.x = vorigin.y = worigin.x = worigin.y = 0; @@ -1970,6 +1926,7 @@ static int GdiMap( need_usage = 1; } else { int count; + argno++; /* In "real-life", this should parse units as well.. */ if ((count = sscanf(argv[argno], "%ld%ld", @@ -2144,7 +2101,7 @@ static int GdiCopyBits( * Parse the arguments. */ /* HDC is required. */ - if (argc < 1) { + if (argc < 2) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; } @@ -2162,7 +2119,7 @@ static int GdiCopyBits( } /* Loop through the remaining arguments. */ - for (k=1; k Date: Wed, 14 Jul 2021 14:01:46 +0000 Subject: Since localPrinterName is in UTF-16, but varlink1 is UTF-8 ... --- win/tkWinGDI.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 1b95eff..2098cf9 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4831,10 +4831,10 @@ static int PrintSelectPrinter( * script level. */ - WCHAR *varlink1 = (WCHAR *) Tcl_Alloc(100 * sizeof(char)); - WCHAR **varlink2 = (WCHAR **) Tcl_Alloc(sizeof(char *)); + char *varlink1 = (char *) Tcl_Alloc(100 * sizeof(char)); + char **varlink2 = (char **) Tcl_Alloc(sizeof(char *)); *varlink2 = varlink1; - wcscpy(varlink1, localPrinterName); + WideCharToMultiByte(CP_UTF8, 0, localPrinterName, -1, varlink1, 0, NULL, NULL); Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); -- cgit v0.12 From 58c629a953ccf1bdfee92168437500af882db671 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 16 Jul 2021 02:26:14 +0000 Subject: Remove unneeded variable calls; printing still crashes on Windows --- library/print.tcl | 2 -- 1 file changed, 2 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index e7a5de6..2a48ae4 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -98,7 +98,6 @@ namespace eval ::tk::print { variable printargs variable printer_name - set printer_name "" _set_dc if {$printer_name eq ""} { return @@ -255,7 +254,6 @@ namespace eval ::tk::print { variable printargs variable printer_name - set printer_name "" _set_dc if {$printer_name eq ""} { return -- cgit v0.12 From 5ede6b1a0a14c0e48b7962c46b01b613b4dc4e04 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 16 Jul 2021 11:23:05 +0000 Subject: Fix [037113a38b]: man tk_library refers erroneously to tcl_library (+ link) --- doc/tkvars.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/tkvars.n b/doc/tkvars.n index 4a45868..0d43ee8 100644 --- a/doc/tkvars.n +++ b/doc/tkvars.n @@ -24,7 +24,7 @@ of Tcl scripts related to Tk. These scripts include an initialization file that is normally processed whenever a Tk application starts up, plus other files containing procedures that implement default behaviors for widgets. -The initial value of \fBtcl_library\fR is set when Tk is added to +The initial value of \fBtk_library\fR is set when Tk is added to an interpreter; this is done by searching several different directories until one is found that contains an appropriate Tk startup script. If the \fBTK_LIBRARY\fR environment variable exists, then -- cgit v0.12 From 99b414dc4f744477535b71bbcaf8579d832770ee Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 16 Jul 2021 12:01:21 +0000 Subject: Install Msys2 the same way as Tcl does --- .github/workflows/win-build.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index 01fb4bf..cf4e2bf 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -25,8 +25,8 @@ jobs: repository: tcltk/tcl ref: core-8-5-branch path: tcl - - name: Install MSYS2, Make - run: choco install -y msys2 make + - name: Install MSYS2 + uses: msys2/setup-msys2@v2 - name: Prepare run: | touch tkStubInit.c -- cgit v0.12 From b91a3f0f691699de82d3375efce84e7666ac4135 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 16 Jul 2021 13:57:56 +0000 Subject: Use msys2 shell in msys environment --- .github/workflows/win-build.yml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index cf4e2bf..442bb1b 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -7,7 +7,7 @@ jobs: runs-on: windows-2019 defaults: run: - shell: bash + shell: msys2 {0} working-directory: win strategy: matrix: @@ -15,8 +15,9 @@ jobs: - "no" - "mem" - "all" - # Using powershell means we need to explicitly stop on failure steps: + - name: Install MSYS2 + uses: msys2/setup-msys2@v2 - name: Checkout uses: actions/checkout@v2 - name: Checkout @@ -25,8 +26,6 @@ jobs: repository: tcltk/tcl ref: core-8-5-branch path: tcl - - name: Install MSYS2 - uses: msys2/setup-msys2@v2 - name: Prepare run: | touch tkStubInit.c -- cgit v0.12 From 7ee5c782b63ec8f260d67820e7869bc22e7ffbcb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 17 Jul 2021 11:24:44 +0000 Subject: Undo part of previous commit: msys2 shell behaves different from bash --- .github/workflows/win-build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index 442bb1b..fa1e2ca 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -7,7 +7,7 @@ jobs: runs-on: windows-2019 defaults: run: - shell: msys2 {0} + shell: bash working-directory: win strategy: matrix: -- cgit v0.12 From 32fed8653b8f1bcab10f4c09b89683b9e95e1528 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 19 Jul 2021 10:15:19 +0000 Subject: Install "zip" with (msys2) pacman, not with choco --- .github/workflows/onefiledist.yml | 7 ++++--- .github/workflows/win-build.yml | 7 ++++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 0fbbc4b..45cb587 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -153,15 +153,16 @@ jobs: runs-on: windows-latest defaults: run: - shell: bash + shell: msys2 {0} env: CC: gcc CFGOPT: --disable-symbols --disable-shared steps: - name: Install MSYS2 uses: msys2/setup-msys2@v2 - - name: Install Zip - run: choco install -y zip + with: + msystem: MINGW64 + install: git mingw-w64-x86_64-toolchain zip - name: Checkout Tk uses: actions/checkout@v2 with: diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index e36f916..1cdf3e7 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -87,7 +87,7 @@ jobs: runs-on: windows-2019 defaults: run: - shell: bash + shell: msys2 {0} working-directory: win strategy: matrix: @@ -98,8 +98,9 @@ jobs: steps: - name: Install MSYS2 uses: msys2/setup-msys2@v2 - - name: Install Zip - run: choco install -y zip + with: + msystem: MINGW64 + install: git mingw-w64-x86_64-toolchain zip - name: Checkout uses: actions/checkout@v2 - name: Checkout -- cgit v0.12 From 175e04365c74098154d0c9f5d15aac7e28c20a35 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 19 Jul 2021 10:31:01 +0000 Subject: (just to be sure) install msys "make" as well --- .github/workflows/onefiledist.yml | 2 +- .github/workflows/win-build.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 45cb587..70e9379 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -162,7 +162,7 @@ jobs: uses: msys2/setup-msys2@v2 with: msystem: MINGW64 - install: git mingw-w64-x86_64-toolchain zip + install: git mingw-w64-x86_64-toolchain make zip - name: Checkout Tk uses: actions/checkout@v2 with: diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index 1cdf3e7..8968f5d 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -100,7 +100,7 @@ jobs: uses: msys2/setup-msys2@v2 with: msystem: MINGW64 - install: git mingw-w64-x86_64-toolchain zip + install: git mingw-w64-x86_64-toolchain make zip - name: Checkout uses: actions/checkout@v2 - name: Checkout -- cgit v0.12 From 2663ec07e3687fa6a29ecda78ef1cfe984eddd75 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 19 Jul 2021 12:23:07 +0000 Subject: Display print dialog only once, not twice --- library/print.tcl | 9 ++------- win/tkWinGDI.c | 6 ------ 2 files changed, 2 insertions(+), 13 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 2a48ae4..51b91c1 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -59,20 +59,14 @@ namespace eval ::tk::print { variable dpi_x variable dpi_y variable copies - - set printer_name "" #First, we select the printer. _selectprinter - if {$printer_name eq ""} { - #they pressed cancel - return - } - #Next, set values. Some are taken from the printer, #some are sane defaults. + if {[info exists printer_name] && $printer_name ne ""} { set printargs(hDC) $printer_name set printargs(pw) $paper_width set printargs(pl) $paper_height @@ -84,6 +78,7 @@ namespace eval ::tk::print { set printargs(resy) $dpi_y set printargs(copies) $copies set printargs(resolution) [list $dpi_x $dpi_y] + } } # _print_data diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 36514b8..a82fcbd 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -4744,12 +4744,6 @@ static int PrintSelectPrinter( pd.hwndOwner = GetDesktopWindow(); pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; - /* Handle user cancellation. */ - if (PrintDlgW(&pd) == 0){ - Tcl_AppendResult(interp, "User cancelled", NULL); - return TCL_OK; - } - if (PrintDlgW(&pd) == TRUE) { /*Get document info.*/ -- cgit v0.12 From 39058b45d900d028f4285df26b7e021f16b6993f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Jul 2021 07:59:21 +0000 Subject: Undo Unicode handling in GDI: Makes debugging easier, Can be re-applied when other things work --- win/tkWinGDI.c | 75 +++++++++++++++++++++++++--------------------------------- 1 file changed, 32 insertions(+), 43 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 2098cf9..ee9d6ef 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -78,7 +78,7 @@ static int TkGdiMakeBezierCurve(Tk_Canvas, double *, int, int, * Helper functions. */ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, - LOGFONTW *lf, HDC hDC); + LOGFONT *lf, HDC hDC); static int GdiMakePen(Tcl_Interp *interp, int width, int dashstyle, const char *dashstyledata, int capstyle, int joinstyle, @@ -106,7 +106,7 @@ static int PalEntriesOnDevice(HDC hDC); static HPALETTE GetSystemPalette(void); static void GetDisplaySize(LONG *width, LONG *height); static int GdiWordToWeight(const char *str); -static int GdiParseFontWords(Tcl_Interp *interp, LOGFONTW *lf, +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, const char *str[], int numargs); static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, @@ -136,9 +136,9 @@ static const char gdi_usage_message[] = * Global state. */ -static PRINTDLGW pd; -static DOCINFOW di; -static WCHAR *localPrinterName = NULL; +static PRINTDLG pd; +static DOCINFO di; +static const char *localPrinterName = NULL; static int copies, paper_width, paper_height, dpi_x, dpi_y; static LPDEVNAMES devnames; static HDC printDC; @@ -1421,7 +1421,7 @@ static int GdiCharWidths( */ HDC hDC; - LOGFONTW lf; + LOGFONT lf; HFONT hfont, oldfont; int made_font = 0; const char *aryvarname = "GdiCharWidths"; @@ -1444,7 +1444,7 @@ static int GdiCharWidths( argc--; argv++; if (GdiMakeLogFont(interp, argv[0], &lf, hDC)) { - if ((hfont = CreateFontIndirectW(&lf)) != NULL) { + if ((hfont = CreateFontIndirect(&lf)) != NULL) { made_font = 1; oldfont = SelectObject(hDC, hfont); } @@ -1462,8 +1462,8 @@ static int GdiCharWidths( } /* Now, get the widths using the correct function for font type. */ - if ((retval = GetCharWidth32W(hDC, 0, 255, widths)) == FALSE) { - retval = GetCharWidthW(hDC, 0, 255, widths); + if ((retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE) { + retval = GetCharWidth(hDC, 0, 255, widths); } /* @@ -1539,7 +1539,7 @@ int GdiText( RECT sizerect; UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas. */ Tk_Anchor anchor = 0; - LOGFONTW lf; + LOGFONT lf; HFONT hfont, oldfont; int made_font = 0; int retval; @@ -1601,7 +1601,7 @@ int GdiText( argc--; argv++; if (GdiMakeLogFont(interp, argv[0], &lf, hDC)) { - if ((hfont = CreateFontIndirectW(&lf)) != NULL) { + if ((hfont = CreateFontIndirect(&lf)) != NULL) { made_font = 1; oldfont = SelectObject(hDC, hfont); } @@ -2503,7 +2503,7 @@ static int DIBNumColors( static int GdiParseFontWords( TCL_UNUSED(Tcl_Interp *), - LOGFONTW *lf, + LOGFONT *lf, const char *str[], int numargs) { @@ -2600,7 +2600,7 @@ static int GdiWordToWeight( static int GdiMakeLogFont( Tcl_Interp *interp, const char *str, - LOGFONTW *lf, + LOGFONT *lf, HDC hDC) { const char **list; @@ -2622,12 +2622,7 @@ static int GdiMakeLogFont( /* Now we have the font structure broken into name, size, weight. */ if (count >= 1) { - Tcl_DString ds; - - Tcl_DStringInit(&ds); - wcsncpy(lf->lfFaceName, Tcl_UtfToWCharDString(list[0], -1, &ds), - sizeof(lf->lfFaceName) - 1); - Tcl_DStringFree(&ds); + strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); } else { return 0; } @@ -4004,7 +3999,7 @@ static void GetDisplaySize( { HDC hDC; - hDC = CreateDCW(L"DISPLAY", 0, 0, 0); + hDC = CreateDC("DISPLAY", 0, 0, 0); *width = GetDeviceCaps(hDC, HORZRES); *height = GetDeviceCaps(hDC, VERTRES); DeleteDC(hDC); @@ -4043,7 +4038,7 @@ static HBITMAP CopyScreenToBitmap( * DC. */ - hScrDC = CreateDCW(L"DISPLAY", NULL, NULL, NULL); + hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL); hMemDC = CreateCompatibleDC(hScrDC); /* Get points of rectangle to grab. */ @@ -4136,7 +4131,7 @@ static HANDLE BitmapToDIB( /* Fill in BITMAP structure, return NULL if it didn't work. */ - if (!GetObjectW(hBitmap, sizeof(bm), (LPWSTR)&bm)) { + if (!GetObject(hBitmap, sizeof(bm), (LPSTR)&bm)) { return NULL; } @@ -4762,9 +4757,9 @@ static int PrintSelectPrinter( int argc, Tcl_Obj *const objv[]) { - LPCWSTR printerName = NULL; - PDEVMODEW returnedDevmode = NULL; - PDEVMODEW localDevmode = NULL; + LPCSTR printerName = NULL; + PDEVMODE returnedDevmode = NULL; + PDEVMODE localDevmode = NULL; (void) clientData; (void) argc; (void) objv; @@ -4783,23 +4778,23 @@ static int PrintSelectPrinter( pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; /* Handle user cancellation. */ - if (PrintDlgW(&pd) == 0){ + if (PrintDlg(&pd) == 0){ Tcl_AppendResult(interp, "User cancelled", NULL); return TCL_OK; } - if (PrintDlgW(&pd) == TRUE) { + if (PrintDlg(&pd) == TRUE) { /*Get document info.*/ ZeroMemory(&di, sizeof(di)); di.cbSize = sizeof(di); - di.lpszDocName = L"Tk Print Output"; + di.lpszDocName = "Tk Print Output"; /* Copy print attributes to local structure. */ - returnedDevmode = (PDEVMODEW) GlobalLock(pd.hDevMode); + returnedDevmode = (PDEVMODE) GlobalLock(pd.hDevMode); devnames = (LPDEVNAMES) GlobalLock(pd.hDevNames); - printerName = (LPCWSTR) devnames + devnames->wDeviceOffset; - localDevmode = (LPDEVMODEW) HeapAlloc(GetProcessHeap(), + printerName = (LPCSTR) devnames + devnames->wDeviceOffset; + localDevmode = (LPDEVMODE) HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); @@ -4808,7 +4803,7 @@ static int PrintSelectPrinter( returnedDevmode->dmSize); /* Get values from user-set and built-in properties. */ - localPrinterName = localDevmode->dmDeviceName; + localPrinterName = (LPCSTR)localDevmode->dmDeviceName; dpi_y = localDevmode->dmYResolution; dpi_x = localDevmode->dmPrintQuality; /* Convert height and width to logical points. */ @@ -4816,7 +4811,7 @@ static int PrintSelectPrinter( paper_width = (int) localDevmode->dmPaperWidth / 0.254; copies = pd.nCopies; /* Set device context here for all GDI printing operations. */ - printDC = CreateDCW(L"WINSPOOL", printerName, NULL, localDevmode); + printDC = CreateDC("WINSPOOL", printerName, NULL, localDevmode); } else { localDevmode = NULL; } @@ -4834,7 +4829,7 @@ static int PrintSelectPrinter( char *varlink1 = (char *) Tcl_Alloc(100 * sizeof(char)); char **varlink2 = (char **) Tcl_Alloc(sizeof(char *)); *varlink2 = varlink1; - WideCharToMultiByte(CP_UTF8, 0, localPrinterName, -1, varlink1, 0, NULL, NULL); + strcpy (varlink1, localPrinterName); Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); @@ -4871,8 +4866,6 @@ int PrintOpenPrinter( int argc, Tcl_Obj *const objv[]) { - Tcl_DString ds; - if (argc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "printer"); return TCL_ERROR; @@ -4883,22 +4876,18 @@ int PrintOpenPrinter( return TCL_ERROR; } - const char *printer = Tcl_GetString(objv[1]); + char *printer = Tcl_GetString(objv[1]); if (printDC == NULL) { Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } - Tcl_DStringInit(&ds); - if ((OpenPrinterW(Tcl_UtfToWCharDString(printer, -1, &ds), - (LPHANDLE)&printDC, NULL)) == FALSE) { + if ((OpenPrinter(printer, (LPHANDLE)&printDC, NULL)) == FALSE) { Tcl_AppendResult(interp, "unable to open printer", NULL); - Tcl_DStringFree(&ds); return TCL_ERROR; } - Tcl_DStringFree(&ds); return TCL_OK; } @@ -4968,7 +4957,7 @@ int PrintOpenDoc( /* * Start printing. */ - output = StartDocW(printDC, &di); + output = StartDoc(printDC, &di); if (output <= 0) { Tcl_AppendResult(interp, "unable to start document", NULL); return TCL_ERROR; -- cgit v0.12 From 01df63a089f721d2c8f657456204bb361adf97a8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Jul 2021 08:00:28 +0000 Subject: printer_name cannot be set, because linked variable is read-only --- library/print.tcl | 4 ---- 1 file changed, 4 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index e7a5de6..35ea4d1 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -60,8 +60,6 @@ namespace eval ::tk::print { variable dpi_y variable copies - set printer_name "" - #First, we select the printer. _selectprinter @@ -98,7 +96,6 @@ namespace eval ::tk::print { variable printargs variable printer_name - set printer_name "" _set_dc if {$printer_name eq ""} { return @@ -255,7 +252,6 @@ namespace eval ::tk::print { variable printargs variable printer_name - set printer_name "" _set_dc if {$printer_name eq ""} { return -- cgit v0.12 From f7eff98cc0929a9f6021a05da7153a912dedbc9d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Jul 2021 09:38:19 +0000 Subject: Use Tcl_UtfToWCharDString() in stead of Tcl_UtfToUniCharDString(), otherwise it won't work with Tcl 9. --- win/tkWinGDI.c | 39 +++++++-------------------------------- 1 file changed, 7 insertions(+), 32 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index ee9d6ef..7c3f437 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1530,8 +1530,7 @@ int GdiText( "-fill color -font fontname " "-justify [left|right|center] " "-stipple bitmap -text string -width linelen " - "-single -backfill" - "-encoding [input encoding] -unicode"; + "-single -backfill"; HDC hDC; int x, y; @@ -1548,12 +1547,8 @@ int GdiText( int bgmode; COLORREF textcolor = 0; int usesingle = 0; - const char *encoding_name = "utf-8"; - TCHAR *ostring; Tcl_DString tds; - Tcl_Encoding encoding = NULL; - int tds_len; if (argc < 4) { Tcl_AppendResult(interp, usage_message, NULL); @@ -1630,26 +1625,12 @@ int GdiText( usesingle = 1; } else if (strcmp(argv[0], "-backfill") == 0) { dobgmode = 1; - } else if (strcmp(argv[0], "-encoding") == 0) { - argc--; - argv++; - if (argc > 0) { - encoding_name = argv[0]; - } } argc--; argv++; } - /* Handle the encoding, if present. */ - if (encoding_name != 0) { - Tcl_Encoding tmp_encoding = Tcl_GetEncoding(interp,encoding_name); - if (tmp_encoding != NULL) { - encoding = tmp_encoding; - } - } - if (string == 0) { Tcl_AppendResult(interp, usage_message, NULL); return TCL_ERROR; @@ -1662,18 +1643,12 @@ int GdiText( format_flags &= ~DT_WORDBREAK; } - /* Calculate the rectangle. */ - Tcl_DStringInit(&tds); - Tcl_UtfToExternalDString(encoding, string, -1, &tds); - ostring = Tcl_DStringValue(&tds); - tds_len = Tcl_DStringLength(&tds); - - /* Just for fun, let's try translating ostring to Unicode. */ - Tcl_UniChar *ustring; + /* Just for fun, let's try translating string to Unicode. */ + WCHAR *wstring; Tcl_DString tds2; Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - DrawTextW(hDC, (LPWSTR)ustring, Tcl_DStringLength(&tds2)/2, &sizerect, + wstring = Tcl_UtfToWCharDString(string, -1, &tds2); + DrawTextW(hDC, wstring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); Tcl_DStringFree(&tds2); @@ -1729,8 +1704,8 @@ int GdiText( /* Print the text. */ Tcl_DStringInit(&tds2); - ustring = Tcl_UtfToUniCharDString(ostring, tds_len, &tds2); - retval = DrawTextW(hDC, (LPWSTR) ustring, + wstring = Tcl_UtfToWCharDString(string, -1, &tds2); + retval = DrawTextW(hDC, wstring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); Tcl_DStringFree(&tds2); Tcl_DStringFree(&tds); -- cgit v0.12 From faddfd9d6fa67962d5a02a743d4455835b989b5f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Jul 2021 15:17:00 +0000 Subject: (redo) start to use msys2 shell: If the right tools are installed, it works --- .github/workflows/win-build.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index fa1e2ca..a5c6102 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -7,7 +7,7 @@ jobs: runs-on: windows-2019 defaults: run: - shell: bash + shell: msys2 {0} working-directory: win strategy: matrix: @@ -18,6 +18,9 @@ jobs: steps: - name: Install MSYS2 uses: msys2/setup-msys2@v2 + with: + msystem: MINGW64 + install: git mingw-w64-x86_64-toolchain make - name: Checkout uses: actions/checkout@v2 - name: Checkout -- cgit v0.12 From 3ad5088090ff34851f7cb29e0dffd9946a1c88f1 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 21 Jul 2021 13:23:33 +0000 Subject: Canvas printing now works again on Windows without crashing; discuss updates with Jan --- win/tkWinGDI.c | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index dec8224..ba6faa3 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1502,7 +1502,8 @@ int GdiText( int bgmode; COLORREF textcolor = 0; int usesingle = 0; - + TCHAR *ostring; + int tds_len; Tcl_DString tds; if (argc < 4) { @@ -1598,14 +1599,25 @@ int GdiText( format_flags &= ~DT_WORDBREAK; } - /* Just for fun, let's try translating string to Unicode. */ - WCHAR *wstring; + + #if 0 + /* Just for fun, let's try translating string to Unicode. */ + WCHAR *wstring; Tcl_DString tds2; Tcl_DStringInit(&tds2); wstring = Tcl_UtfToWCharDString(string, -1, &tds2); DrawTextW(hDC, wstring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); Tcl_DStringFree(&tds2); + #endif + + /*This prints without crashing.*/ + Tcl_DStringInit(&tds); + // Tcl_UtfToExternalDString(encoding, string, -1, &tds); + Tcl_DStringAppend(&tds, string, -1); + ostring = Tcl_DStringValue(&tds); + tds_len = Tcl_DStringLength(&tds); + DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); /* Adjust the rectangle according to the anchor. */ x = y = 0; @@ -1658,12 +1670,16 @@ int GdiText( } /* Print the text. */ + #if 0 Tcl_DStringInit(&tds2); wstring = Tcl_UtfToWCharDString(string, -1, &tds2); retval = DrawTextW(hDC, wstring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); Tcl_DStringFree(&tds2); Tcl_DStringFree(&tds); + #endif + retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); + Tcl_DStringFree(&tds); /* Get the color set back. */ if (dotextcolor) { @@ -4374,7 +4390,7 @@ int Winprint_Init( (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL); for (i=0; i Date: Wed, 21 Jul 2021 13:41:16 +0000 Subject: Minor formatting cleanup --- win/tkWinGDI.c | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index ba6faa3..5442775 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1502,8 +1502,8 @@ int GdiText( int bgmode; COLORREF textcolor = 0; int usesingle = 0; - TCHAR *ostring; - int tds_len; + TCHAR *ostring; + int tds_len; Tcl_DString tds; if (argc < 4) { @@ -1600,24 +1600,24 @@ int GdiText( } - #if 0 + #if 0 /* Just for fun, let's try translating string to Unicode. */ - WCHAR *wstring; + WCHAR *wstring; Tcl_DString tds2; Tcl_DStringInit(&tds2); wstring = Tcl_UtfToWCharDString(string, -1, &tds2); DrawTextW(hDC, wstring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags | DT_CALCRECT); Tcl_DStringFree(&tds2); - #endif + #endif - /*This prints without crashing.*/ - Tcl_DStringInit(&tds); + /*This prints without crashing.*/ + Tcl_DStringInit(&tds); // Tcl_UtfToExternalDString(encoding, string, -1, &tds); - Tcl_DStringAppend(&tds, string, -1); + Tcl_DStringAppend(&tds, string, -1); ostring = Tcl_DStringValue(&tds); tds_len = Tcl_DStringLength(&tds); - DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); + DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); /* Adjust the rectangle according to the anchor. */ x = y = 0; @@ -1670,15 +1670,15 @@ int GdiText( } /* Print the text. */ - #if 0 + #if 0 Tcl_DStringInit(&tds2); wstring = Tcl_UtfToWCharDString(string, -1, &tds2); retval = DrawTextW(hDC, wstring, Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); Tcl_DStringFree(&tds2); Tcl_DStringFree(&tds); - #endif - retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); + #endif + retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); Tcl_DStringFree(&tds); /* Get the color set back. */ -- cgit v0.12 From 9f497d0caba6ea2bb13af086eb58ac73af99ac80 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 21 Jul 2021 14:45:33 +0000 Subject: Put back DrawTextW() without crashing. Use more TCL_UNUSED() --- win/tkWinGDI.c | 104 ++++++++++++++++----------------------------------------- 1 file changed, 29 insertions(+), 75 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 5442775..a2e58d5 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -1502,8 +1502,7 @@ int GdiText( int bgmode; COLORREF textcolor = 0; int usesingle = 0; - TCHAR *ostring; - int tds_len; + WCHAR *wstring; Tcl_DString tds; if (argc < 4) { @@ -1599,25 +1598,11 @@ int GdiText( format_flags &= ~DT_WORDBREAK; } - - #if 0 - /* Just for fun, let's try translating string to Unicode. */ - WCHAR *wstring; - Tcl_DString tds2; - Tcl_DStringInit(&tds2); - wstring = Tcl_UtfToWCharDString(string, -1, &tds2); - DrawTextW(hDC, wstring, Tcl_DStringLength(&tds2)/2, &sizerect, - format_flags | DT_CALCRECT); - Tcl_DStringFree(&tds2); - #endif - - /*This prints without crashing.*/ Tcl_DStringInit(&tds); - // Tcl_UtfToExternalDString(encoding, string, -1, &tds); - Tcl_DStringAppend(&tds, string, -1); - ostring = Tcl_DStringValue(&tds); - tds_len = Tcl_DStringLength(&tds); - DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags | DT_CALCRECT); + /* Just for fun, let's try translating string to Unicode. */ + wstring = Tcl_UtfToWCharDString(string, -1, &tds); + DrawTextW(hDC, wstring, Tcl_DStringLength(&tds)/2, &sizerect, + format_flags | DT_CALCRECT); /* Adjust the rectangle according to the anchor. */ x = y = 0; @@ -1670,15 +1655,8 @@ int GdiText( } /* Print the text. */ - #if 0 - Tcl_DStringInit(&tds2); - wstring = Tcl_UtfToWCharDString(string, -1, &tds2); retval = DrawTextW(hDC, wstring, - Tcl_DStringLength(&tds2)/2, &sizerect, format_flags); - Tcl_DStringFree(&tds2); - Tcl_DStringFree(&tds); - #endif - retval = DrawText (hDC, ostring, Tcl_DStringLength(&tds), &sizerect, format_flags ); + Tcl_DStringLength(&tds)/2, &sizerect, format_flags); Tcl_DStringFree(&tds); /* Get the color set back. */ @@ -4390,7 +4368,7 @@ int Winprint_Init( (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL); for (i=0; i Date: Wed, 21 Jul 2021 20:13:45 +0000 Subject: Remove unneeded macro; fix crash on Windows when cancel print button pressed --- library/print.tcl | 4 ++-- win/tkWinGDI.c | 39 +++++++++++++++++++-------------------- 2 files changed, 21 insertions(+), 22 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 02aed73..bf8e107 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -94,7 +94,7 @@ namespace eval ::tk::print { variable printer_name _set_dc - if {$printer_name eq ""} { + if {![info exists printer_name]} { return } @@ -250,7 +250,7 @@ namespace eval ::tk::print { variable printer_name _set_dc - if {$printer_name eq ""} { + if {![info exists printer_name]} { return } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index a2e58d5..810b95f 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -12,8 +12,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -/* Remove deprecation warnings. */ -#define _CRT_SECURE_NO_WARNINGS #include #include @@ -4747,24 +4745,25 @@ static int PrintSelectPrinter( * Store print properties and link variables so they can be accessed from * script level. */ - - char *varlink1 = (char *) Tcl_Alloc(100 * sizeof(char)); - char **varlink2 = (char **) Tcl_Alloc(sizeof(char *)); - *varlink2 = varlink1; - strcpy (varlink1, localPrinterName); - - Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, - TCL_LINK_STRING | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::copies", (char *)&copies, - TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::dpi_x", (char *)&dpi_x, - TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::dpi_y", (char *)&dpi_y, - TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_width", (char *)&paper_width, - TCL_LINK_INT | TCL_LINK_READ_ONLY); - Tcl_LinkVar(interp, "::tk::print::paper_height", (char *)&paper_height, - TCL_LINK_INT | TCL_LINK_READ_ONLY); + if (localPrinterName != NULL) { + char* varlink1 = (char*)Tcl_Alloc(100 * sizeof(char)); + char** varlink2 = (char**)Tcl_Alloc(sizeof(char*)); + *varlink2 = varlink1; + strcpy(varlink1, localPrinterName); + + Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, + TCL_LINK_STRING | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::copies", (char*)&copies, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::dpi_x", (char*)&dpi_x, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::dpi_y", (char*)&dpi_y, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_width", (char*)&paper_width, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + Tcl_LinkVar(interp, "::tk::print::paper_height", (char*)&paper_height, + TCL_LINK_INT | TCL_LINK_READ_ONLY); + } return TCL_OK; } -- cgit v0.12 From 1cf063a45ffc8ab7c7c5f1cd2bc902dfe47bf18e Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 21 Jul 2021 20:46:44 +0000 Subject: Formatting tweak --- library/print.tcl | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index bf8e107..cb4cf84 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -94,9 +94,10 @@ namespace eval ::tk::print { variable printer_name _set_dc - if {![info exists printer_name]} { - return - } + + if {![info exists printer_name]} { + return + } if {$font eq ""} { _gdi characters $printargs(hDC) -array printcharwid @@ -249,10 +250,11 @@ namespace eval ::tk::print { variable printargs variable printer_name - _set_dc - if {![info exists printer_name]} { - return - } + _set_dc + + if {![info exists printer_name]} { + return + } _opendoc _openpage -- cgit v0.12 From 9dc70b2be8b3f2ae9ddaeb85b2eb9627aa42609a Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 21 Jul 2021 20:47:23 +0000 Subject: Formatting tweak --- library/print.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index cb4cf84..142ffe6 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -91,7 +91,7 @@ namespace eval ::tk::print { # font - Font for printing proc _print_data {data {breaklines 1} {font ""}} { variable printargs - variable printer_name + variable printer_name _set_dc @@ -248,7 +248,7 @@ namespace eval ::tk::print { proc _print_widget {wid {printer default} {name "Tk Print Output"}} { variable printargs - variable printer_name + variable printer_name _set_dc -- cgit v0.12 From 0a539ef4bde6811ba28df6b2cedf93b37817c0f4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 22 Jul 2021 13:58:04 +0000 Subject: Font handling enhancement: Use LOGFONTW in stead of LOGFONT for full Unicode. --- library/print.tcl | 10 +++++----- macosx/tkMacOSXPrint.c | 10 +++++----- win/tkWinGDI.c | 25 +++++++++++++++---------- 3 files changed, 25 insertions(+), 20 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 142ffe6..1bca4c9 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -92,9 +92,9 @@ namespace eval ::tk::print { proc _print_data {data {breaklines 1} {font ""}} { variable printargs variable printer_name - + _set_dc - + if {![info exists printer_name]} { return } @@ -251,11 +251,11 @@ namespace eval ::tk::print { variable printer_name _set_dc - + if {![info exists printer_name]} { return } - + _opendoc _openpage @@ -285,7 +285,7 @@ namespace eval ::tk::print { $printargs(resx) / 1000.0 }] set printer_y [expr { - ( $printargs(pl) - $printargs(tm) - $printargs(bm) ) * + ( $printargs(pl) - $printargs(tm) - $printargs(bm) ) * $printargs(resy) / 1000.0 }] set factor_x [expr {$window_x / $printer_x}] diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index bad105c..f0b3693 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -222,7 +222,7 @@ FinishPrint( /* Destination is file. Determine how to handle. */ if (status == noErr && printDestination == kPMDestinationFile) { CFURLRef outputLocation = NULL; - + status = PMSessionCopyDestinationLocation(printSession, printSettings, & outputLocation); if (status == noErr) { /*Get the source file and target destination, convert to strings.*/ @@ -233,7 +233,7 @@ FinishPrint( NSString * pathExtension = [finalPath pathExtension]; NSFileManager * fileManager = [NSFileManager defaultManager]; NSError * error = nil; - + /* * Is the target file a PDF? If so, copy print file * to output location. @@ -265,8 +265,8 @@ FinishPrint( if ([fileManager fileExistsAtPath: finalPath]) { [fileManager removeItemAtPath: finalPath error: &error]; } - - /* + + /* * Fork and start new process with command string. Thanks to Peter da Silva * for assistance. */ @@ -278,7 +278,7 @@ FinishPrint( dup2(open(target, O_RDWR | O_CREAT, 0777), 1); dup2(open("/dev/null", O_WRONLY), 2); execl("/usr/sbin/cupsfilter", "/usr/sbin/cupsfilter", "-m", "application/postscript", source, NULL); - exit(0); + exit(0); } return status; } diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 810b95f..5a9a957 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -72,7 +72,7 @@ static int TkGdiMakeBezierCurve(Tk_Canvas, double *, int, int, * Helper functions. */ static int GdiMakeLogFont(Tcl_Interp *interp, const char *str, - LOGFONT *lf, HDC hDC); + LOGFONTW *lf, HDC hDC); static int GdiMakePen(Tcl_Interp *interp, int width, int dashstyle, const char *dashstyledata, int capstyle, int joinstyle, @@ -100,7 +100,7 @@ static int PalEntriesOnDevice(HDC hDC); static HPALETTE GetSystemPalette(void); static void GetDisplaySize(LONG *width, LONG *height); static int GdiWordToWeight(const char *str); -static int GdiParseFontWords(Tcl_Interp *interp, LOGFONT *lf, +static int GdiParseFontWords(Tcl_Interp *interp, LOGFONTW *lf, const char *str[], int numargs); static int PrintSelectPrinter(ClientData clientData, Tcl_Interp *interp, int argc, @@ -1374,7 +1374,7 @@ static int GdiCharWidths( */ HDC hDC; - LOGFONT lf; + LOGFONTW lf; HFONT hfont, oldfont; int made_font = 0; const char *aryvarname = "GdiCharWidths"; @@ -1397,7 +1397,7 @@ static int GdiCharWidths( argc--; argv++; if (GdiMakeLogFont(interp, argv[0], &lf, hDC)) { - if ((hfont = CreateFontIndirect(&lf)) != NULL) { + if ((hfont = CreateFontIndirectW(&lf)) != NULL) { made_font = 1; oldfont = SelectObject(hDC, hfont); } @@ -1491,7 +1491,7 @@ int GdiText( RECT sizerect; UINT format_flags = DT_EXPANDTABS|DT_NOPREFIX; /* Like the canvas. */ Tk_Anchor anchor = 0; - LOGFONT lf; + LOGFONTW lf; HFONT hfont, oldfont; int made_font = 0; int retval; @@ -1549,7 +1549,7 @@ int GdiText( argc--; argv++; if (GdiMakeLogFont(interp, argv[0], &lf, hDC)) { - if ((hfont = CreateFontIndirect(&lf)) != NULL) { + if ((hfont = CreateFontIndirectW(&lf)) != NULL) { made_font = 1; oldfont = SelectObject(hDC, hfont); } @@ -2427,7 +2427,7 @@ static int DIBNumColors( static int GdiParseFontWords( TCL_UNUSED(Tcl_Interp *), - LOGFONT *lf, + LOGFONTW *lf, const char *str[], int numargs) { @@ -2524,7 +2524,7 @@ static int GdiWordToWeight( static int GdiMakeLogFont( Tcl_Interp *interp, const char *str, - LOGFONT *lf, + LOGFONTW *lf, HDC hDC) { const char **list; @@ -2546,7 +2546,12 @@ static int GdiMakeLogFont( /* Now we have the font structure broken into name, size, weight. */ if (count >= 1) { - strncpy(lf->lfFaceName, list[0], sizeof(lf->lfFaceName) - 1); + Tcl_DString ds; + + Tcl_DStringInit(&ds); + wcsncpy(lf->lfFaceName, Tcl_UtfToWCharDString(list[0], -1, &ds), + sizeof(lf->lfFaceName) - 1); + Tcl_DStringFree(&ds); } else { return 0; } @@ -3962,7 +3967,7 @@ static HBITMAP CopyScreenToBitmap( * DC. */ - hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL); + hScrDC = CreateDCW(L"DISPLAY", NULL, NULL, NULL); hMemDC = CreateCompatibleDC(hScrDC); /* Get points of rectangle to grab. */ -- cgit v0.12 From 4f35be7be85adc2e1aa7812a0ba053f9bc584370 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 22 Jul 2021 13:59:11 +0000 Subject: end-of-line spacing --- macosx/tkMacOSXPrint.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/macosx/tkMacOSXPrint.c b/macosx/tkMacOSXPrint.c index f0b3693..38cd1ca 100644 --- a/macosx/tkMacOSXPrint.c +++ b/macosx/tkMacOSXPrint.c @@ -239,7 +239,7 @@ FinishPrint( * to output location. */ if ([pathExtension isEqualToString: @ "pdf"]) { - + /*Make sure no file conflict exists.*/ if ([fileManager fileExistsAtPath: finalPath]) { [fileManager removeItemAtPath: finalPath error: &error]; @@ -251,7 +251,7 @@ FinishPrint( return status; } - /* + /* * Is the target file PostScript? If so, run print file * through CUPS filter to convert back to PostScript. */ -- cgit v0.12 From d272aa3ff3f01f96ad65d20abc62bdae37037721 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 23 Jul 2021 16:06:20 +0000 Subject: Fix max chars to be written by wcsncpy (taken over from tkWinDialog.c) --- win/tkWinGDI.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 5a9a957..4d7eaf8 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -2550,7 +2550,7 @@ static int GdiMakeLogFont( Tcl_DStringInit(&ds); wcsncpy(lf->lfFaceName, Tcl_UtfToWCharDString(list[0], -1, &ds), - sizeof(lf->lfFaceName) - 1); + LF_FACESIZE-1); Tcl_DStringFree(&ds); } else { return 0; -- cgit v0.12 From 0948306752ac58e7f1d55be77d8b6bf44e31df27 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 23 Jul 2021 16:14:00 +0000 Subject: wide-api-bug, still to be tested --- win/tkWinDialog.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index cdfdafa..d4ebd96 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -3151,7 +3151,7 @@ HookProc( WPARAM wParam, LPARAM lParam) { - CHOOSEFONT *pcf = (CHOOSEFONT *) lParam; + CHOOSEFONTW *pcf = (CHOOSEFONTW *) lParam; HWND hwndCtrl; static HookData *phd = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) @@ -3463,10 +3463,10 @@ FontchooserShowCmd( Tk_MakeWindowExist(parent); - ZeroMemory(&cf, sizeof(CHOOSEFONT)); - ZeroMemory(&lf, sizeof(LOGFONT)); + ZeroMemory(&cf, sizeof(CHOOSEFONTW)); + ZeroMemory(&lf, sizeof(LOGFONTW)); lf.lfCharSet = DEFAULT_CHARSET; - cf.lStructSize = sizeof(CHOOSEFONT); + cf.lStructSize = sizeof(CHOOSEFONTW); cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent)); cf.lpLogFont = &lf; cf.nFontType = SCREEN_FONTTYPE; -- cgit v0.12 From 9fad0cc49a86ed1a8fee748f4e4b7cbecb52758b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 23 Jul 2021 16:27:32 +0000 Subject: 3 more places --- win/tkWinDialog.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index d4ebd96..176ba88 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -782,7 +782,7 @@ Tk_ChooseColorObjCmd( } parent = tkwin; - chooseColor.lStructSize = sizeof(CHOOSECOLOR); + chooseColor.lStructSize = sizeof(CHOOSECOLORW); chooseColor.hwndOwner = NULL; chooseColor.hInstance = NULL; chooseColor.rgbResult = oldColor; @@ -908,7 +908,7 @@ ColorDlgHookProc( ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); const char *title; - CHOOSECOLOR *ccPtr; + CHOOSECOLORW *ccPtr; (void)wParam; if (WM_INITDIALOG == uMsg) { @@ -917,7 +917,7 @@ ColorDlgHookProc( * Set the title string of the dialog. */ - ccPtr = (CHOOSECOLOR *) lParam; + ccPtr = (CHOOSECOLORW *) lParam; title = (const char *) ccPtr->lCustData; if ((title != NULL) && (title[0] != '\0')) { -- cgit v0.12 From 7b9f5894378d39899caf6e20fc4b1e3d2329495b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 24 Jul 2021 13:26:51 +0000 Subject: Silence OSACopyScriptingDefinition warning --- library/tk.tcl | 5 +++++ macosx/tkMacOSXHLEvents.c | 26 ++++++++++++++++++++++++++ 2 files changed, 31 insertions(+) diff --git a/library/tk.tcl b/library/tk.tcl index 2668491..63d90f9 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -699,6 +699,11 @@ if {[tk windowingsystem] eq "aqua"} { uplevel #0 $script eval $script } + #This procedure is required to silence warnings generated + #by inline AppleScript execution. + proc ::tk::mac::GetDynamicSdef {} { + puts "" + } } # Create a dictionary to store the starting index of the IME marked diff --git a/macosx/tkMacOSXHLEvents.c b/macosx/tkMacOSXHLEvents.c index 7cd8344..03b3722 100644 --- a/macosx/tkMacOSXHLEvents.c +++ b/macosx/tkMacOSXHLEvents.c @@ -59,6 +59,7 @@ static const char launchURLProc[] = "::tk::mac::LaunchURL"; static const char printDocProc[] = "::tk::mac::PrintDocument"; static const char scriptFileProc[] = "::tk::mac::DoScriptFile"; static const char scriptTextProc[] = "::tk::mac::DoScriptText"; +static const char getSdefProc[] = "::tk::mac::GetDynamicSdef"; #pragma mark TKApplication(TKHLEvents) @@ -386,6 +387,22 @@ static const char scriptTextProc[] = "::tk::mac::DoScriptText"; ProcessAppleEvent((ClientData)AEInfo); } +- (void)handleGetSDEFEvent:(NSAppleEventDescriptor *)event withReplyEvent:(NSAppleEventDescriptor *)replyEvent { + AppleEventInfo *AEInfo = (AppleEventInfo *)ckalloc(sizeof(AppleEventInfo)); + Tcl_DString *sdefCommand = &AEInfo->command; + (void)replyEvent; + + Tcl_DStringInit(sdefCommand); + Tcl_DStringAppend(sdefCommand, getSdefProc, -1); + AEInfo->interp = _eventInterp; + AEInfo->procedure = getSdefProc; + AEInfo->replyEvent = nil; + Tcl_DoWhenIdle(ProcessAppleEvent, (ClientData)AEInfo); + AEInfo->retryCount = 0; + ProcessAppleEvent((ClientData)AEInfo); + +} + @end #pragma mark - @@ -523,6 +540,15 @@ TkMacOSXInitAppleEvents( andSelector:@selector(handleURLEvent:withReplyEvent:) forEventClass:kInternetEventClass andEventID:kAEGetURL]; + /* + * We do not load our sdef dynamically but this event handler + * is required to silence error messages from inline execution + * of AppleScript at the Objective-C level. + */ + [aeManager setEventHandler:NSApp + andSelector:@selector(handleGetSDEFEvent:withReplyEvent:) + forEventClass:'ascr' andEventID:'gsdf']; + } } -- cgit v0.12 From 0aa68fe1f0e21e2d14f68ac70a5cbacee220815a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 Jul 2021 13:12:15 +0000 Subject: Further conversion to Wide Win32 API --- win/tkWinGDI.c | 49 ++++++++++++++++++++++++++++--------------------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 4d7eaf8..3f36363 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -125,9 +125,9 @@ static int PrintClosePage(ClientData clientData, * Global state. */ -static PRINTDLG pd; -static DOCINFO di; -static const char *localPrinterName = NULL; +static PRINTDLGW pd; +static DOCINFOW di; +static WCHAR *localPrinterName = NULL; static int copies, paper_width, paper_height, dpi_x, dpi_y; static LPDEVNAMES devnames; static HDC printDC; @@ -1415,8 +1415,8 @@ static int GdiCharWidths( } /* Now, get the widths using the correct function for font type. */ - if ((retval = GetCharWidth32(hDC, 0, 255, widths)) == FALSE) { - retval = GetCharWidth(hDC, 0, 255, widths); + if ((retval = GetCharWidth32W(hDC, 0, 255, widths)) == FALSE) { + retval = GetCharWidthW(hDC, 0, 255, widths); } /* @@ -2552,6 +2552,7 @@ static int GdiMakeLogFont( wcsncpy(lf->lfFaceName, Tcl_UtfToWCharDString(list[0], -1, &ds), LF_FACESIZE-1); Tcl_DStringFree(&ds); + lf->lfFaceName[LF_FACESIZE-1] = 0; } else { return 0; } @@ -3928,7 +3929,7 @@ static void GetDisplaySize( { HDC hDC; - hDC = CreateDC("DISPLAY", 0, 0, 0); + hDC = CreateDCW(L"DISPLAY", 0, 0, 0); *width = GetDeviceCaps(hDC, HORZRES); *height = GetDeviceCaps(hDC, VERTRES); DeleteDC(hDC); @@ -4060,7 +4061,7 @@ static HANDLE BitmapToDIB( /* Fill in BITMAP structure, return NULL if it didn't work. */ - if (!GetObject(hBitmap, sizeof(bm), (LPSTR)&bm)) { + if (!GetObjectW(hBitmap, sizeof(bm), (LPWSTR)&bm)) { return NULL; } @@ -4691,9 +4692,9 @@ static int PrintSelectPrinter( TCL_UNUSED(int), TCL_UNUSED(Tcl_Obj* const*)) { - LPCSTR printerName = NULL; - PDEVMODE returnedDevmode = NULL; - PDEVMODE localDevmode = NULL; + LPCWSTR printerName = NULL; + PDEVMODEW returnedDevmode = NULL; + PDEVMODEW localDevmode = NULL; copies = 0; paper_width = 0; @@ -4708,18 +4709,18 @@ static int PrintSelectPrinter( pd.hwndOwner = GetDesktopWindow(); pd.Flags = PD_HIDEPRINTTOFILE | PD_DISABLEPRINTTOFILE | PD_NOSELECTION; - if (PrintDlg(&pd) == TRUE) { + if (PrintDlgW(&pd) == TRUE) { /*Get document info.*/ ZeroMemory(&di, sizeof(di)); di.cbSize = sizeof(di); - di.lpszDocName = "Tk Print Output"; + di.lpszDocName = L"Tk Print Output"; /* Copy print attributes to local structure. */ - returnedDevmode = (PDEVMODE) GlobalLock(pd.hDevMode); + returnedDevmode = (PDEVMODEW) GlobalLock(pd.hDevMode); devnames = (LPDEVNAMES) GlobalLock(pd.hDevNames); - printerName = (LPCSTR) devnames + devnames->wDeviceOffset; - localDevmode = (LPDEVMODE) HeapAlloc(GetProcessHeap(), + printerName = (LPCWSTR) devnames + devnames->wDeviceOffset; + localDevmode = (LPDEVMODEW) HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY | HEAP_GENERATE_EXCEPTIONS, returnedDevmode->dmSize); @@ -4728,7 +4729,7 @@ static int PrintSelectPrinter( returnedDevmode->dmSize); /* Get values from user-set and built-in properties. */ - localPrinterName = (LPCSTR)localDevmode->dmDeviceName; + localPrinterName = localDevmode->dmDeviceName; dpi_y = localDevmode->dmYResolution; dpi_x = localDevmode->dmPrintQuality; /* Convert height and width to logical points. */ @@ -4736,7 +4737,7 @@ static int PrintSelectPrinter( paper_width = (int) localDevmode->dmPaperWidth / 0.254; copies = pd.nCopies; /* Set device context here for all GDI printing operations. */ - printDC = CreateDC("WINSPOOL", printerName, NULL, localDevmode); + printDC = CreateDCW(L"WINSPOOL", printerName, NULL, localDevmode); } else { localDevmode = NULL; } @@ -4754,7 +4755,7 @@ static int PrintSelectPrinter( char* varlink1 = (char*)Tcl_Alloc(100 * sizeof(char)); char** varlink2 = (char**)Tcl_Alloc(sizeof(char*)); *varlink2 = varlink1; - strcpy(varlink1, localPrinterName); + WideCharToMultiByte(CP_UTF8, 0, localPrinterName, -1, varlink1, 0, NULL, NULL); Tcl_LinkVar(interp, "::tk::print::printer_name", (char*)varlink2, TCL_LINK_STRING | TCL_LINK_READ_ONLY); @@ -4792,6 +4793,8 @@ int PrintOpenPrinter( int argc, Tcl_Obj *const objv[]) { + Tcl_DString ds; + if (argc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "printer"); return TCL_ERROR; @@ -4802,18 +4805,22 @@ int PrintOpenPrinter( return TCL_ERROR; } - char *printer = Tcl_GetString(objv[1]); + const char *printer = Tcl_GetString(objv[1]); if (printDC == NULL) { Tcl_AppendResult(interp, "unable to establish device context", NULL); return TCL_ERROR; } - if ((OpenPrinter(printer, (LPHANDLE)&printDC, NULL)) == FALSE) { + Tcl_DStringInit(&ds); + if ((OpenPrinterW(Tcl_UtfToWCharDString(printer, -1, &ds), + (LPHANDLE)&printDC, NULL)) == FALSE) { Tcl_AppendResult(interp, "unable to open printer", NULL); + Tcl_DStringFree(&ds); return TCL_ERROR; } + Tcl_DStringFree(&ds); return TCL_OK; } @@ -4874,7 +4881,7 @@ int PrintOpenDoc( /* * Start printing. */ - output = StartDoc(printDC, &di); + output = StartDocW(printDC, &di); if (output <= 0) { Tcl_AppendResult(interp, "unable to start document", NULL); return TCL_ERROR; -- cgit v0.12 From 93fc305094e32d137611c6399a97876452d2fead Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 26 Jul 2021 22:11:48 +0000 Subject: Remove const char warning --- macosx/tkMacOSXSysTray.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/macosx/tkMacOSXSysTray.c b/macosx/tkMacOSXSysTray.c index 4229a1c..e708b97 100644 --- a/macosx/tkMacOSXSysTray.c +++ b/macosx/tkMacOSXSysTray.c @@ -439,7 +439,7 @@ static int SysNotifyObjCmd( NSDictionary *errorInfo; NSAppleEventDescriptor *result = [scpt executeAndReturnError:&errorInfo]; NSString *info = [result stringValue]; - char *output = [info UTF8String]; + const char* output = [info UTF8String]; Tcl_AppendResult(interp, output, -- cgit v0.12 From 70f2c1c4bff98d5b06d5756b9215c9418b0a9876 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 27 Jul 2021 15:10:54 +0000 Subject: Don't bother some testcases on XQuarz --- tests/font.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/font.test b/tests/font.test index a44b194..503e786 100644 --- a/tests/font.test +++ b/tests/font.test @@ -729,7 +729,7 @@ foreach p { ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats} } { set values [lassign $p testName family] - test $testName {Tk_PostscriptFontName procedure: exhaustive} unix { + test $testName {Tk_PostscriptFontName procedure: exhaustive} {unix failsOnQuarz} { set x {} set j 0 foreach slant {roman italic} { -- cgit v0.12 From 00a59ceb407bd2aece5e4d0671944c8046896206 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 28 Jul 2021 10:39:36 +0000 Subject: Don't bother a "make install" on MacOS either. --- .github/workflows/mac-build.yml | 7 ------- 1 file changed, 7 deletions(-) diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index 7378565..84aeeec 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -75,10 +75,3 @@ jobs: } env: MAC_CI: 1 - - name: Carry out trial installation - run: | - sudo make install || { - cat config.log - echo "::error::Failure during Install" - exit 1 - } -- cgit v0.12 From cd6990c42bb8b127221d2f944641542af9edf855 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 4 Aug 2021 16:00:01 +0000 Subject: eol-spacing --- changes | 2 +- generic/tkCanvas.c | 2 +- macosx/tkMacOSXHLEvents.c | 6 +++--- macosx/tkMacOSXSysTray.c | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/changes b/changes index c209520..144dee7 100644 --- a/changes +++ b/changes @@ -7952,7 +7952,7 @@ in this changeset (new minor version) rather than bug fixes: 2021-01-08 (bug)[822330] Prevent buffer overflow in SVG image. -2021-01-28 (bug)[237971] 'end' argument to [$canvas insert] +2021-01-28 (bug)[237971] 'end' argument to [$canvas insert] 2021-02-25 (bug)[be9cad] crash in [tkwait] diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 95fec62..829d65a 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -2924,7 +2924,7 @@ DrawCanvas( #else #define COPY_PIXEL 0 #endif - + if (COPY_PIXEL) { /* * This platform packs pixels in RGBA byte order, as expected diff --git a/macosx/tkMacOSXHLEvents.c b/macosx/tkMacOSXHLEvents.c index 03b3722..aefc63c 100644 --- a/macosx/tkMacOSXHLEvents.c +++ b/macosx/tkMacOSXHLEvents.c @@ -400,7 +400,7 @@ static const char getSdefProc[] = "::tk::mac::GetDynamicSdef"; Tcl_DoWhenIdle(ProcessAppleEvent, (ClientData)AEInfo); AEInfo->retryCount = 0; ProcessAppleEvent((ClientData)AEInfo); - + } @end @@ -541,8 +541,8 @@ TkMacOSXInitAppleEvents( forEventClass:kInternetEventClass andEventID:kAEGetURL]; /* - * We do not load our sdef dynamically but this event handler - * is required to silence error messages from inline execution + * We do not load our sdef dynamically but this event handler + * is required to silence error messages from inline execution * of AppleScript at the Objective-C level. */ [aeManager setEventHandler:NSApp diff --git a/macosx/tkMacOSXSysTray.c b/macosx/tkMacOSXSysTray.c index e708b97..c2e347f 100644 --- a/macosx/tkMacOSXSysTray.c +++ b/macosx/tkMacOSXSysTray.c @@ -439,7 +439,7 @@ static int SysNotifyObjCmd( NSDictionary *errorInfo; NSAppleEventDescriptor *result = [scpt executeAndReturnError:&errorInfo]; NSString *info = [result stringValue]; - const char* output = [info UTF8String]; + const char* output = [info UTF8String]; Tcl_AppendResult(interp, output, -- cgit v0.12 From 5ebcc873d819a2a9ebdc6eb8416db300492e0961 Mon Sep 17 00:00:00 2001 From: griffin Date: Wed, 4 Aug 2021 21:40:11 +0000 Subject: Possible fix for tkticket 3049518 - Generate <> event. --- doc/event.n | 9 ++++ generic/tkFont.c | 14 ++++-- generic/tkUtil.c | 1 + tests/font.test | 141 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 162 insertions(+), 3 deletions(-) diff --git a/doc/event.n b/doc/event.n index 9ab48e5..786dcc6 100644 --- a/doc/event.n +++ b/doc/event.n @@ -343,6 +343,15 @@ This is sent to all widgets when the ttk theme changed. The ttk widgets listen to this event and redisplay themselves when it fires. The legacy widgets ignore this event. .TP +\fB<>\fR +. +For font changes, this event is sent to widgets holding a reference to +a modified font. The user_data field (%d) will have the value +"FontChanged". For other system wide changes, this event will be sent +to widgets potentially effected by the change, and the user_data field +will indicate the cause of the change. NOTE: all tk and ttk widgets +already handle this event internally. +.TP \fB<>\fR This is sent to a widget when the focus enters the widget because of a user-driven diff --git a/generic/tkFont.c b/generic/tkFont.c index 9c157db..d3ef712 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -897,7 +897,8 @@ RecomputeWidgets( { Tk_ClassWorldChangedProc *proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc); - + TkWindow *tkwinPtr; + if (proc != NULL) { proc(winPtr->instanceData); } @@ -921,9 +922,16 @@ RecomputeWidgets( * of the code below. */ - for (winPtr=winPtr->childList ; winPtr!=NULL ; winPtr=winPtr->nextPtr) { - RecomputeWidgets(winPtr); + for (tkwinPtr=winPtr->childList ; tkwinPtr!=NULL ; tkwinPtr=tkwinPtr->nextPtr) { + RecomputeWidgets(tkwinPtr); } + + /* + * Broadcast font change virtually for mega-widget layout managers. + * Do this after the font change has been propagated to core widgets. + */ + TkSendVirtualEvent((Tk_Window)winPtr, "TkWorldChanged", + Tcl_NewStringObj("FontChanged",-1)); } /* diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 375bb83..3cc8dbf 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -1186,6 +1186,7 @@ TkSendVirtualEvent( event.general.xany.display = Tk_Display(target); event.virt.name = Tk_GetUid(eventName); event.virt.user_data = detail; + if (detail) Tcl_IncrRefCount(detail); // Event code will DecrRefCount Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL); } diff --git a/tests/font.test b/tests/font.test index 5af2dbb..dd6f539 100644 --- a/tests/font.test +++ b/tests/font.test @@ -2408,6 +2408,147 @@ test font-47.1 {Bug f214b8ad5b} -body { interp delete two } -result {} +test font-47.2 {Bug 3049518 - Canvas} -body { + if {"MyFont" ni [font names]} { + font create MyFont -family "Liberation Sans" -size 13 + } + set text Hello! + destroy .t.c + set c [canvas .t.c] + set textid [$c create text 20 20 -font MyFont -text $text -anchor nw] + set twidth [font measure MyFont $text] + set theight [font metrics MyFont -linespace] + set circid [$c create polygon \ + 15 15 \ + [expr {15 + $twidth}] 15 \ + [expr {15 + $twidth}] [expr {15 + $theight}] \ + 15 [expr {15 + $theight}] \ + -width 1 -joinstyle round -smooth true -fill {} -outline blue] + pack $c -fill both -expand 1 -side top + tkwait visibility $c + + # Lamda test functions + set circle_text {{w user_data text circ} { + if {[winfo class $w] ne "Canvas"} { + puts "Wrong widget type: $w" + return + } + if {$user_data ne "FontChanged"} { + return + } + lappend ::results called-$w + lassign [$w bbox $text] x0 y0 x1 y1 + set offset 5 + set coord [lmap expr { + $x0-5 $y0-5 $x1+5 $y0-5 + $x1+5 $y1+5 $x0-5 $y1+5 + } {expr $expr}] + if {[catch {$w coord $circ $coord} err]} { + puts Error:$err + } + }} + set waitfor {{tag {time 333}} {after $time incr ::wait4; vwait ::wait4}} + set enclosed {{can id} {$can find enclosed {*}[$can bbox $id]}} + + set results {} + apply $circle_text $c FontChanged $textid $circid + bind $c <> [list apply $circle_text %W %d $textid $circid] + apply $waitfor 1 + + # Begin test: + set results {} + lappend results [apply $enclosed $c $circid] + font configure MyFont -size 26 + apply $waitfor 2 + lappend results [apply $enclosed $c $circid] + font configure MyFont -size 9 + apply $waitfor 3 + lappend results [apply $enclosed $c $circid] + apply $waitfor 4 + font configure MyFont -size 12 + apply $waitfor 5 + lappend results [apply $enclosed $c $circid] +} -cleanup { + destroy $c + unset -nocomplain ::results +} -result {{1 2} called-.t.c {1 2} called-.t.c {1 2} called-.t.c {1 2}} + +test font-47.3 {Bug 3049518 - Label} -body { + if {"MyFont" ni [font names]} { + font create MyFont -family "Liberation Sans" -size 13 + } + set text "Label Test" + destroy .t.l + + set make-img {{size} { + set img [image create photo -width $size -height $size] + $img blank + set max [expr {$size - 1}] + for {set x 0} {$x < $size} {incr x} { + $img put red -to $x $x + $img put black -to 0 $x + $img put black -to $x 0 + $img put black -to $max $x + $img put black -to $x $max + } + return $img + }} + + set testWorldChanged {{w user_data} { + global make-img + if {$user_data ne "FontChanged"} { + return + } + if {![winfo exists $w] || [winfo class $w] ne "Label"} { + return + } + if {[$w cget -image] ne ""} { + image delete [$w cget -image] + } + set size [font metrics [$w cget -font] -linespace] + set img [apply ${make-img} $size] + $w configure -image $img + }} + + set waitfor {{tag {time 500}} { + after $time incr ::wait4 + vwait ::wait4 + }} + + set check {{w} { + global results + set f [$w cget -font] + set i [$w cget -image] + set fs [font metrics $f -linespace] + set ish [image height $i] + set isw [image width $i] + lappend results [list [expr {$fs == $ish ? 1 : [list $fs $ish]}] [expr {$fs == $isw ? 1 : [list $fs $isw]}]] + }} + + set size [font metrics MyFont -linespace] + set img [apply ${make-img} $size] + set l [label .t.l -compound left -image $img -text $text -font MyFont] + pack $l -side top -fill both -expand 1 + bind $l <> [list apply $testWorldChanged %W %d] + set ::results {} + + apply $waitfor 0 + apply $check $l + font configure MyFont -size 26 + apply $waitfor 1 + apply $check $l + font configure MyFont -size 9 + apply $waitfor 2 + apply $check $l + font configure MyFont -size 13 + apply $waitfor 3 + apply $check $l + set results +} -cleanup { + destroy $l + unset -nocomplain ::results +} -result {{1 1} {1 1} {1 1} {1 1}} + # cleanup cleanupTests return -- cgit v0.12 From de7b4ec667039126edb1fc76898f79c4068231a7 Mon Sep 17 00:00:00 2001 From: griffin Date: Thu, 5 Aug 2021 17:47:37 +0000 Subject: Correct documentation for this new virtual event. --- doc/event.n | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/event.n b/doc/event.n index 786dcc6..afb5e4c 100644 --- a/doc/event.n +++ b/doc/event.n @@ -345,12 +345,12 @@ The legacy widgets ignore this event. .TP \fB<>\fR . -For font changes, this event is sent to widgets holding a reference to -a modified font. The user_data field (%d) will have the value -"FontChanged". For other system wide changes, this event will be sent -to widgets potentially effected by the change, and the user_data field -will indicate the cause of the change. NOTE: all tk and ttk widgets -already handle this event internally. +This event is sent to all widgets when a font is changed, for example, +by the use of [font configure]. The user_data field (%d) will have the +value "FontChanged". For other system wide changes, this event will +be sent to all widgets, and the user_data field will indicate the +cause of the change. NOTE: all tk and ttk widgets already handle this +event internally. .TP \fB<>\fR This is sent to a widget when the focus enters the widget because of a -- cgit v0.12 From 961a49c60641c790aef8412e4e03e6d40f4fc9e3 Mon Sep 17 00:00:00 2001 From: culler Date: Sat, 7 Aug 2021 13:15:36 +0000 Subject: remove unused pixelpower field from XImage --- xlib/X11/Xlib.h | 3 --- 1 file changed, 3 deletions(-) diff --git a/xlib/X11/Xlib.h b/xlib/X11/Xlib.h index 1977939..56d049c 100644 --- a/xlib/X11/Xlib.h +++ b/xlib/X11/Xlib.h @@ -330,9 +330,6 @@ typedef struct _XImage { unsigned long green_mask; unsigned long blue_mask; XPointer obdata; /* hook for the object routines to hang on */ -#if defined(MAC_OSX_TK) - int pixelpower; /* No longer used. */ -#endif struct funcs { /* image manipulation routines */ struct _XImage *(*create_image)(); #if NeedFunctionPrototypes -- cgit v0.12 From b32f8c59f05164448142b13707e7c6181564d3ea Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 9 Aug 2021 00:46:22 +0000 Subject: Minor tweak for Linux printing --- library/print.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/print.tcl b/library/print.tcl index 1bca4c9..bb22bbb 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -741,7 +741,7 @@ namespace eval ::tk::print { -side left -fill x -expand no bind $p.frame.printframe.mb <> { - set chooseprinter + set chooseprinter [$p.frame.printframe.mb get] } set paperlist [list [mc Letter] [mc Legal] [mc A4]] -- cgit v0.12 From e8f47f901447e36cee01824b2cd2f916a546a7bf Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 9 Aug 2021 01:18:02 +0000 Subject: One final tweak --- library/print.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/print.tcl b/library/print.tcl index bb22bbb..7820a5f 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -741,7 +741,7 @@ namespace eval ::tk::print { -side left -fill x -expand no bind $p.frame.printframe.mb <> { - set chooseprinter [$p.frame.printframe.mb get] + set chooseprinter {$p.frame.printframe.mb get} } set paperlist [list [mc Letter] [mc Legal] [mc A4]] -- cgit v0.12 From fbf2eec2ecbbcf708e274459c558c8e70fea93fb Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 11 Aug 2021 01:42:35 +0000 Subject: Begin tk_badges TIP --- library/iconbadges.tcl | 441 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 441 insertions(+) create mode 100644 library/iconbadges.tcl diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl new file mode 100644 index 0000000..99e3c34 --- /dev/null +++ b/library/iconbadges.tcl @@ -0,0 +1,441 @@ +# iconsbadges.tcl -- +# +# Notification badges for Tk applications. +# +# +# Copyright © 2021 Kevin Walzer/WordTech Communications LLC + +namespace eval ::tk::icons {} + + image create photo ::tk::icons::0-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 51BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AwP/JCT/RUX/ISH/AgL/BQX/cnL/4eH/+vr/29v/W1v/PDz/ + 7u7/+fn/kpL/pKT/////eHj/1NT/FRX/KSn/5+f//v7/WFj/lJT/v7//CQn/Fxf/ + 1tb/d3f/mJj/vLz/CAj/FBT/09P/fn7/iIj/xsb/DAz/Ghr/2tr/b2//Xl7/Njb/ + SUn/8vL/+Pj/HBz/yMj/39//5OT/vb3/ExP/Ly//nJz/ysr/lpb/Kir/DQ3HpLSX + AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCJdZVysAAAAxUlE + QVQY021QxRLCUBDbR5UipRR3Fnd3Ly7//z2wfUUO5JJMZnYnCQAw5hJESZYlUXAx + BkCOoroNG25VIY8xzWN84NFeHlO8xg+8CgOfn1TQDIXCEVJ+Hwj6i6OxeCKRTJGl + CyASpzPZXB6TJmkRJKICFkvlSrVGWgKZqI6NZquNHdIyt7rY6w+GOOKWfTjGyXQ2 + xwU/tN8vq5XVerNd8/d2iJ2F+wMeTzwEj3q+XK3b3YnqFAo+ppF3oT+1/4zznTDg + TPgETvcYi7Qhbm4AAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6 + MTQtMDQ6MDDRpfobAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1 + OjE0LTA0OjAwoPhCpwAAAABJRU5ErkJggg== + } + image create photo ::tk::icons::1-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + kFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/HBz/V1f/Rkb/BQX/Dw//oKD/////y8v/Bgb/Pz//ra3/+/v/ + zMz/Li7/5ub/+vr/8fH/Ly//uLj/Zmb/n5//Bwf/Dg7/kpL/YWH/rq7/h4f/Cgr/ + AQH/AgLXmjE+AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBib + aYUeAAAAnElEQVQY022Q5w6DMBCD78hi03RQuvegg77/25ULCakq/MenT4piGwAQ + A8aFlIKzABGAiAojbRSFihhinOheSdwyVKn+UaoQsry7x5PpjDzPgBWGlPNqUdJR + MODky9V6U20N0hwE2W5/ODokQJKdzperQ7JDt7uuPRL299o/5P+IuxA9akO4qI/n + 622jukLNp3GFBmoPjOMnHNkJv3kDExXHctm+AAAAJXRFWHRkYXRlOmNyZWF0ZQAy + MDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0RVh0ZGF0ZTptb2RpZnkA + MjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAASUVORK5CYII= + } + image create photo ::tk::icons::2-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 21BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Cwv/ODj/UlL/UFD/MjL/CAj/ExP/oKD/8fH//v7//f3/7u7/ + kJD/DAz/ZWX/9fX/jIz/lpb/+vr/9/f/TEz/TU3/m5v/iYn/Ly//6+v/////YmL/ + nJz/5OT/MDD/KSn/srL/7Oz/ZGT/AQH/Nzf/zs7/zc3/SUn/AgL/ICD/ysr/7e3/ + gYH/VVX/WVn/Kir/fX3/eXn/AwP/dnb/rKz/qan/q6vjChO4AAAAEXRSTlMAAA5V + q9/4NK/0St3cDa7z4Pnet34AAAABYktHRCy63XGrAAAAwElEQVQY021Q1xLCMAxz + uktpS9hQoOwZ9t57/P8XUSesB/RinXz2SQIAQiRZUTVNVWSJEABUdMOkHKaho0ZI + yKIfWKFAI3qY/iCsE7AdZNFYPJFMIXNskN1gpjNZL5cv+AF1ZVBwVfRK5Uq1Vkeu + gIqj0Wz57Q7rIldBe/1N91h/gER7S8ORN55MhcQP6WzOFssVFYf8/XrDtrv94Sje + cxMnxnEWJtDq5Xq7B3gkhFUeaCUwFYH+xP5TzrfCyKvCJ3EzGUFH/1QDAAAAJXRF + WHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0 + RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAA + SUVORK5CYII= + } + image create photo ::tk::icons::3-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + +VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/CQn/NTX/UlL/Tk7/Kir/BAT/ERH/mZn/8PD/+Pj/+vr/5ub/ + cHD/AgL/Vlb/9PT/5eX/X1//nZ3/////29v/HR3/Fhb/QED/RET/Cwv/f3//1dX/ + Ghr/Bwf/mpr/9vb/+fn/b2//lZX/2tr//Pz/wsL/Jyf/Dg7/Bgb/MzP/c3P/XV3/ + wMD/qqr/ExP/KSn/4+P/bm7/Q0P/6ur/vb3/x8f/19f/KCj/SEj/qan/zc3/y8v/ + oKD/ODj/BQX/DQ3/AwON+4wDAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34A + AAABYktHRCXDAckPAAAAx0lEQVQY021Q1RLCQBDbo4qW4l7ssOLu7g7//zH07oo8 + kJfNZGczyQIAQhaOF0RR4DkLQgBEkWSrSmGVJaIhZLOrH9hthoYkh/oDh4TA6SLM + 4/X5A0HCXE7gFGOGwpFoLJ7QDKpwwJNVMpXOZHEuTzgPAhmFYkkv40qVcAFEZlur + N5otysS3pLc73V6fSfRQ8wyGozges0NqP5nO5oslXjF7GmK96W53eH9gIWhU7Xg6 + X643M6pZ6D54PN+F/tT+85zvC93mC1+z9hl5VNGhJwAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMNGl+hsAAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTQtMDQ6MDCg+EKnAAAAAElFTkSuQmCC + } + image create photo ::tk::icons::4-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 1VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AgL/OTn/W1v/ODj/QED/4uL/////oaH/AQH/KSn/zs7/oqL/ + Fhb/tbX/9PT/1NT/Cgr/l5f//Pz/h4f/fHz/dXX/+/v/trb/HBz/fX3/qKj/DAz/ + EBD/ysr/4eH/zc3/5eX/8fH/lJT/BAT/Dw//uLj/5+f/5ub/8vL/+vr/paX/BQX/ + HR3/JCT/ISH/iYn/sLD/Ghr/Tk7/rq7/a2vT0ZXAAAAAEXRSTlMAAA5Vq9/4NK/0 + St3cDa7z4Pnet34AAAABYktHRBibaYUeAAAAvklEQVQY022QVRPCMBCEL1RSg5Ji + Ibi7W9Hi//8n0aRBHtiXvflm7mZvAQChmKJquq6pSgwhAE6wYRIh08CcIWTZ5CPb + ChnCDvmRgxHEE9HspdIZ7ok4KG6EsjmaZ6G7CqgRKRQpLXFEVNAEKVeqNYk00LnV + G81WWyJdINbp9voDOhxFiC+OJ3Q6m9PFciUW+fn1xt/6O7o/HMV5HsI7BcH5Qq83 + JkK8o5L74ymjfh5iHpMP/Xn7TznfCpOywhdM6Ra8aC+AYwAAACV0RVh0ZGF0ZTpj + cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6 + bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC + } + image create photo ::tk::icons::5-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 7VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/ICD/MjL/Li7/CQn/Bgb/q6v/8/P/8vL/9PT/4uL/FRX/0tL/ + ////wsL/xcX/uLj/Jib/Kyv/6ur/8fH/aGj/XV3/SUn/Fhb/AQH/+Pj//Pz/7Oz/ + +fn/l5f/Dg7/ODj/qan/sLD/W1v/fn7/9/f/+vr/WVn/EBD/Ghr/2dn/gID/X1// + oKD/EhL/5OT/Y2P/S0v/7e3/vb3/ycn/yMj/HR3/AwP/Skr/zc3/LCz/BQX/DAz/ + AgKLBoLHAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRB5yCiAr + AAAAyUlEQVQY021Q1RLDMAxzVhp1XcbYMXXMzIz//zmLk9HD9GKdzvZJAgBCbJKs + qKoiSzZCAFDR7A7K4bBrqBHidNEPXE6mEc1Nf+DWCOgeZD4/QyDImEcHyWAzFI5E + I7F4gFFDAhmXEkkzmUpnsshlUHDk8oViqVyxkCug4ihXa/VGtNlCrgqp3en2+oPh + SEj80AqO6WRqzsQhfz/PLJa5lbkW77mJzba225uHozDBrZ7Oncu+eaXC6ivQrXV/ + vAP9if2nnG+F3leFT2jDGOnV8F/uAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4 + LTEwVDA4OjM1OjE1LTA0OjAwd9LxrwAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0w + OC0xMFQwODozNToxNS0wNDowMAaPSRMAAAAASUVORK5CYII= + } + image create photo ::tk::icons::6-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 9lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AQH/ICD/S0v/UlL/NDT/CAj/WVn/2dn/+Pj/+fn/8PD/jY3/ + Cgr/LCz/4OD//f3/hob/cHD/5eX/1NT/NTX/bGz/////39//T0//Bwf/j4//5ub/ + wcH/7+//4uL/f3//CQn/lpb/+/v/n5//iIj/8vL/9/f/UVH/hYX/3t7/Hx//vb3/ + VVX/6Oj/MzP/ExP/x8f/e3v/EhL/t7f/0tL/wMD/MTH/IiL/xsb/zc3/qKj/QkL/ + AgL/Cwv/Dg7/BQWiS7IgAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB + YktHRCi9sLWyAAAAyklEQVQY021Q1RLCQBDbowalBYq7y+FWirs7/P/PwPawB/Ky + mezsThIAIMTC8YIoCjxnIQQAFclq00zYrBJqhMh27QO7/NSIpGg/UCQCqgOZ2+P1 + +QPIHCpwTlSCoXAkGos/qZMDHleJZCqdyebyyHkQcBRoMeEvecrIBRBxVGi1Vm80 + W8hFJrWp3jG6vT6TzMMBHY4CY2qwQ/P9RJ/O5gu6ZO9NE6s13Wz14o6ZYFb3scPx + dHYzq69Al+vt/g70J/afcr4Vul4VPgDLCRmO3FuJegAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC + } + image create photo ::tk::icons::7-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + xlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Hh7/Njb/NTX/Ghr/i4v/9/f/8/P/8vL/8fH/9PT/eHj/fHz/ + 3Nz/2Nj/19f/6Oj/////+Pj/YGD/DQ3/Fxf/FRX/IiL/trb/j4//CQn/Zmb/+/v/ + xsb/GBj/HR3/0tL//f3/Xl7/ZGT/1dX/BAT/p6f/n5//AQH/Fhb/09P/c3P/GRn/ + mZn/qqr/PT3/AgKXVg1iAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB + YktHRCJdZVysAAAAu0lEQVQY022Q1xKCMBBFN5LQixFR7Bp77wU7//9TJgTFB+7L + njmTydxdAECooGCiqgQrBYQAhNF0gyYxdE04hEyL/mKZ3CHNpn+xNQSOy6Hkl3n8 + gKPrgOLxWamGYa3eaHL0FMDieavd6fZYfyAYAxFjOBpPpmw2F0xATf9dLFfrBNSv + 2mx3e5oqIuHAjoEkIr+npzO7RFJhWYJeb+wuDS+RVKWP5+stFa8qF4riOFsoZ+2c + 42QnLKYn/ADYChWCRPB9rQAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw + ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU + MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC + } + image create photo ::tk::icons::8-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 6lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Bwf/MjL/UVH/TU3/Kir/BAT/DAz/j4//7e3/+Pj/5+f/eXn/ + BQX/Skr/9/f/7+//Z2f/fn7/+/v/6ur/MDD/UFD/4uL/Jib/QUH/9PT/NTX/EhL/ + srL/////09P/2tr/m5v/CAj/ycn//f3/y8v/1dX/s7P/GBj/hYX/HR3/Zmb/0dH/ + LCz/5eX/dHT/S0v/wsL/NDT/V1f/sLD/zc3/ysr/paX/RUX/AQH/Bgb/Dg7/DQ3m + iTf5AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRC8j1CARAAAA + yklEQVQY021Q1RLCQBDbowZFSpEWh+J+xd3d/v936N5hD+QlmezsTrIAQIhLECVZ + lkTBRQgAOorbozN43Ap6hKhe/QOv6nhE8ek/8CkE/AFUoXAkapioAn4QNIdj8UQy + mUpnHKkJIOIom7PyhWKpjFoECalSrNbqDauJWgIZqdWmdod2e6hlbhn9wXBExxNu + scUptWfhFJ3zRXY+TheT5Yqu+XkWYmMNtkNa3fEQLGpmfziezpcrj/oqdLs/zHeh + P7X/POf7wuDrhU+46hlBGTVCQgAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0x + MFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgt + MTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC + } + image create photo ::tk::icons::9-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 8FBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/DAz/OTn/U1P/R0f/HBz/AQH/Fhb/oqL/8/P/+fn/+Pj/1NT/ + S0v/cXH/////29v/W1v/mJj/0ND/AgL/paX/np7/Ly//7e3//Pz/lZX/vr7/GBj/ + VVX/9fX/c3P/QED/5ub//f3/19f/4OD/+/v/eXn/Pz//mZn/oaH/dXX/6Oj/Z2f/ + Kir/cHD/enr/FRX/TU3/8PD/Ojr/Ozv/2tr/nJz/CAj/Tk7/sbH/z8//wcH/Bgb/ + Dw//CgoJOUsyAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCCz + az2AAAAAy0lEQVQY022Q1RLCQAxFs9QovlAozuLu7u72/39D0y3yQB6SO2cmmXsD + AITYBFGSZUkUbIQAIFHsKjVLtSvICHE46aecDoMRxUV/yqUQcHtQ+QNaMKSj8rhB + 8BozHInG4okkIq8AIs4US2eyLBdCLYJk9HyBFWmpXNEQSSDjqLJavdFkLdQyR+1O + t9cfsCFHuEj10XgynbE5XzTPL5ar9Sa+3fHzpon9rFI7sOOJmzCt5s+X6221tqxa + ge6Pp/4O9Cf2n+d8X+izXvgCm5cZM7QQ1AwAAAAldEVYdGRhdGU6Y3JlYXRlADIw + MjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAy + MDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== + } + image create photo ::tk::icons::10-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + MlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/BAT/IiL/AAD/AAD/GBj/VVX/Skr/Bwf/AQH/Hh7/Q0P/R0f/Jyf/AwP/ + Cwv/lZX/////1dX/Fhb/X1//2tr/+fn/+vr/4+P/bm7/BAT/Ojr/pqb/1tb/KCj/ + 4OD//v7/oKD/lpb/6ur/Njb/JCT/3t7/+/v/8PD/XV3/5eX/Jib/Fxf/cnL/trb/ + bGz/lJT/eHj/CQn/wcH/kpL/Bgb/Dw//hIT/fHz/0tL/FBT/vb3/mZn/29v/Ghr/ + DAz/xsb/iYn/RUX/9vb/8/P/NTX/5ub/YWH/19f/EBD/tLT/5OT/0ND/WFj/ra3/ + jo7/Dg7/IyP/kZH/yMj/ysr/AgL/DQ1XjFJNAAAAE3RSTlMAAA5Vq9/4NK/0St3c + Da7z8/PgJJvUWQAAAAFiS0dEILNrPYAAAADzSURBVBjTbZDXUgJBEEV7mLBkQyus + AWlXQVRUFDGgEkxgwoA5B/z/X3B6y/TAfTxVXX3PBQAhAlJpY7SSASEAmDjBEPoJ + BR1mQoQj+JtI2DLhRPFfoo6AWBxxYDCRRHSHhkdGU/EYyB4cS9O4h+7EZCY7leuV + oKZnZjOU93BufqGwmF0qKtDLpZVVRmu0Xt7I06YGU96qVBnV7HV9m3YMmN093GfU + oOZB8pCODGj72UcVOj5pndKZBvWDzi/aicsrulZcwqIbD2/v6L5ED33Sr/r49PyC + +Pr2/lEo2qos5HZclum0PlMs1EW7yzh/E/Z/T/gFtqkjSXNN8rEAAAAldEVYdGRh + dGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRk + YXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5E + rkJggg== + } + image create photo ::tk::icons::11-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 4VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/GBj/VVX/Skr/Bwf/FBT/U1P/TU3/Cgr/Cwv/lZX/////1dX/ + Fhb/CAj/ior//v7/3t7/HR3/BAT/Ojr/pqb/+fn/1tb/AwP/NTX/np7/9/f/39// + JCT/+/v/8PD/HBz//f3/7+//Jib/trb/bGz/lJT/Hh7/s7P/c3P/Bgb/Dw//hIT/ + BQX/dnb/19f/4OD/WFj/ra3/jo7/Dg7/Tk7/rKz/ExP/AQH/AgL8EhtJAAAAEXRS + TlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBycBEEHAAAAyElEQVQY023Q + Vw7CMBAE0DWxHTosvYTee++9k9z/QHgDAoSYvzzJ0cwCAGMOjQspBdccjAGQ6E4X + 2nE5dTLG3B58x+NWxnQvfsWrM/D5EUPhSJS+Y/FE0u8DLYCptJHJKsnlC8VSQANe + rlRrRj2LjWarbXRKyEF0i70+0aA+HBEJkOPJdEY0XyzzRBLkao0bou0ad08S6r82 + qeyeD/kvcSqhaP+iw1yVoKrH0/lCdL3N7qoqDTIt015jWhYN+jP7z3E+Jwy+TvgA + cTUbrJizqpQAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTUt + MDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE1 + LTA0OjAwBo9JEwAAAABJRU5ErkJggg== + } + image create photo ::tk::icons::12-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + LFBMVEUAAAD/AAD/AQH/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/Fhb/mpr/jo7/AgL/BQX/AAD/AAD/GBj/VVX/Skr/Bwf/CAj/MjL/ + UVH/UlL/ODj/DAz/Cwv/lZX/////1dX/Fhb/jY3/7e3//v7/8vL/oqL/BAT/Ojr/ + pqb/+fn/1tb/S0v/9vb/+/v/mpr/iYn/8/P/ZGT/JCT/3t7/8PD/PT3/l5f/k5P/ + Fxf/HBz/29v/fHz/Jib/trb/bGz/lJT/hob//Pz/RET/Bgb/Dw//hIT/HR3/oKD/ + +vr/9PT/eXn/BQX/KCj/vr7/2dn/WVn/ExP/t7f/9fX/jo7/19f/Y2P/WFj/ra3/ + Dg7/rKz/qan/qqr/AQH/AgJeYrBbAAAAF3RSTlMAAAAOVavf+DSv9Erd3A2u8/Pz + rtw04GaGKL0AAAABYktHRCS0BvmZAAAA7ElEQVQY023QWztCURCA4Vlah91pp8II + URmbTY4hcq6IUJEQCvX//4O1dk4XfVfzvFczAwCM+biQSknBfYwBGLH8AfQK+C1j + jAVD+FsoqI1ZYfxX2GJgRxAnE1PTiDPJ2blUOmIDH8XMPC04mFlcct3llSgHkV1d + W6cNBze3cts7u25egNzbzxUMHRweHZ+c0pkEVSyVzw3p0heVwqUCdVXF6wHd3Nbq + jTsFUs8Dum/SQyuLEsQPPT7RczvRSgqzhKYXB18rRC5RjHurvnXaXcy/f+g+47Z3 + UK/fQ+x7jY2PDDt7yHP+Xjjx/cIvG7EnkM/vXyUAAAAldEVYdGRhdGU6Y3JlYXRl + ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlm + eQAyMDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== + } + image create photo ::tk::icons::13-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + HVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/Bwf/PT3/AgL/AAD/AAD/GBj/VVX/Skr/Bwf/Bgb/Ly//UFD/MDD/Cwv/ + lZX/////1dX/Fhb/CQn/hob/6+v/+fn/+vr/7Oz/hIT/BAT/Ojr/pqb/1tb/Pz// + 6ur/8PD/bGz/iYn//v7/JCT/3t7/+/v/ERH/PDz/DQ3/ZWX//f3/5ub/Kyv/Jib/ + trb/lJT/AQH/8vL/h4f/Dw//1NT//Pz/0ND/Nzf/AgL/Dg7/IyP/jY3/u7v/IiL/ + 0tL/iIj/19f/3d3/xcX/vr7/5OT/WFj/ra3/jo7/Ozv/oaH/y8v/zc3/qKj/RUX/ + AwMz70tLAAAAFHRSTlMAAA5Vq9/4NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRB8F + DRC9AAAA8UlEQVQY023Q11rCQBAF4Fm2hBZsgwlFlyhooihIFxWighIFewX0/R/D + bMRywbma77+acwCAkBBlXAjOaIgQACVaOIJBImFNGSHRGP4mFvWNaHH8l7hGQE8g + JlcNEzGVzmSyZkIHuoBr6zJn4cZmvrC1bS9SYM7ObkEWLdzbL5UPKvk0A16t1UuK + Gk2jddg+OuYgTjrlriJE1z6tnDkCROoc7W9y7F7/4lIA9++ABqZnXuXkNQf2Q8aw + M0reyFumnvDpzsLsvXx4bD8t0eDV55dXD/HtfTyZfizrQSF34Koyny3PUYXm1J4z + zt+EK7MJvwDJgSGaiujlLAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw + ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU + MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC + } + image create photo ::tk::icons::14-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + MlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/BAT/AAD/CAj/AQH/EBD/GBj/JSX/Bgb/Bwf/AQH/AAD/AAD/GBj/VVX/Skr/ + Bwf/MDD/Wlr/QED/Cwv/lZX/////1dX/Fhb/Ly//09P/urr/BAT/Ojr/pqb/+fn/ + 1tb/Gxv/vLz/u7v/CAj/JCT/3t7/+/v/8PD/DQ3/n5//+Pj/0tL/Jib/trb/bGz/ + lJT/gID/np7/aGj/Bgb/Dw//hIT/Xl7/9PT/ysr/Jyf/YmL/wMD/FBT/FRX/s7P/ + 5ub/zc3/4OD/9fX/o6P/6Oj/5+f//Pz/uLj/19f/Ghr/JSX/ICD/cnL/xcX/WFj/ + ra3/jo7/Dg7/PDz/q6v/e3v/AQH/AgJ9lF2oAAAAGnRSTlMAAA5Vq9/4NK/0St3c + Da6u8/P436vzVa7c4LQK5msAAAABYktHRCS0BvmZAAAA7UlEQVQY023Q11oCMRAF + 4AmbZGlrAQQNKiojZUVFERQboIIiSFOwi2V5/1cwifWCc/lfzHfOAAAhLoMyzhk1 + XIQAKDHdHqHjcZvKCPH6xG98XmnE9It/8ZsErAkhovMLixpiS8uTFhhTYiWOqwkl + yRSmpw2g9lpmHTcUbWYRt7YpsNxOvqBpd6+4L4kBPzg8OlZkl/LliiQO/ORUnCmq + 1s4v6njZCACTRyQ17StstTvYzQSB/lDvunVTwP4gpEpIuk2Iu/vcwyM+zYR11eeX + 4auu+vb+EbH0IGfkfM1xRrNy0JjZY57z98K57xd+AgvXJw2x8S2eAAAAJXRFWHRk + YXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwRjrrMgAAACV0RVh0 + ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMDdnU44AAAAASUVO + RK5CYII= + } + image create photo ::tk::icons::15-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + NVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/FBT/AAD/R0f/Li7/AAD/AAD/GBj/VVX/Skr/Bwf/Gxv/MjL/Ly//Cwv/lZX/ + ////1dX/Fhb/kpL/8/P/8vL/6+v/BAT/Ojr/pqb/+fn/1tb/CQn/vLz/2Nj/wsL/ + xMT/wcH/Nzf/JCT/3t7/+/v/8PD/GRn/2dn/dnb/Wlr/T0//AgL/Jib/trb/bGz/ + lJT/7u7//v7/7e3/9/f/9vb/qqr/Bgb/Dw//hIT/KCj/oaH/tbX/ZWX/bm7/7+// + cnL/AQH/ERH/DQ3/mZn/TU3/tLT/rKz/ICD/Ghr/09P/fX3/19f/Njb/4eH/xcX/ + wMD/WFj/ra3/jo7/Dg7/PDz/y8v/OTn/AwNVwL6YAAAAFHRSTlMAAA5Vq9/4NK/0 + St3cDa6u8/Pz4MH3NZkAAAABYktHRB5yCiArAAAA9UlEQVQY023Q11rCQBAF4Fm2 + hBZAHZTmGoMVAQs2sKGoEFuMDRUQVOT9H8FsPlEvOJf/zcw5AECIjzIuBGfURwiA + Es0fQC8Bv6aMkGAIfxMKuka0MP5LWCOgRxDjk1MJxGTKTTqqA41hZlrOGIizZtY0 + 58YosPmFxSW5bGBuReYLxdU1Bnx9o7SpaGu7tLNbTlY4iL39g0NFqaPq8UntNC5A + nJ1jXVHDuri8upY3Arh72SM7cWs7RXnHgQ3p/uHxqfksX5h6wqVXA1tt2Xmr5sep + 92q39/6B+Gn1+9ZXRPcK2RVblRk4zkAVGlF7xDh/E078TPgNVMok5Eu0euUAAAAl + dEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAA + JXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAA + AABJRU5ErkJggg== + } + image create photo ::tk::icons::16-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + LFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/ExP/AQH/SEj/BQX/AAD/AAD/GBj/VVX/Skr/Bwf/Ghr/R0f/U1P/Ojr/ + Cwv/lZX/////1dX/Fhb/z8//9/f/+fn/9PT/oKD/BAT/pqb/1tb/Gxv/mZn/Y2P/ + 3t7/3d3/SEj/JCT/+/v/8PD/UlL/7u7/PDz/LCz/UVH/Jib/CQn/trb/bGz/lJT/ + c3P/vr7/7Oz/5+f/kZH/EBD/Bgb/Dw//hIT/enr//v7/rq7/f3//6en/amr/aWn/ + 7e3/MjL/pKT/oaH/PT3/8fH/CAj/sLD/19f/29v/urr/6+v/WFj/ra3/jo7/Dg7/ + gYH/wsL/UFD/AQH/AgL/Cgoto8vpAAAAFXRSTlMAAA5Vq9/4NK/0St3cDa7z89/z + ruDPFLgEAAAAAWJLR0Qgs2s9gAAAAPNJREFUGNNtkMdWAkEQRavpMKTBWBgQLGcI + ooKIooJiRAXMAYyAo///D3bPMS14u7qbevcBAGMBLqRSUvAAYwCGWMEQ+gkFLcMY + C0fwN5GwZsyK4r9ELQZ2DDE+NT2jz9nEXDIVs4GPYGqeFhzEhJvOZHOjHMRiMp+h + JQeXXVopFFdLAuRasbxu0Ea5srm1Xa1JUNWd3bpBe1TZPzg8OlagGid4atAZNVvt + 8+aFAqlf+eiSrq7xhm7HQPygu/ts6aFDdWFKaNR1sJajx6f08zj3q768vvV04f7A + 7bxP2L6Q9+EZGe+z1zBCQ7SHjPM34eT3hF9IiCRlUyvoEQAAACV0RVh0ZGF0ZTpj + cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY66zIAAAAldEVYdGRhdGU6 + bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3Z1OOAAAAAElFTkSuQmCC + } + image create photo ::tk::icons::17-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + BVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/Li7/AAD/mJj/AAD/AAD/GBj/VVX/Skr/Bwf/GRn/Njb/NTX/Cwv/lZX///// + 1dX/Fhb/cXH/9vb/8/P/8vL/8fH/9PT/BAT/Ojr/pqb/+fn/1tb/ZGT/29v/2Nj/ + 19f/4+P//f3/eHj/JCT/3t7/+/v/8PD/Cgr/Fxf/Gxv/oKD/paX/EBD/Jib/trb/ + bGz/lJT/Tk7/2dn/Jyf/Bgb/Dw//hIT/vr7/+Pj/5ub/Kyv/jIz/uLj/CQn/vb3/ + j4//WFj/ra3/jo7/Dg7/jY3/UFD/AQH/AgJwwfqkAAAAE3RSTlMAAA5Vq9/4NK/0 + St3cDa6u8/PgHfwDJgAAAAFiS0dEHesDcZEAAADhSURBVBjTbdDJVgIxEAXQChma + qRF4igqG1gacRXFgVBxAQAFBFP7/U0xajrjgbZJzN1X1iIixEBdSKSl4iDEiK044 + giCRsGONsWgMf4lFjTEnjn+JO4zcBLC5ldnGzm7WZsMlnkRuT+c97B/4fqFYSnES + h0fHJ/rUw9n5RflSX1UEyeub2ztL1ZpXb+hmS5K6f2g/WjJ58p9foEh1unj9pVZP + V2BImv+SMv3BGyBJrOhdD0eAsEsYKhuqjvUHkOTBqpPp5wyYfU2/gYQbHDRfzO3A + hXnsQWvOXlPOqsL0ssIfbB0e7ntg/vYAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEt + MDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIx + LTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAAAABJRU5ErkJggg== + } + image create photo ::tk::icons::18-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + PlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/DAz/S0v/Bgb/AAD/AAD/GBj/VVX/Skr/Bwf/BQX/LCz/T0//MDD/Cwv/ + lZX/////1dX/Fhb/Bgb/e3v/6Oj/+Pj/7Oz/jIz/BAT/Ojr/pqb/+fn/1tb/MzP/ + d3f/bW3/8/P/9vb/RUX/JCT/3t7/+/v/8PD/ODj/8fH/5+f/+vr/S0v/Jib/trb/ + bGz/lJT/CQn/nJz/2dn/1NT/srL/EBD/Dw//hIT/HBz/t7f//v7/0tL/zc3/xsb/ + JSX/amr/5OT/Li7/ICD/19f/gID/dHT/4+P/KSn/Ghr/jo7/Njb/y8v/w8P//f3/ + 7e3/WFj/ra3/Dg7/AgL/SEj/qan/zMz/rKz/UlL/AQH/DQ192iTxAAAAFHRSTlMA + AA5Vq9/4NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRB8FDRC9AAAA9klEQVQY023Q + x1oCQRAE4B4mLGkxtUhQm0UXQTErZklGTCgmQEUw4fu/gDv7mQ7U8b90VwEAYx4u + pFJScA9jAFoMrw/d+LyGNsb8AfxNwO8YM4L4L0GDgRlCHA6PRBCjsXh8NBIygffh + 2DglLExOTNp2aqqfg0hnpmcoa+Fsyp6bX1hcEiCXV1ZzmtbWc5nYxuaWBLW9s5vX + VChSqUx7+wpU8gAPNR0dV05OK2fnCqRz2aULql5e1ehagvihG7q9uy9TXegnHKpZ + 2KhS8+HxaYC7r7ae623svLw2394/Bk23ULfT1WXSn+2oLtSjdo9x/iYc+p7wC++L + Jf2uJzrcAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0 + OjAwRjrrMgAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0w + NDowMDdnU44AAAAASUVORK5CYII= + } + image create photo ::tk::icons::19-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + LFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AQH/EhL/AAD/AAD/GBj/VVX/Skr/Bwf/CAj/NDT/UlL/S0v/IiL/AgL/ + Cwv/lZX/////1dX/Fhb/DQ3/j4//7+//+fn/3d3/Xl7/BAT/Ojr/pqb/1tb/V1f/ + +vr/6Oj/ZWX/hob/4eH/LCz/JCT/3t7/+/v/8PD/ior/uLj/Bgb/HBz/bGz/Jib/ + trb/lJT/enr/0tL/QED/6+v/jo7/Dw//hIT/LS3/2Nj/29v/MzP/kpL/c3P/2tr/ + gYH/Hx//amr/f3//ICD/Njb/7e3/UVH/19f/KSn/xcX/0dH/srL/WFj/ra3/Dg7/ + qan/zc3/h4f/Hh7/AQH/BQVtNoEFAAAAE3RSTlMAAA5Vq9/4NK/0St3cDa7z8/Pg + JJvUWQAAAAFiS0dEILNrPYAAAADySURBVBjTbdDHWsJQEAXgudwSOsrYFRyDBhWN + DRuiIGABRexiwRLf/x3M5LMtOMt/M+cMAAgRkkobo5UMCQHAYoUjGCQSttiEiMbw + N7Gob8KK47/ELQGJJOLQ8Mgo4tj4xORUJpkAmcLsNM3YmJudc5z8/IAEtbBYcGjJ + xmV3ZXXNXd9QoIubW9tMO7Rb2stTWYPZPyhXmKp0WKzVqWHAlI7wmOnklJpNhyoG + tH85IGydFc7bdKFB/VDn8ur65ta9U1zCp3sbH9rUfaSnQRlUfX5p9BBrr2/d9w+/ + Kg/yMh6P+exlPR7UZ3af5/y9MP39wi8SoyQetkVHgwAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY66zIAAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3Z1OOAAAAAElFTkSuQmCC + } + image create photo ::tk::icons::20-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASEAYAAAAGXlIUAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + BmJLR0T///////8JWPfcAAAErElEQVRIx7WWbUhUaRTH/6OmTmnWlr0IWfbih16o + LEewsg8NFEmElsagixW2GIVgKCixxFJbRBSZIibUUotJzJYkVuxitBZRua6J5AqR + q5TphxYZG9d8m/nth7nTXk032mXPl/99zj3nf/48z3PvOdI4g4kwvNGHaQd96Oz0 + YWeGD4fmGDjb8KcZcS1G3mGD55fx/JPauECLD9cZQqpP+LC/34fwedg/YPB8Y/A2 + ja3zyR3ZXujD9pZ/J+BT2P7cqFP00Y6Ndax3GAlr/h8hHwlbZ9T9cpyg8K99ePMd + WLdZtwHEr41fC5BSk1IDkJKYkggQvyB+AYD1nvXeRIUshZZCgOiz0WcBtmzeshlg + a83WGoBYd6wbIDAuMM6fd9Nt6DhmCEq7DRGOCIfbC2Wvy14DuIpcRQDeRm8jgPe+ + 9z6Ay+lyAlTsrtgNMMM6wwqgSEUCZFmzrAAv9r7YCzB0fug8wEjOSA5AV1RXFEBu + Y24jQODVwKv9H3QYl8q5V0p/kv5k93dS5ZnKM5LkXeFdIUkVrypeSdLootFFkpSz + K2eXJAX1BvVKUkZVRpUkNYU1hUlSXWJdoiQtrF1YK0lXbFdskjRwa+CWJB2IOhAl + Sa4HrgeSlByWHCZJDc8anv2QZijrqAB7qb0U4OLdi3cBzj0+9xhg5pqZawCWvlz6 + EqDrYNdBTHao81AngMPisADQRBNAt6PbARBri7UBzN0/dz9AW2pbqjn/yPQj0/1H + 13FJIIssg22gUIUCaL7mm+9ExLSIaQDFucW5AN5h7zDA2+y32QA2u80OUOAscJoL + tV5vvQ4Q+SjyEYA1z5oHUH+t/po57kLShSR/vcE3AZIQGpU0qEFJUo96JGnx+8Xv + JamivKJckg5fPnxZktx57jxJOvH0xFNJaqhrqJOkkPyQfPMPxTPiGZEkb7Q3WpK8 + w95hSRp9OPrQHBfiDnF/WPwR4MOe+38HrLattklSZWFloSSlZ6ZnSlLbzradkpRV + mlUqSSWXSi6ZiV3JrmTz2hpsDZakkKyQLEkKWha0TJKsHqvHHNfX3Nfsf+752bhD + zhSY1zavDaC+rr7OvKXv0t+lA5wqP1UOkLYxbSOAI8oRBbC8d3kvgL3AXgAw0DXQ + BeAedg8DbE/dngoQPyd+DkB3e3e7mX9f5L5I/5E59/g/tx8hvzm/ud8C3j5vnzmB + aqoByCefCezkhpMbAMJXhq8EqLXX2s3v34S+CQXoiO+IN/ubS5pLAGLuxNxxG4LS + frLA7ITZCeFD0mnPac/3X0jhq8JX7eyXOMpRSVKYwiTJEmOJkSQFKECSArIDsiXp + xo4bOySpyl5ll6QlcUviJCn3eO5xSUp4nvBckgJvB96WpNbi1mJJKmsta5WkhsyG + zGqX78iyzpqaW0hSSNL6DGmkZaTl+m8STpyLmyQFK1gTmeEnllhJ0izNMr8O2BSw + SZKmRk+NliTLFMsUSRqIGYiRJM8xz7Hf1/pi9yz3YeO1yZpr0dgmOFGL+C/Y3jpp + c/XbJOPHM2Ns+HbsGPG5Avr/HMvj551g/NA/C/M331+NS5czdvDqNLr0UKyBKw3/ + V0Zcu5F3wOBpmnRHDPsLflt0HfDi3lIAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEt + MDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIx + LTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAAAABJRU5ErkJggg== + } + image create photo ::tk::icons::20plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASEAYAAAAGXlIUAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + BmJLR0T///////8JWPfcAAAEjElEQVRIx7WWa0iUeRTGnxkdu9i0mrOFJtaQbCRZ + QYl2gT6UFEERmHSRRRNaNrrSZVs1kY0ipYJSakOiovqgaSViIBshSpSRtSQleFsV + my3MstzXambU337wdRlr2mxhz5cHznvOcx7O//3/z5E+MvCH9rohTN46hCXtQ9ie + MoTuySY6TH+yGVdv5m03eR58zP9Z+yjQMoTzTSE3Dg+hYQwhfB0a70yeX0zeRyPr + fLEjq34ewtb6/ybgS9j6xKyT8UnHRjoWbDQT5v0/Qj4RNt+s+72PIG+7tz3pJ9g9 + cffE345BvD3eDhB8Pfi6PyKr1+oFiA6NDgVIrE6sBkgsTiwGcEY4IwAspy2nRyvs + +l/mP5YjoIaagUQY6Bzo5FfoPdB7AOByweUCAEeVowog4FDAIYA9B/ccBOjwdngB + PIWeQgDPBc8FgJa4ljiAlDkpcwC0Vmv9CQk0Ag0AJ06MyZAUlxS3+RtBviPf8S4R + 8t7kvQEwVhorAQZdgy6A9Ir0CoCEnIQcgNdnX58FcHvdXoD8a/nXAK6UXCnBx1pW + tawCiB4fPd6foGl50/IA6t7WvQXojeiNqO8W2EJsIX8GQGRjZCNAs7vZ7UucWZxZ + DLDfut/q639S+aQSwHHVcRVg1vFZxwFeLHmxBGCwdLAUYMOWDVt8hQSEBIQAzHw5 + 8yWAq8XVAuAxPEbnLas0Nn9s/qR50tZjW49JkrPIWSRJvVG9UZJ033bfJkmRBZEF + vveze133OkkywowwSXoV8ypGknru9NyRJEuSJUmSIhUpSVq4fuF6SSqfXT5bkgpP + FZ6SJMcdxx1J6lrSteTbGKt0qeRSSdBaad/SfUsl6UPih0RJyq3MrZSk6qrqKkka + s2vMLl9B/dv6t0kST3kqSQMhAyGS1H+i/4RvXND7oPeSNKVsSpkkLVuxbIUkLbIv + sktSUGpQqiSRS666Zfb/D2hKbUoF2Lh3416AwDWBa3xbnZuVm+V7ZPcW31sMEHwv + +B5AuCvcBdDU0dThG7ezfGc5QKgr1AWw9OjSowApRooB0O3sdgJ4Mj2ZnWWBUt/2 + vu1ySjftN+2S1B/bHytJyTeSb0hSQ3ZDtiQ1lDSUSJLKVS5J0zOmZ0hSTGxMrCQ5 + VjtWS1K4JdwiSe40d5okNSU0JUhSz9SeqZJUrWpJ0oyuGV2S5B7nHidJtiO2I55C + weDpwdMAA5sHNuPHCrILsgEi2iLaAGrP1573/d6W15YH8Ozis4u+/tsVtysAJj2f + 9NzfLQvLCMsAOJx2OO3dJmg82XjyVLt5ZEW34OHjh4/rG6GovqgeoLSutA4g3Ug3 + fInmxs+NBzjXfK4Z4EHUgyiA2ru1dwHOlJ0pA4jZEbNj1A9jj/kwHvQZHWMzx2Yu + 6AOrzWprnQWWGksNgMVmsfkjClgesBzAvsK+AmBCzoQcAGuWNWu0QoZH1IJNn5ll + /wzXjJFDcLQFRi3k6WeHq/wLG14/fjfXhiMj14ivFWD0jeQZ5vWzfujfhQ0vaA/N + RevHkYtXuzml3d+ZONv0/2DGtZp5W0yeR5/tiGl/A2jL8ui+maoGAAAAJXRFWHRk + YXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwRjrrMgAAACV0RVh0 + ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMDdnU44AAAAASUVO + RK5CYII= + } + image create photo ::tk::icons::9plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + OFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/ERH/AAD/NDT/AQH/AAD/AAD/Cgr/Nzf/U1P/SUn/Hx//AQH/mJj/8fH/+fn/ + 2dn/VFT/BAT/YmL//f3/4uL/YGD/j4//IyP/GBj/xsb/xcX/Fxf/lZX/////rKz/ + JSX/5eX/3t7/3Nz/AgL/hob/yMj/Hh7/Skr/fn7/MTH/srL/vr7/9fX/NDT/NTX/ + 39///v7/3d3/+vr/g4P/RET/9PT/+/v/8/P/R0f/OTn/lpb/pKT/c3P/4eH/dHT/ + Dw//Pz//VVX/5ub/ExP/JCT/bW3/fX3/Ghr/QUH/Rkb/Gxv/wsL/1dX/p6f/DAz/ + e3v/enr/Dg7/ra3/zs7/w8P/gYH/GRn/Bgb/CwuphzIHAAAAFHRSTlMAAA5Vq9/4 + NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRCy63XGrAAAA+ElEQVQY02NgYGBkZGJm + YWVjY2VhZmJkZGAAibBzcIqAAScHO0iMkZGLWwQOuLmAYozsPCJIgIedkYGXT1RM + XEJSCibGx8vAzC8tIysrJw/kKUhKKogIMDOwKCopq6gqyamJiKhraGqJiLAwsGrr + 6Erp6euoABUZGEoqGLEysBnrmJiayeiYW1haWVtbWdqwMbDZ2tnLOTjqODm7uNrb + u7q5szGwinh4enn76Pj6+QcE6gf4B7EysASHhIaFu1lHiIhEGhiGgYxnFvSxj4rW + iYkVEfGLi08AOYJXKCIxKTklFcmpQA+lJaRLIXsIi7exBA4iCIWhQQgAiNMk9J5+ + e/MAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBG + OusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAw + N2dTjgAAAABJRU5ErkJggg== + } + image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + olBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Fhb/QED/Pj7/ExP/VVX/9PT/8PD/SUn/WFj//v7/+fn/S0v/ + SEj/PDz/MjL/6Oj/Jyf/ICD/4+P/2Nj/Fxf/Dw//qKj/nZ3/Cgr/IyP/hIT/gYH/ + Hh7/PT3/Ly//paX/oqL/KCj/AgL///8V6AjgAAAAEXRSTlMAAA5Vq9/4NK/0St3c + Da7z4Pnet34AAAABYktHRDXettlrAAAAoElEQVQY022QxxKCQBBEZ9hERkygophz + lv//NmF3Bz0wp1dd1V3dAwCIDuNCSsGZgwjQKMr1Un2eqxoN0Q/S9gK/1lCF6d+F + CiGKNfYHw5GGOAKWaBpn+URDwoAbw3RWzA1xEAYWRVYaEiANLPPV2pAkabPd7Umy + xsPxdCajjb9cb3eKtyXq+AeVsFWfr/eHqtKgqmoHdczueM7vhT37wi9PRRMHXNeq + aAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY6 + 6zIAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3 + Z1OOAAAAAElFTkSuQmCC + } +} -- cgit v0.12 From f54e489be1208f7f2356fa04e1c21e7c50c2cd75 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 11 Aug 2021 01:54:37 +0000 Subject: Fix indent --- library/iconbadges.tcl | 862 ++++++++++++++++++++++++------------------------- 1 file changed, 431 insertions(+), 431 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 99e3c34..8f0ac0e 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -7,435 +7,435 @@ namespace eval ::tk::icons {} - image create photo ::tk::icons::0-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 51BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/AwP/JCT/RUX/ISH/AgL/BQX/cnL/4eH/+vr/29v/W1v/PDz/ - 7u7/+fn/kpL/pKT/////eHj/1NT/FRX/KSn/5+f//v7/WFj/lJT/v7//CQn/Fxf/ - 1tb/d3f/mJj/vLz/CAj/FBT/09P/fn7/iIj/xsb/DAz/Ghr/2tr/b2//Xl7/Njb/ - SUn/8vL/+Pj/HBz/yMj/39//5OT/vb3/ExP/Ly//nJz/ysr/lpb/Kir/DQ3HpLSX - AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCJdZVysAAAAxUlE - QVQY021QxRLCUBDbR5UipRR3Fnd3Ly7//z2wfUUO5JJMZnYnCQAw5hJESZYlUXAx - BkCOoroNG25VIY8xzWN84NFeHlO8xg+8CgOfn1TQDIXCEVJ+Hwj6i6OxeCKRTJGl - CyASpzPZXB6TJmkRJKICFkvlSrVGWgKZqI6NZquNHdIyt7rY6w+GOOKWfTjGyXQ2 - xwU/tN8vq5XVerNd8/d2iJ2F+wMeTzwEj3q+XK3b3YnqFAo+ppF3oT+1/4zznTDg - TPgETvcYi7Qhbm4AAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6 - MTQtMDQ6MDDRpfobAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1 - OjE0LTA0OjAwoPhCpwAAAABJRU5ErkJggg== - } - image create photo ::tk::icons::1-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - kFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/HBz/V1f/Rkb/BQX/Dw//oKD/////y8v/Bgb/Pz//ra3/+/v/ - zMz/Li7/5ub/+vr/8fH/Ly//uLj/Zmb/n5//Bwf/Dg7/kpL/YWH/rq7/h4f/Cgr/ - AQH/AgLXmjE+AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBib - aYUeAAAAnElEQVQY022Q5w6DMBCD78hi03RQuvegg77/25ULCakq/MenT4piGwAQ - A8aFlIKzABGAiAojbRSFihhinOheSdwyVKn+UaoQsry7x5PpjDzPgBWGlPNqUdJR - MODky9V6U20N0hwE2W5/ODokQJKdzperQ7JDt7uuPRL299o/5P+IuxA9akO4qI/n - 622jukLNp3GFBmoPjOMnHNkJv3kDExXHctm+AAAAJXRFWHRkYXRlOmNyZWF0ZQAy - MDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0RVh0ZGF0ZTptb2RpZnkA - MjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAASUVORK5CYII= - } - image create photo ::tk::icons::2-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 21BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/Cwv/ODj/UlL/UFD/MjL/CAj/ExP/oKD/8fH//v7//f3/7u7/ - kJD/DAz/ZWX/9fX/jIz/lpb/+vr/9/f/TEz/TU3/m5v/iYn/Ly//6+v/////YmL/ - nJz/5OT/MDD/KSn/srL/7Oz/ZGT/AQH/Nzf/zs7/zc3/SUn/AgL/ICD/ysr/7e3/ - gYH/VVX/WVn/Kir/fX3/eXn/AwP/dnb/rKz/qan/q6vjChO4AAAAEXRSTlMAAA5V - q9/4NK/0St3cDa7z4Pnet34AAAABYktHRCy63XGrAAAAwElEQVQY021Q1xLCMAxz - uktpS9hQoOwZ9t57/P8XUSesB/RinXz2SQIAQiRZUTVNVWSJEABUdMOkHKaho0ZI - yKIfWKFAI3qY/iCsE7AdZNFYPJFMIXNskN1gpjNZL5cv+AF1ZVBwVfRK5Uq1Vkeu - gIqj0Wz57Q7rIldBe/1N91h/gER7S8ORN55MhcQP6WzOFssVFYf8/XrDtrv94Sje - cxMnxnEWJtDq5Xq7B3gkhFUeaCUwFYH+xP5TzrfCyKvCJ3EzGUFH/1QDAAAAJXRF - WHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0 - RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAA - SUVORK5CYII= - } - image create photo ::tk::icons::3-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - +VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/CQn/NTX/UlL/Tk7/Kir/BAT/ERH/mZn/8PD/+Pj/+vr/5ub/ - cHD/AgL/Vlb/9PT/5eX/X1//nZ3/////29v/HR3/Fhb/QED/RET/Cwv/f3//1dX/ - Ghr/Bwf/mpr/9vb/+fn/b2//lZX/2tr//Pz/wsL/Jyf/Dg7/Bgb/MzP/c3P/XV3/ - wMD/qqr/ExP/KSn/4+P/bm7/Q0P/6ur/vb3/x8f/19f/KCj/SEj/qan/zc3/y8v/ - oKD/ODj/BQX/DQ3/AwON+4wDAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34A - AAABYktHRCXDAckPAAAAx0lEQVQY021Q1RLCQBDbo4qW4l7ssOLu7g7//zH07oo8 - kJfNZGczyQIAQhaOF0RR4DkLQgBEkWSrSmGVJaIhZLOrH9hthoYkh/oDh4TA6SLM - 4/X5A0HCXE7gFGOGwpFoLJ7QDKpwwJNVMpXOZHEuTzgPAhmFYkkv40qVcAFEZlur - N5otysS3pLc73V6fSfRQ8wyGozges0NqP5nO5oslXjF7GmK96W53eH9gIWhU7Xg6 - X643M6pZ6D54PN+F/tT+85zvC93mC1+z9hl5VNGhJwAAACV0RVh0ZGF0ZTpjcmVh - dGUAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMNGl+hsAAAAldEVYdGRhdGU6bW9k - aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTQtMDQ6MDCg+EKnAAAAAElFTkSuQmCC - } - image create photo ::tk::icons::4-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 1VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/AgL/OTn/W1v/ODj/QED/4uL/////oaH/AQH/KSn/zs7/oqL/ - Fhb/tbX/9PT/1NT/Cgr/l5f//Pz/h4f/fHz/dXX/+/v/trb/HBz/fX3/qKj/DAz/ - EBD/ysr/4eH/zc3/5eX/8fH/lJT/BAT/Dw//uLj/5+f/5ub/8vL/+vr/paX/BQX/ - HR3/JCT/ISH/iYn/sLD/Ghr/Tk7/rq7/a2vT0ZXAAAAAEXRSTlMAAA5Vq9/4NK/0 - St3cDa7z4Pnet34AAAABYktHRBibaYUeAAAAvklEQVQY022QVRPCMBCEL1RSg5Ji - Ibi7W9Hi//8n0aRBHtiXvflm7mZvAQChmKJquq6pSgwhAE6wYRIh08CcIWTZ5CPb - ChnCDvmRgxHEE9HspdIZ7ok4KG6EsjmaZ6G7CqgRKRQpLXFEVNAEKVeqNYk00LnV - G81WWyJdINbp9voDOhxFiC+OJ3Q6m9PFciUW+fn1xt/6O7o/HMV5HsI7BcH5Qq83 - JkK8o5L74ymjfh5iHpMP/Xn7TznfCpOywhdM6Ra8aC+AYwAAACV0RVh0ZGF0ZTpj - cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6 - bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC - } - image create photo ::tk::icons::5-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 7VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/ICD/MjL/Li7/CQn/Bgb/q6v/8/P/8vL/9PT/4uL/FRX/0tL/ - ////wsL/xcX/uLj/Jib/Kyv/6ur/8fH/aGj/XV3/SUn/Fhb/AQH/+Pj//Pz/7Oz/ - +fn/l5f/Dg7/ODj/qan/sLD/W1v/fn7/9/f/+vr/WVn/EBD/Ghr/2dn/gID/X1// - oKD/EhL/5OT/Y2P/S0v/7e3/vb3/ycn/yMj/HR3/AwP/Skr/zc3/LCz/BQX/DAz/ - AgKLBoLHAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRB5yCiAr - AAAAyUlEQVQY021Q1RLDMAxzVhp1XcbYMXXMzIz//zmLk9HD9GKdzvZJAgBCbJKs - qKoiSzZCAFDR7A7K4bBrqBHidNEPXE6mEc1Nf+DWCOgeZD4/QyDImEcHyWAzFI5E - I7F4gFFDAhmXEkkzmUpnsshlUHDk8oViqVyxkCug4ihXa/VGtNlCrgqp3en2+oPh - SEj80AqO6WRqzsQhfz/PLJa5lbkW77mJzba225uHozDBrZ7Oncu+eaXC6ivQrXV/ - vAP9if2nnG+F3leFT2jDGOnV8F/uAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4 - LTEwVDA4OjM1OjE1LTA0OjAwd9LxrwAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0w - OC0xMFQwODozNToxNS0wNDowMAaPSRMAAAAASUVORK5CYII= - } - image create photo ::tk::icons::6-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 9lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/AQH/ICD/S0v/UlL/NDT/CAj/WVn/2dn/+Pj/+fn/8PD/jY3/ - Cgr/LCz/4OD//f3/hob/cHD/5eX/1NT/NTX/bGz/////39//T0//Bwf/j4//5ub/ - wcH/7+//4uL/f3//CQn/lpb/+/v/n5//iIj/8vL/9/f/UVH/hYX/3t7/Hx//vb3/ - VVX/6Oj/MzP/ExP/x8f/e3v/EhL/t7f/0tL/wMD/MTH/IiL/xsb/zc3/qKj/QkL/ - AgL/Cwv/Dg7/BQWiS7IgAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB - YktHRCi9sLWyAAAAyklEQVQY021Q1RLCQBDbowalBYq7y+FWirs7/P/PwPawB/Ky - mezsThIAIMTC8YIoCjxnIQQAFclq00zYrBJqhMh27QO7/NSIpGg/UCQCqgOZ2+P1 - +QPIHCpwTlSCoXAkGos/qZMDHleJZCqdyebyyHkQcBRoMeEvecrIBRBxVGi1Vm80 - W8hFJrWp3jG6vT6TzMMBHY4CY2qwQ/P9RJ/O5gu6ZO9NE6s13Wz14o6ZYFb3scPx - dHYzq69Al+vt/g70J/afcr4Vul4VPgDLCRmO3FuJegAAACV0RVh0ZGF0ZTpjcmVh - dGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9k - aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC - } - image create photo ::tk::icons::7-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - xlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/Hh7/Njb/NTX/Ghr/i4v/9/f/8/P/8vL/8fH/9PT/eHj/fHz/ - 3Nz/2Nj/19f/6Oj/////+Pj/YGD/DQ3/Fxf/FRX/IiL/trb/j4//CQn/Zmb/+/v/ - xsb/GBj/HR3/0tL//f3/Xl7/ZGT/1dX/BAT/p6f/n5//AQH/Fhb/09P/c3P/GRn/ - mZn/qqr/PT3/AgKXVg1iAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB - YktHRCJdZVysAAAAu0lEQVQY022Q1xKCMBBFN5LQixFR7Bp77wU7//9TJgTFB+7L - njmTydxdAECooGCiqgQrBYQAhNF0gyYxdE04hEyL/mKZ3CHNpn+xNQSOy6Hkl3n8 - gKPrgOLxWamGYa3eaHL0FMDieavd6fZYfyAYAxFjOBpPpmw2F0xATf9dLFfrBNSv - 2mx3e5oqIuHAjoEkIr+npzO7RFJhWYJeb+wuDS+RVKWP5+stFa8qF4riOFsoZ+2c - 42QnLKYn/ADYChWCRPB9rQAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw - ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU - MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC - } - image create photo ::tk::icons::8-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 6lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/Bwf/MjL/UVH/TU3/Kir/BAT/DAz/j4//7e3/+Pj/5+f/eXn/ - BQX/Skr/9/f/7+//Z2f/fn7/+/v/6ur/MDD/UFD/4uL/Jib/QUH/9PT/NTX/EhL/ - srL/////09P/2tr/m5v/CAj/ycn//f3/y8v/1dX/s7P/GBj/hYX/HR3/Zmb/0dH/ - LCz/5eX/dHT/S0v/wsL/NDT/V1f/sLD/zc3/ysr/paX/RUX/AQH/Bgb/Dg7/DQ3m - iTf5AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRC8j1CARAAAA - yklEQVQY021Q1RLCQBDbowZFSpEWh+J+xd3d/v936N5hD+QlmezsTrIAQIhLECVZ - lkTBRQgAOorbozN43Ap6hKhe/QOv6nhE8ek/8CkE/AFUoXAkapioAn4QNIdj8UQy - mUpnHKkJIOIom7PyhWKpjFoECalSrNbqDauJWgIZqdWmdod2e6hlbhn9wXBExxNu - scUptWfhFJ3zRXY+TheT5Yqu+XkWYmMNtkNa3fEQLGpmfziezpcrj/oqdLs/zHeh - P7X/POf7wuDrhU+46hlBGTVCQgAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0x - MFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgt - MTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC - } - image create photo ::tk::icons::9-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 8FBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/DAz/OTn/U1P/R0f/HBz/AQH/Fhb/oqL/8/P/+fn/+Pj/1NT/ - S0v/cXH/////29v/W1v/mJj/0ND/AgL/paX/np7/Ly//7e3//Pz/lZX/vr7/GBj/ - VVX/9fX/c3P/QED/5ub//f3/19f/4OD/+/v/eXn/Pz//mZn/oaH/dXX/6Oj/Z2f/ - Kir/cHD/enr/FRX/TU3/8PD/Ojr/Ozv/2tr/nJz/CAj/Tk7/sbH/z8//wcH/Bgb/ - Dw//CgoJOUsyAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCCz - az2AAAAAy0lEQVQY022Q1RLCQAxFs9QovlAozuLu7u72/39D0y3yQB6SO2cmmXsD - AITYBFGSZUkUbIQAIFHsKjVLtSvICHE46aecDoMRxUV/yqUQcHtQ+QNaMKSj8rhB - 8BozHInG4okkIq8AIs4US2eyLBdCLYJk9HyBFWmpXNEQSSDjqLJavdFkLdQyR+1O - t9cfsCFHuEj10XgynbE5XzTPL5ar9Sa+3fHzpon9rFI7sOOJmzCt5s+X6221tqxa - ge6Pp/4O9Cf2n+d8X+izXvgCm5cZM7QQ1AwAAAAldEVYdGRhdGU6Y3JlYXRlADIw - MjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAy - MDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== - } - image create photo ::tk::icons::10-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - MlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/BAT/IiL/AAD/AAD/GBj/VVX/Skr/Bwf/AQH/Hh7/Q0P/R0f/Jyf/AwP/ - Cwv/lZX/////1dX/Fhb/X1//2tr/+fn/+vr/4+P/bm7/BAT/Ojr/pqb/1tb/KCj/ - 4OD//v7/oKD/lpb/6ur/Njb/JCT/3t7/+/v/8PD/XV3/5eX/Jib/Fxf/cnL/trb/ - bGz/lJT/eHj/CQn/wcH/kpL/Bgb/Dw//hIT/fHz/0tL/FBT/vb3/mZn/29v/Ghr/ - DAz/xsb/iYn/RUX/9vb/8/P/NTX/5ub/YWH/19f/EBD/tLT/5OT/0ND/WFj/ra3/ - jo7/Dg7/IyP/kZH/yMj/ysr/AgL/DQ1XjFJNAAAAE3RSTlMAAA5Vq9/4NK/0St3c - Da7z8/PgJJvUWQAAAAFiS0dEILNrPYAAAADzSURBVBjTbZDXUgJBEEV7mLBkQyus - AWlXQVRUFDGgEkxgwoA5B/z/X3B6y/TAfTxVXX3PBQAhAlJpY7SSASEAmDjBEPoJ - BR1mQoQj+JtI2DLhRPFfoo6AWBxxYDCRRHSHhkdGU/EYyB4cS9O4h+7EZCY7leuV - oKZnZjOU93BufqGwmF0qKtDLpZVVRmu0Xt7I06YGU96qVBnV7HV9m3YMmN093GfU - oOZB8pCODGj72UcVOj5pndKZBvWDzi/aicsrulZcwqIbD2/v6L5ED33Sr/r49PyC - +Pr2/lEo2qos5HZclum0PlMs1EW7yzh/E/Z/T/gFtqkjSXNN8rEAAAAldEVYdGRh - dGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRk - YXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5E - rkJggg== - } - image create photo ::tk::icons::11-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 4VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/GBj/VVX/Skr/Bwf/FBT/U1P/TU3/Cgr/Cwv/lZX/////1dX/ - Fhb/CAj/ior//v7/3t7/HR3/BAT/Ojr/pqb/+fn/1tb/AwP/NTX/np7/9/f/39// - JCT/+/v/8PD/HBz//f3/7+//Jib/trb/bGz/lJT/Hh7/s7P/c3P/Bgb/Dw//hIT/ - BQX/dnb/19f/4OD/WFj/ra3/jo7/Dg7/Tk7/rKz/ExP/AQH/AgL8EhtJAAAAEXRS - TlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBycBEEHAAAAyElEQVQY023Q - Vw7CMBAE0DWxHTosvYTee++9k9z/QHgDAoSYvzzJ0cwCAGMOjQspBdccjAGQ6E4X - 2nE5dTLG3B58x+NWxnQvfsWrM/D5EUPhSJS+Y/FE0u8DLYCptJHJKsnlC8VSQANe - rlRrRj2LjWarbXRKyEF0i70+0aA+HBEJkOPJdEY0XyzzRBLkao0bou0ad08S6r82 - qeyeD/kvcSqhaP+iw1yVoKrH0/lCdL3N7qoqDTIt015jWhYN+jP7z3E+Jwy+TvgA - cTUbrJizqpQAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTUt - MDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE1 - LTA0OjAwBo9JEwAAAABJRU5ErkJggg== - } - image create photo ::tk::icons::12-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - LFBMVEUAAAD/AAD/AQH/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/Fhb/mpr/jo7/AgL/BQX/AAD/AAD/GBj/VVX/Skr/Bwf/CAj/MjL/ - UVH/UlL/ODj/DAz/Cwv/lZX/////1dX/Fhb/jY3/7e3//v7/8vL/oqL/BAT/Ojr/ - pqb/+fn/1tb/S0v/9vb/+/v/mpr/iYn/8/P/ZGT/JCT/3t7/8PD/PT3/l5f/k5P/ - Fxf/HBz/29v/fHz/Jib/trb/bGz/lJT/hob//Pz/RET/Bgb/Dw//hIT/HR3/oKD/ - +vr/9PT/eXn/BQX/KCj/vr7/2dn/WVn/ExP/t7f/9fX/jo7/19f/Y2P/WFj/ra3/ - Dg7/rKz/qan/qqr/AQH/AgJeYrBbAAAAF3RSTlMAAAAOVavf+DSv9Erd3A2u8/Pz - rtw04GaGKL0AAAABYktHRCS0BvmZAAAA7ElEQVQY023QWztCURCA4Vlah91pp8II - URmbTY4hcq6IUJEQCvX//4O1dk4XfVfzvFczAwCM+biQSknBfYwBGLH8AfQK+C1j - jAVD+FsoqI1ZYfxX2GJgRxAnE1PTiDPJ2blUOmIDH8XMPC04mFlcct3llSgHkV1d - W6cNBze3cts7u25egNzbzxUMHRweHZ+c0pkEVSyVzw3p0heVwqUCdVXF6wHd3Nbq - jTsFUs8Dum/SQyuLEsQPPT7RczvRSgqzhKYXB18rRC5RjHurvnXaXcy/f+g+47Z3 - UK/fQ+x7jY2PDDt7yHP+Xjjx/cIvG7EnkM/vXyUAAAAldEVYdGRhdGU6Y3JlYXRl - ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlm - eQAyMDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== - } - image create photo ::tk::icons::13-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - HVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/Bwf/PT3/AgL/AAD/AAD/GBj/VVX/Skr/Bwf/Bgb/Ly//UFD/MDD/Cwv/ - lZX/////1dX/Fhb/CQn/hob/6+v/+fn/+vr/7Oz/hIT/BAT/Ojr/pqb/1tb/Pz// - 6ur/8PD/bGz/iYn//v7/JCT/3t7/+/v/ERH/PDz/DQ3/ZWX//f3/5ub/Kyv/Jib/ - trb/lJT/AQH/8vL/h4f/Dw//1NT//Pz/0ND/Nzf/AgL/Dg7/IyP/jY3/u7v/IiL/ - 0tL/iIj/19f/3d3/xcX/vr7/5OT/WFj/ra3/jo7/Ozv/oaH/y8v/zc3/qKj/RUX/ - AwMz70tLAAAAFHRSTlMAAA5Vq9/4NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRB8F - DRC9AAAA8UlEQVQY023Q11rCQBAF4Fm2hBZsgwlFlyhooihIFxWighIFewX0/R/D - bMRywbma77+acwCAkBBlXAjOaIgQACVaOIJBImFNGSHRGP4mFvWNaHH8l7hGQE8g - JlcNEzGVzmSyZkIHuoBr6zJn4cZmvrC1bS9SYM7ObkEWLdzbL5UPKvk0A16t1UuK - Gk2jddg+OuYgTjrlriJE1z6tnDkCROoc7W9y7F7/4lIA9++ABqZnXuXkNQf2Q8aw - M0reyFumnvDpzsLsvXx4bD8t0eDV55dXD/HtfTyZfizrQSF34Koyny3PUYXm1J4z - zt+EK7MJvwDJgSGaiujlLAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw - ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU - MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC - } - image create photo ::tk::icons::14-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - MlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/BAT/AAD/CAj/AQH/EBD/GBj/JSX/Bgb/Bwf/AQH/AAD/AAD/GBj/VVX/Skr/ - Bwf/MDD/Wlr/QED/Cwv/lZX/////1dX/Fhb/Ly//09P/urr/BAT/Ojr/pqb/+fn/ - 1tb/Gxv/vLz/u7v/CAj/JCT/3t7/+/v/8PD/DQ3/n5//+Pj/0tL/Jib/trb/bGz/ - lJT/gID/np7/aGj/Bgb/Dw//hIT/Xl7/9PT/ysr/Jyf/YmL/wMD/FBT/FRX/s7P/ - 5ub/zc3/4OD/9fX/o6P/6Oj/5+f//Pz/uLj/19f/Ghr/JSX/ICD/cnL/xcX/WFj/ - ra3/jo7/Dg7/PDz/q6v/e3v/AQH/AgJ9lF2oAAAAGnRSTlMAAA5Vq9/4NK/0St3c - Da6u8/P436vzVa7c4LQK5msAAAABYktHRCS0BvmZAAAA7UlEQVQY023Q11oCMRAF - 4AmbZGlrAQQNKiojZUVFERQboIIiSFOwi2V5/1cwifWCc/lfzHfOAAAhLoMyzhk1 - XIQAKDHdHqHjcZvKCPH6xG98XmnE9It/8ZsErAkhovMLixpiS8uTFhhTYiWOqwkl - yRSmpw2g9lpmHTcUbWYRt7YpsNxOvqBpd6+4L4kBPzg8OlZkl/LliiQO/ORUnCmq - 1s4v6njZCACTRyQ17StstTvYzQSB/lDvunVTwP4gpEpIuk2Iu/vcwyM+zYR11eeX - 4auu+vb+EbH0IGfkfM1xRrNy0JjZY57z98K57xd+AgvXJw2x8S2eAAAAJXRFWHRk - YXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwRjrrMgAAACV0RVh0 - ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMDdnU44AAAAASUVO - RK5CYII= - } - image create photo ::tk::icons::15-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - NVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/FBT/AAD/R0f/Li7/AAD/AAD/GBj/VVX/Skr/Bwf/Gxv/MjL/Ly//Cwv/lZX/ - ////1dX/Fhb/kpL/8/P/8vL/6+v/BAT/Ojr/pqb/+fn/1tb/CQn/vLz/2Nj/wsL/ - xMT/wcH/Nzf/JCT/3t7/+/v/8PD/GRn/2dn/dnb/Wlr/T0//AgL/Jib/trb/bGz/ - lJT/7u7//v7/7e3/9/f/9vb/qqr/Bgb/Dw//hIT/KCj/oaH/tbX/ZWX/bm7/7+// - cnL/AQH/ERH/DQ3/mZn/TU3/tLT/rKz/ICD/Ghr/09P/fX3/19f/Njb/4eH/xcX/ - wMD/WFj/ra3/jo7/Dg7/PDz/y8v/OTn/AwNVwL6YAAAAFHRSTlMAAA5Vq9/4NK/0 - St3cDa6u8/Pz4MH3NZkAAAABYktHRB5yCiArAAAA9UlEQVQY023Q11rCQBAF4Fm2 - hBZAHZTmGoMVAQs2sKGoEFuMDRUQVOT9H8FsPlEvOJf/zcw5AECIjzIuBGfURwiA - Es0fQC8Bv6aMkGAIfxMKuka0MP5LWCOgRxDjk1MJxGTKTTqqA41hZlrOGIizZtY0 - 58YosPmFxSW5bGBuReYLxdU1Bnx9o7SpaGu7tLNbTlY4iL39g0NFqaPq8UntNC5A - nJ1jXVHDuri8upY3Arh72SM7cWs7RXnHgQ3p/uHxqfksX5h6wqVXA1tt2Xmr5sep - 92q39/6B+Gn1+9ZXRPcK2RVblRk4zkAVGlF7xDh/E078TPgNVMok5Eu0euUAAAAl - dEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAA - JXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAA - AABJRU5ErkJggg== - } - image create photo ::tk::icons::16-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - LFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/ExP/AQH/SEj/BQX/AAD/AAD/GBj/VVX/Skr/Bwf/Ghr/R0f/U1P/Ojr/ - Cwv/lZX/////1dX/Fhb/z8//9/f/+fn/9PT/oKD/BAT/pqb/1tb/Gxv/mZn/Y2P/ - 3t7/3d3/SEj/JCT/+/v/8PD/UlL/7u7/PDz/LCz/UVH/Jib/CQn/trb/bGz/lJT/ - c3P/vr7/7Oz/5+f/kZH/EBD/Bgb/Dw//hIT/enr//v7/rq7/f3//6en/amr/aWn/ - 7e3/MjL/pKT/oaH/PT3/8fH/CAj/sLD/19f/29v/urr/6+v/WFj/ra3/jo7/Dg7/ - gYH/wsL/UFD/AQH/AgL/Cgoto8vpAAAAFXRSTlMAAA5Vq9/4NK/0St3cDa7z89/z - ruDPFLgEAAAAAWJLR0Qgs2s9gAAAAPNJREFUGNNtkMdWAkEQRavpMKTBWBgQLGcI - ooKIooJiRAXMAYyAo///D3bPMS14u7qbevcBAGMBLqRSUvAAYwCGWMEQ+gkFLcMY - C0fwN5GwZsyK4r9ELQZ2DDE+NT2jz9nEXDIVs4GPYGqeFhzEhJvOZHOjHMRiMp+h - JQeXXVopFFdLAuRasbxu0Ea5srm1Xa1JUNWd3bpBe1TZPzg8OlagGid4atAZNVvt - 8+aFAqlf+eiSrq7xhm7HQPygu/ts6aFDdWFKaNR1sJajx6f08zj3q768vvV04f7A - 7bxP2L6Q9+EZGe+z1zBCQ7SHjPM34eT3hF9IiCRlUyvoEQAAACV0RVh0ZGF0ZTpj - cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY66zIAAAAldEVYdGRhdGU6 - bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3Z1OOAAAAAElFTkSuQmCC - } - image create photo ::tk::icons::17-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - BVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/Li7/AAD/mJj/AAD/AAD/GBj/VVX/Skr/Bwf/GRn/Njb/NTX/Cwv/lZX///// - 1dX/Fhb/cXH/9vb/8/P/8vL/8fH/9PT/BAT/Ojr/pqb/+fn/1tb/ZGT/29v/2Nj/ - 19f/4+P//f3/eHj/JCT/3t7/+/v/8PD/Cgr/Fxf/Gxv/oKD/paX/EBD/Jib/trb/ - bGz/lJT/Tk7/2dn/Jyf/Bgb/Dw//hIT/vr7/+Pj/5ub/Kyv/jIz/uLj/CQn/vb3/ - j4//WFj/ra3/jo7/Dg7/jY3/UFD/AQH/AgJwwfqkAAAAE3RSTlMAAA5Vq9/4NK/0 - St3cDa6u8/PgHfwDJgAAAAFiS0dEHesDcZEAAADhSURBVBjTbdDJVgIxEAXQChma - qRF4igqG1gacRXFgVBxAQAFBFP7/U0xajrjgbZJzN1X1iIixEBdSKSl4iDEiK044 - giCRsGONsWgMf4lFjTEnjn+JO4zcBLC5ldnGzm7WZsMlnkRuT+c97B/4fqFYSnES - h0fHJ/rUw9n5RflSX1UEyeub2ztL1ZpXb+hmS5K6f2g/WjJ58p9foEh1unj9pVZP - V2BImv+SMv3BGyBJrOhdD0eAsEsYKhuqjvUHkOTBqpPp5wyYfU2/gYQbHDRfzO3A - hXnsQWvOXlPOqsL0ssIfbB0e7ntg/vYAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEt - MDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIx - LTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAAAABJRU5ErkJggg== - } - image create photo ::tk::icons::18-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - PlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/DAz/S0v/Bgb/AAD/AAD/GBj/VVX/Skr/Bwf/BQX/LCz/T0//MDD/Cwv/ - lZX/////1dX/Fhb/Bgb/e3v/6Oj/+Pj/7Oz/jIz/BAT/Ojr/pqb/+fn/1tb/MzP/ - d3f/bW3/8/P/9vb/RUX/JCT/3t7/+/v/8PD/ODj/8fH/5+f/+vr/S0v/Jib/trb/ - bGz/lJT/CQn/nJz/2dn/1NT/srL/EBD/Dw//hIT/HBz/t7f//v7/0tL/zc3/xsb/ - JSX/amr/5OT/Li7/ICD/19f/gID/dHT/4+P/KSn/Ghr/jo7/Njb/y8v/w8P//f3/ - 7e3/WFj/ra3/Dg7/AgL/SEj/qan/zMz/rKz/UlL/AQH/DQ192iTxAAAAFHRSTlMA - AA5Vq9/4NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRB8FDRC9AAAA9klEQVQY023Q - x1oCQRAE4B4mLGkxtUhQm0UXQTErZklGTCgmQEUw4fu/gDv7mQ7U8b90VwEAYx4u - pFJScA9jAFoMrw/d+LyGNsb8AfxNwO8YM4L4L0GDgRlCHA6PRBCjsXh8NBIygffh - 2DglLExOTNp2aqqfg0hnpmcoa+Fsyp6bX1hcEiCXV1ZzmtbWc5nYxuaWBLW9s5vX - VChSqUx7+wpU8gAPNR0dV05OK2fnCqRz2aULql5e1ehagvihG7q9uy9TXegnHKpZ - 2KhS8+HxaYC7r7ae623svLw2394/Bk23ULfT1WXSn+2oLtSjdo9x/iYc+p7wC++L - Jf2uJzrcAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0 - OjAwRjrrMgAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0w - NDowMDdnU44AAAAASUVORK5CYII= - } - image create photo ::tk::icons::19-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - LFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AQH/EhL/AAD/AAD/GBj/VVX/Skr/Bwf/CAj/NDT/UlL/S0v/IiL/AgL/ - Cwv/lZX/////1dX/Fhb/DQ3/j4//7+//+fn/3d3/Xl7/BAT/Ojr/pqb/1tb/V1f/ - +vr/6Oj/ZWX/hob/4eH/LCz/JCT/3t7/+/v/8PD/ior/uLj/Bgb/HBz/bGz/Jib/ - trb/lJT/enr/0tL/QED/6+v/jo7/Dw//hIT/LS3/2Nj/29v/MzP/kpL/c3P/2tr/ - gYH/Hx//amr/f3//ICD/Njb/7e3/UVH/19f/KSn/xcX/0dH/srL/WFj/ra3/Dg7/ - qan/zc3/h4f/Hh7/AQH/BQVtNoEFAAAAE3RSTlMAAA5Vq9/4NK/0St3cDa7z8/Pg - JJvUWQAAAAFiS0dEILNrPYAAAADySURBVBjTbdDHWsJQEAXgudwSOsrYFRyDBhWN - DRuiIGABRexiwRLf/x3M5LMtOMt/M+cMAAgRkkobo5UMCQHAYoUjGCQSttiEiMbw - N7Gob8KK47/ELQGJJOLQ8Mgo4tj4xORUJpkAmcLsNM3YmJudc5z8/IAEtbBYcGjJ - xmV3ZXXNXd9QoIubW9tMO7Rb2stTWYPZPyhXmKp0WKzVqWHAlI7wmOnklJpNhyoG - tH85IGydFc7bdKFB/VDn8ur65ta9U1zCp3sbH9rUfaSnQRlUfX5p9BBrr2/d9w+/ - Kg/yMh6P+exlPR7UZ3af5/y9MP39wi8SoyQetkVHgwAAACV0RVh0ZGF0ZTpjcmVh - dGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY66zIAAAAldEVYdGRhdGU6bW9k - aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3Z1OOAAAAAElFTkSuQmCC - } - image create photo ::tk::icons::20-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASEAYAAAAGXlIUAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - BmJLR0T///////8JWPfcAAAErElEQVRIx7WWbUhUaRTH/6OmTmnWlr0IWfbih16o - LEewsg8NFEmElsagixW2GIVgKCixxFJbRBSZIibUUotJzJYkVuxitBZRua6J5AqR - q5TphxYZG9d8m/nth7nTXk032mXPl/99zj3nf/48z3PvOdI4g4kwvNGHaQd96Oz0 - YWeGD4fmGDjb8KcZcS1G3mGD55fx/JPauECLD9cZQqpP+LC/34fwedg/YPB8Y/A2 - ja3zyR3ZXujD9pZ/J+BT2P7cqFP00Y6Ndax3GAlr/h8hHwlbZ9T9cpyg8K99ePMd - WLdZtwHEr41fC5BSk1IDkJKYkggQvyB+AYD1nvXeRIUshZZCgOiz0WcBtmzeshlg - a83WGoBYd6wbIDAuMM6fd9Nt6DhmCEq7DRGOCIfbC2Wvy14DuIpcRQDeRm8jgPe+ - 9z6Ay+lyAlTsrtgNMMM6wwqgSEUCZFmzrAAv9r7YCzB0fug8wEjOSA5AV1RXFEBu - Y24jQODVwKv9H3QYl8q5V0p/kv5k93dS5ZnKM5LkXeFdIUkVrypeSdLootFFkpSz - K2eXJAX1BvVKUkZVRpUkNYU1hUlSXWJdoiQtrF1YK0lXbFdskjRwa+CWJB2IOhAl - Sa4HrgeSlByWHCZJDc8anv2QZijrqAB7qb0U4OLdi3cBzj0+9xhg5pqZawCWvlz6 - EqDrYNdBTHao81AngMPisADQRBNAt6PbARBri7UBzN0/dz9AW2pbqjn/yPQj0/1H - 13FJIIssg22gUIUCaL7mm+9ExLSIaQDFucW5AN5h7zDA2+y32QA2u80OUOAscJoL - tV5vvQ4Q+SjyEYA1z5oHUH+t/po57kLShSR/vcE3AZIQGpU0qEFJUo96JGnx+8Xv - JamivKJckg5fPnxZktx57jxJOvH0xFNJaqhrqJOkkPyQfPMPxTPiGZEkb7Q3WpK8 - w95hSRp9OPrQHBfiDnF/WPwR4MOe+38HrLattklSZWFloSSlZ6ZnSlLbzradkpRV - mlUqSSWXSi6ZiV3JrmTz2hpsDZakkKyQLEkKWha0TJKsHqvHHNfX3Nfsf+752bhD - zhSY1zavDaC+rr7OvKXv0t+lA5wqP1UOkLYxbSOAI8oRBbC8d3kvgL3AXgAw0DXQ - BeAedg8DbE/dngoQPyd+DkB3e3e7mX9f5L5I/5E59/g/tx8hvzm/ud8C3j5vnzmB - aqoByCefCezkhpMbAMJXhq8EqLXX2s3v34S+CQXoiO+IN/ubS5pLAGLuxNxxG4LS - frLA7ITZCeFD0mnPac/3X0jhq8JX7eyXOMpRSVKYwiTJEmOJkSQFKECSArIDsiXp - xo4bOySpyl5ll6QlcUviJCn3eO5xSUp4nvBckgJvB96WpNbi1mJJKmsta5WkhsyG - zGqX78iyzpqaW0hSSNL6DGmkZaTl+m8STpyLmyQFK1gTmeEnllhJ0izNMr8O2BSw - SZKmRk+NliTLFMsUSRqIGYiRJM8xz7Hf1/pi9yz3YeO1yZpr0dgmOFGL+C/Y3jpp - c/XbJOPHM2Ns+HbsGPG5Avr/HMvj551g/NA/C/M331+NS5czdvDqNLr0UKyBKw3/ - V0Zcu5F3wOBpmnRHDPsLflt0HfDi3lIAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEt - MDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIx - LTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAAAABJRU5ErkJggg== - } - image create photo ::tk::icons::20plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASEAYAAAAGXlIUAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - BmJLR0T///////8JWPfcAAAEjElEQVRIx7WWa0iUeRTGnxkdu9i0mrOFJtaQbCRZ - QYl2gT6UFEERmHSRRRNaNrrSZVs1kY0ipYJSakOiovqgaSViIBshSpSRtSQleFsV - my3MstzXambU337wdRlr2mxhz5cHznvOcx7O//3/z5E+MvCH9rohTN46hCXtQ9ie - MoTuySY6TH+yGVdv5m03eR58zP9Z+yjQMoTzTSE3Dg+hYQwhfB0a70yeX0zeRyPr - fLEjq34ewtb6/ybgS9j6xKyT8UnHRjoWbDQT5v0/Qj4RNt+s+72PIG+7tz3pJ9g9 - cffE345BvD3eDhB8Pfi6PyKr1+oFiA6NDgVIrE6sBkgsTiwGcEY4IwAspy2nRyvs - +l/mP5YjoIaagUQY6Bzo5FfoPdB7AOByweUCAEeVowog4FDAIYA9B/ccBOjwdngB - PIWeQgDPBc8FgJa4ljiAlDkpcwC0Vmv9CQk0Ag0AJ06MyZAUlxS3+RtBviPf8S4R - 8t7kvQEwVhorAQZdgy6A9Ir0CoCEnIQcgNdnX58FcHvdXoD8a/nXAK6UXCnBx1pW - tawCiB4fPd6foGl50/IA6t7WvQXojeiNqO8W2EJsIX8GQGRjZCNAs7vZ7UucWZxZ - DLDfut/q639S+aQSwHHVcRVg1vFZxwFeLHmxBGCwdLAUYMOWDVt8hQSEBIQAzHw5 - 8yWAq8XVAuAxPEbnLas0Nn9s/qR50tZjW49JkrPIWSRJvVG9UZJ033bfJkmRBZEF - vveze133OkkywowwSXoV8ypGknru9NyRJEuSJUmSIhUpSVq4fuF6SSqfXT5bkgpP - FZ6SJMcdxx1J6lrSteTbGKt0qeRSSdBaad/SfUsl6UPih0RJyq3MrZSk6qrqKkka - s2vMLl9B/dv6t0kST3kqSQMhAyGS1H+i/4RvXND7oPeSNKVsSpkkLVuxbIUkLbIv - sktSUGpQqiSRS666Zfb/D2hKbUoF2Lh3416AwDWBa3xbnZuVm+V7ZPcW31sMEHwv - +B5AuCvcBdDU0dThG7ezfGc5QKgr1AWw9OjSowApRooB0O3sdgJ4Mj2ZnWWBUt/2 - vu1ySjftN+2S1B/bHytJyTeSb0hSQ3ZDtiQ1lDSUSJLKVS5J0zOmZ0hSTGxMrCQ5 - VjtWS1K4JdwiSe40d5okNSU0JUhSz9SeqZJUrWpJ0oyuGV2S5B7nHidJtiO2I55C - weDpwdMAA5sHNuPHCrILsgEi2iLaAGrP1573/d6W15YH8Ozis4u+/tsVtysAJj2f - 9NzfLQvLCMsAOJx2OO3dJmg82XjyVLt5ZEW34OHjh4/rG6GovqgeoLSutA4g3Ug3 - fInmxs+NBzjXfK4Z4EHUgyiA2ru1dwHOlJ0pA4jZEbNj1A9jj/kwHvQZHWMzx2Yu - 6AOrzWprnQWWGksNgMVmsfkjClgesBzAvsK+AmBCzoQcAGuWNWu0QoZH1IJNn5ll - /wzXjJFDcLQFRi3k6WeHq/wLG14/fjfXhiMj14ivFWD0jeQZ5vWzfujfhQ0vaA/N - RevHkYtXuzml3d+ZONv0/2DGtZp5W0yeR5/tiGl/A2jL8ui+maoGAAAAJXRFWHRk - YXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwRjrrMgAAACV0RVh0 - ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMDdnU44AAAAASUVO - RK5CYII= - } - image create photo ::tk::icons::9plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - OFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/ERH/AAD/NDT/AQH/AAD/AAD/Cgr/Nzf/U1P/SUn/Hx//AQH/mJj/8fH/+fn/ - 2dn/VFT/BAT/YmL//f3/4uL/YGD/j4//IyP/GBj/xsb/xcX/Fxf/lZX/////rKz/ - JSX/5eX/3t7/3Nz/AgL/hob/yMj/Hh7/Skr/fn7/MTH/srL/vr7/9fX/NDT/NTX/ - 39///v7/3d3/+vr/g4P/RET/9PT/+/v/8/P/R0f/OTn/lpb/pKT/c3P/4eH/dHT/ - Dw//Pz//VVX/5ub/ExP/JCT/bW3/fX3/Ghr/QUH/Rkb/Gxv/wsL/1dX/p6f/DAz/ - e3v/enr/Dg7/ra3/zs7/w8P/gYH/GRn/Bgb/CwuphzIHAAAAFHRSTlMAAA5Vq9/4 - NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRCy63XGrAAAA+ElEQVQY02NgYGBkZGJm - YWVjY2VhZmJkZGAAibBzcIqAAScHO0iMkZGLWwQOuLmAYozsPCJIgIedkYGXT1RM - XEJSCibGx8vAzC8tIysrJw/kKUhKKogIMDOwKCopq6gqyamJiKhraGqJiLAwsGrr - 6Erp6euoABUZGEoqGLEysBnrmJiayeiYW1haWVtbWdqwMbDZ2tnLOTjqODm7uNrb - u7q5szGwinh4enn76Pj6+QcE6gf4B7EysASHhIaFu1lHiIhEGhiGgYxnFvSxj4rW - iYkVEfGLi08AOYJXKCIxKTklFcmpQA+lJaRLIXsIi7exBA4iCIWhQQgAiNMk9J5+ - e/MAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBG - OusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAw - N2dTjgAAAABJRU5ErkJggg== - } - image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - olBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/Fhb/QED/Pj7/ExP/VVX/9PT/8PD/SUn/WFj//v7/+fn/S0v/ - SEj/PDz/MjL/6Oj/Jyf/ICD/4+P/2Nj/Fxf/Dw//qKj/nZ3/Cgr/IyP/hIT/gYH/ - Hh7/PT3/Ly//paX/oqL/KCj/AgL///8V6AjgAAAAEXRSTlMAAA5Vq9/4NK/0St3c - Da7z4Pnet34AAAABYktHRDXettlrAAAAoElEQVQY022QxxKCQBBEZ9hERkygophz - lv//NmF3Bz0wp1dd1V3dAwCIDuNCSsGZgwjQKMr1Un2eqxoN0Q/S9gK/1lCF6d+F - CiGKNfYHw5GGOAKWaBpn+URDwoAbw3RWzA1xEAYWRVYaEiANLPPV2pAkabPd7Umy - xsPxdCajjb9cb3eKtyXq+AeVsFWfr/eHqtKgqmoHdczueM7vhT37wi9PRRMHXNeq - aAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY6 - 6zIAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3 - Z1OOAAAAAElFTkSuQmCC - } +image create photo ::tk::icons::0-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 51BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AwP/JCT/RUX/ISH/AgL/BQX/cnL/4eH/+vr/29v/W1v/PDz/ + 7u7/+fn/kpL/pKT/////eHj/1NT/FRX/KSn/5+f//v7/WFj/lJT/v7//CQn/Fxf/ + 1tb/d3f/mJj/vLz/CAj/FBT/09P/fn7/iIj/xsb/DAz/Ghr/2tr/b2//Xl7/Njb/ + SUn/8vL/+Pj/HBz/yMj/39//5OT/vb3/ExP/Ly//nJz/ysr/lpb/Kir/DQ3HpLSX + AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCJdZVysAAAAxUlE + QVQY021QxRLCUBDbR5UipRR3Fnd3Ly7//z2wfUUO5JJMZnYnCQAw5hJESZYlUXAx + BkCOoroNG25VIY8xzWN84NFeHlO8xg+8CgOfn1TQDIXCEVJ+Hwj6i6OxeCKRTJGl + CyASpzPZXB6TJmkRJKICFkvlSrVGWgKZqI6NZquNHdIyt7rY6w+GOOKWfTjGyXQ2 + xwU/tN8vq5XVerNd8/d2iJ2F+wMeTzwEj3q+XK3b3YnqFAo+ppF3oT+1/4zznTDg + TPgETvcYi7Qhbm4AAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6 + MTQtMDQ6MDDRpfobAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1 + OjE0LTA0OjAwoPhCpwAAAABJRU5ErkJggg== } +image create photo ::tk::icons::1-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + kFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/HBz/V1f/Rkb/BQX/Dw//oKD/////y8v/Bgb/Pz//ra3/+/v/ + zMz/Li7/5ub/+vr/8fH/Ly//uLj/Zmb/n5//Bwf/Dg7/kpL/YWH/rq7/h4f/Cgr/ + AQH/AgLXmjE+AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBib + aYUeAAAAnElEQVQY022Q5w6DMBCD78hi03RQuvegg77/25ULCakq/MenT4piGwAQ + A8aFlIKzABGAiAojbRSFihhinOheSdwyVKn+UaoQsry7x5PpjDzPgBWGlPNqUdJR + MODky9V6U20N0hwE2W5/ODokQJKdzperQ7JDt7uuPRL299o/5P+IuxA9akO4qI/n + 622jukLNp3GFBmoPjOMnHNkJv3kDExXHctm+AAAAJXRFWHRkYXRlOmNyZWF0ZQAy + MDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0RVh0ZGF0ZTptb2RpZnkA + MjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAASUVORK5CYII= +} +image create photo ::tk::icons::2-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 21BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Cwv/ODj/UlL/UFD/MjL/CAj/ExP/oKD/8fH//v7//f3/7u7/ + kJD/DAz/ZWX/9fX/jIz/lpb/+vr/9/f/TEz/TU3/m5v/iYn/Ly//6+v/////YmL/ + nJz/5OT/MDD/KSn/srL/7Oz/ZGT/AQH/Nzf/zs7/zc3/SUn/AgL/ICD/ysr/7e3/ + gYH/VVX/WVn/Kir/fX3/eXn/AwP/dnb/rKz/qan/q6vjChO4AAAAEXRSTlMAAA5V + q9/4NK/0St3cDa7z4Pnet34AAAABYktHRCy63XGrAAAAwElEQVQY021Q1xLCMAxz + uktpS9hQoOwZ9t57/P8XUSesB/RinXz2SQIAQiRZUTVNVWSJEABUdMOkHKaho0ZI + yKIfWKFAI3qY/iCsE7AdZNFYPJFMIXNskN1gpjNZL5cv+AF1ZVBwVfRK5Uq1Vkeu + gIqj0Wz57Q7rIldBe/1N91h/gER7S8ORN55MhcQP6WzOFssVFYf8/XrDtrv94Sje + cxMnxnEWJtDq5Xq7B3gkhFUeaCUwFYH+xP5TzrfCyKvCJ3EzGUFH/1QDAAAAJXRF + WHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0 + RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAA + SUVORK5CYII= +} +image create photo ::tk::icons::3-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + +VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/CQn/NTX/UlL/Tk7/Kir/BAT/ERH/mZn/8PD/+Pj/+vr/5ub/ + cHD/AgL/Vlb/9PT/5eX/X1//nZ3/////29v/HR3/Fhb/QED/RET/Cwv/f3//1dX/ + Ghr/Bwf/mpr/9vb/+fn/b2//lZX/2tr//Pz/wsL/Jyf/Dg7/Bgb/MzP/c3P/XV3/ + wMD/qqr/ExP/KSn/4+P/bm7/Q0P/6ur/vb3/x8f/19f/KCj/SEj/qan/zc3/y8v/ + oKD/ODj/BQX/DQ3/AwON+4wDAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34A + AAABYktHRCXDAckPAAAAx0lEQVQY021Q1RLCQBDbo4qW4l7ssOLu7g7//zH07oo8 + kJfNZGczyQIAQhaOF0RR4DkLQgBEkWSrSmGVJaIhZLOrH9hthoYkh/oDh4TA6SLM + 4/X5A0HCXE7gFGOGwpFoLJ7QDKpwwJNVMpXOZHEuTzgPAhmFYkkv40qVcAFEZlur + N5otysS3pLc73V6fSfRQ8wyGozges0NqP5nO5oslXjF7GmK96W53eH9gIWhU7Xg6 + X643M6pZ6D54PN+F/tT+85zvC93mC1+z9hl5VNGhJwAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMNGl+hsAAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTQtMDQ6MDCg+EKnAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::4-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 1VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AgL/OTn/W1v/ODj/QED/4uL/////oaH/AQH/KSn/zs7/oqL/ + Fhb/tbX/9PT/1NT/Cgr/l5f//Pz/h4f/fHz/dXX/+/v/trb/HBz/fX3/qKj/DAz/ + EBD/ysr/4eH/zc3/5eX/8fH/lJT/BAT/Dw//uLj/5+f/5ub/8vL/+vr/paX/BQX/ + HR3/JCT/ISH/iYn/sLD/Ghr/Tk7/rq7/a2vT0ZXAAAAAEXRSTlMAAA5Vq9/4NK/0 + St3cDa7z4Pnet34AAAABYktHRBibaYUeAAAAvklEQVQY022QVRPCMBCEL1RSg5Ji + Ibi7W9Hi//8n0aRBHtiXvflm7mZvAQChmKJquq6pSgwhAE6wYRIh08CcIWTZ5CPb + ChnCDvmRgxHEE9HspdIZ7ok4KG6EsjmaZ6G7CqgRKRQpLXFEVNAEKVeqNYk00LnV + G81WWyJdINbp9voDOhxFiC+OJ3Q6m9PFciUW+fn1xt/6O7o/HMV5HsI7BcH5Qq83 + JkK8o5L74ymjfh5iHpMP/Xn7TznfCpOywhdM6Ra8aC+AYwAAACV0RVh0ZGF0ZTpj + cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6 + bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::5-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 7VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/ICD/MjL/Li7/CQn/Bgb/q6v/8/P/8vL/9PT/4uL/FRX/0tL/ + ////wsL/xcX/uLj/Jib/Kyv/6ur/8fH/aGj/XV3/SUn/Fhb/AQH/+Pj//Pz/7Oz/ + +fn/l5f/Dg7/ODj/qan/sLD/W1v/fn7/9/f/+vr/WVn/EBD/Ghr/2dn/gID/X1// + oKD/EhL/5OT/Y2P/S0v/7e3/vb3/ycn/yMj/HR3/AwP/Skr/zc3/LCz/BQX/DAz/ + AgKLBoLHAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRB5yCiAr + AAAAyUlEQVQY021Q1RLDMAxzVhp1XcbYMXXMzIz//zmLk9HD9GKdzvZJAgBCbJKs + qKoiSzZCAFDR7A7K4bBrqBHidNEPXE6mEc1Nf+DWCOgeZD4/QyDImEcHyWAzFI5E + I7F4gFFDAhmXEkkzmUpnsshlUHDk8oViqVyxkCug4ihXa/VGtNlCrgqp3en2+oPh + SEj80AqO6WRqzsQhfz/PLJa5lbkW77mJzba225uHozDBrZ7Oncu+eaXC6ivQrXV/ + vAP9if2nnG+F3leFT2jDGOnV8F/uAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4 + LTEwVDA4OjM1OjE1LTA0OjAwd9LxrwAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0w + OC0xMFQwODozNToxNS0wNDowMAaPSRMAAAAASUVORK5CYII= +} +image create photo ::tk::icons::6-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 9lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AQH/ICD/S0v/UlL/NDT/CAj/WVn/2dn/+Pj/+fn/8PD/jY3/ + Cgr/LCz/4OD//f3/hob/cHD/5eX/1NT/NTX/bGz/////39//T0//Bwf/j4//5ub/ + wcH/7+//4uL/f3//CQn/lpb/+/v/n5//iIj/8vL/9/f/UVH/hYX/3t7/Hx//vb3/ + VVX/6Oj/MzP/ExP/x8f/e3v/EhL/t7f/0tL/wMD/MTH/IiL/xsb/zc3/qKj/QkL/ + AgL/Cwv/Dg7/BQWiS7IgAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB + YktHRCi9sLWyAAAAyklEQVQY021Q1RLCQBDbowalBYq7y+FWirs7/P/PwPawB/Ky + mezsThIAIMTC8YIoCjxnIQQAFclq00zYrBJqhMh27QO7/NSIpGg/UCQCqgOZ2+P1 + +QPIHCpwTlSCoXAkGos/qZMDHleJZCqdyebyyHkQcBRoMeEvecrIBRBxVGi1Vm80 + W8hFJrWp3jG6vT6TzMMBHY4CY2qwQ/P9RJ/O5gu6ZO9NE6s13Wz14o6ZYFb3scPx + dHYzq69Al+vt/g70J/afcr4Vul4VPgDLCRmO3FuJegAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::7-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + xlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Hh7/Njb/NTX/Ghr/i4v/9/f/8/P/8vL/8fH/9PT/eHj/fHz/ + 3Nz/2Nj/19f/6Oj/////+Pj/YGD/DQ3/Fxf/FRX/IiL/trb/j4//CQn/Zmb/+/v/ + xsb/GBj/HR3/0tL//f3/Xl7/ZGT/1dX/BAT/p6f/n5//AQH/Fhb/09P/c3P/GRn/ + mZn/qqr/PT3/AgKXVg1iAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB + YktHRCJdZVysAAAAu0lEQVQY022Q1xKCMBBFN5LQixFR7Bp77wU7//9TJgTFB+7L + njmTydxdAECooGCiqgQrBYQAhNF0gyYxdE04hEyL/mKZ3CHNpn+xNQSOy6Hkl3n8 + gKPrgOLxWamGYa3eaHL0FMDieavd6fZYfyAYAxFjOBpPpmw2F0xATf9dLFfrBNSv + 2mx3e5oqIuHAjoEkIr+npzO7RFJhWYJeb+wuDS+RVKWP5+stFa8qF4riOFsoZ+2c + 42QnLKYn/ADYChWCRPB9rQAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw + ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU + MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::8-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 6lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Bwf/MjL/UVH/TU3/Kir/BAT/DAz/j4//7e3/+Pj/5+f/eXn/ + BQX/Skr/9/f/7+//Z2f/fn7/+/v/6ur/MDD/UFD/4uL/Jib/QUH/9PT/NTX/EhL/ + srL/////09P/2tr/m5v/CAj/ycn//f3/y8v/1dX/s7P/GBj/hYX/HR3/Zmb/0dH/ + LCz/5eX/dHT/S0v/wsL/NDT/V1f/sLD/zc3/ysr/paX/RUX/AQH/Bgb/Dg7/DQ3m + iTf5AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRC8j1CARAAAA + yklEQVQY021Q1RLCQBDbowZFSpEWh+J+xd3d/v936N5hD+QlmezsTrIAQIhLECVZ + lkTBRQgAOorbozN43Ap6hKhe/QOv6nhE8ek/8CkE/AFUoXAkapioAn4QNIdj8UQy + mUpnHKkJIOIom7PyhWKpjFoECalSrNbqDauJWgIZqdWmdod2e6hlbhn9wXBExxNu + scUptWfhFJ3zRXY+TheT5Yqu+XkWYmMNtkNa3fEQLGpmfziezpcrj/oqdLs/zHeh + P7X/POf7wuDrhU+46hlBGTVCQgAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0x + MFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgt + MTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::9-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 8FBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/DAz/OTn/U1P/R0f/HBz/AQH/Fhb/oqL/8/P/+fn/+Pj/1NT/ + S0v/cXH/////29v/W1v/mJj/0ND/AgL/paX/np7/Ly//7e3//Pz/lZX/vr7/GBj/ + VVX/9fX/c3P/QED/5ub//f3/19f/4OD/+/v/eXn/Pz//mZn/oaH/dXX/6Oj/Z2f/ + Kir/cHD/enr/FRX/TU3/8PD/Ojr/Ozv/2tr/nJz/CAj/Tk7/sbH/z8//wcH/Bgb/ + Dw//CgoJOUsyAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCCz + az2AAAAAy0lEQVQY022Q1RLCQAxFs9QovlAozuLu7u72/39D0y3yQB6SO2cmmXsD + AITYBFGSZUkUbIQAIFHsKjVLtSvICHE46aecDoMRxUV/yqUQcHtQ+QNaMKSj8rhB + 8BozHInG4okkIq8AIs4US2eyLBdCLYJk9HyBFWmpXNEQSSDjqLJavdFkLdQyR+1O + t9cfsCFHuEj10XgynbE5XzTPL5ar9Sa+3fHzpon9rFI7sOOJmzCt5s+X6221tqxa + ge6Pp/4O9Cf2n+d8X+izXvgCm5cZM7QQ1AwAAAAldEVYdGRhdGU6Y3JlYXRlADIw + MjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAy + MDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== +} +image create photo ::tk::icons::10-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + MlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/BAT/IiL/AAD/AAD/GBj/VVX/Skr/Bwf/AQH/Hh7/Q0P/R0f/Jyf/AwP/ + Cwv/lZX/////1dX/Fhb/X1//2tr/+fn/+vr/4+P/bm7/BAT/Ojr/pqb/1tb/KCj/ + 4OD//v7/oKD/lpb/6ur/Njb/JCT/3t7/+/v/8PD/XV3/5eX/Jib/Fxf/cnL/trb/ + bGz/lJT/eHj/CQn/wcH/kpL/Bgb/Dw//hIT/fHz/0tL/FBT/vb3/mZn/29v/Ghr/ + DAz/xsb/iYn/RUX/9vb/8/P/NTX/5ub/YWH/19f/EBD/tLT/5OT/0ND/WFj/ra3/ + jo7/Dg7/IyP/kZH/yMj/ysr/AgL/DQ1XjFJNAAAAE3RSTlMAAA5Vq9/4NK/0St3c + Da7z8/PgJJvUWQAAAAFiS0dEILNrPYAAAADzSURBVBjTbZDXUgJBEEV7mLBkQyus + AWlXQVRUFDGgEkxgwoA5B/z/X3B6y/TAfTxVXX3PBQAhAlJpY7SSASEAmDjBEPoJ + BR1mQoQj+JtI2DLhRPFfoo6AWBxxYDCRRHSHhkdGU/EYyB4cS9O4h+7EZCY7leuV + oKZnZjOU93BufqGwmF0qKtDLpZVVRmu0Xt7I06YGU96qVBnV7HV9m3YMmN093GfU + oOZB8pCODGj72UcVOj5pndKZBvWDzi/aicsrulZcwqIbD2/v6L5ED33Sr/r49PyC + +Pr2/lEo2qos5HZclum0PlMs1EW7yzh/E/Z/T/gFtqkjSXNN8rEAAAAldEVYdGRh + dGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRk + YXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5E + rkJggg== +} +image create photo ::tk::icons::11-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 4VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/GBj/VVX/Skr/Bwf/FBT/U1P/TU3/Cgr/Cwv/lZX/////1dX/ + Fhb/CAj/ior//v7/3t7/HR3/BAT/Ojr/pqb/+fn/1tb/AwP/NTX/np7/9/f/39// + JCT/+/v/8PD/HBz//f3/7+//Jib/trb/bGz/lJT/Hh7/s7P/c3P/Bgb/Dw//hIT/ + BQX/dnb/19f/4OD/WFj/ra3/jo7/Dg7/Tk7/rKz/ExP/AQH/AgL8EhtJAAAAEXRS + TlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBycBEEHAAAAyElEQVQY023Q + Vw7CMBAE0DWxHTosvYTee++9k9z/QHgDAoSYvzzJ0cwCAGMOjQspBdccjAGQ6E4X + 2nE5dTLG3B58x+NWxnQvfsWrM/D5EUPhSJS+Y/FE0u8DLYCptJHJKsnlC8VSQANe + rlRrRj2LjWarbXRKyEF0i70+0aA+HBEJkOPJdEY0XyzzRBLkao0bou0ad08S6r82 + qeyeD/kvcSqhaP+iw1yVoKrH0/lCdL3N7qoqDTIt015jWhYN+jP7z3E+Jwy+TvgA + cTUbrJizqpQAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTUt + MDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE1 + LTA0OjAwBo9JEwAAAABJRU5ErkJggg== +} +image create photo ::tk::icons::12-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + LFBMVEUAAAD/AAD/AQH/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/Fhb/mpr/jo7/AgL/BQX/AAD/AAD/GBj/VVX/Skr/Bwf/CAj/MjL/ + UVH/UlL/ODj/DAz/Cwv/lZX/////1dX/Fhb/jY3/7e3//v7/8vL/oqL/BAT/Ojr/ + pqb/+fn/1tb/S0v/9vb/+/v/mpr/iYn/8/P/ZGT/JCT/3t7/8PD/PT3/l5f/k5P/ + Fxf/HBz/29v/fHz/Jib/trb/bGz/lJT/hob//Pz/RET/Bgb/Dw//hIT/HR3/oKD/ + +vr/9PT/eXn/BQX/KCj/vr7/2dn/WVn/ExP/t7f/9fX/jo7/19f/Y2P/WFj/ra3/ + Dg7/rKz/qan/qqr/AQH/AgJeYrBbAAAAF3RSTlMAAAAOVavf+DSv9Erd3A2u8/Pz + rtw04GaGKL0AAAABYktHRCS0BvmZAAAA7ElEQVQY023QWztCURCA4Vlah91pp8II + URmbTY4hcq6IUJEQCvX//4O1dk4XfVfzvFczAwCM+biQSknBfYwBGLH8AfQK+C1j + jAVD+FsoqI1ZYfxX2GJgRxAnE1PTiDPJ2blUOmIDH8XMPC04mFlcct3llSgHkV1d + W6cNBze3cts7u25egNzbzxUMHRweHZ+c0pkEVSyVzw3p0heVwqUCdVXF6wHd3Nbq + jTsFUs8Dum/SQyuLEsQPPT7RczvRSgqzhKYXB18rRC5RjHurvnXaXcy/f+g+47Z3 + UK/fQ+x7jY2PDDt7yHP+Xjjx/cIvG7EnkM/vXyUAAAAldEVYdGRhdGU6Y3JlYXRl + ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlm + eQAyMDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== +} +image create photo ::tk::icons::13-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + HVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/Bwf/PT3/AgL/AAD/AAD/GBj/VVX/Skr/Bwf/Bgb/Ly//UFD/MDD/Cwv/ + lZX/////1dX/Fhb/CQn/hob/6+v/+fn/+vr/7Oz/hIT/BAT/Ojr/pqb/1tb/Pz// + 6ur/8PD/bGz/iYn//v7/JCT/3t7/+/v/ERH/PDz/DQ3/ZWX//f3/5ub/Kyv/Jib/ + trb/lJT/AQH/8vL/h4f/Dw//1NT//Pz/0ND/Nzf/AgL/Dg7/IyP/jY3/u7v/IiL/ + 0tL/iIj/19f/3d3/xcX/vr7/5OT/WFj/ra3/jo7/Ozv/oaH/y8v/zc3/qKj/RUX/ + AwMz70tLAAAAFHRSTlMAAA5Vq9/4NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRB8F + DRC9AAAA8UlEQVQY023Q11rCQBAF4Fm2hBZsgwlFlyhooihIFxWighIFewX0/R/D + bMRywbma77+acwCAkBBlXAjOaIgQACVaOIJBImFNGSHRGP4mFvWNaHH8l7hGQE8g + JlcNEzGVzmSyZkIHuoBr6zJn4cZmvrC1bS9SYM7ObkEWLdzbL5UPKvk0A16t1UuK + Gk2jddg+OuYgTjrlriJE1z6tnDkCROoc7W9y7F7/4lIA9++ABqZnXuXkNQf2Q8aw + M0reyFumnvDpzsLsvXx4bD8t0eDV55dXD/HtfTyZfizrQSF34Koyny3PUYXm1J4z + zt+EK7MJvwDJgSGaiujlLAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw + ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU + MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::14-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + MlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/BAT/AAD/CAj/AQH/EBD/GBj/JSX/Bgb/Bwf/AQH/AAD/AAD/GBj/VVX/Skr/ + Bwf/MDD/Wlr/QED/Cwv/lZX/////1dX/Fhb/Ly//09P/urr/BAT/Ojr/pqb/+fn/ + 1tb/Gxv/vLz/u7v/CAj/JCT/3t7/+/v/8PD/DQ3/n5//+Pj/0tL/Jib/trb/bGz/ + lJT/gID/np7/aGj/Bgb/Dw//hIT/Xl7/9PT/ysr/Jyf/YmL/wMD/FBT/FRX/s7P/ + 5ub/zc3/4OD/9fX/o6P/6Oj/5+f//Pz/uLj/19f/Ghr/JSX/ICD/cnL/xcX/WFj/ + ra3/jo7/Dg7/PDz/q6v/e3v/AQH/AgJ9lF2oAAAAGnRSTlMAAA5Vq9/4NK/0St3c + Da6u8/P436vzVa7c4LQK5msAAAABYktHRCS0BvmZAAAA7UlEQVQY023Q11oCMRAF + 4AmbZGlrAQQNKiojZUVFERQboIIiSFOwi2V5/1cwifWCc/lfzHfOAAAhLoMyzhk1 + XIQAKDHdHqHjcZvKCPH6xG98XmnE9It/8ZsErAkhovMLixpiS8uTFhhTYiWOqwkl + yRSmpw2g9lpmHTcUbWYRt7YpsNxOvqBpd6+4L4kBPzg8OlZkl/LliiQO/ORUnCmq + 1s4v6njZCACTRyQ17StstTvYzQSB/lDvunVTwP4gpEpIuk2Iu/vcwyM+zYR11eeX + 4auu+vb+EbH0IGfkfM1xRrNy0JjZY57z98K57xd+AgvXJw2x8S2eAAAAJXRFWHRk + YXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwRjrrMgAAACV0RVh0 + ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMDdnU44AAAAASUVO + RK5CYII= +} +image create photo ::tk::icons::15-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + NVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/FBT/AAD/R0f/Li7/AAD/AAD/GBj/VVX/Skr/Bwf/Gxv/MjL/Ly//Cwv/lZX/ + ////1dX/Fhb/kpL/8/P/8vL/6+v/BAT/Ojr/pqb/+fn/1tb/CQn/vLz/2Nj/wsL/ + xMT/wcH/Nzf/JCT/3t7/+/v/8PD/GRn/2dn/dnb/Wlr/T0//AgL/Jib/trb/bGz/ + lJT/7u7//v7/7e3/9/f/9vb/qqr/Bgb/Dw//hIT/KCj/oaH/tbX/ZWX/bm7/7+// + cnL/AQH/ERH/DQ3/mZn/TU3/tLT/rKz/ICD/Ghr/09P/fX3/19f/Njb/4eH/xcX/ + wMD/WFj/ra3/jo7/Dg7/PDz/y8v/OTn/AwNVwL6YAAAAFHRSTlMAAA5Vq9/4NK/0 + St3cDa6u8/Pz4MH3NZkAAAABYktHRB5yCiArAAAA9UlEQVQY023Q11rCQBAF4Fm2 + hBZAHZTmGoMVAQs2sKGoEFuMDRUQVOT9H8FsPlEvOJf/zcw5AECIjzIuBGfURwiA + Es0fQC8Bv6aMkGAIfxMKuka0MP5LWCOgRxDjk1MJxGTKTTqqA41hZlrOGIizZtY0 + 58YosPmFxSW5bGBuReYLxdU1Bnx9o7SpaGu7tLNbTlY4iL39g0NFqaPq8UntNC5A + nJ1jXVHDuri8upY3Arh72SM7cWs7RXnHgQ3p/uHxqfksX5h6wqVXA1tt2Xmr5sep + 92q39/6B+Gn1+9ZXRPcK2RVblRk4zkAVGlF7xDh/E078TPgNVMok5Eu0euUAAAAl + dEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAA + JXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAA + AABJRU5ErkJggg== +} +image create photo ::tk::icons::16-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + LFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/ExP/AQH/SEj/BQX/AAD/AAD/GBj/VVX/Skr/Bwf/Ghr/R0f/U1P/Ojr/ + Cwv/lZX/////1dX/Fhb/z8//9/f/+fn/9PT/oKD/BAT/pqb/1tb/Gxv/mZn/Y2P/ + 3t7/3d3/SEj/JCT/+/v/8PD/UlL/7u7/PDz/LCz/UVH/Jib/CQn/trb/bGz/lJT/ + c3P/vr7/7Oz/5+f/kZH/EBD/Bgb/Dw//hIT/enr//v7/rq7/f3//6en/amr/aWn/ + 7e3/MjL/pKT/oaH/PT3/8fH/CAj/sLD/19f/29v/urr/6+v/WFj/ra3/jo7/Dg7/ + gYH/wsL/UFD/AQH/AgL/Cgoto8vpAAAAFXRSTlMAAA5Vq9/4NK/0St3cDa7z89/z + ruDPFLgEAAAAAWJLR0Qgs2s9gAAAAPNJREFUGNNtkMdWAkEQRavpMKTBWBgQLGcI + ooKIooJiRAXMAYyAo///D3bPMS14u7qbevcBAGMBLqRSUvAAYwCGWMEQ+gkFLcMY + C0fwN5GwZsyK4r9ELQZ2DDE+NT2jz9nEXDIVs4GPYGqeFhzEhJvOZHOjHMRiMp+h + JQeXXVopFFdLAuRasbxu0Ea5srm1Xa1JUNWd3bpBe1TZPzg8OlagGid4atAZNVvt + 8+aFAqlf+eiSrq7xhm7HQPygu/ts6aFDdWFKaNR1sJajx6f08zj3q768vvV04f7A + 7bxP2L6Q9+EZGe+z1zBCQ7SHjPM34eT3hF9IiCRlUyvoEQAAACV0RVh0ZGF0ZTpj + cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY66zIAAAAldEVYdGRhdGU6 + bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3Z1OOAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::17-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + BVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/Li7/AAD/mJj/AAD/AAD/GBj/VVX/Skr/Bwf/GRn/Njb/NTX/Cwv/lZX///// + 1dX/Fhb/cXH/9vb/8/P/8vL/8fH/9PT/BAT/Ojr/pqb/+fn/1tb/ZGT/29v/2Nj/ + 19f/4+P//f3/eHj/JCT/3t7/+/v/8PD/Cgr/Fxf/Gxv/oKD/paX/EBD/Jib/trb/ + bGz/lJT/Tk7/2dn/Jyf/Bgb/Dw//hIT/vr7/+Pj/5ub/Kyv/jIz/uLj/CQn/vb3/ + j4//WFj/ra3/jo7/Dg7/jY3/UFD/AQH/AgJwwfqkAAAAE3RSTlMAAA5Vq9/4NK/0 + St3cDa6u8/PgHfwDJgAAAAFiS0dEHesDcZEAAADhSURBVBjTbdDJVgIxEAXQChma + qRF4igqG1gacRXFgVBxAQAFBFP7/U0xajrjgbZJzN1X1iIixEBdSKSl4iDEiK044 + giCRsGONsWgMf4lFjTEnjn+JO4zcBLC5ldnGzm7WZsMlnkRuT+c97B/4fqFYSnES + h0fHJ/rUw9n5RflSX1UEyeub2ztL1ZpXb+hmS5K6f2g/WjJ58p9foEh1unj9pVZP + V2BImv+SMv3BGyBJrOhdD0eAsEsYKhuqjvUHkOTBqpPp5wyYfU2/gYQbHDRfzO3A + hXnsQWvOXlPOqsL0ssIfbB0e7ntg/vYAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEt + MDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIx + LTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAAAABJRU5ErkJggg== +} +image create photo ::tk::icons::18-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + PlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/DAz/S0v/Bgb/AAD/AAD/GBj/VVX/Skr/Bwf/BQX/LCz/T0//MDD/Cwv/ + lZX/////1dX/Fhb/Bgb/e3v/6Oj/+Pj/7Oz/jIz/BAT/Ojr/pqb/+fn/1tb/MzP/ + d3f/bW3/8/P/9vb/RUX/JCT/3t7/+/v/8PD/ODj/8fH/5+f/+vr/S0v/Jib/trb/ + bGz/lJT/CQn/nJz/2dn/1NT/srL/EBD/Dw//hIT/HBz/t7f//v7/0tL/zc3/xsb/ + JSX/amr/5OT/Li7/ICD/19f/gID/dHT/4+P/KSn/Ghr/jo7/Njb/y8v/w8P//f3/ + 7e3/WFj/ra3/Dg7/AgL/SEj/qan/zMz/rKz/UlL/AQH/DQ192iTxAAAAFHRSTlMA + AA5Vq9/4NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRB8FDRC9AAAA9klEQVQY023Q + x1oCQRAE4B4mLGkxtUhQm0UXQTErZklGTCgmQEUw4fu/gDv7mQ7U8b90VwEAYx4u + pFJScA9jAFoMrw/d+LyGNsb8AfxNwO8YM4L4L0GDgRlCHA6PRBCjsXh8NBIygffh + 2DglLExOTNp2aqqfg0hnpmcoa+Fsyp6bX1hcEiCXV1ZzmtbWc5nYxuaWBLW9s5vX + VChSqUx7+wpU8gAPNR0dV05OK2fnCqRz2aULql5e1ehagvihG7q9uy9TXegnHKpZ + 2KhS8+HxaYC7r7ae623svLw2394/Bk23ULfT1WXSn+2oLtSjdo9x/iYc+p7wC++L + Jf2uJzrcAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0 + OjAwRjrrMgAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0w + NDowMDdnU44AAAAASUVORK5CYII= +} +image create photo ::tk::icons::19-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + LFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AQH/EhL/AAD/AAD/GBj/VVX/Skr/Bwf/CAj/NDT/UlL/S0v/IiL/AgL/ + Cwv/lZX/////1dX/Fhb/DQ3/j4//7+//+fn/3d3/Xl7/BAT/Ojr/pqb/1tb/V1f/ + +vr/6Oj/ZWX/hob/4eH/LCz/JCT/3t7/+/v/8PD/ior/uLj/Bgb/HBz/bGz/Jib/ + trb/lJT/enr/0tL/QED/6+v/jo7/Dw//hIT/LS3/2Nj/29v/MzP/kpL/c3P/2tr/ + gYH/Hx//amr/f3//ICD/Njb/7e3/UVH/19f/KSn/xcX/0dH/srL/WFj/ra3/Dg7/ + qan/zc3/h4f/Hh7/AQH/BQVtNoEFAAAAE3RSTlMAAA5Vq9/4NK/0St3cDa7z8/Pg + JJvUWQAAAAFiS0dEILNrPYAAAADySURBVBjTbdDHWsJQEAXgudwSOsrYFRyDBhWN + DRuiIGABRexiwRLf/x3M5LMtOMt/M+cMAAgRkkobo5UMCQHAYoUjGCQSttiEiMbw + N7Gob8KK47/ELQGJJOLQ8Mgo4tj4xORUJpkAmcLsNM3YmJudc5z8/IAEtbBYcGjJ + xmV3ZXXNXd9QoIubW9tMO7Rb2stTWYPZPyhXmKp0WKzVqWHAlI7wmOnklJpNhyoG + tH85IGydFc7bdKFB/VDn8ur65ta9U1zCp3sbH9rUfaSnQRlUfX5p9BBrr2/d9w+/ + Kg/yMh6P+exlPR7UZ3af5/y9MP39wi8SoyQetkVHgwAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY66zIAAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3Z1OOAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::20-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASEAYAAAAGXlIUAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + BmJLR0T///////8JWPfcAAAErElEQVRIx7WWbUhUaRTH/6OmTmnWlr0IWfbih16o + LEewsg8NFEmElsagixW2GIVgKCixxFJbRBSZIibUUotJzJYkVuxitBZRua6J5AqR + q5TphxYZG9d8m/nth7nTXk032mXPl/99zj3nf/48z3PvOdI4g4kwvNGHaQd96Oz0 + YWeGD4fmGDjb8KcZcS1G3mGD55fx/JPauECLD9cZQqpP+LC/34fwedg/YPB8Y/A2 + ja3zyR3ZXujD9pZ/J+BT2P7cqFP00Y6Ndax3GAlr/h8hHwlbZ9T9cpyg8K99ePMd + WLdZtwHEr41fC5BSk1IDkJKYkggQvyB+AYD1nvXeRIUshZZCgOiz0WcBtmzeshlg + a83WGoBYd6wbIDAuMM6fd9Nt6DhmCEq7DRGOCIfbC2Wvy14DuIpcRQDeRm8jgPe+ + 9z6Ay+lyAlTsrtgNMMM6wwqgSEUCZFmzrAAv9r7YCzB0fug8wEjOSA5AV1RXFEBu + Y24jQODVwKv9H3QYl8q5V0p/kv5k93dS5ZnKM5LkXeFdIUkVrypeSdLootFFkpSz + K2eXJAX1BvVKUkZVRpUkNYU1hUlSXWJdoiQtrF1YK0lXbFdskjRwa+CWJB2IOhAl + Sa4HrgeSlByWHCZJDc8anv2QZijrqAB7qb0U4OLdi3cBzj0+9xhg5pqZawCWvlz6 + EqDrYNdBTHao81AngMPisADQRBNAt6PbARBri7UBzN0/dz9AW2pbqjn/yPQj0/1H + 13FJIIssg22gUIUCaL7mm+9ExLSIaQDFucW5AN5h7zDA2+y32QA2u80OUOAscJoL + tV5vvQ4Q+SjyEYA1z5oHUH+t/po57kLShSR/vcE3AZIQGpU0qEFJUo96JGnx+8Xv + JamivKJckg5fPnxZktx57jxJOvH0xFNJaqhrqJOkkPyQfPMPxTPiGZEkb7Q3WpK8 + w95hSRp9OPrQHBfiDnF/WPwR4MOe+38HrLattklSZWFloSSlZ6ZnSlLbzradkpRV + mlUqSSWXSi6ZiV3JrmTz2hpsDZakkKyQLEkKWha0TJKsHqvHHNfX3Nfsf+752bhD + zhSY1zavDaC+rr7OvKXv0t+lA5wqP1UOkLYxbSOAI8oRBbC8d3kvgL3AXgAw0DXQ + BeAedg8DbE/dngoQPyd+DkB3e3e7mX9f5L5I/5E59/g/tx8hvzm/ud8C3j5vnzmB + aqoByCefCezkhpMbAMJXhq8EqLXX2s3v34S+CQXoiO+IN/ubS5pLAGLuxNxxG4LS + frLA7ITZCeFD0mnPac/3X0jhq8JX7eyXOMpRSVKYwiTJEmOJkSQFKECSArIDsiXp + xo4bOySpyl5ll6QlcUviJCn3eO5xSUp4nvBckgJvB96WpNbi1mJJKmsta5WkhsyG + zGqX78iyzpqaW0hSSNL6DGmkZaTl+m8STpyLmyQFK1gTmeEnllhJ0izNMr8O2BSw + SZKmRk+NliTLFMsUSRqIGYiRJM8xz7Hf1/pi9yz3YeO1yZpr0dgmOFGL+C/Y3jpp + c/XbJOPHM2Ns+HbsGPG5Avr/HMvj551g/NA/C/M331+NS5czdvDqNLr0UKyBKw3/ + V0Zcu5F3wOBpmnRHDPsLflt0HfDi3lIAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEt + MDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIx + LTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAAAABJRU5ErkJggg== +} +image create photo ::tk::icons::20plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASEAYAAAAGXlIUAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + BmJLR0T///////8JWPfcAAAEjElEQVRIx7WWa0iUeRTGnxkdu9i0mrOFJtaQbCRZ + QYl2gT6UFEERmHSRRRNaNrrSZVs1kY0ipYJSakOiovqgaSViIBshSpSRtSQleFsV + my3MstzXambU337wdRlr2mxhz5cHznvOcx7O//3/z5E+MvCH9rohTN46hCXtQ9ie + MoTuySY6TH+yGVdv5m03eR58zP9Z+yjQMoTzTSE3Dg+hYQwhfB0a70yeX0zeRyPr + fLEjq34ewtb6/ybgS9j6xKyT8UnHRjoWbDQT5v0/Qj4RNt+s+72PIG+7tz3pJ9g9 + cffE345BvD3eDhB8Pfi6PyKr1+oFiA6NDgVIrE6sBkgsTiwGcEY4IwAspy2nRyvs + +l/mP5YjoIaagUQY6Bzo5FfoPdB7AOByweUCAEeVowog4FDAIYA9B/ccBOjwdngB + PIWeQgDPBc8FgJa4ljiAlDkpcwC0Vmv9CQk0Ag0AJ06MyZAUlxS3+RtBviPf8S4R + 8t7kvQEwVhorAQZdgy6A9Ir0CoCEnIQcgNdnX58FcHvdXoD8a/nXAK6UXCnBx1pW + tawCiB4fPd6foGl50/IA6t7WvQXojeiNqO8W2EJsIX8GQGRjZCNAs7vZ7UucWZxZ + DLDfut/q639S+aQSwHHVcRVg1vFZxwFeLHmxBGCwdLAUYMOWDVt8hQSEBIQAzHw5 + 8yWAq8XVAuAxPEbnLas0Nn9s/qR50tZjW49JkrPIWSRJvVG9UZJ033bfJkmRBZEF + vveze133OkkywowwSXoV8ypGknru9NyRJEuSJUmSIhUpSVq4fuF6SSqfXT5bkgpP + FZ6SJMcdxx1J6lrSteTbGKt0qeRSSdBaad/SfUsl6UPih0RJyq3MrZSk6qrqKkka + s2vMLl9B/dv6t0kST3kqSQMhAyGS1H+i/4RvXND7oPeSNKVsSpkkLVuxbIUkLbIv + sktSUGpQqiSRS666Zfb/D2hKbUoF2Lh3416AwDWBa3xbnZuVm+V7ZPcW31sMEHwv + +B5AuCvcBdDU0dThG7ezfGc5QKgr1AWw9OjSowApRooB0O3sdgJ4Mj2ZnWWBUt/2 + vu1ySjftN+2S1B/bHytJyTeSb0hSQ3ZDtiQ1lDSUSJLKVS5J0zOmZ0hSTGxMrCQ5 + VjtWS1K4JdwiSe40d5okNSU0JUhSz9SeqZJUrWpJ0oyuGV2S5B7nHidJtiO2I55C + weDpwdMAA5sHNuPHCrILsgEi2iLaAGrP1573/d6W15YH8Ozis4u+/tsVtysAJj2f + 9NzfLQvLCMsAOJx2OO3dJmg82XjyVLt5ZEW34OHjh4/rG6GovqgeoLSutA4g3Ug3 + fInmxs+NBzjXfK4Z4EHUgyiA2ru1dwHOlJ0pA4jZEbNj1A9jj/kwHvQZHWMzx2Yu + 6AOrzWprnQWWGksNgMVmsfkjClgesBzAvsK+AmBCzoQcAGuWNWu0QoZH1IJNn5ll + /wzXjJFDcLQFRi3k6WeHq/wLG14/fjfXhiMj14ivFWD0jeQZ5vWzfujfhQ0vaA/N + RevHkYtXuzml3d+ZONv0/2DGtZp5W0yeR5/tiGl/A2jL8ui+maoGAAAAJXRFWHRk + YXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwRjrrMgAAACV0RVh0 + ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMDdnU44AAAAASUVO + RK5CYII= +} +image create photo ::tk::icons::9plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + OFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/ERH/AAD/NDT/AQH/AAD/AAD/Cgr/Nzf/U1P/SUn/Hx//AQH/mJj/8fH/+fn/ + 2dn/VFT/BAT/YmL//f3/4uL/YGD/j4//IyP/GBj/xsb/xcX/Fxf/lZX/////rKz/ + JSX/5eX/3t7/3Nz/AgL/hob/yMj/Hh7/Skr/fn7/MTH/srL/vr7/9fX/NDT/NTX/ + 39///v7/3d3/+vr/g4P/RET/9PT/+/v/8/P/R0f/OTn/lpb/pKT/c3P/4eH/dHT/ + Dw//Pz//VVX/5ub/ExP/JCT/bW3/fX3/Ghr/QUH/Rkb/Gxv/wsL/1dX/p6f/DAz/ + e3v/enr/Dg7/ra3/zs7/w8P/gYH/GRn/Bgb/CwuphzIHAAAAFHRSTlMAAA5Vq9/4 + NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRCy63XGrAAAA+ElEQVQY02NgYGBkZGJm + YWVjY2VhZmJkZGAAibBzcIqAAScHO0iMkZGLWwQOuLmAYozsPCJIgIedkYGXT1RM + XEJSCibGx8vAzC8tIysrJw/kKUhKKogIMDOwKCopq6gqyamJiKhraGqJiLAwsGrr + 6Erp6euoABUZGEoqGLEysBnrmJiayeiYW1haWVtbWdqwMbDZ2tnLOTjqODm7uNrb + u7q5szGwinh4enn76Pj6+QcE6gf4B7EysASHhIaFu1lHiIhEGhiGgYxnFvSxj4rW + iYkVEfGLi08AOYJXKCIxKTklFcmpQA+lJaRLIXsIi7exBA4iCIWhQQgAiNMk9J5+ + e/MAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBG + OusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAw + N2dTjgAAAABJRU5ErkJggg== +} +image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + olBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Fhb/QED/Pj7/ExP/VVX/9PT/8PD/SUn/WFj//v7/+fn/S0v/ + SEj/PDz/MjL/6Oj/Jyf/ICD/4+P/2Nj/Fxf/Dw//qKj/nZ3/Cgr/IyP/hIT/gYH/ + Hh7/PT3/Ly//paX/oqL/KCj/AgL///8V6AjgAAAAEXRSTlMAAA5Vq9/4NK/0St3c + Da7z4Pnet34AAAABYktHRDXettlrAAAAoElEQVQY022QxxKCQBBEZ9hERkygophz + lv//NmF3Bz0wp1dd1V3dAwCIDuNCSsGZgwjQKMr1Un2eqxoN0Q/S9gK/1lCF6d+F + CiGKNfYHw5GGOAKWaBpn+URDwoAbw3RWzA1xEAYWRVYaEiANLPPV2pAkabPd7Umy + xsPxdCajjb9cb3eKtyXq+AeVsFWfr/eHqtKgqmoHdczueM7vhT37wi9PRRMHXNeq + aAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY6 + 6zIAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3 + Z1OOAAAAAElFTkSuQmCC +} + -- cgit v0.12 From 61c607c4562150a879e94efbedcb14526eb4ebcf Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 13 Aug 2021 13:25:10 +0000 Subject: Implement wm iconphoto command with only window arg to return name of current iconphoto --- macosx/tkMacOSXWm.c | 13 ++++++++++++- unix/tkUnixWm.c | 25 ++++++++++++++++++++++++- win/tkWinWm.c | 27 +++++++++++++++++++++++++-- 3 files changed, 61 insertions(+), 4 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index c59950b..0dd17d0 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -193,6 +193,11 @@ static const Tk_GeomMgr wmMgrType = { static int tkMacOSXWmAttrNotifyVal = 0; /* + * The following stores the name of the "wm iconphoto" image. + */ +char *base_icon = NULL; + +/* * Forward declarations for procedures defined in this file: */ @@ -2630,7 +2635,12 @@ WmIconphotoCmd( int width, height, isDefault = 0; NSImage *newIcon = NULL; - if (objc < 4) { + if ((objc == 3) && (base_icon !=NULL)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); + return TCL_OK; + } + + if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; @@ -2687,6 +2697,7 @@ WmIconphotoCmd( return TCL_ERROR; } [NSApp setApplicationIconImage: newIcon]; + base_icon = icon; return TCL_OK; } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 7ef3667..ac8f809 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -335,6 +335,11 @@ typedef struct WaitRestrictInfo { } WaitRestrictInfo; /* + * The following stores the name of the "wm iconphoto" image. + */ +char *base_icon = NULL; + +/* * Forward declarations for functions defined in this file: */ @@ -2387,7 +2392,12 @@ WmIconphotoCmd( int i, size = 0, width, height, index = 0, x, y, isDefault = 0; unsigned long *iconPropertyData; - if (objc < 4) { + if ((objc == 3) && (base_icon !=NULL)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); + return TCL_OK; + } + + if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; @@ -2401,6 +2411,17 @@ WmIconphotoCmd( } } + /* + * Get icon name. We only use the first icon name. + */ + + char *icon; + if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { + icon = Tcl_GetString(objv[4]); + } else { + icon = Tcl_GetString(objv[3]); + } + /* * Iterate over all images to retrieve their sizes, in order to allocate a * buffer large enough to hold all images. @@ -2503,6 +2524,8 @@ WmIconphotoCmd( if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdatePhotoIcon(winPtr); } + + base_icon = icon; return TCL_OK; } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 153a7a3..923d039 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -347,6 +347,11 @@ static int initialized; /* Flag indicating whether module has been TCL_DECLARE_MUTEX(winWmMutex) /* + * The following stores the name of the "wm iconphoto" image. + */ +char *base_icon = NULL; + +/* * Forward declarations for functions defined in this file: */ @@ -4154,12 +4159,28 @@ WmIconphotoCmd( unsigned size; (void)tkwin; - if (objc < 4) { + if ((objc == 3) && (base_icon !=NULL)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); + return TCL_OK; + } + + if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; } + /* + * Get icon name. We only use the first icon name. + */ + + char *icon; + if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { + icon = Tcl_GetString(objv[4]); + } else { + icon = Tcl_GetString(objv[3]); + } + /* * Iterate over all images to validate their existence. */ @@ -4174,7 +4195,7 @@ WmIconphotoCmd( } } for (i = startObj; i < objc; i++) { - photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); +s photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't use \"%s\" as iconphoto: not a photo image", @@ -4228,6 +4249,8 @@ WmIconphotoCmd( DecrIconRefCount(titlebaricon); return TCL_ERROR; } + base_icon = icon; + return TCL_OK; } -- cgit v0.12 From 23fe28a469687617889a61d1a9acb082fb62a07b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 13 Aug 2021 14:10:47 +0000 Subject: Check for NULL iconphoto --- macosx/tkMacOSXWm.c | 6 ++++++ unix/tkUnixWm.c | 6 ++++++ win/tkWinWm.c | 5 +++++ 3 files changed, 17 insertions(+) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 0dd17d0..39399cf 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2635,6 +2635,12 @@ WmIconphotoCmd( int width, height, isDefault = 0; NSImage *newIcon = NULL; + if ((objc == 3) && (base_icon == NULL)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); + return TCL_OK; + } + + if ((objc == 3) && (base_icon !=NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); return TCL_OK; diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index ac8f809..dcf669f 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2392,6 +2392,12 @@ WmIconphotoCmd( int i, size = 0, width, height, index = 0, x, y, isDefault = 0; unsigned long *iconPropertyData; + if ((objc == 3) && (base_icon == NULL)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); + return TCL_OK; + } + + if ((objc == 3) && (base_icon !=NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); return TCL_OK; diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 923d039..40e6754 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -4159,6 +4159,11 @@ WmIconphotoCmd( unsigned size; (void)tkwin; + if ((objc == 3) && (base_icon == NULL)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); + return TCL_OK; + } + if ((objc == 3) && (base_icon !=NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); return TCL_OK; -- cgit v0.12 From 2545f523119d60b5abc19446998e21a10826031d Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 13 Aug 2021 14:14:56 +0000 Subject: Fix typo --- win/tkWinWm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 40e6754..c7224e8 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -4200,7 +4200,7 @@ WmIconphotoCmd( } } for (i = startObj; i < objc; i++) { -s photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); + photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't use \"%s\" as iconphoto: not a photo image", -- cgit v0.12 From f24942bdf708f28647514f3074e3c6bf03cba55e Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 14 Aug 2021 02:19:58 +0000 Subject: Initial implementation of Tk-based icon badge API - much more polish needed --- library/iconbadges.tcl | 30 +++++++++++++++++++++++++++++- library/tk.tcl | 1 + 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 8f0ac0e..5b7ce7e 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -1,4 +1,4 @@ -# iconsbadges.tcl -- +# iconbadges.tcl -- # # Notification badges for Tk applications. # @@ -439,3 +439,31 @@ image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS Z1OOAAAAAElFTkSuQmCC } + +# ::tk::icons::IconBadge -- +# This procedure creates an icon with an overlay badge on systems that +# do not have a native icon/badge API. +# +# Arguments: +# badgenumber - number to draw over the icon + +proc ::tk::icons::IconBadge {badgenumber} { + + set badge "" + + if {![info exists base_icon]} { + set base_icon [wm iconphoto .] + } + + wm iconphoto . $base_icon + + if {[expr $badgenumber > 20] == 1} { + set badge ::tk::icons::20plus-badge + } else { + set badge ::tk::icons::$badgenumber-badge + } + set dest [image create photo] + $dest copy $base_icon + $dest copy $badge -from 0 0 18 18 -to 18 0 + wm iconphoto . $dest +} diff --git a/library/tk.tcl b/library/tk.tcl index 63d90f9..952db30 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -497,6 +497,7 @@ if {$::tk_library ne ""} { } namespace eval ::tk { SourceLibFile icons + SourceLibFile iconbadges SourceLibFile button SourceLibFile entry SourceLibFile listbox -- cgit v0.12 From b49fe39c8aa91fc4e88b5c997a011e75f39b136b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 15 Aug 2021 16:20:04 +0000 Subject: Further refinement of icon badge API; now consistently works on X11, needs to be wrapped at C level --- library/iconbadges.tcl | 300 +++++-------------------------------------------- 1 file changed, 31 insertions(+), 269 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 5b7ce7e..7963ddc 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -7,22 +7,11 @@ namespace eval ::tk::icons {} -image create photo ::tk::icons::0-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 51BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/AwP/JCT/RUX/ISH/AgL/BQX/cnL/4eH/+vr/29v/W1v/PDz/ - 7u7/+fn/kpL/pKT/////eHj/1NT/FRX/KSn/5+f//v7/WFj/lJT/v7//CQn/Fxf/ - 1tb/d3f/mJj/vLz/CAj/FBT/09P/fn7/iIj/xsb/DAz/Ghr/2tr/b2//Xl7/Njb/ - SUn/8vL/+Pj/HBz/yMj/39//5OT/vb3/ExP/Ly//nJz/ysr/lpb/Kir/DQ3HpLSX - AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCJdZVysAAAAxUlE - QVQY021QxRLCUBDbR5UipRR3Fnd3Ly7//z2wfUUO5JJMZnYnCQAw5hJESZYlUXAx - BkCOoroNG25VIY8xzWN84NFeHlO8xg+8CgOfn1TQDIXCEVJ+Hwj6i6OxeCKRTJGl - CyASpzPZXB6TJmkRJKICFkvlSrVGWgKZqI6NZquNHdIyt7rY6w+GOOKWfTjGyXQ2 - xwU/tN8vq5XVerNd8/d2iJ2F+wMeTzwEj3q+XK3b3YnqFAo+ppF3oT+1/4zznTDg - TPgETvcYi7Qhbm4AAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6 - MTQtMDQ6MDDRpfobAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1 - OjE0LTA0OjAwoPhCpwAAAABJRU5ErkJggg== -} +variable ::tk::icons::base_icon + +set ::tk::icons::base_icon "" + + image create photo ::tk::icons::1-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA kFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ @@ -162,249 +151,7 @@ image create photo ::tk::icons::9-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS MjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAy MDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== } -image create photo ::tk::icons::10-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - MlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/BAT/IiL/AAD/AAD/GBj/VVX/Skr/Bwf/AQH/Hh7/Q0P/R0f/Jyf/AwP/ - Cwv/lZX/////1dX/Fhb/X1//2tr/+fn/+vr/4+P/bm7/BAT/Ojr/pqb/1tb/KCj/ - 4OD//v7/oKD/lpb/6ur/Njb/JCT/3t7/+/v/8PD/XV3/5eX/Jib/Fxf/cnL/trb/ - bGz/lJT/eHj/CQn/wcH/kpL/Bgb/Dw//hIT/fHz/0tL/FBT/vb3/mZn/29v/Ghr/ - DAz/xsb/iYn/RUX/9vb/8/P/NTX/5ub/YWH/19f/EBD/tLT/5OT/0ND/WFj/ra3/ - jo7/Dg7/IyP/kZH/yMj/ysr/AgL/DQ1XjFJNAAAAE3RSTlMAAA5Vq9/4NK/0St3c - Da7z8/PgJJvUWQAAAAFiS0dEILNrPYAAAADzSURBVBjTbZDXUgJBEEV7mLBkQyus - AWlXQVRUFDGgEkxgwoA5B/z/X3B6y/TAfTxVXX3PBQAhAlJpY7SSASEAmDjBEPoJ - BR1mQoQj+JtI2DLhRPFfoo6AWBxxYDCRRHSHhkdGU/EYyB4cS9O4h+7EZCY7leuV - oKZnZjOU93BufqGwmF0qKtDLpZVVRmu0Xt7I06YGU96qVBnV7HV9m3YMmN093GfU - oOZB8pCODGj72UcVOj5pndKZBvWDzi/aicsrulZcwqIbD2/v6L5ED33Sr/r49PyC - +Pr2/lEo2qos5HZclum0PlMs1EW7yzh/E/Z/T/gFtqkjSXNN8rEAAAAldEVYdGRh - dGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRk - YXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5E - rkJggg== -} -image create photo ::tk::icons::11-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - 4VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/AAD/GBj/VVX/Skr/Bwf/FBT/U1P/TU3/Cgr/Cwv/lZX/////1dX/ - Fhb/CAj/ior//v7/3t7/HR3/BAT/Ojr/pqb/+fn/1tb/AwP/NTX/np7/9/f/39// - JCT/+/v/8PD/HBz//f3/7+//Jib/trb/bGz/lJT/Hh7/s7P/c3P/Bgb/Dw//hIT/ - BQX/dnb/19f/4OD/WFj/ra3/jo7/Dg7/Tk7/rKz/ExP/AQH/AgL8EhtJAAAAEXRS - TlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBycBEEHAAAAyElEQVQY023Q - Vw7CMBAE0DWxHTosvYTee++9k9z/QHgDAoSYvzzJ0cwCAGMOjQspBdccjAGQ6E4X - 2nE5dTLG3B58x+NWxnQvfsWrM/D5EUPhSJS+Y/FE0u8DLYCptJHJKsnlC8VSQANe - rlRrRj2LjWarbXRKyEF0i70+0aA+HBEJkOPJdEY0XyzzRBLkao0bou0ad08S6r82 - qeyeD/kvcSqhaP+iw1yVoKrH0/lCdL3N7qoqDTIt015jWhYN+jP7z3E+Jwy+TvgA - cTUbrJizqpQAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTUt - MDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE1 - LTA0OjAwBo9JEwAAAABJRU5ErkJggg== -} -image create photo ::tk::icons::12-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - LFBMVEUAAAD/AAD/AQH/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AAD/Fhb/mpr/jo7/AgL/BQX/AAD/AAD/GBj/VVX/Skr/Bwf/CAj/MjL/ - UVH/UlL/ODj/DAz/Cwv/lZX/////1dX/Fhb/jY3/7e3//v7/8vL/oqL/BAT/Ojr/ - pqb/+fn/1tb/S0v/9vb/+/v/mpr/iYn/8/P/ZGT/JCT/3t7/8PD/PT3/l5f/k5P/ - Fxf/HBz/29v/fHz/Jib/trb/bGz/lJT/hob//Pz/RET/Bgb/Dw//hIT/HR3/oKD/ - +vr/9PT/eXn/BQX/KCj/vr7/2dn/WVn/ExP/t7f/9fX/jo7/19f/Y2P/WFj/ra3/ - Dg7/rKz/qan/qqr/AQH/AgJeYrBbAAAAF3RSTlMAAAAOVavf+DSv9Erd3A2u8/Pz - rtw04GaGKL0AAAABYktHRCS0BvmZAAAA7ElEQVQY023QWztCURCA4Vlah91pp8II - URmbTY4hcq6IUJEQCvX//4O1dk4XfVfzvFczAwCM+biQSknBfYwBGLH8AfQK+C1j - jAVD+FsoqI1ZYfxX2GJgRxAnE1PTiDPJ2blUOmIDH8XMPC04mFlcct3llSgHkV1d - W6cNBze3cts7u25egNzbzxUMHRweHZ+c0pkEVSyVzw3p0heVwqUCdVXF6wHd3Nbq - jTsFUs8Dum/SQyuLEsQPPT7RczvRSgqzhKYXB18rRC5RjHurvnXaXcy/f+g+47Z3 - UK/fQ+x7jY2PDDt7yHP+Xjjx/cIvG7EnkM/vXyUAAAAldEVYdGRhdGU6Y3JlYXRl - ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlm - eQAyMDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== -} -image create photo ::tk::icons::13-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - HVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/Bwf/PT3/AgL/AAD/AAD/GBj/VVX/Skr/Bwf/Bgb/Ly//UFD/MDD/Cwv/ - lZX/////1dX/Fhb/CQn/hob/6+v/+fn/+vr/7Oz/hIT/BAT/Ojr/pqb/1tb/Pz// - 6ur/8PD/bGz/iYn//v7/JCT/3t7/+/v/ERH/PDz/DQ3/ZWX//f3/5ub/Kyv/Jib/ - trb/lJT/AQH/8vL/h4f/Dw//1NT//Pz/0ND/Nzf/AgL/Dg7/IyP/jY3/u7v/IiL/ - 0tL/iIj/19f/3d3/xcX/vr7/5OT/WFj/ra3/jo7/Ozv/oaH/y8v/zc3/qKj/RUX/ - AwMz70tLAAAAFHRSTlMAAA5Vq9/4NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRB8F - DRC9AAAA8UlEQVQY023Q11rCQBAF4Fm2hBZsgwlFlyhooihIFxWighIFewX0/R/D - bMRywbma77+acwCAkBBlXAjOaIgQACVaOIJBImFNGSHRGP4mFvWNaHH8l7hGQE8g - JlcNEzGVzmSyZkIHuoBr6zJn4cZmvrC1bS9SYM7ObkEWLdzbL5UPKvk0A16t1UuK - Gk2jddg+OuYgTjrlriJE1z6tnDkCROoc7W9y7F7/4lIA9++ABqZnXuXkNQf2Q8aw - M0reyFumnvDpzsLsvXx4bD8t0eDV55dXD/HtfTyZfizrQSF34Koyny3PUYXm1J4z - zt+EK7MJvwDJgSGaiujlLAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw - ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU - MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC -} -image create photo ::tk::icons::14-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - MlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/BAT/AAD/CAj/AQH/EBD/GBj/JSX/Bgb/Bwf/AQH/AAD/AAD/GBj/VVX/Skr/ - Bwf/MDD/Wlr/QED/Cwv/lZX/////1dX/Fhb/Ly//09P/urr/BAT/Ojr/pqb/+fn/ - 1tb/Gxv/vLz/u7v/CAj/JCT/3t7/+/v/8PD/DQ3/n5//+Pj/0tL/Jib/trb/bGz/ - lJT/gID/np7/aGj/Bgb/Dw//hIT/Xl7/9PT/ysr/Jyf/YmL/wMD/FBT/FRX/s7P/ - 5ub/zc3/4OD/9fX/o6P/6Oj/5+f//Pz/uLj/19f/Ghr/JSX/ICD/cnL/xcX/WFj/ - ra3/jo7/Dg7/PDz/q6v/e3v/AQH/AgJ9lF2oAAAAGnRSTlMAAA5Vq9/4NK/0St3c - Da6u8/P436vzVa7c4LQK5msAAAABYktHRCS0BvmZAAAA7UlEQVQY023Q11oCMRAF - 4AmbZGlrAQQNKiojZUVFERQboIIiSFOwi2V5/1cwifWCc/lfzHfOAAAhLoMyzhk1 - XIQAKDHdHqHjcZvKCPH6xG98XmnE9It/8ZsErAkhovMLixpiS8uTFhhTYiWOqwkl - yRSmpw2g9lpmHTcUbWYRt7YpsNxOvqBpd6+4L4kBPzg8OlZkl/LliiQO/ORUnCmq - 1s4v6njZCACTRyQ17StstTvYzQSB/lDvunVTwP4gpEpIuk2Iu/vcwyM+zYR11eeX - 4auu+vb+EbH0IGfkfM1xRrNy0JjZY57z98K57xd+AgvXJw2x8S2eAAAAJXRFWHRk - YXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwRjrrMgAAACV0RVh0 - ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMDdnU44AAAAASUVO - RK5CYII= -} -image create photo ::tk::icons::15-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - NVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/FBT/AAD/R0f/Li7/AAD/AAD/GBj/VVX/Skr/Bwf/Gxv/MjL/Ly//Cwv/lZX/ - ////1dX/Fhb/kpL/8/P/8vL/6+v/BAT/Ojr/pqb/+fn/1tb/CQn/vLz/2Nj/wsL/ - xMT/wcH/Nzf/JCT/3t7/+/v/8PD/GRn/2dn/dnb/Wlr/T0//AgL/Jib/trb/bGz/ - lJT/7u7//v7/7e3/9/f/9vb/qqr/Bgb/Dw//hIT/KCj/oaH/tbX/ZWX/bm7/7+// - cnL/AQH/ERH/DQ3/mZn/TU3/tLT/rKz/ICD/Ghr/09P/fX3/19f/Njb/4eH/xcX/ - wMD/WFj/ra3/jo7/Dg7/PDz/y8v/OTn/AwNVwL6YAAAAFHRSTlMAAA5Vq9/4NK/0 - St3cDa6u8/Pz4MH3NZkAAAABYktHRB5yCiArAAAA9UlEQVQY023Q11rCQBAF4Fm2 - hBZAHZTmGoMVAQs2sKGoEFuMDRUQVOT9H8FsPlEvOJf/zcw5AECIjzIuBGfURwiA - Es0fQC8Bv6aMkGAIfxMKuka0MP5LWCOgRxDjk1MJxGTKTTqqA41hZlrOGIizZtY0 - 58YosPmFxSW5bGBuReYLxdU1Bnx9o7SpaGu7tLNbTlY4iL39g0NFqaPq8UntNC5A - nJ1jXVHDuri8upY3Arh72SM7cWs7RXnHgQ3p/uHxqfksX5h6wqVXA1tt2Xmr5sep - 92q39/6B+Gn1+9ZXRPcK2RVblRk4zkAVGlF7xDh/E078TPgNVMok5Eu0euUAAAAl - dEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAA - JXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAA - AABJRU5ErkJggg== -} -image create photo ::tk::icons::16-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - LFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/ExP/AQH/SEj/BQX/AAD/AAD/GBj/VVX/Skr/Bwf/Ghr/R0f/U1P/Ojr/ - Cwv/lZX/////1dX/Fhb/z8//9/f/+fn/9PT/oKD/BAT/pqb/1tb/Gxv/mZn/Y2P/ - 3t7/3d3/SEj/JCT/+/v/8PD/UlL/7u7/PDz/LCz/UVH/Jib/CQn/trb/bGz/lJT/ - c3P/vr7/7Oz/5+f/kZH/EBD/Bgb/Dw//hIT/enr//v7/rq7/f3//6en/amr/aWn/ - 7e3/MjL/pKT/oaH/PT3/8fH/CAj/sLD/19f/29v/urr/6+v/WFj/ra3/jo7/Dg7/ - gYH/wsL/UFD/AQH/AgL/Cgoto8vpAAAAFXRSTlMAAA5Vq9/4NK/0St3cDa7z89/z - ruDPFLgEAAAAAWJLR0Qgs2s9gAAAAPNJREFUGNNtkMdWAkEQRavpMKTBWBgQLGcI - ooKIooJiRAXMAYyAo///D3bPMS14u7qbevcBAGMBLqRSUvAAYwCGWMEQ+gkFLcMY - C0fwN5GwZsyK4r9ELQZ2DDE+NT2jz9nEXDIVs4GPYGqeFhzEhJvOZHOjHMRiMp+h - JQeXXVopFFdLAuRasbxu0Ea5srm1Xa1JUNWd3bpBe1TZPzg8OlagGid4atAZNVvt - 8+aFAqlf+eiSrq7xhm7HQPygu/ts6aFDdWFKaNR1sJajx6f08zj3q768vvV04f7A - 7bxP2L6Q9+EZGe+z1zBCQ7SHjPM34eT3hF9IiCRlUyvoEQAAACV0RVh0ZGF0ZTpj - cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY66zIAAAAldEVYdGRhdGU6 - bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3Z1OOAAAAAElFTkSuQmCC -} -image create photo ::tk::icons::17-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - BVBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/Li7/AAD/mJj/AAD/AAD/GBj/VVX/Skr/Bwf/GRn/Njb/NTX/Cwv/lZX///// - 1dX/Fhb/cXH/9vb/8/P/8vL/8fH/9PT/BAT/Ojr/pqb/+fn/1tb/ZGT/29v/2Nj/ - 19f/4+P//f3/eHj/JCT/3t7/+/v/8PD/Cgr/Fxf/Gxv/oKD/paX/EBD/Jib/trb/ - bGz/lJT/Tk7/2dn/Jyf/Bgb/Dw//hIT/vr7/+Pj/5ub/Kyv/jIz/uLj/CQn/vb3/ - j4//WFj/ra3/jo7/Dg7/jY3/UFD/AQH/AgJwwfqkAAAAE3RSTlMAAA5Vq9/4NK/0 - St3cDa6u8/PgHfwDJgAAAAFiS0dEHesDcZEAAADhSURBVBjTbdDJVgIxEAXQChma - qRF4igqG1gacRXFgVBxAQAFBFP7/U0xajrjgbZJzN1X1iIixEBdSKSl4iDEiK044 - giCRsGONsWgMf4lFjTEnjn+JO4zcBLC5ldnGzm7WZsMlnkRuT+c97B/4fqFYSnES - h0fHJ/rUw9n5RflSX1UEyeub2ztL1ZpXb+hmS5K6f2g/WjJ58p9foEh1unj9pVZP - V2BImv+SMv3BGyBJrOhdD0eAsEsYKhuqjvUHkOTBqpPp5wyYfU2/gYQbHDRfzO3A - hXnsQWvOXlPOqsL0ssIfbB0e7ntg/vYAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEt - MDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIx - LTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAAAABJRU5ErkJggg== -} -image create photo ::tk::icons::18-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - PlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/DAz/S0v/Bgb/AAD/AAD/GBj/VVX/Skr/Bwf/BQX/LCz/T0//MDD/Cwv/ - lZX/////1dX/Fhb/Bgb/e3v/6Oj/+Pj/7Oz/jIz/BAT/Ojr/pqb/+fn/1tb/MzP/ - d3f/bW3/8/P/9vb/RUX/JCT/3t7/+/v/8PD/ODj/8fH/5+f/+vr/S0v/Jib/trb/ - bGz/lJT/CQn/nJz/2dn/1NT/srL/EBD/Dw//hIT/HBz/t7f//v7/0tL/zc3/xsb/ - JSX/amr/5OT/Li7/ICD/19f/gID/dHT/4+P/KSn/Ghr/jo7/Njb/y8v/w8P//f3/ - 7e3/WFj/ra3/Dg7/AgL/SEj/qan/zMz/rKz/UlL/AQH/DQ192iTxAAAAFHRSTlMA - AA5Vq9/4NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRB8FDRC9AAAA9klEQVQY023Q - x1oCQRAE4B4mLGkxtUhQm0UXQTErZklGTCgmQEUw4fu/gDv7mQ7U8b90VwEAYx4u - pFJScA9jAFoMrw/d+LyGNsb8AfxNwO8YM4L4L0GDgRlCHA6PRBCjsXh8NBIygffh - 2DglLExOTNp2aqqfg0hnpmcoa+Fsyp6bX1hcEiCXV1ZzmtbWc5nYxuaWBLW9s5vX - VChSqUx7+wpU8gAPNR0dV05OK2fnCqRz2aULql5e1ehagvihG7q9uy9TXegnHKpZ - 2KhS8+HxaYC7r7ae623svLw2394/Bk23ULfT1WXSn+2oLtSjdo9x/iYc+p7wC++L - Jf2uJzrcAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0 - OjAwRjrrMgAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0w - NDowMDdnU44AAAAASUVORK5CYII= -} -image create photo ::tk::icons::19-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB - LFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ - AAD/AAD/AQH/EhL/AAD/AAD/GBj/VVX/Skr/Bwf/CAj/NDT/UlL/S0v/IiL/AgL/ - Cwv/lZX/////1dX/Fhb/DQ3/j4//7+//+fn/3d3/Xl7/BAT/Ojr/pqb/1tb/V1f/ - +vr/6Oj/ZWX/hob/4eH/LCz/JCT/3t7/+/v/8PD/ior/uLj/Bgb/HBz/bGz/Jib/ - trb/lJT/enr/0tL/QED/6+v/jo7/Dw//hIT/LS3/2Nj/29v/MzP/kpL/c3P/2tr/ - gYH/Hx//amr/f3//ICD/Njb/7e3/UVH/19f/KSn/xcX/0dH/srL/WFj/ra3/Dg7/ - qan/zc3/h4f/Hh7/AQH/BQVtNoEFAAAAE3RSTlMAAA5Vq9/4NK/0St3cDa7z8/Pg - JJvUWQAAAAFiS0dEILNrPYAAAADySURBVBjTbdDHWsJQEAXgudwSOsrYFRyDBhWN - DRuiIGABRexiwRLf/x3M5LMtOMt/M+cMAAgRkkobo5UMCQHAYoUjGCQSttiEiMbw - N7Gob8KK47/ELQGJJOLQ8Mgo4tj4xORUJpkAmcLsNM3YmJudc5z8/IAEtbBYcGjJ - xmV3ZXXNXd9QoIubW9tMO7Rb2stTWYPZPyhXmKp0WKzVqWHAlI7wmOnklJpNhyoG - tH85IGydFc7bdKFB/VDn8ur65ta9U1zCp3sbH9rUfaSnQRlUfX5p9BBrr2/d9w+/ - Kg/yMh6P+exlPR7UZ3af5/y9MP39wi8SoyQetkVHgwAAACV0RVh0ZGF0ZTpjcmVh - dGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY66zIAAAAldEVYdGRhdGU6bW9k - aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3Z1OOAAAAAElFTkSuQmCC -} -image create photo ::tk::icons::20-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASEAYAAAAGXlIUAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - BmJLR0T///////8JWPfcAAAErElEQVRIx7WWbUhUaRTH/6OmTmnWlr0IWfbih16o - LEewsg8NFEmElsagixW2GIVgKCixxFJbRBSZIibUUotJzJYkVuxitBZRua6J5AqR - q5TphxYZG9d8m/nth7nTXk032mXPl/99zj3nf/48z3PvOdI4g4kwvNGHaQd96Oz0 - YWeGD4fmGDjb8KcZcS1G3mGD55fx/JPauECLD9cZQqpP+LC/34fwedg/YPB8Y/A2 - ja3zyR3ZXujD9pZ/J+BT2P7cqFP00Y6Ndax3GAlr/h8hHwlbZ9T9cpyg8K99ePMd - WLdZtwHEr41fC5BSk1IDkJKYkggQvyB+AYD1nvXeRIUshZZCgOiz0WcBtmzeshlg - a83WGoBYd6wbIDAuMM6fd9Nt6DhmCEq7DRGOCIfbC2Wvy14DuIpcRQDeRm8jgPe+ - 9z6Ay+lyAlTsrtgNMMM6wwqgSEUCZFmzrAAv9r7YCzB0fug8wEjOSA5AV1RXFEBu - Y24jQODVwKv9H3QYl8q5V0p/kv5k93dS5ZnKM5LkXeFdIUkVrypeSdLootFFkpSz - K2eXJAX1BvVKUkZVRpUkNYU1hUlSXWJdoiQtrF1YK0lXbFdskjRwa+CWJB2IOhAl - Sa4HrgeSlByWHCZJDc8anv2QZijrqAB7qb0U4OLdi3cBzj0+9xhg5pqZawCWvlz6 - EqDrYNdBTHao81AngMPisADQRBNAt6PbARBri7UBzN0/dz9AW2pbqjn/yPQj0/1H - 13FJIIssg22gUIUCaL7mm+9ExLSIaQDFucW5AN5h7zDA2+y32QA2u80OUOAscJoL - tV5vvQ4Q+SjyEYA1z5oHUH+t/po57kLShSR/vcE3AZIQGpU0qEFJUo96JGnx+8Xv - JamivKJckg5fPnxZktx57jxJOvH0xFNJaqhrqJOkkPyQfPMPxTPiGZEkb7Q3WpK8 - w95hSRp9OPrQHBfiDnF/WPwR4MOe+38HrLattklSZWFloSSlZ6ZnSlLbzradkpRV - mlUqSSWXSi6ZiV3JrmTz2hpsDZakkKyQLEkKWha0TJKsHqvHHNfX3Nfsf+752bhD - zhSY1zavDaC+rr7OvKXv0t+lA5wqP1UOkLYxbSOAI8oRBbC8d3kvgL3AXgAw0DXQ - BeAedg8DbE/dngoQPyd+DkB3e3e7mX9f5L5I/5E59/g/tx8hvzm/ud8C3j5vnzmB - aqoByCefCezkhpMbAMJXhq8EqLXX2s3v34S+CQXoiO+IN/ubS5pLAGLuxNxxG4LS - frLA7ITZCeFD0mnPac/3X0jhq8JX7eyXOMpRSVKYwiTJEmOJkSQFKECSArIDsiXp - xo4bOySpyl5ll6QlcUviJCn3eO5xSUp4nvBckgJvB96WpNbi1mJJKmsta5WkhsyG - zGqX78iyzpqaW0hSSNL6DGmkZaTl+m8STpyLmyQFK1gTmeEnllhJ0izNMr8O2BSw - SZKmRk+NliTLFMsUSRqIGYiRJM8xz7Hf1/pi9yz3YeO1yZpr0dgmOFGL+C/Y3jpp - c/XbJOPHM2Ns+HbsGPG5Avr/HMvj551g/NA/C/M331+NS5czdvDqNLr0UKyBKw3/ - V0Zcu5F3wOBpmnRHDPsLflt0HfDi3lIAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEt - MDgtMTBUMDg6MzU6MTYtMDQ6MDBGOusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIx - LTA4LTEwVDA4OjM1OjE2LTA0OjAwN2dTjgAAAABJRU5ErkJggg== -} -image create photo ::tk::icons::20plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASEAYAAAAGXlIUAAAABGdBTUEAALGPC/xh - BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA - BmJLR0T///////8JWPfcAAAEjElEQVRIx7WWa0iUeRTGnxkdu9i0mrOFJtaQbCRZ - QYl2gT6UFEERmHSRRRNaNrrSZVs1kY0ipYJSakOiovqgaSViIBshSpSRtSQleFsV - my3MstzXambU337wdRlr2mxhz5cHznvOcx7O//3/z5E+MvCH9rohTN46hCXtQ9ie - MoTuySY6TH+yGVdv5m03eR58zP9Z+yjQMoTzTSE3Dg+hYQwhfB0a70yeX0zeRyPr - fLEjq34ewtb6/ybgS9j6xKyT8UnHRjoWbDQT5v0/Qj4RNt+s+72PIG+7tz3pJ9g9 - cffE345BvD3eDhB8Pfi6PyKr1+oFiA6NDgVIrE6sBkgsTiwGcEY4IwAspy2nRyvs - +l/mP5YjoIaagUQY6Bzo5FfoPdB7AOByweUCAEeVowog4FDAIYA9B/ccBOjwdngB - PIWeQgDPBc8FgJa4ljiAlDkpcwC0Vmv9CQk0Ag0AJ06MyZAUlxS3+RtBviPf8S4R - 8t7kvQEwVhorAQZdgy6A9Ir0CoCEnIQcgNdnX58FcHvdXoD8a/nXAK6UXCnBx1pW - tawCiB4fPd6foGl50/IA6t7WvQXojeiNqO8W2EJsIX8GQGRjZCNAs7vZ7UucWZxZ - DLDfut/q639S+aQSwHHVcRVg1vFZxwFeLHmxBGCwdLAUYMOWDVt8hQSEBIQAzHw5 - 8yWAq8XVAuAxPEbnLas0Nn9s/qR50tZjW49JkrPIWSRJvVG9UZJ033bfJkmRBZEF - vveze133OkkywowwSXoV8ypGknru9NyRJEuSJUmSIhUpSVq4fuF6SSqfXT5bkgpP - FZ6SJMcdxx1J6lrSteTbGKt0qeRSSdBaad/SfUsl6UPih0RJyq3MrZSk6qrqKkka - s2vMLl9B/dv6t0kST3kqSQMhAyGS1H+i/4RvXND7oPeSNKVsSpkkLVuxbIUkLbIv - sktSUGpQqiSRS666Zfb/D2hKbUoF2Lh3416AwDWBa3xbnZuVm+V7ZPcW31sMEHwv - +B5AuCvcBdDU0dThG7ezfGc5QKgr1AWw9OjSowApRooB0O3sdgJ4Mj2ZnWWBUt/2 - vu1ySjftN+2S1B/bHytJyTeSb0hSQ3ZDtiQ1lDSUSJLKVS5J0zOmZ0hSTGxMrCQ5 - VjtWS1K4JdwiSe40d5okNSU0JUhSz9SeqZJUrWpJ0oyuGV2S5B7nHidJtiO2I55C - weDpwdMAA5sHNuPHCrILsgEi2iLaAGrP1573/d6W15YH8Ozis4u+/tsVtysAJj2f - 9NzfLQvLCMsAOJx2OO3dJmg82XjyVLt5ZEW34OHjh4/rG6GovqgeoLSutA4g3Ug3 - fInmxs+NBzjXfK4Z4EHUgyiA2ru1dwHOlJ0pA4jZEbNj1A9jj/kwHvQZHWMzx2Yu - 6AOrzWprnQWWGksNgMVmsfkjClgesBzAvsK+AmBCzoQcAGuWNWu0QoZH1IJNn5ll - /wzXjJFDcLQFRi3k6WeHq/wLG14/fjfXhiMj14ivFWD0jeQZ5vWzfujfhQ0vaA/N - RevHkYtXuzml3d+ZONv0/2DGtZp5W0yeR5/tiGl/A2jL8ui+maoGAAAAJXRFWHRk - YXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAwRjrrMgAAACV0RVh0 - ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMDdnU44AAAAASUVO - RK5CYII= -} + image create photo ::tk::icons::9plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB OFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ @@ -449,21 +196,36 @@ image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS proc ::tk::icons::IconBadge {badgenumber} { + variable ::tk::icons::base_icon + set badge "" - - if {![info exists base_icon]} { - set base_icon [wm iconphoto .] + + image create photo overlay + + if {$::tk::icons::base_icon eq ""} { + error "You must set the value of ::tk::icons::base_icon\ + to a Tk photo before setting an icon badge" } - wm iconphoto . $base_icon - if {[expr $badgenumber > 20] == 1} { - set badge ::tk::icons::20plus-badge + if {$badgenumber eq ""} { + wm iconphoto . $::tk::icons::base_icon + return + } + + update idletasks + + wm iconphoto . $::tk::icons::base_icon + + if {[expr $badgenumber > 9] == 1} { + set badge ::tk::icons::9plus-badge } else { set badge ::tk::icons::$badgenumber-badge } - set dest [image create photo] - $dest copy $base_icon - $dest copy $badge -from 0 0 18 18 -to 18 0 - wm iconphoto . $dest + + update idletasks + overlay copy $::tk::icons::base_icon + overlay copy $badge -from 0 0 18 18 -to 18 0 + wm iconphoto . overlay + } -- cgit v0.12 From 57410166f0e19205b5e4a7109ec345ffb2dbc915 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 16 Aug 2021 14:45:04 +0000 Subject: X11 implementation substantially complete --- library/iconbadges.tcl | 14 +++++++++----- unix/tkUnixWm.c | 51 ++++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 58 insertions(+), 7 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 7963ddc..122863d 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -194,7 +194,7 @@ image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS # Arguments: # badgenumber - number to draw over the icon -proc ::tk::icons::IconBadge {badgenumber} { +proc ::tk::icons::IconBadge {win badgenumber} { variable ::tk::icons::base_icon @@ -203,19 +203,23 @@ proc ::tk::icons::IconBadge {badgenumber} { image create photo overlay if {$::tk::icons::base_icon eq ""} { - error "You must set the value of ::tk::icons::base_icon\ + return -code error "You must set the value of ::tk::icons::base_icon\ to a Tk photo before setting an icon badge" } + if {[wm iconphoto $win] eq ""} { + return -code error "You must set a Tk image as a window icon via the wm\ iconphoto command before setting an icon badge" +} + if {$badgenumber eq ""} { - wm iconphoto . $::tk::icons::base_icon + wm iconphoto $win $::tk::icons::base_icon return } update idletasks - wm iconphoto . $::tk::icons::base_icon + wm iconphoto $win $::tk::icons::base_icon if {[expr $badgenumber > 9] == 1} { set badge ::tk::icons::9plus-badge @@ -226,6 +230,6 @@ proc ::tk::icons::IconBadge {badgenumber} { update idletasks overlay copy $::tk::icons::base_icon overlay copy $badge -from 0 0 18 18 -to 18 0 - wm iconphoto . overlay + wm iconphoto $win overlay } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index dcf669f..0666012 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -419,6 +419,9 @@ static int WmGridCmd(Tk_Window tkwin, TkWindow *winPtr, static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int WmIconbadgeCmd(Tk_Window tkwin, TkWindow *winPtr, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1021,7 +1024,7 @@ Tk_WmObjCmd( static const char *const optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", "command", "deiconify", "focusmodel", "forget", - "frame", "geometry", "grid", "group", "iconbitmap", + "frame", "geometry", "grid", "group", "iconbadge", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", "positionfrom", @@ -1031,7 +1034,7 @@ Tk_WmObjCmd( WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, - WMOPT_ICONBITMAP, + WMOPT_ICONBADGE, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, @@ -1121,6 +1124,8 @@ Tk_WmObjCmd( return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONBADGE: + return WmIconbadgeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONIFY: @@ -2125,6 +2130,48 @@ WmGroupCmd( /* *---------------------------------------------------------------------- * + * WmIconbadgeCmd -- + * + * This function is invoked to process the "wm iconbadge" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmIconbadgeCmd( + TCL_UNUSED(Tk_Window), /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ? badge?"); + return TCL_ERROR; + } + + char cmd[4096]; + sprintf(cmd, "::tk::icons::IconBadge {%s} {%s}", Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); + if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { + //Tcl_GetStringResult(interp); + return TCL_ERROR; + } + + +return TCL_OK; +} +/* + *---------------------------------------------------------------------- + * * WmIconbitmapCmd -- * * This function is invoked to process the "wm iconbitmap" Tcl command. -- cgit v0.12 From 3cbb9fe42c6b71efea554af53e30dd68c83b3052 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 16 Aug 2021 14:58:32 +0000 Subject: Minor tweaks --- unix/tkUnixWm.c | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 0666012..c475ec3 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -421,7 +421,7 @@ static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Obj *const objv[]); static int WmIconbadgeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); + Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -2147,12 +2147,13 @@ WmGroupCmd( static int WmIconbadgeCmd( TCL_UNUSED(Tk_Window), /* Main window of the application. */ - TkWindow *winPtr, /* Toplevel to work with */ + TkWindow *tkWin, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - + (void) tkWin; + if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); @@ -2162,12 +2163,12 @@ WmIconbadgeCmd( char cmd[4096]; sprintf(cmd, "::tk::icons::IconBadge {%s} {%s}", Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { - //Tcl_GetStringResult(interp); + Tcl_SetResult(interp,"Unable to set icon badge",TCL_VOLATILE); return TCL_ERROR; } -return TCL_OK; + return TCL_OK; } /* *---------------------------------------------------------------------- -- cgit v0.12 From ac6259da7e1ef7944319835a5f76a324a49cc718 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 16 Aug 2021 15:07:03 +0000 Subject: One more tweak --- library/iconbadges.tcl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 122863d..f7be680 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -194,6 +194,7 @@ image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS # Arguments: # badgenumber - number to draw over the icon +if {[tk windowingsystem] eq "x11"} { proc ::tk::icons::IconBadge {win badgenumber} { variable ::tk::icons::base_icon @@ -233,3 +234,4 @@ proc ::tk::icons::IconBadge {win badgenumber} { wm iconphoto $win overlay } +} -- cgit v0.12 From cd744e203c11766ea33c951abc4029a0171716e1 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 16 Aug 2021 15:57:57 +0000 Subject: Add widget demo --- library/demos/widget | 2 ++ library/demos/windowicons.tcl | 30 ++++++++++++++++++++++++++++++ 2 files changed, 32 insertions(+) create mode 100644 library/demos/windowicons.tcl diff --git a/library/demos/widget b/library/demos/widget index 39e4dc5..e56954d 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -399,6 +399,8 @@ addFormattedText { @@demo bitmap The built-in bitmaps @@demo dialog1 A dialog box with a local grab @@demo dialog2 A dialog box with a global grab + @@new + @@demo windowicons Window icons and badges } ############################################################################## diff --git a/library/demos/windowicons.tcl b/library/demos/windowicons.tcl new file mode 100644 index 0000000..ab89f84 --- /dev/null +++ b/library/demos/windowicons.tcl @@ -0,0 +1,30 @@ +# windowicons.tcl -- +# +# This demonstration script showcases the wm iconphoto and wm iconbadge commands. +# + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + + +set w .windowicons +destroy $w +toplevel $w +wm title $w "Window Icon Demonstration" +positionWindow $w + +image create photo icon -data { +iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJQElEQVRYw+WXW2xdV5nHf/ty7lcf2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNUSEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKqRJgBSikiuGlN22TqhsR27OPL8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614f/7MP6vC3O5f8L3G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8pHjvfS3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3G/7ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf/8hj5//5H97/YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3Vm9vfqc0WNi9evUKWr/xLh3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemxeCafxRcKw7TJxKC+12RpbYdAx7HsOCrSRNpg+sQQj1w8nS0N5h8JAvm+rWr99ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/++2P/eOFkV0FkJTDQgCaXTbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsPLyxU5orFTK1cfphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vliTCRxEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq1fn7A4yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8ThaQxRpIg0q6DGUNjg6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe2Hj1XoBLl55menqcbDb1haeeevyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAADSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7/uUSlk6Hed0oxG9HI9bm+Pjs2xsvIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUxSHyqSy+f31hzaRZRpMDKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu7zz54SCRinD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJGnTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZmYmMEIJmx6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtdEvEQrSN8IVEq5MSJ4YlSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3FUYyjxuEeELt7/NoP+eBVAipCFXEsYE4xcydYFIeSHKynOXhUwM0mh32egH1tsdL16oo007kcskHs7kYly49fRcALqby+fQopklkZ4jHY3g6gQgjHF/QcgQdV+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQCyZHrv0sUe4JwKFXMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibOvdJ7pSCiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYiTh1NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPlmuL4oIFWkbx8rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXDfZFII0NFIBW/XQiZHraoNbsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8tgW/sHynAxzcVTBQYzFp4v6boBjidwfcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6NacWIfD/yveDmXq3F3NxzdwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pYeh/C9QSOJ3EECGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCGrvNubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7jee6eN4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pjkxuVGo7Tw+1/MAh83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVjhO2e16q3fzR2cjQwDPPeZrSx8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEsQoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkkCHTQwa5WIjne9xY2mT+VouRfI7NxfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGnh0oHwktlZzmBq0SNsRQgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrTXdzf+9Nb8N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LSTRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE9wOIARmtw9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18tPSIhEfouwSuQ9cx2VxpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsrzZ1O13eMcSuezC61LJzQRgY+KvCJhI+WPpH0IAywIkEhaVIupAhdHS0t3F66Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL+fzEmalTsx+emjl3YWjsaMlMpcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leYwNoA01gr297BzVwv/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6XVae/Vqfbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuMVKjC0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZFDgot6Fe8eqfw3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0QXV0aG9yAHdhcnN6YXdpYW5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAgUHVibGljIERvbWFpbiBEZWRpY2F0aW9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/G4735AAAAIXRFWHRDcmVhdGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADIelRYdERlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhWHXUrd2pmLXr7tDrVpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mHoTeuJlUxYoly8nRRxHW4HahO30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sKhBuy2H4xUlM1i76+BhcBwwirLj/bAlJqjXXzP9UyxmuHzp8feiknLPW6Q/H9moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHRwczovL29wZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2ViLWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGFuZ28gaW5ldHJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC +} + + +set ::tk::icons::base_icon icon + +pack [button .i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon -compound top -command {wm iconphoto . $::tk::icons::base_icon }] +pack [button .b -text "Set Badge to 3" -command {wm iconbadge . 3}] +pack [button .e -text "Set Badge to 11" -command {wm iconbadge . 11}] +pack [button .f -text "Reset Badge" -command {wm iconbadge . ""}] + +## See Code / Dismiss buttons +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x -- cgit v0.12 From 797ddeb8ac2455c7fd761a4ad3516b9d438c18e2 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 16 Aug 2021 16:36:12 +0000 Subject: Refine widget demo --- library/demos/tclIndex | 1 + library/demos/windowicons.tcl | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/library/demos/tclIndex b/library/demos/tclIndex index 0c3a516..85be67d 100644 --- a/library/demos/tclIndex +++ b/library/demos/tclIndex @@ -66,4 +66,5 @@ set auto_index(setColor) [list source -encoding utf-8 [file join $dir clrpick.tc set auto_index(setColor_helper) [list source -encoding utf-8 [file join $dir clrpick.tcl]] set auto_index(fileDialog) [list source -encoding utf-8 [file join $dir filebox.tcl]] set auto_index(systray) [list source -encoding utf-8 [file join $dir systray.tcl]] +set auto_index(windoicons [list source -encoding utf-8 [file join $dir windowicons.tcl]] diff --git a/library/demos/windowicons.tcl b/library/demos/windowicons.tcl index ab89f84..0d90b1b 100644 --- a/library/demos/windowicons.tcl +++ b/library/demos/windowicons.tcl @@ -21,10 +21,10 @@ iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6 set ::tk::icons::base_icon icon -pack [button .i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon -compound top -command {wm iconphoto . $::tk::icons::base_icon }] -pack [button .b -text "Set Badge to 3" -command {wm iconbadge . 3}] -pack [button .e -text "Set Badge to 11" -command {wm iconbadge . 11}] -pack [button .f -text "Reset Badge" -command {wm iconbadge . ""}] +pack [button $w.i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon -compound top -command {wm iconphoto $w $::tk::icons::base_icon }] +pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge $w 3}] +pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge $w 11}] +pack [button $w.f -text "Reset Badge" -command {wm iconbadge $w ""}] ## See Code / Dismiss buttons pack [addSeeDismiss $w.buttons $w] -side bottom -fill x -- cgit v0.12 From 4ee27eb807bf07999817c7311d4bd71c4173f273 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 16 Aug 2021 18:58:21 +0000 Subject: Documentation update --- doc/wm.n | 29 +++++++++++++++++++++---- library/iconbadges.tcl | 58 ++++++++++++++++++++++++-------------------------- unix/tkUnixWm.c | 4 +++- 3 files changed, 56 insertions(+), 35 deletions(-) diff --git a/doc/wm.n b/doc/wm.n index 5bb1c61..e332035 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -407,6 +407,23 @@ specified then the command returns an empty string; otherwise it returns the path name of \fIwindow\fR's current group leader, or an empty string if \fIwindow\fR is not part of any group. .TP +\fBwm iconbadge \fIwindow\fR ?\fIbadge\fR? +. +Sets a badge for the icon of the \fIwindow\fR. The badge can be a number, +for instance the number of new or unread messages, or +an exclamation point denoting attention needed. For this command to work, +the variable \fB::tk::icons::base_icon\fR must be set to the image that is +being used for the window icon, and the window's iconphoto must actually +be set via the \fBwm iconphoto\fR command. +.RS +.PP +On Windows and X, the iconphoto images work best at 32x32 or a similar dimension, as +the badge images are provided by Tk and drawn to overlay the icon images +using native (Windows) API's or Tk rendering. On macOS, the icon badge is +rendered by a system API and is not provided by Tk. The icon image itself +should be higher-resolution, preferably 512 pixels, to avoid being blurry. +.RE +.TP \fBwm iconbitmap \fIwindow\fR ?\fIbitmap\fR? . If \fIbitmap\fR is specified, then it names a bitmap in the standard @@ -470,23 +487,27 @@ as specified with the \fBwm title\fR command). .TP \fBwm iconphoto \fIwindow\fR ?\fB\-default\fR? \fIimage1\fR ?\fIimage2 ...\fR? . -Sets the titlebar icon for \fIwindow\fR based on the named photo images. +Sets the titlebar icon for \fIwindow\fR based on the named photo images. If \fB\-default\fR is specified, this is applied to all future created toplevels as well. The data in the images is taken as a snapshot at the time of invocation. If the images are later changed, this is not reflected to the titlebar icons. Multiple images are accepted to allow different images sizes (e.g., 16x16 and 32x32) to be provided. The window -manager may scale provided icons to an appropriate size. +manager may scale provided icons to an appropriate size. If this command +is called without an image argument, the current image set for the +titlebar icon is returned. .RS .PP On Windows, the images are packed into a Windows icon structure. This will override an ico specified to \fBwm iconbitmap\fR, and -vice versa. +vice versa. This command sets the taskbar icon as the designated icon on +Windows. .PP On X, the images are arranged into the _NET_WM_ICON X property, which most modern window managers support. A \fBwm iconbitmap\fR may exist simultaneously. It is recommended to use not more than 2 icons, placing -the larger icon first. +the larger icon first. This command also sets the panel icon for the +application if the window manager or desktop environment supports it. .PP On Macintosh, the first image called is loaded into an OSX-native icon format, and becomes the application icon in dialogs, the Dock, and diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index f7be680..44017e5 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -195,43 +195,41 @@ image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS # badgenumber - number to draw over the icon if {[tk windowingsystem] eq "x11"} { -proc ::tk::icons::IconBadge {win badgenumber} { + proc ::tk::icons::IconBadge {win badgenumber} { - variable ::tk::icons::base_icon + variable ::tk::icons::base_icon - set badge "" - - image create photo overlay - - if {$::tk::icons::base_icon eq ""} { - return -code error "You must set the value of ::tk::icons::base_icon\ - to a Tk photo before setting an icon badge" - } + set badge "" + + image create photo overlay + + if {$::tk::icons::base_icon eq ""} { + return -code error "You must set the value of \"::tk::icons::base_icon\" to a Tk photo before setting an icon badge" + } - if {[wm iconphoto $win] eq ""} { - return -code error "You must set a Tk image as a window icon via the wm\ iconphoto command before setting an icon badge" -} + if {[wm iconphoto $win] eq ""} { + return -code error "You must set a Tk image as a window icon via the \"wm iconphoto\" command before setting an icon badge" + } + if {$badgenumber eq ""} { + wm iconphoto $win $::tk::icons::base_icon + return + } - if {$badgenumber eq ""} { - wm iconphoto $win $::tk::icons::base_icon - return - } + update idletasks - update idletasks + wm iconphoto $win $::tk::icons::base_icon - wm iconphoto $win $::tk::icons::base_icon + if {[expr $badgenumber > 9] == 1} { + set badge ::tk::icons::9plus-badge + } else { + set badge ::tk::icons::$badgenumber-badge + } - if {[expr $badgenumber > 9] == 1} { - set badge ::tk::icons::9plus-badge - } else { - set badge ::tk::icons::$badgenumber-badge - } + update idletasks + overlay copy $::tk::icons::base_icon + overlay copy $badge -from 0 0 18 18 -to 18 0 + wm iconphoto $win overlay - update idletasks - overlay copy $::tk::icons::base_icon - overlay copy $badge -from 0 0 18 18 -to 18 0 - wm iconphoto $win overlay - -} + } } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index c475ec3..eba322d 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2161,7 +2161,9 @@ WmIconbadgeCmd( } char cmd[4096]; - sprintf(cmd, "::tk::icons::IconBadge {%s} {%s}", Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); + sprintf(cmd, "::tk::icons::IconBadge {%s} {%s}", + Tcl_GetString(objv[2]), + Tcl_GetString(objv[3])); if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { Tcl_SetResult(interp,"Unable to set icon badge",TCL_VOLATILE); return TCL_ERROR; -- cgit v0.12 From 894e012be469ccf33af304775715605b177c44a6 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 16 Aug 2021 20:59:28 +0000 Subject: Initial Windows implementation --- win/tkWinWm.c | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 83 insertions(+), 2 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index c7224e8..0a5efb2 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -437,6 +437,9 @@ static int WmGridCmd(Tk_Window tkwin, static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int WmIconbadgeCmd(Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -2618,7 +2621,7 @@ Tk_WmObjCmd( static const char *const optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", "command", "deiconify", "focusmodel", "forget", "frame", - "geometry", "grid", "group", "iconbitmap", + "geometry", "grid", "group", "iconbadge", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", @@ -2630,7 +2633,7 @@ Tk_WmObjCmd( WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, - WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP, + WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBADGE, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, @@ -2723,6 +2726,8 @@ Tk_WmObjCmd( return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONBADGE: + return WmIconbadgeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONIFY: @@ -3813,6 +3818,82 @@ WmGroupCmd( /* *---------------------------------------------------------------------- * + * WmIconbadgeCmd -- + * + * This function is invoked to process the "wm iconbadge" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmIconbadgeCmd( + Tk_Window tkwin, /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + HWND hwnd; + Tk_PhotoHandle photo; + Tk_PhotoImageBlock block; + int width, height; + HICON overlayicon; + (void)tkwin; + unsigned int badgenumber = NULL; + char *badgestring = NULL; + char *photoname = NULL; + + /* Establish a COM interface to the ITaskBarList3 API. */ + ITaskBarList3 *ptbl; + HRESULT hr = CoCreateInstance(CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, IID_PPV_ARGS(&ptbl); + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv,"window ? badge?"); + return TCL_ERROR; + } + + badgestring = Tcl_GetString(objv[3]); + sprintf(photoname, "::tk::icons::{%s}-badge", badgestring); + badgenumber = (unsigned int) badgestring; + if (badgenumber > 9) + photoname = "::tk::icons::9plus-badge"; + + /* Get image, convert to icon. */ + photo = Tk_FindPhoto(interp, photoname); + if (photo == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist", photoname))); + return TCL_ERROR; + } + Tk_PhotoGetSize(photo, &width, &height); + Tk_PhotoGetImage(photo, &block); + + overlayicon = CreateIcoFromPhoto(width, height, block); + if (overlayicon == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "failed to create an iconphoto with image \"%s\"", + photoname)); + return TCL_ERROR; + } + + /* Place overlay icon on taskbar icon. */ + hwnd = Tk_GetHWND(winPtr->window); + ptbl->SetOverlayIcon(hwnd, overlayicon, badgestring); + DestroyIcon(overlayicon); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * WmIconbitmapCmd -- * * This function is invoked to process the "wm iconbitmap" Tcl command. -- cgit v0.12 From e02bd57b0aed182ae341187acb8f95ed67c79710 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 17 Aug 2021 01:14:13 +0000 Subject: Minor adjustments/updates --- macosx/tkMacOSXWm.c | 49 ++++++++++++++++++++++++++++++++++++-- unix/tkUnixWm.c | 32 ++++++++++++------------- win/tkWinWm.c | 68 +++++++++++++++++++++++++++-------------------------- 3 files changed, 97 insertions(+), 52 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 39399cf..ef5c205 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -248,6 +248,9 @@ static int WmGridCmd(Tk_Window tkwin, TkWindow *winPtr, static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int WmIconbadgeCmd(Tk_Window tkwin, TkWindow *winPtr, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1196,7 +1199,7 @@ Tk_WmObjCmd( static const char *const optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", "command", "deiconify", "focusmodel", "forget", - "frame", "geometry", "grid", "group", + "frame", "geometry", "grid", "group", "iconbadge", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", @@ -1206,7 +1209,7 @@ Tk_WmObjCmd( enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, - WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, + WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBADGE, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, @@ -1284,6 +1287,8 @@ Tk_WmObjCmd( return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONBADGE: + return WmIconbadgeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONIFY: @@ -2342,6 +2347,46 @@ WmGroupCmd( } return TCL_OK; } + + /*---------------------------------------------------------------------- + * + * WmIconbadgeCmd -- + * + * This procedure is invoked to process the "wm iconbadge" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmIconbadgeCmd( + TCL_UNUSED(Tk_Window), /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv,"window ? badge?"); + return TCL_ERROR; + } + + (void) winPtr; + NSString *label; + label = [NSString stringWithUTF8String:Tcl_GetString(objv[3])]; + + /* Set the icon badge on the Dock icon. */ + NSDockTile *dockicon = [NSApp dockTile]; + [dockicon setBadgeLabel: label]; + return TCL_OK; +} /* *---------------------------------------------------------------------- diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index eba322d..627ab74 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2152,25 +2152,23 @@ WmIconbadgeCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - (void) tkWin; + (void) tkWin; - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "window ? badge?"); - return TCL_ERROR; - } + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ? badge?"); + return TCL_ERROR; + } - char cmd[4096]; - sprintf(cmd, "::tk::icons::IconBadge {%s} {%s}", - Tcl_GetString(objv[2]), - Tcl_GetString(objv[3])); - if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { - Tcl_SetResult(interp,"Unable to set icon badge",TCL_VOLATILE); - return TCL_ERROR; - } - - - return TCL_OK; + char cmd[4096]; + sprintf(cmd, "::tk::icons::IconBadge {%s} {%s}", + Tcl_GetString(objv[2]), + Tcl_GetString(objv[3])); + if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { + Tcl_SetResult(interp,"Unable to set icon badge",TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; } /* *---------------------------------------------------------------------- diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 0a5efb2..cf1d2a7 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3840,55 +3840,57 @@ WmIconbadgeCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - HWND hwnd; - Tk_PhotoHandle photo; - Tk_PhotoImageBlock block; - int width, height; - HICON overlayicon; - (void)tkwin; - unsigned int badgenumber = NULL; - char *badgestring = NULL; - char *photoname = NULL; + HWND hwnd; + Tk_PhotoHandle photo; + Tk_PhotoImageBlock block; + int width, height; + HICON overlayicon; + (void) tkwin; + unsigned int badgenumber = NULL; + char * badgestring = NULL; + char * photoname = NULL; /* Establish a COM interface to the ITaskBarList3 API. */ - ITaskBarList3 *ptbl; - HRESULT hr = CoCreateInstance(CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, IID_PPV_ARGS(&ptbl); + ITaskBarList3 * ptbl; + HRESULT hr = CoCreateInstance(CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, IID_PPV_ARGS( & ptbl); if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv,"window ? badge?"); - return TCL_ERROR; - } + Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); + return TCL_ERROR; + } - badgestring = Tcl_GetString(objv[3]); - sprintf(photoname, "::tk::icons::{%s}-badge", badgestring); + badgestring = Tcl_GetString(objv[3]); + sprintf(photoname, "::tk::icons::{%s}-badge", badgestring); badgenumber = (unsigned int) badgestring; - if (badgenumber > 9) - photoname = "::tk::icons::9plus-badge"; + if {(badgenumber > 9)} { + photoname = "::tk::icons::9plus-badge"; + } /* Get image, convert to icon. */ photo = Tk_FindPhoto(interp, photoname); if (photo == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "image \"%s\" doesn't exist", photoname))); - return TCL_ERROR; - } - Tk_PhotoGetSize(photo, &width, &height); - Tk_PhotoGetImage(photo, &block); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist", photoname))); + return TCL_ERROR; + } + + Tk_PhotoGetSize(photo, & width, & height); + Tk_PhotoGetImage(photo, & block); overlayicon = CreateIcoFromPhoto(width, height, block); if (overlayicon == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "failed to create an iconphoto with image \"%s\"", - photoname)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "failed to create an iconphoto with image \"%s\"", + photoname)); + return TCL_ERROR; } - /* Place overlay icon on taskbar icon. */ - hwnd = Tk_GetHWND(winPtr->window); - ptbl->SetOverlayIcon(hwnd, overlayicon, badgestring); - DestroyIcon(overlayicon); + /* Place overlay icon on taskbar icon. */ + hwnd = Tk_GetHWND(winPtr -> window); + ptbl -> SetOverlayIcon(hwnd, overlayicon, badgestring); + DestroyIcon(overlayicon); - return TCL_OK; + return TCL_OK; } /* -- cgit v0.12 From 17bde8e6bc5613d54fee6854d31783fb4da3ee52 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 17 Aug 2021 01:44:53 +0000 Subject: Add tests for iconbadge --- tests/wm.test | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/tests/wm.test b/tests/wm.test index e24181e..ca29bd6 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -15,6 +15,10 @@ package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +image create photo icon -data { +iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJQElEQVRYw+WXW2xdV5nHf/ty7lcf2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNUSEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKqRJgBSikiuGlN22TqhsR27OPL8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614f/7MP6vC3O5f8L3G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8pHjvfS3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3G/7ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf/8hj5//5H97/YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3Vm9vfqc0WNi9evUKWr/xLh3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemxeCafxRcKw7TJxKC+12RpbYdAx7HsOCrSRNpg+sQQj1w8nS0N5h8JAvm+rWr99ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/++2P/eOFkV0FkJTDQgCaXTbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsPLyxU5orFTK1cfphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vliTCRxEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq1fn7A4yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8ThaQxRpIg0q6DGUNjg6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe2Hj1XoBLl55menqcbDb1haeeevyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAADSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7/uUSlk6Hed0oxG9HI9bm+Pjs2xsvIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUxSHyqSy+f31hzaRZRpMDKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu7zz54SCRinD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJGnTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZmYmMEIJmx6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtdEvEQrSN8IVEq5MSJ4YlSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3FUYyjxuEeELt7/NoP+eBVAipCFXEsYE4xcydYFIeSHKynOXhUwM0mh32egH1tsdL16oo007kcskHs7kYly49fRcALqby+fQopklkZ4jHY3g6gQgjHF/QcgQdV+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQCyZHrv0sUe4JwKFXMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibOvdJ7pSCiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYiTh1NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPlmuL4oIFWkbx8rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXDfZFII0NFIBW/XQiZHraoNbsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8tgW/sHynAxzcVTBQYzFp4v6boBjidwfcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6NacWIfD/yveDmXq3F3NxzdwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pYeh/C9QSOJ3EECGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCGrvNubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7jee6eN4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pjkxuVGo7Tw+1/MAh83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVjhO2e16q3fzR2cjQwDPPeZrSx8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEsQoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkkCHTQwa5WIjne9xY2mT+VouRfI7NxfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGnh0oHwktlZzmBq0SNsRQgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrTXdzf+9Nb8N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LSTRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE9wOIARmtw9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18tPSIhEfouwSuQ9cx2VxpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsrzZ1O13eMcSuezC61LJzQRgY+KvCJhI+WPpH0IAywIkEhaVIupAhdHS0t3F66Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL+fzEmalTsx+emjl3YWjsaMlMpcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leYwNoA01gr297BzVwv/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6XVae/Vqfbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuMVKjC0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZFDgot6Fe8eqfw3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0QXV0aG9yAHdhcnN6YXdpYW5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAgUHVibGljIERvbWFpbiBEZWRpY2F0aW9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/G4735AAAAIXRFWHRDcmVhdGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADIelRYdERlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhWHXUrd2pmLXr7tDrVpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mHoTeuJlUxYoly8nRRxHW4HahO30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sKhBuy2H4xUlM1i76+BhcBwwirLj/bAlJqjXXzP9UyxmuHzp8feiknLPW6Q/H9moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHRwczovL29wZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2ViLWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGFuZ28gaW5ldHJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC +} + wm deiconify . if {![winfo ismapped .]} { tkwait visibility . @@ -59,7 +63,7 @@ test wm-1.1 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -bo # Next test will fail every time set of subcommands is changed test wm-1.2 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body { wm foo -} -result {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw} +} -result {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw} test wm-1.3 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body { wm command } -result {wrong # args: should be "wm option window ?arg ...?"} @@ -728,6 +732,13 @@ test wm-group-2.1 {setting and reading values} -setup { lappend result [wm group .t] } -result [list {} . {}] +###wm iconbadge ### +test wm-iconbadge-1.1 {usage} -returnCodes error -body { + wm iconbadge +} -result {wrong # args: should be "wm option window ?arg ...?"} +test wm-iconbadge-1.2 {usage} -returnCodes error -body { + set ::tk::icons::base_icon icon; wm iconbadge . 14 +} ### wm iconbitmap ### test wm-iconbitmap-1.1 {usage} -returnCodes error -body { @@ -869,7 +880,7 @@ test wm-iconphoto-1.1 {usage} -returnCodes error -body { wm iconphoto } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconphoto-1.2 {usage} -returnCodes error -body { - wm iconphoto . + wm iconphoto {} } -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} test wm-iconphoto-1.3 {usage} -returnCodes error -body { wm iconphoto . notanimage @@ -884,6 +895,9 @@ test wm-iconphoto-1.5.1 {usage} -constraints aquaOrWin32 -returnCodes error -bod test wm-iconphoto-1.5.2 {usage} -constraints x11 -body { wm iconphoto . -default [image create photo -file {}] } -result {} +test wm-iconphoto-1.6 {usage} -body { + wm iconphoto . icon +} -result {} # All other iconphoto tests are platform specific -- cgit v0.12 From c341dcad20c0f34bf0273f11f586611a831d566f Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 18 Aug 2021 03:40:24 +0000 Subject: Windows API now builds; still need to test --- win/makefile.vc | 2 +- win/tkWinWm.c | 39 ++++++++++++++++++++++++++------------- 2 files changed, 27 insertions(+), 14 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index 68daeee..8ee1804 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -360,7 +360,7 @@ CONFIG_DEFS =/DHAVE_SYS_TYPES_H=1 /DHAVE_SYS_STAT_H=1 \ PRJ_DEFINES = /DBUILD_ttk $(CONFIG_DEFS) /Dinline=__inline /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE # Additional Link libraries needed beyond those in rules.vc -PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib +PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib shell32.lib ole32.lib #--------------------------------------------------------------------- # TkTest flags diff --git a/win/tkWinWm.c b/win/tkWinWm.c index cf1d2a7..a630415 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -13,9 +13,15 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include +#include +#include +#include +#include #include "tkWinInt.h" #include "tkWinIco.h" -#include + + /* * These next two defines are only valid on Win2K/XP+. @@ -3846,14 +3852,23 @@ WmIconbadgeCmd( int width, height; HICON overlayicon; (void) tkwin; - unsigned int badgenumber = NULL; + int badgenumber; char * badgestring = NULL; char * photoname = NULL; /* Establish a COM interface to the ITaskBarList3 API. */ - ITaskBarList3 * ptbl; - HRESULT hr = CoCreateInstance(CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, IID_PPV_ARGS( & ptbl); + ITaskbarList3 *ptbl; + HRESULT hr; + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); + if (hr == S_OK) { + ptbl->lpVtbl->HrInit(ptbl); + } else { + Tcl_SetResult(interp, "Error: unable to initialize taskbar icon", TCL_VOLATILE); + return TCL_ERROR; + } + + if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); return TCL_ERROR; @@ -3861,16 +3876,14 @@ WmIconbadgeCmd( badgestring = Tcl_GetString(objv[3]); sprintf(photoname, "::tk::icons::{%s}-badge", badgestring); - badgenumber = (unsigned int) badgestring; - if {(badgenumber > 9)} { + badgenumber = atoi(badgestring); + if (badgenumber > 9) photoname = "::tk::icons::9plus-badge"; - } /* Get image, convert to icon. */ photo = Tk_FindPhoto(interp, photoname); if (photo == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "image \"%s\" doesn't exist", photoname))); + Tcl_SetResult(interp, "Error: image doesn't exist", TCL_VOLATILE); return TCL_ERROR; } @@ -3879,15 +3892,13 @@ WmIconbadgeCmd( overlayicon = CreateIcoFromPhoto(width, height, block); if (overlayicon == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "failed to create an iconphoto with image \"%s\"", - photoname)); + Tcl_SetResult(interp, "Error: failed to create icon photo", TCL_VOLATILE); return TCL_ERROR; } /* Place overlay icon on taskbar icon. */ hwnd = Tk_GetHWND(winPtr -> window); - ptbl -> SetOverlayIcon(hwnd, overlayicon, badgestring); + ptbl -> lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, NULL); DestroyIcon(overlayicon); return TCL_OK; @@ -4342,6 +4353,8 @@ WmIconphotoCmd( return TCL_OK; } + + /* *---------------------------------------------------------------------- * -- cgit v0.12 From d41ddfc4f00415971a4d1b7c6e61df2a2a2ab4ce Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 18 Aug 2021 16:49:12 +0000 Subject: Remove compiler warnings and segfaults --- library/demos/windowicons.tcl | 8 ++++---- win/makefile.vc | 2 +- win/tkWinWm.c | 38 +++++++++++++++++++++++--------------- 3 files changed, 28 insertions(+), 20 deletions(-) diff --git a/library/demos/windowicons.tcl b/library/demos/windowicons.tcl index 0d90b1b..82bfe38 100644 --- a/library/demos/windowicons.tcl +++ b/library/demos/windowicons.tcl @@ -21,10 +21,10 @@ iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6 set ::tk::icons::base_icon icon -pack [button $w.i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon -compound top -command {wm iconphoto $w $::tk::icons::base_icon }] -pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge $w 3}] -pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge $w 11}] -pack [button $w.f -text "Reset Badge" -command {wm iconbadge $w ""}] +pack [button $w.i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon -compound top -command {wm iconphoto . $::tk::icons::base_icon }] +pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge . 3}] +pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge . 11}] +pack [button $w.f -text "Reset Badge" -command {wm iconbadge . ""}] ## See Code / Dismiss buttons pack [addSeeDismiss $w.buttons $w] -side bottom -fill x diff --git a/win/makefile.vc b/win/makefile.vc index 8ee1804..acb8304 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -360,7 +360,7 @@ CONFIG_DEFS =/DHAVE_SYS_TYPES_H=1 /DHAVE_SYS_STAT_H=1 \ PRJ_DEFINES = /DBUILD_ttk $(CONFIG_DEFS) /Dinline=__inline /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE # Additional Link libraries needed beyond those in rules.vc -PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib shell32.lib ole32.lib +PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib shell32.lib ole32.lib uuid.lib #--------------------------------------------------------------------- # TkTest flags diff --git a/win/tkWinWm.c b/win/tkWinWm.c index a630415..a33659a 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3854,7 +3854,8 @@ WmIconbadgeCmd( (void) tkwin; int badgenumber; char * badgestring = NULL; - char * photoname = NULL; + char photoname[4096]; + LPCWSTR string; /* Establish a COM interface to the ITaskBarList3 API. */ ITaskbarList3 *ptbl; @@ -3864,7 +3865,7 @@ WmIconbadgeCmd( if (hr == S_OK) { ptbl->lpVtbl->HrInit(ptbl); } else { - Tcl_SetResult(interp, "Error: unable to initialize taskbar icon", TCL_VOLATILE); + Tcl_SetResult(interp, "Unable to initialize taskbar icon", TCL_VOLATILE); return TCL_ERROR; } @@ -3874,31 +3875,38 @@ WmIconbadgeCmd( return TCL_ERROR; } + hwnd = Tk_GetHWND(winPtr -> window); badgestring = Tcl_GetString(objv[3]); - sprintf(photoname, "::tk::icons::{%s}-badge", badgestring); + string = L"Alert"; + badgenumber = atoi(badgestring); - if (badgenumber > 9) - photoname = "::tk::icons::9plus-badge"; - - /* Get image, convert to icon. */ + if (badgenumber > 9) { + strcpy(photoname, "::tk::icons::9plus-badge"); + } else { + strcpy(photoname , "::tk::icons::"); + strcat(photoname, badgestring); + strcat(photoname, "-badge"); + } + + /* Get image. If NULL, remove badge icon. */ photo = Tk_FindPhoto(interp, photoname); if (photo == NULL) { - Tcl_SetResult(interp, "Error: image doesn't exist", TCL_VOLATILE); - return TCL_ERROR; + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); + return TCL_OK; } - Tk_PhotoGetSize(photo, & width, & height); - Tk_PhotoGetImage(photo, & block); + /* We have found the image. Convert to icon. */ + Tk_PhotoGetSize(photo, &width, &height); + Tk_PhotoGetImage(photo, &block); overlayicon = CreateIcoFromPhoto(width, height, block); if (overlayicon == NULL) { - Tcl_SetResult(interp, "Error: failed to create icon photo", TCL_VOLATILE); + Tcl_SetResult(interp, "Failed to create icon photo", TCL_VOLATILE); return TCL_ERROR; } - /* Place overlay icon on taskbar icon. */ - hwnd = Tk_GetHWND(winPtr -> window); - ptbl -> lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, NULL); + /* Place overlay icon on taskbar icon. */ + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); DestroyIcon(overlayicon); return TCL_OK; -- cgit v0.12 From e3f8844a9440b1653ddbe6fb7b3580cc2e7723ed Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 18 Aug 2021 21:31:11 +0000 Subject: Windows builds and appears correct, but icon overlay does not display; more review needed --- win/tkWinWm.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index a33659a..dd01ceb 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3851,15 +3851,17 @@ WmIconbadgeCmd( Tk_PhotoImageBlock block; int width, height; HICON overlayicon; - (void) tkwin; + (void) winPtr; int badgenumber; char * badgestring = NULL; char photoname[4096]; LPCWSTR string; - /* Establish a COM interface to the ITaskBarList3 API. */ + /* Establish a COM interface to the ITaskbarList3 API. */ ITaskbarList3 *ptbl; HRESULT hr; + Tk_Window badgewindow; + Window win; hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); if (hr == S_OK) { @@ -3875,7 +3877,9 @@ WmIconbadgeCmd( return TCL_ERROR; } - hwnd = Tk_GetHWND(winPtr -> window); + badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); + win = Tk_WindowId(badgewindow); + hwnd = Tk_GetHWND(win); badgestring = Tcl_GetString(objv[3]); string = L"Alert"; @@ -3901,7 +3905,7 @@ WmIconbadgeCmd( overlayicon = CreateIcoFromPhoto(width, height, block); if (overlayicon == NULL) { - Tcl_SetResult(interp, "Failed to create icon photo", TCL_VOLATILE); + Tcl_SetResult(interp, "Failed to create overlay icon", TCL_VOLATILE); return TCL_ERROR; } -- cgit v0.12 From eed63d324d4263b6da2cfc6b95480f33485d15be Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 19 Aug 2021 02:18:40 +0000 Subject: Possible fix --- win/tkWinWm.c | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index dd01ceb..c92d488 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3847,39 +3847,36 @@ WmIconbadgeCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { HWND hwnd; + HRESULT hr; Tk_PhotoHandle photo; Tk_PhotoImageBlock block; int width, height; HICON overlayicon; - (void) winPtr; + (void) tkwin; int badgenumber; char * badgestring = NULL; char photoname[4096]; - LPCWSTR string; - - /* Establish a COM interface to the ITaskbarList3 API. */ + LPCWSTR string; ITaskbarList3 *ptbl; - HRESULT hr; - Tk_Window badgewindow; - Window win; + UINT TaskbarButtonCreatedMessageId; - hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); + /* Establish a COM interface to the ITaskBarList3 API. */ + hr = CoInitialize(0); + TaskbarButtonCreatedMessageId = RegisterWindowMessage("TaskbarButtonCreated"); if (hr == S_OK) { - ptbl->lpVtbl->HrInit(ptbl); + CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); + ptbl->lpVtbl->HrInit(ptbl); } else { - Tcl_SetResult(interp, "Unable to initialize taskbar icon", TCL_VOLATILE); - return TCL_ERROR; + Tcl_SetResult(interp, "Unable to initialize taskbar icon", TCL_VOLATILE); + return TCL_ERROR; } - if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); return TCL_ERROR; } - badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - win = Tk_WindowId(badgewindow); - hwnd = Tk_GetHWND(win); + hwnd = Tk_GetHWND(winPtr -> window); badgestring = Tcl_GetString(objv[3]); string = L"Alert"; @@ -3905,7 +3902,7 @@ WmIconbadgeCmd( overlayicon = CreateIcoFromPhoto(width, height, block); if (overlayicon == NULL) { - Tcl_SetResult(interp, "Failed to create overlay icon", TCL_VOLATILE); + Tcl_SetResult(interp, "Failed to create icon photo", TCL_VOLATILE); return TCL_ERROR; } -- cgit v0.12 From 38da147406ebb749ffdcd39627f107d7589c3396 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 19 Aug 2021 12:53:04 +0000 Subject: Tweak initialization of COM library --- win/tkWinWm.c | 30 +++++++++++++----------------- win/winMain.c | 6 ++++++ 2 files changed, 19 insertions(+), 17 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index c92d488..4008836 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3858,17 +3858,13 @@ WmIconbadgeCmd( char photoname[4096]; LPCWSTR string; ITaskbarList3 *ptbl; - UINT TaskbarButtonCreatedMessageId; - /* Establish a COM interface to the ITaskBarList3 API. */ - hr = CoInitialize(0); - TaskbarButtonCreatedMessageId = RegisterWindowMessage("TaskbarButtonCreated"); + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); if (hr == S_OK) { - CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); - ptbl->lpVtbl->HrInit(ptbl); + ptbl->lpVtbl->HrInit(ptbl); } else { - Tcl_SetResult(interp, "Unable to initialize taskbar icon", TCL_VOLATILE); - return TCL_ERROR; + Tcl_SetResult(interp, "Unable to initialize taskbar icon", TCL_VOLATILE); + return TCL_ERROR; } if (objc < 4) { @@ -3876,24 +3872,24 @@ WmIconbadgeCmd( return TCL_ERROR; } - hwnd = Tk_GetHWND(winPtr -> window); + hwnd = Tk_GetHWND(winPtr->window); badgestring = Tcl_GetString(objv[3]); string = L"Alert"; badgenumber = atoi(badgestring); if (badgenumber > 9) { - strcpy(photoname, "::tk::icons::9plus-badge"); + strcpy(photoname, "::tk::icons::9plus-badge"); } else { - strcpy(photoname , "::tk::icons::"); - strcat(photoname, badgestring); - strcat(photoname, "-badge"); + strcpy(photoname, "::tk::icons::"); + strcat(photoname, badgestring); + strcat(photoname, "-badge"); } /* Get image. If NULL, remove badge icon. */ photo = Tk_FindPhoto(interp, photoname); if (photo == NULL) { - ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); - return TCL_OK; + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); + return TCL_OK; } /* We have found the image. Convert to icon. */ @@ -3902,8 +3898,8 @@ WmIconbadgeCmd( overlayicon = CreateIcoFromPhoto(width, height, block); if (overlayicon == NULL) { - Tcl_SetResult(interp, "Failed to create icon photo", TCL_VOLATILE); - return TCL_ERROR; + Tcl_SetResult(interp, "Failed to create icon photo", TCL_VOLATILE); + return TCL_ERROR; } /* Place overlay icon on taskbar icon. */ diff --git a/win/winMain.c b/win/winMain.c index 9c23037..0231200 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -134,6 +134,10 @@ _tWinMain( (void)lpszCmdLine; (void)nCmdShow; + + /* Load COM library for icon overlay. */ + CoInitialize(NULL); + /* * Create the console channels and install them as the standard channels. * All I/O will be discarded until Tk_CreateConsoleWindow is called to @@ -178,6 +182,8 @@ _tWinMain( #endif Tk_Main(argc, argv, TK_LOCAL_APPINIT); + /* COM library cleanup. */ + CoUninitialize(); return 0; /* Needed only to prevent compiler warning. */ } -- cgit v0.12 From 4dd22cb49d770258157816c69d36956fd76233fd Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 19 Aug 2021 17:51:20 +0000 Subject: Further refinements to get overlay icons to display --- win/tkWinWm.c | 3 +++ win/winMain.c | 5 +++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 4008836..4f1d5a8 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -1731,6 +1731,9 @@ TkWinWmCleanup( return; } tsdPtr->initialized = 0; + + /* COM library cleanup. */ + CoUninitialize(); UnregisterClassW(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance); } diff --git a/win/winMain.c b/win/winMain.c index 0231200..cd09d6c 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -19,6 +19,8 @@ #include #include #include +#include +#include #if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 # define Tcl_LibraryInitProc Tcl_PackageInitProc # define Tcl_StaticLibrary Tcl_StaticPackage @@ -182,8 +184,7 @@ _tWinMain( #endif Tk_Main(argc, argv, TK_LOCAL_APPINIT); - /* COM library cleanup. */ - CoUninitialize(); + return 0; /* Needed only to prevent compiler warning. */ } -- cgit v0.12 From ae0f836febf0c1b61d2dba3ad16510cff2589acc Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 19 Aug 2021 17:58:31 +0000 Subject: Let's see if this works --- win/tkWinSysTray.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinSysTray.c b/win/tkWinSysTray.c index aca9eb9..6ff1115 100644 --- a/win/tkWinSysTray.c +++ b/win/tkWinSysTray.c @@ -742,7 +742,7 @@ TaskbarHandlerProc( switch (message) { case WM_CREATE: - msgTaskbarCreated = RegisterWindowMessage(TEXT("TaskbarCreated")); + msgTaskbarCreated = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); break; case ICON_MESSAGE: -- cgit v0.12 From 33ee877385677145c5e0ba4b2257430424d28c5b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 19 Aug 2021 18:26:38 +0000 Subject: Additional refactoring --- win/tkWinSysTray.c | 2 +- win/tkWinWm.c | 42 +++++++++++++++++++++++++++++++++--------- 2 files changed, 34 insertions(+), 10 deletions(-) diff --git a/win/tkWinSysTray.c b/win/tkWinSysTray.c index 6ff1115..aca9eb9 100644 --- a/win/tkWinSysTray.c +++ b/win/tkWinSysTray.c @@ -742,7 +742,7 @@ TaskbarHandlerProc( switch (message) { case WM_CREATE: - msgTaskbarCreated = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); + msgTaskbarCreated = RegisterWindowMessage(TEXT("TaskbarCreated")); break; case ICON_MESSAGE: diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 4f1d5a8..1eeb6d9 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -357,6 +357,16 @@ TCL_DECLARE_MUTEX(winWmMutex) */ char *base_icon = NULL; +/* + * The following records the "TaskbarButtonCreated" message ID + * for overlay icons. + */ + +UINT TaskbarButtonCreatedMessageId = NULL; + +/* Reference to taskbarlist API for overlay icons. */ +ITaskbarList3 *ptbl; + /* * Forward declarations for functions defined in this file: */ @@ -2179,6 +2189,29 @@ UpdateWrapper( } else if (focusHWND) { SetFocus(focusHWND); } + + /* This is necessary to initialize the system for overlay icons. */ + if (TaskbarButtonCreatedMessageId == WM_NULL) { + + /* Compute the value for the TaskbarButtonCreated message. */ + TaskbarButtonCreatedMessageId = RegisterWindowMessage(L"TaskbarButtonCreated"); + + /* + * In case the application is run elevated, allow the + * TaskbarButtonCreated message through. + */ + + ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); + /* Create the ITaskbarList3 instance for overlay icons.*/ + HRESULT hr; + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); + if (hr == S_OK) { + ptbl->lpVtbl->HrInit(ptbl); + } else { + Tcl_SetResult(interp, "Unable to initialize taskbar icon", TCL_VOLATILE); + return TCL_ERROR; + } + } } /* @@ -3860,15 +3893,6 @@ WmIconbadgeCmd( char * badgestring = NULL; char photoname[4096]; LPCWSTR string; - ITaskbarList3 *ptbl; - - hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); - if (hr == S_OK) { - ptbl->lpVtbl->HrInit(ptbl); - } else { - Tcl_SetResult(interp, "Unable to initialize taskbar icon", TCL_VOLATILE); - return TCL_ERROR; - } if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); -- cgit v0.12 From 5edb661b9aa3334daa0b49a1bca78603342b785a Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 19 Aug 2021 20:48:09 +0000 Subject: Committing cleaned up version; still doesn't work, unclear why --- win/tkWinWm.c | 37 ++++++++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 11 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 1eeb6d9..046c34e 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -362,7 +362,7 @@ char *base_icon = NULL; * for overlay icons. */ -UINT TaskbarButtonCreatedMessageId = NULL; +static UINT TaskbarButtonCreatedMessageId = WM_NULL; /* Reference to taskbarlist API for overlay icons. */ ITaskbarList3 *ptbl; @@ -2194,7 +2194,7 @@ UpdateWrapper( if (TaskbarButtonCreatedMessageId == WM_NULL) { /* Compute the value for the TaskbarButtonCreated message. */ - TaskbarButtonCreatedMessageId = RegisterWindowMessage(L"TaskbarButtonCreated"); + TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); /* * In case the application is run elevated, allow the @@ -2202,14 +2202,16 @@ UpdateWrapper( */ ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); + /* Create the ITaskbarList3 instance for overlay icons.*/ HRESULT hr; hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); if (hr == S_OK) { - ptbl->lpVtbl->HrInit(ptbl); + ptbl->lpVtbl->HrInit(ptbl); } else { - Tcl_SetResult(interp, "Unable to initialize taskbar icon", TCL_VOLATILE); - return TCL_ERROR; + printf("Unable to initialize ITaskbarList3 API"); + ptbl->lpVtbl->Release(NULL); + ptbl = NULL; } } } @@ -3883,23 +3885,32 @@ WmIconbadgeCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { HWND hwnd; - HRESULT hr; Tk_PhotoHandle photo; Tk_PhotoImageBlock block; int width, height; HICON overlayicon; - (void) tkwin; +// (void) tkwin; + (void) winPtr; int badgenumber; char * badgestring = NULL; char photoname[4096]; LPCWSTR string; - + HRESULT hr; + Tk_Window badgewindow; + Window win; + Display *dispPtr; + if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); return TCL_ERROR; } + + dispPtr=Tk_Display(tkwin); - hwnd = Tk_GetHWND(winPtr->window); + badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); + win = Tk_WindowId(badgewindow); + hwnd = Tk_GetHWND(win); + printf("win is %s\n", Tk_PathName(Tk_HWNDToWindow(hwnd))); badgestring = Tcl_GetString(objv[3]); string = L"Alert"; @@ -3925,12 +3936,16 @@ WmIconbadgeCmd( overlayicon = CreateIcoFromPhoto(width, height, block); if (overlayicon == NULL) { - Tcl_SetResult(interp, "Failed to create icon photo", TCL_VOLATILE); + Tcl_SetResult(interp, "Failed to create overlay icon", TCL_VOLATILE); return TCL_ERROR; } /* Place overlay icon on taskbar icon. */ - ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); + hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); + if (hr != S_OK) { + Tcl_SetResult(interp, "Failed to display overlay icon", TCL_VOLATILE); + return TCL_ERROR; + } DestroyIcon(overlayicon); return TCL_OK; -- cgit v0.12 From 4d8bf7e3009d512651bb11067822484879c4bf05 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 19 Aug 2021 22:01:09 +0000 Subject: Minor tweaks --- win/tkWinWm.c | 38 +++++++++++++++++--------------------- 1 file changed, 17 insertions(+), 21 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 046c34e..56acecd 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -2193,26 +2193,26 @@ UpdateWrapper( /* This is necessary to initialize the system for overlay icons. */ if (TaskbarButtonCreatedMessageId == WM_NULL) { - /* Compute the value for the TaskbarButtonCreated message. */ - TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); + /* Compute the value for the TaskbarButtonCreated message. */ + TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); - /* - * In case the application is run elevated, allow the - * TaskbarButtonCreated message through. - */ + /* + * In case the application is run elevated, allow the + * TaskbarButtonCreated message through. + */ - ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); + ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); - /* Create the ITaskbarList3 instance for overlay icons.*/ - HRESULT hr; - hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); - if (hr == S_OK) { - ptbl->lpVtbl->HrInit(ptbl); - } else { - printf("Unable to initialize ITaskbarList3 API"); - ptbl->lpVtbl->Release(NULL); - ptbl = NULL; - } + /* Create the ITaskbarList3 instance for overlay icons.*/ + HRESULT hr; + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); + if (hr == S_OK) { + ptbl->lpVtbl->HrInit(ptbl); + } else { + printf("Unable to initialize ITaskbarList3 API"); + ptbl->lpVtbl->Release(NULL); + ptbl = NULL; + } } } @@ -3889,7 +3889,6 @@ WmIconbadgeCmd( Tk_PhotoImageBlock block; int width, height; HICON overlayicon; -// (void) tkwin; (void) winPtr; int badgenumber; char * badgestring = NULL; @@ -3898,19 +3897,16 @@ WmIconbadgeCmd( HRESULT hr; Tk_Window badgewindow; Window win; - Display *dispPtr; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); return TCL_ERROR; } - dispPtr=Tk_Display(tkwin); badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); win = Tk_WindowId(badgewindow); hwnd = Tk_GetHWND(win); - printf("win is %s\n", Tk_PathName(Tk_HWNDToWindow(hwnd))); badgestring = Tcl_GetString(objv[3]); string = L"Alert"; -- cgit v0.12 From d286cd3e7ec03f1f93f48a72ae1107c1da07e2f4 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 20 Aug 2021 00:21:47 +0000 Subject: Move COM initialization --- win/tkWinWm.c | 6 +++++- win/winMain.c | 3 --- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 56acecd..7c4b435 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -2202,9 +2202,13 @@ UpdateWrapper( */ ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); + + /* Load COM library for icon overlay. */ + CoInitialize(NULL); /* Create the ITaskbarList3 instance for overlay icons.*/ HRESULT hr; + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); if (hr == S_OK) { ptbl->lpVtbl->HrInit(ptbl); @@ -3922,7 +3926,7 @@ WmIconbadgeCmd( /* Get image. If NULL, remove badge icon. */ photo = Tk_FindPhoto(interp, photoname); if (photo == NULL) { - ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); return TCL_OK; } diff --git a/win/winMain.c b/win/winMain.c index cd09d6c..3d691e1 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -137,9 +137,6 @@ _tWinMain( (void)nCmdShow; - /* Load COM library for icon overlay. */ - CoInitialize(NULL); - /* * Create the console channels and install them as the standard channels. * All I/O will be discarded until Tk_CreateConsoleWindow is called to -- cgit v0.12 From d1a7d9fdb941a57dd9ad1d9ea9568f82f1668414 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 20 Aug 2021 01:17:02 +0000 Subject: Minor reformatting --- win/tkWinWm.c | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 7c4b435..be30185 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -2193,30 +2193,30 @@ UpdateWrapper( /* This is necessary to initialize the system for overlay icons. */ if (TaskbarButtonCreatedMessageId == WM_NULL) { - /* Compute the value for the TaskbarButtonCreated message. */ - TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); + /* Compute the value for the TaskbarButtonCreated message. */ + TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); - /* - * In case the application is run elevated, allow the - * TaskbarButtonCreated message through. - */ + /* + * In case the application is run elevated, allow the + * TaskbarButtonCreated message through. + */ - ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); + ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); - /* Load COM library for icon overlay. */ - CoInitialize(NULL); + /* Load COM library for icon overlay. */ + CoInitialize(NULL); - /* Create the ITaskbarList3 instance for overlay icons.*/ - HRESULT hr; + /* Create the ITaskbarList3 instance for overlay icons.*/ + HRESULT hr; - hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); - if (hr == S_OK) { - ptbl->lpVtbl->HrInit(ptbl); - } else { - printf("Unable to initialize ITaskbarList3 API"); - ptbl->lpVtbl->Release(NULL); - ptbl = NULL; - } + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); + if (hr == S_OK) { + ptbl->lpVtbl->HrInit(ptbl); + } else { + printf("Unable to initialize ITaskbarList3 API"); + ptbl->lpVtbl->Release(NULL); + ptbl = NULL; + } } } @@ -3907,7 +3907,6 @@ WmIconbadgeCmd( return TCL_ERROR; } - badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); win = Tk_WindowId(badgewindow); hwnd = Tk_GetHWND(win); @@ -3926,7 +3925,7 @@ WmIconbadgeCmd( /* Get image. If NULL, remove badge icon. */ photo = Tk_FindPhoto(interp, photoname); if (photo == NULL) { - ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); return TCL_OK; } @@ -3943,7 +3942,7 @@ WmIconbadgeCmd( /* Place overlay icon on taskbar icon. */ hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); if (hr != S_OK) { - Tcl_SetResult(interp, "Failed to display overlay icon", TCL_VOLATILE); + Tcl_SetResult(interp, "Failed to display overlay icon", TCL_VOLATILE); return TCL_ERROR; } DestroyIcon(overlayicon); -- cgit v0.12 From 47f5c4a89563f07c0ba06e8fddab455d924546b8 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 20 Aug 2021 02:31:25 +0000 Subject: Tweaks --- win/tkWinWm.c | 1 + 1 file changed, 1 insertion(+) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index be30185..d407e89 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3907,6 +3907,7 @@ WmIconbadgeCmd( return TCL_ERROR; } + /* Parse args and determine image. */ badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); win = Tk_WindowId(badgewindow); hwnd = Tk_GetHWND(win); -- cgit v0.12 From ab3b9686c3c14114802db24e8c448262661a77f5 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 20 Aug 2021 02:32:25 +0000 Subject: Indentation --- win/tkWinWm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index d407e89..d2ac646 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3909,7 +3909,7 @@ WmIconbadgeCmd( /* Parse args and determine image. */ badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - win = Tk_WindowId(badgewindow); + win = Tk_WindowId(badgewindow); hwnd = Tk_GetHWND(win); badgestring = Tcl_GetString(objv[3]); string = L"Alert"; -- cgit v0.12 From 216bbe2817badec7a6e2acae8724017805e14c0c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 20 Aug 2021 08:18:22 +0000 Subject: autoconf -> 2.71 --- unix/configure | 142 +++++++++++++++++++++++++++------------------------------ win/configure | 142 +++++++++++++++++++++++++++------------------------------ 2 files changed, 136 insertions(+), 148 deletions(-) diff --git a/unix/configure b/unix/configure index 34a1968..bd4b7d8 100755 --- a/unix/configure +++ b/unix/configure @@ -1,9 +1,10 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.70 for tk 8.7. +# Generated by GNU Autoconf 2.71 for tk 8.7. # # -# Copyright (C) 1992-1996, 1998-2017, 2020 Free Software Foundation, Inc. +# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Inc. # # # This configure script is free software; the Free Software Foundation @@ -1564,9 +1565,9 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tk configure 8.7 -generated by GNU Autoconf 2.70 +generated by GNU Autoconf 2.71 -Copyright (C) 2020 Free Software Foundation, Inc. +Copyright (C) 2021 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1920,7 +1921,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tk $as_me 8.7, which was -generated by GNU Autoconf 2.70. Invocation command line was +generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -3773,7 +3774,10 @@ else CFLAGS= fi fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 +ac_prog_cc_stdc=no +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : @@ -3797,28 +3801,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c11" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c11" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 -printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c11" != xno + +if test "x$ac_cv_prog_cc_c11" = xno then : - ac_prog_cc_stdc=c11 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c11" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } + CC="$CC $ac_cv_prog_cc_c11" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + ac_prog_cc_stdc=c11 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} @@ -3829,9 +3833,9 @@ else $as_nop ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -$ac_c_conftest_c89_program +$ac_c_conftest_c99_program _ACEOF -for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99 +for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" @@ -3843,28 +3847,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c99" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c99" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 -printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c99" != xno + +if test "x$ac_cv_prog_cc_c99" = xno then : - ac_prog_cc_stdc=c99 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c99" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } + CC="$CC $ac_cv_prog_cc_c99" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + ac_prog_cc_stdc=c99 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} @@ -3877,8 +3881,7 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c89_program _ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" @@ -3890,34 +3893,25 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c89" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c89" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c89" != xno + +if test "x$ac_cv_prog_cc_c89" = xno then : - ac_prog_cc_stdc=c89 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } else $as_nop - ac_prog_cc_stdc=no - ac_cv_prog_cc_stdc=no + if test "x$ac_cv_prog_cc_c89" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } + CC="$CC $ac_cv_prog_cc_c89" fi - + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + ac_prog_cc_stdc=c89 fi - fi ac_ext=c @@ -9559,7 +9553,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by tk $as_me 8.7, which was -generated by GNU Autoconf 2.70. Invocation command line was +generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -9618,10 +9612,10 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tk config.status 8.7 -configured by $0, generated by GNU Autoconf 2.70, +configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" -Copyright (C) 2020 Free Software Foundation, Inc. +Copyright (C) 2021 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." diff --git a/win/configure b/win/configure index 4e212c5..1b38323 100755 --- a/win/configure +++ b/win/configure @@ -1,9 +1,10 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.70 for tk 8.7. +# Generated by GNU Autoconf 2.71 for tk 8.7. # # -# Copyright (C) 1992-1996, 1998-2017, 2020 Free Software Foundation, Inc. +# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Inc. # # # This configure script is free software; the Free Software Foundation @@ -1525,9 +1526,9 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tk configure 8.7 -generated by GNU Autoconf 2.70 +generated by GNU Autoconf 2.71 -Copyright (C) 2020 Free Software Foundation, Inc. +Copyright (C) 2021 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1729,7 +1730,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tk $as_me 8.7, which was -generated by GNU Autoconf 2.70. Invocation command line was +generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -3271,7 +3272,10 @@ else CFLAGS= fi fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 +ac_prog_cc_stdc=no +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : @@ -3295,28 +3299,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c11" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c11" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 -printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c11" != xno + +if test "x$ac_cv_prog_cc_c11" = xno then : - ac_prog_cc_stdc=c11 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c11" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } + CC="$CC $ac_cv_prog_cc_c11" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + ac_prog_cc_stdc=c11 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} @@ -3327,9 +3331,9 @@ else $as_nop ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -$ac_c_conftest_c89_program +$ac_c_conftest_c99_program _ACEOF -for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99 +for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" @@ -3341,28 +3345,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c99" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c99" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 -printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c99" != xno + +if test "x$ac_cv_prog_cc_c99" = xno then : - ac_prog_cc_stdc=c99 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c99" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } + CC="$CC $ac_cv_prog_cc_c99" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + ac_prog_cc_stdc=c99 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} @@ -3375,8 +3379,7 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c89_program _ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" @@ -3388,34 +3391,25 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c89" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c89" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c89" != xno + +if test "x$ac_cv_prog_cc_c89" = xno then : - ac_prog_cc_stdc=c89 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } else $as_nop - ac_prog_cc_stdc=no - ac_cv_prog_cc_stdc=no + if test "x$ac_cv_prog_cc_c89" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } + CC="$CC $ac_cv_prog_cc_c89" fi - + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + ac_prog_cc_stdc=c89 fi - fi ac_ext=c @@ -6498,7 +6492,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by tk $as_me 8.7, which was -generated by GNU Autoconf 2.70. Invocation command line was +generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -6553,10 +6547,10 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tk config.status 8.7 -configured by $0, generated by GNU Autoconf 2.70, +configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" -Copyright (C) 2020 Free Software Foundation, Inc. +Copyright (C) 2021 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." -- cgit v0.12 From 6aab7ba7932a3480c1e43364600be0ac6f3e7a2b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 21 Aug 2021 02:23:20 +0000 Subject: Try again with hooking COM bits --- win/tkWinWm.c | 57 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index d2ac646..e418a10 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -20,9 +20,6 @@ #include #include "tkWinInt.h" #include "tkWinIco.h" - - - /* * These next two defines are only valid on Win2K/XP+. */ @@ -1861,8 +1858,9 @@ UpdateWrapper( WINDOWPLACEMENT place; HICON hSmallIcon = NULL; HICON hBigIcon = NULL; + HRESULT hr; Tcl_DString titleString; - int *childStateInfo = NULL; + int *childStateInfo = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -2190,34 +2188,37 @@ UpdateWrapper( SetFocus(focusHWND); } - /* This is necessary to initialize the system for overlay icons. */ - if (TaskbarButtonCreatedMessageId == WM_NULL) { + /* + *Initialize hooks for overlay icon. + * Start with TaskbarButtonCreated message. + */ - /* Compute the value for the TaskbarButtonCreated message. */ - TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); + TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); - /* - * In case the application is run elevated, allow the - * TaskbarButtonCreated message through. - */ + if (TaskbarButtonCreatedMessageId == 0) { + Tcl_SetResult(interp, "Unable to register taskbar for icon overlay", TCL_VOLATILE); + return TCL_ERROR; + } - ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); - - /* Load COM library for icon overlay. */ - CoInitialize(NULL); - - /* Create the ITaskbarList3 instance for overlay icons.*/ - HRESULT hr; + /* + * In case the application is run elevated, allow the + * TaskbarButtonCreated message through. + */ + + ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); - hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); - if (hr == S_OK) { - ptbl->lpVtbl->HrInit(ptbl); - } else { - printf("Unable to initialize ITaskbarList3 API"); - ptbl->lpVtbl->Release(NULL); - ptbl = NULL; - } - } + /* Load COM library for icon overlay. */ + hr = CoInitialize(0); + if (SUCCEEDED(hr)) { + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); + if (SUCCEEDED(hr)) { + ptbl->lpVtbl->Release(ptbl); + } else { + printf("Unable to initialize ITaskbarList3 API"); + ptbl->lpVtbl->Release(NULL); + ptbl = NULL; + } + } } /* -- cgit v0.12 From 9e8260fce8465df1fb1355ffb97ca653b9ede943 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 21 Aug 2021 03:26:43 +0000 Subject: Minor tweaks --- win/tkWinWm.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index e418a10..54e0ac9 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -2189,17 +2189,12 @@ UpdateWrapper( } /* - *Initialize hooks for overlay icon. + * Initialize hooks for overlay icon. * Start with TaskbarButtonCreated message. */ TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); - if (TaskbarButtonCreatedMessageId == 0) { - Tcl_SetResult(interp, "Unable to register taskbar for icon overlay", TCL_VOLATILE); - return TCL_ERROR; - } - /* * In case the application is run elevated, allow the * TaskbarButtonCreated message through. @@ -2210,6 +2205,7 @@ UpdateWrapper( /* Load COM library for icon overlay. */ hr = CoInitialize(0); if (SUCCEEDED(hr)) { + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); if (SUCCEEDED(hr)) { ptbl->lpVtbl->Release(ptbl); -- cgit v0.12 From 72dc38db65139f5d2447781da7ee4b7187fda3ca Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 21 Aug 2021 11:45:40 +0000 Subject: Use native wrapper window for iconbadge; now works on Windows --- win/tkWinWm.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 54e0ac9..b24c4f1 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3897,17 +3897,17 @@ WmIconbadgeCmd( LPCWSTR string; HRESULT hr; Tk_Window badgewindow; - Window win; + WmInfo *wmPtr; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); return TCL_ERROR; } - /* Parse args and determine image. */ + /* Parse args, get native wrapper window, and determine image. */ badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - win = Tk_WindowId(badgewindow); - hwnd = Tk_GetHWND(win); + wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; + hwnd = wmPtr->wrapper; badgestring = Tcl_GetString(objv[3]); string = L"Alert"; -- cgit v0.12 From 15b9dfb5ba3094c79e8da446aaaff36aedde1ee8 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 21 Aug 2021 11:46:54 +0000 Subject: Indentation --- win/tkWinWm.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index b24c4f1..bbf27c3 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3906,8 +3906,8 @@ WmIconbadgeCmd( /* Parse args, get native wrapper window, and determine image. */ badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; - hwnd = wmPtr->wrapper; + wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; + hwnd = wmPtr->wrapper; badgestring = Tcl_GetString(objv[3]); string = L"Alert"; -- cgit v0.12 From 6038694da4a850a9e6c2c3e5f0b6c62b845115a6 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 21 Aug 2021 12:26:12 +0000 Subject: Documentation and test tweaks --- doc/wm.n | 10 +++++----- tests/wm.test | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/wm.n b/doc/wm.n index e332035..41bce83 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -411,13 +411,13 @@ string if \fIwindow\fR is not part of any group. . Sets a badge for the icon of the \fIwindow\fR. The badge can be a number, for instance the number of new or unread messages, or -an exclamation point denoting attention needed. For this command to work, -the variable \fB::tk::icons::base_icon\fR must be set to the image that is -being used for the window icon, and the window's iconphoto must actually -be set via the \fBwm iconphoto\fR command. +an exclamation point denoting attention needed. .RS .PP -On Windows and X, the iconphoto images work best at 32x32 or a similar dimension, as +On X11, for this command to work, +the variable \fB::tk::icons::base_icon\fR must be set to the image that is +being used for the window icon, and the window's iconphoto must actually +be set via the \fBwm iconphoto\fR command. On Windows and X11, the iconphoto images work best at 32x32 or a similar dimension, as the badge images are provided by Tk and drawn to overlay the icon images using native (Windows) API's or Tk rendering. On macOS, the icon badge is rendered by a system API and is not provided by Tk. The icon image itself diff --git a/tests/wm.test b/tests/wm.test index ca29bd6..0d19a1e 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -736,7 +736,7 @@ test wm-group-2.1 {setting and reading values} -setup { test wm-iconbadge-1.1 {usage} -returnCodes error -body { wm iconbadge } -result {wrong # args: should be "wm option window ?arg ...?"} -test wm-iconbadge-1.2 {usage} -returnCodes error -body { +test wm-iconbadge-1.2 {usage} -body { set ::tk::icons::base_icon icon; wm iconbadge . 14 } -- cgit v0.12 From fed15de17f77ad433c6164f27758a99539feee0c Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 21 Aug 2021 13:25:14 +0000 Subject: Test update --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index 0d19a1e..ffd2506 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -737,7 +737,7 @@ test wm-iconbadge-1.1 {usage} -returnCodes error -body { wm iconbadge } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconbadge-1.2 {usage} -body { - set ::tk::icons::base_icon icon; wm iconbadge . 14 + set ::tk::icons::base_icon icon; wm iconphoto . $::tk::icons::base_icon; wm iconbadge . 14 } ### wm iconbitmap ### -- cgit v0.12 From 9711125e219ac12545cc9150911a0855314b1805 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 21 Aug 2021 19:14:44 +0000 Subject: Documentation update --- doc/wm.n | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/wm.n b/doc/wm.n index 41bce83..0a358f7 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -411,7 +411,9 @@ string if \fIwindow\fR is not part of any group. . Sets a badge for the icon of the \fIwindow\fR. The badge can be a number, for instance the number of new or unread messages, or -an exclamation point denoting attention needed. +an exclamation point denoting attention needed. If the badge is an empty +string, the badge image is removed from the application icon. Managing +these changes through bindings, such as , is the responsibility of the developer. .RS .PP On X11, for this command to work, -- cgit v0.12 From d0ef3d76b3cbe0e0b35d0e90b27d48cfcc83e8a5 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 22 Aug 2021 01:25:37 +0000 Subject: Add support for ! badge on X11 --- library/iconbadges.tcl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 44017e5..1d25a20 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -222,6 +222,8 @@ if {[tk windowingsystem] eq "x11"} { if {[expr $badgenumber > 9] == 1} { set badge ::tk::icons::9plus-badge + } else if {$badgenumber eq "!"} { + set badge ::tk::icons::!-badge } else { set badge ::tk::icons::$badgenumber-badge } -- cgit v0.12 From 6efcf291c8d6222a6b808f3cdfca5ddf249661dd Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 22 Aug 2021 01:57:21 +0000 Subject: Clean up some hiccups in X11 implementation --- library/iconbadges.tcl | 46 ++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 38 insertions(+), 8 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 1d25a20..4d4d8a8 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -220,13 +220,43 @@ if {[tk windowingsystem] eq "x11"} { wm iconphoto $win $::tk::icons::base_icon - if {[expr $badgenumber > 9] == 1} { - set badge ::tk::icons::9plus-badge - } else if {$badgenumber eq "!"} { - set badge ::tk::icons::!-badge - } else { - set badge ::tk::icons::$badgenumber-badge - } + switch $badgenumber { + ! { + set badge ::tk::icons::!-badge + } + 1 { + set badge ::tk::icons::$badgenumber-badge + } + 2 { + set badge ::tk::icons::$badgenumber-badge + } + 3 { + set badge ::tk::icons::$badgenumber-badge + } + 4 { + set badge ::tk::icons::$badgenumber-badge + } + 5 { + set badge ::tk::icons::$badgenumber-badge + } + 6 { + set badge ::tk::icons::$badgenumber-badge + } + 7 { + set badge ::tk::icons::$badgenumber-badge + } + 8 { + set badge ::tk::icons::$badgenumber-badge + } + 9 { + set badge ::tk::icons::$badgenumber-badge + } + + default { + set badge ::tk::icons::9plus-badge + } + + } update idletasks overlay copy $::tk::icons::base_icon @@ -234,4 +264,4 @@ if {[tk windowingsystem] eq "x11"} { wm iconphoto $win overlay } -} +} \ No newline at end of file -- cgit v0.12 From b6b48dab8e7544d29d76bddff16c95c66c0f4e89 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 26 Aug 2021 23:18:57 +0000 Subject: Remove Release() call that was causing crash on Windows --- win/tkWinWm.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index bbf27c3..345697d 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -2207,9 +2207,7 @@ UpdateWrapper( if (SUCCEEDED(hr)) { hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); - if (SUCCEEDED(hr)) { - ptbl->lpVtbl->Release(ptbl); - } else { + if (FAILED(hr)) { printf("Unable to initialize ITaskbarList3 API"); ptbl->lpVtbl->Release(NULL); ptbl = NULL; -- cgit v0.12 From de0b49bb2ba6e47aaef78bdd262380568efbb255 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 26 Aug 2021 23:34:55 +0000 Subject: Improve error message on Windows --- win/tkWinWm.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 345697d..10087f2 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3931,14 +3931,14 @@ WmIconbadgeCmd( overlayicon = CreateIcoFromPhoto(width, height, block); if (overlayicon == NULL) { - Tcl_SetResult(interp, "Failed to create overlay icon", TCL_VOLATILE); + Tcl_SetResult(interp, "Failed to create badge icon", TCL_VOLATILE); return TCL_ERROR; } /* Place overlay icon on taskbar icon. */ hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); if (hr != S_OK) { - Tcl_SetResult(interp, "Failed to display overlay icon", TCL_VOLATILE); + Tcl_SetResult(interp, "Failed to display badge icon", TCL_VOLATILE); return TCL_ERROR; } DestroyIcon(overlayicon); -- cgit v0.12 From 4bc57ff33a4272f6b3f1030d6abd33d149aa6e02 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 27 Aug 2021 08:21:34 +0000 Subject: Fix erroneous comment (labelframe widgets do exist) --- generic/tkFont.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tkFont.c b/generic/tkFont.c index d3ef712..726995b 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -913,10 +913,10 @@ RecomputeWidgets( * * However, the additional overhead of the recursive calls may become a * performance problem if typical usage alters such that -font'ed widgets - * appear high in the heirarchy, causing deep recursion. This could happen - * with text widgets, or more likely with the (not yet existant) labeled - * frame widget. With these widgets it is possible, even likely, that a - * -font'ed widget (text or labeled frame) will not be a leaf node, but + * appear high in the hierarchy, causing deep recursion. This could happen + * with text widgets, or more likely with the labelframe + * widget. With these widgets it is possible, even likely, that a + * -font'ed widget (text or labelframe) will not be a leaf node, but * will instead have many descendants. If this is ever found to cause a * performance problem, it may be worth investigating an iterative version * of the code below. -- cgit v0.12 From 1a54044f9bb3b3a3d3128fe2037c7e24c2ad7371 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 27 Aug 2021 13:07:59 +0000 Subject: Fix crash in wm test suite on Windows --- win/tkWinWm.c | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 10087f2..6a23ff3 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -4288,7 +4288,7 @@ WmIconphotoCmd( TkWindow *useWinPtr = winPtr; /* window to apply to (NULL if -default) */ Tk_PhotoHandle photo; Tk_PhotoImageBlock block; - int i, width, height, startObj = 3; + int i, width, height, startObj = 3, isDefault = 0; BlockOfIconImagesPtr lpIR; WinIconPtr titlebaricon = NULL; HICON hIcon; @@ -4310,6 +4310,15 @@ WmIconphotoCmd( "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; } + + if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { + isDefault = 1; + if (objc == 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ?-default? image1 ?image2 ...?"); + return TCL_ERROR; + } + } /* * Get icon name. We only use the first icon name. -- cgit v0.12 From 17bfdac0145370ef0014e8b7e25833e00669bcfc Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Fri, 27 Aug 2021 14:31:13 +0000 Subject: Restore test for wm iconphoto . --- tests/wm.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/wm.test b/tests/wm.test index ffd2506..95e8781 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -880,8 +880,8 @@ test wm-iconphoto-1.1 {usage} -returnCodes error -body { wm iconphoto } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconphoto-1.2 {usage} -returnCodes error -body { - wm iconphoto {} -} -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} + wm iconphoto . +} -result {} test wm-iconphoto-1.3 {usage} -returnCodes error -body { wm iconphoto . notanimage } -result {can't use "notanimage" as iconphoto: not a photo image} -- cgit v0.12 From ad90033ce1bb3f1be8a009cb3d596578f654acf6 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 30 Aug 2021 20:57:11 +0000 Subject: Fix argument parsing in test suite --- win/tkWinWm.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 6a23ff3..0c69837 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -4295,7 +4295,12 @@ WmIconphotoCmd( unsigned size; (void)tkwin; - if ((objc == 3) && (base_icon == NULL)) { + if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); + return TCL_ERROR; + } + + if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "iconphoto") == 0) && base_icon == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); return TCL_OK; } -- cgit v0.12 From 1650917b92031a921d4a7de3a5b866dd01ee628e Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 30 Aug 2021 21:01:41 +0000 Subject: More fixes for test suite --- tests/unixWm.test | 6 +++--- tests/winWm.test | 2 +- tests/wm.test | 2 +- unix/tkUnixWm.c | 6 ++++++ win/tkWinWm.c | 8 ++++---- 5 files changed, 15 insertions(+), 9 deletions(-) diff --git a/tests/unixWm.test b/tests/unixWm.test index d54bc69..84eafff 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -902,7 +902,7 @@ test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} unix { test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} unix { list [catch {wm icon .t} msg] $msg -} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} +} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} unix { list [catch {wm iconname .t 12 13} msg] $msg } {1 {wrong # args: should be "wm iconname window ?newName?"}} @@ -1351,7 +1351,7 @@ test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} unix { test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} unix { list [catch {wm unknown .t} msg] $msg -} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} +} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} destroy .t .icon @@ -2539,7 +2539,7 @@ test unixWm-60.5 {wm attributes - bad attribute} -constraints unix -body { test unixWm-61.1 {Tk_WmCmd procedure, "iconphoto" option} unix { list [catch {wm iconph .} msg] $msg -} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}} +} {1 {Argument should be "iconphoto"}} test unixWm-61.2 {Tk_WmCmd procedure, "iconphoto" option} unix { destroy .t toplevel .t diff --git a/tests/winWm.test b/tests/winWm.test index f659a13..3effef9 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -431,7 +431,7 @@ test winWm-7.4 {UpdateWrapper must maintain focus} -constraints win -setup { test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -body { wm iconph . -} -returnCodes error -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} +} -returnCodes error -result {Argument should be "iconphoto"} test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -setup { destroy .t } -body { diff --git a/tests/wm.test b/tests/wm.test index 95e8781..8b8b7a7 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -879,7 +879,7 @@ test wm-iconname-2.1 {setting and reading values} -setup { test wm-iconphoto-1.1 {usage} -returnCodes error -body { wm iconphoto } -result {wrong # args: should be "wm option window ?arg ...?"} -test wm-iconphoto-1.2 {usage} -returnCodes error -body { +test wm-iconphoto-1.2 {usage} -body { wm iconphoto . } -result {} test wm-iconphoto-1.3 {usage} -returnCodes error -body { diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 627ab74..964c7a7 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2440,6 +2440,12 @@ WmIconphotoCmd( int i, size = 0, width, height, index = 0, x, y, isDefault = 0; unsigned long *iconPropertyData; + + if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); + return TCL_ERROR; + } + if ((objc == 3) && (base_icon == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); return TCL_OK; diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 0c69837..57527f9 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -4295,10 +4295,10 @@ WmIconphotoCmd( unsigned size; (void)tkwin; - if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); - return TCL_ERROR; - } + if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); + return TCL_ERROR; + } if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "iconphoto") == 0) && base_icon == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); -- cgit v0.12 From 6609b926d139dc491d8fd898a82db1839d2962c1 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 30 Aug 2021 21:10:43 +0000 Subject: Additional fix for macOS --- macosx/tkMacOSXWm.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index ef5c205..182c661 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2680,6 +2680,11 @@ WmIconphotoCmd( int width, height, isDefault = 0; NSImage *newIcon = NULL; + if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); + return TCL_ERROR; + } + if ((objc == 3) && (base_icon == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); return TCL_OK; -- cgit v0.12 From 428d8f9e88d51af890eb6235e0d598659282083b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 31 Aug 2021 21:05:23 +0000 Subject: Fix for test error --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index 8b8b7a7..c6b624e 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -881,7 +881,7 @@ test wm-iconphoto-1.1 {usage} -returnCodes error -body { } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconphoto-1.2 {usage} -body { wm iconphoto . -} -result {} +} -result {icon} test wm-iconphoto-1.3 {usage} -returnCodes error -body { wm iconphoto . notanimage } -result {can't use "notanimage" as iconphoto: not a photo image} -- cgit v0.12 From 30c81bb2d2538fb5dc458275ed94055375dc2540 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 31 Aug 2021 21:54:54 +0000 Subject: Possible additional fix --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index c6b624e..bdddc48 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -881,7 +881,7 @@ test wm-iconphoto-1.1 {usage} -returnCodes error -body { } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconphoto-1.2 {usage} -body { wm iconphoto . -} -result {icon} +} -result $::tk::icons::base_icon test wm-iconphoto-1.3 {usage} -returnCodes error -body { wm iconphoto . notanimage } -result {can't use "notanimage" as iconphoto: not a photo image} -- cgit v0.12 From 202d497fd594ef0b2f67a8269b675561923293e3 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Wed, 1 Sep 2021 10:54:54 +0000 Subject: Exclude X11 from wm iconphoto test; unable to return correct result because of wm iconbadge mechanism --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index bdddc48..fd968b4 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -879,7 +879,7 @@ test wm-iconname-2.1 {setting and reading values} -setup { test wm-iconphoto-1.1 {usage} -returnCodes error -body { wm iconphoto } -result {wrong # args: should be "wm option window ?arg ...?"} -test wm-iconphoto-1.2 {usage} -body { +test wm-iconphoto-1.2 -constraints aquaOrWin32 {usage} -body { wm iconphoto . } -result $::tk::icons::base_icon test wm-iconphoto-1.3 {usage} -returnCodes error -body { -- cgit v0.12 From 10d06a53367444c56874c85b40eacdf3bc7fd5c6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 1 Sep 2021 14:44:31 +0000 Subject: Put '-constraints' after test title --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index fd968b4..e58f34d 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -879,7 +879,7 @@ test wm-iconname-2.1 {setting and reading values} -setup { test wm-iconphoto-1.1 {usage} -returnCodes error -body { wm iconphoto } -result {wrong # args: should be "wm option window ?arg ...?"} -test wm-iconphoto-1.2 -constraints aquaOrWin32 {usage} -body { +test wm-iconphoto-1.2 {usage} -constraints aquaOrWin32 -body { wm iconphoto . } -result $::tk::icons::base_icon test wm-iconphoto-1.3 {usage} -returnCodes error -body { -- cgit v0.12 From c61abc4c2d3e7f422f8817245b4caef4c1f454d3 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 1 Sep 2021 20:19:20 +0000 Subject: Use a specific toplevel for the 'wm iconbadge' tests, in order to decouple the tests. This should work but it doesn't because the implementation on X11 is incorrect. --- tests/wm.test | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/tests/wm.test b/tests/wm.test index e58f34d..6fa440a 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -737,8 +737,13 @@ test wm-iconbadge-1.1 {usage} -returnCodes error -body { wm iconbadge } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconbadge-1.2 {usage} -body { - set ::tk::icons::base_icon icon; wm iconphoto . $::tk::icons::base_icon; wm iconbadge . 14 -} + toplevel .top + set ::tk::icons::base_icon icon + wm iconphoto .top $::tk::icons::base_icon + wm iconbadge .top 14 +} -cleanup { + destroy .top +} ### wm iconbitmap ### test wm-iconbitmap-1.1 {usage} -returnCodes error -body { @@ -879,9 +884,9 @@ test wm-iconname-2.1 {setting and reading values} -setup { test wm-iconphoto-1.1 {usage} -returnCodes error -body { wm iconphoto } -result {wrong # args: should be "wm option window ?arg ...?"} -test wm-iconphoto-1.2 {usage} -constraints aquaOrWin32 -body { +test wm-iconphoto-1.2 {usage} -body { wm iconphoto . -} -result $::tk::icons::base_icon +} -result {icon} test wm-iconphoto-1.3 {usage} -returnCodes error -body { wm iconphoto . notanimage } -result {can't use "notanimage" as iconphoto: not a photo image} -- cgit v0.12 From f7dae9448df18b97fe24a2c6cb0637dc1083470f Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 06:21:13 +0000 Subject: Cosmetic changes --- library/iconbadges.tcl | 69 ++++++++++++++++++++------------------------------ 1 file changed, 28 insertions(+), 41 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 4d4d8a8..ab8dd5b 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -12,7 +12,8 @@ variable ::tk::icons::base_icon set ::tk::icons::base_icon "" -image create photo ::tk::icons::1-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::1-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA kFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/HBz/V1f/Rkb/BQX/Dw//oKD/////y8v/Bgb/Pz//ra3/+/v/ @@ -25,7 +26,8 @@ image create photo ::tk::icons::1-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS MDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0RVh0ZGF0ZTptb2RpZnkA MjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAASUVORK5CYII= } -image create photo ::tk::icons::2-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::2-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA 21BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/Cwv/ODj/UlL/UFD/MjL/CAj/ExP/oKD/8fH//v7//f3/7u7/ @@ -41,7 +43,8 @@ image create photo ::tk::icons::2-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAA SUVORK5CYII= } -image create photo ::tk::icons::3-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::3-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA +VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/CQn/NTX/UlL/Tk7/Kir/BAT/ERH/mZn/8PD/+Pj/+vr/5ub/ @@ -57,7 +60,8 @@ image create photo ::tk::icons::3-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS dGUAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMNGl+hsAAAAldEVYdGRhdGU6bW9k aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTQtMDQ6MDCg+EKnAAAAAElFTkSuQmCC } -image create photo ::tk::icons::4-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::4-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA 1VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/AgL/OTn/W1v/ODj/QED/4uL/////oaH/AQH/KSn/zs7/oqL/ @@ -72,7 +76,8 @@ image create photo ::tk::icons::4-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6 bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC } -image create photo ::tk::icons::5-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::5-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA 7VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/ICD/MjL/Li7/CQn/Bgb/q6v/8/P/8vL/9PT/4uL/FRX/0tL/ @@ -88,7 +93,8 @@ image create photo ::tk::icons::5-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS LTEwVDA4OjM1OjE1LTA0OjAwd9LxrwAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0w OC0xMFQwODozNToxNS0wNDowMAaPSRMAAAAASUVORK5CYII= } -image create photo ::tk::icons::6-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::6-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA 9lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/AQH/ICD/S0v/UlL/NDT/CAj/WVn/2dn/+Pj/+fn/8PD/jY3/ @@ -104,7 +110,8 @@ image create photo ::tk::icons::6-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS dGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9k aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC } -image create photo ::tk::icons::7-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::7-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA xlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/Hh7/Njb/NTX/Ghr/i4v/9/f/8/P/8vL/8fH/9PT/eHj/fHz/ @@ -119,7 +126,8 @@ image create photo ::tk::icons::7-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC } -image create photo ::tk::icons::8-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::8-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA 6lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/Bwf/MjL/UVH/TU3/Kir/BAT/DAz/j4//7e3/+Pj/5+f/eXn/ @@ -135,7 +143,8 @@ image create photo ::tk::icons::8-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS MFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgt MTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC } -image create photo ::tk::icons::9-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::9-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA 8FBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/DAz/OTn/U1P/R0f/HBz/AQH/Fhb/oqL/8/P/+fn/+Pj/1NT/ @@ -152,7 +161,8 @@ image create photo ::tk::icons::9-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS MDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== } -image create photo ::tk::icons::9plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::9plus-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB OFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/ERH/AAD/NDT/AQH/AAD/AAD/Cgr/Nzf/U1P/SUn/Hx//AQH/mJj/8fH/+fn/ @@ -171,7 +181,8 @@ image create photo ::tk::icons::9plus-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIA OusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAw N2dTjgAAAABJRU5ErkJggg== } -image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh +image create photo ::tk::icons::!-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA olBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ AAD/AAD/AAD/AAD/Fhb/QED/Pj7/ExP/VVX/9PT/8PD/SUn/WFj//v7/+fn/S0v/ @@ -192,7 +203,8 @@ image create photo ::tk::icons::!-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAAS # do not have a native icon/badge API. # # Arguments: -# badgenumber - number to draw over the icon +# win - window name +# badgenumber - badge number to draw over the window icon if {[tk windowingsystem] eq "x11"} { proc ::tk::icons::IconBadge {win badgenumber} { @@ -212,7 +224,7 @@ if {[tk windowingsystem] eq "x11"} { } if {$badgenumber eq ""} { - wm iconphoto $win $::tk::icons::base_icon + wm iconphoto $win $::tk::icons::base_icon return } @@ -220,38 +232,13 @@ if {[tk windowingsystem] eq "x11"} { wm iconphoto $win $::tk::icons::base_icon - switch $badgenumber { + switch -glob -- $badgenumber { ! { set badge ::tk::icons::!-badge } - 1 { + [1-9] { set badge ::tk::icons::$badgenumber-badge } - 2 { - set badge ::tk::icons::$badgenumber-badge - } - 3 { - set badge ::tk::icons::$badgenumber-badge - } - 4 { - set badge ::tk::icons::$badgenumber-badge - } - 5 { - set badge ::tk::icons::$badgenumber-badge - } - 6 { - set badge ::tk::icons::$badgenumber-badge - } - 7 { - set badge ::tk::icons::$badgenumber-badge - } - 8 { - set badge ::tk::icons::$badgenumber-badge - } - 9 { - set badge ::tk::icons::$badgenumber-badge - } - default { set badge ::tk::icons::9plus-badge } @@ -264,4 +251,4 @@ if {[tk windowingsystem] eq "x11"} { wm iconphoto $win overlay } -} \ No newline at end of file +} -- cgit v0.12 From ff1cfa9dacdf27ec5bc8a0e2c8bac690d99ed9ab Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 06:24:16 +0000 Subject: Move code after input argument checking. --- library/iconbadges.tcl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index ab8dd5b..a47175a 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -211,10 +211,6 @@ if {[tk windowingsystem] eq "x11"} { variable ::tk::icons::base_icon - set badge "" - - image create photo overlay - if {$::tk::icons::base_icon eq ""} { return -code error "You must set the value of \"::tk::icons::base_icon\" to a Tk photo before setting an icon badge" } @@ -228,6 +224,10 @@ if {[tk windowingsystem] eq "x11"} { return } + set badge "" + + image create photo overlay + update idletasks wm iconphoto $win $::tk::icons::base_icon -- cgit v0.12 From 33b410445ea31b0d9e665edf7f32a44098ff2df6 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 06:29:25 +0000 Subject: Remove useless statements. --- library/iconbadges.tcl | 3 --- 1 file changed, 3 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index a47175a..74c4262 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -228,8 +228,6 @@ if {[tk windowingsystem] eq "x11"} { image create photo overlay - update idletasks - wm iconphoto $win $::tk::icons::base_icon switch -glob -- $badgenumber { @@ -245,7 +243,6 @@ if {[tk windowingsystem] eq "x11"} { } - update idletasks overlay copy $::tk::icons::base_icon overlay copy $badge -from 0 0 18 18 -to 18 0 wm iconphoto $win overlay -- cgit v0.12 From e14225741f1cb59a24a1e36ceccc625a9d71c173 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 06:30:51 +0000 Subject: Remove useless statement. --- library/iconbadges.tcl | 2 -- 1 file changed, 2 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 74c4262..4009ecb 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -224,8 +224,6 @@ if {[tk windowingsystem] eq "x11"} { return } - set badge "" - image create photo overlay wm iconphoto $win $::tk::icons::base_icon -- cgit v0.12 From 021dc38068a30700905bc66df5cbac98abb930b9 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 06:34:41 +0000 Subject: Move statement inside the x11 part since it does not apply to anything else. --- library/iconbadges.tcl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 4009ecb..4659d9d 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -7,11 +7,6 @@ namespace eval ::tk::icons {} -variable ::tk::icons::base_icon - -set ::tk::icons::base_icon "" - - image create photo ::tk::icons::1-badge -data { iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA @@ -207,6 +202,11 @@ image create photo ::tk::icons::!-badge -data { # badgenumber - badge number to draw over the window icon if {[tk windowingsystem] eq "x11"} { + + variable ::tk::icons::base_icon + + set ::tk::icons::base_icon "" + proc ::tk::icons::IconBadge {win badgenumber} { variable ::tk::icons::base_icon -- cgit v0.12 From 6f9306249726894b5a9b764bffa7de717bcf8f19 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 06:36:08 +0000 Subject: Re-locate proc description. --- library/iconbadges.tcl | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 4659d9d..0b7173a 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -193,20 +193,21 @@ image create photo ::tk::icons::!-badge -data { } -# ::tk::icons::IconBadge -- -# This procedure creates an icon with an overlay badge on systems that -# do not have a native icon/badge API. -# -# Arguments: -# win - window name -# badgenumber - badge number to draw over the window icon - if {[tk windowingsystem] eq "x11"} { variable ::tk::icons::base_icon set ::tk::icons::base_icon "" + + # ::tk::icons::IconBadge -- + # This procedure creates an icon with an overlay badge on systems that + # do not have a native icon/badge API. + # + # Arguments: + # win - window name + # badgenumber - badge number to draw over the window icon + proc ::tk::icons::IconBadge {win badgenumber} { variable ::tk::icons::base_icon -- cgit v0.12 From 23f84a297d08c9312ab7486bfe57388f73964c16 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 2 Sep 2021 15:29:33 +0000 Subject: Adjust placement of wm iconphoto . command in test --- tests/wm.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/wm.test b/tests/wm.test index 6fa440a..56e64a0 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -885,7 +885,7 @@ test wm-iconphoto-1.1 {usage} -returnCodes error -body { wm iconphoto } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconphoto-1.2 {usage} -body { - wm iconphoto . + wm iconphoto . icon } -result {icon} test wm-iconphoto-1.3 {usage} -returnCodes error -body { wm iconphoto . notanimage @@ -901,8 +901,8 @@ test wm-iconphoto-1.5.2 {usage} -constraints x11 -body { wm iconphoto . -default [image create photo -file {}] } -result {} test wm-iconphoto-1.6 {usage} -body { - wm iconphoto . icon -} -result {} + wm iconphoto . +} -result {icon} # All other iconphoto tests are platform specific -- cgit v0.12 From b1c914a716d30b3abd676af596238d4ab7d1eff9 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 2 Sep 2021 17:43:26 +0000 Subject: Additional changes to test suite; wm tests finally pass on X11 --- tests/wm.test | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/tests/wm.test b/tests/wm.test index 56e64a0..1529ae6 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -886,23 +886,24 @@ test wm-iconphoto-1.1 {usage} -returnCodes error -body { } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconphoto-1.2 {usage} -body { wm iconphoto . icon +} -result {} +test wm-iconphoto-1.3 {usage} -body { + wm iconphoto . } -result {icon} -test wm-iconphoto-1.3 {usage} -returnCodes error -body { +test wm-iconphoto-1.4 {usage} -returnCodes error -body { wm iconphoto . notanimage } -result {can't use "notanimage" as iconphoto: not a photo image} -test wm-iconphoto-1.4 {usage} -returnCodes error -body { +test wm-iconphoto-1.5 {usage} -returnCodes error -body { # we currently have no return info wm iconphoto . -default } -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} -test wm-iconphoto-1.5.1 {usage} -constraints aquaOrWin32 -returnCodes error -body { +test wm-iconphoto-1.6.1 {usage} -constraints aquaOrWin32 -returnCodes error -body { wm iconphoto . -default [image create photo -file {}] } -match {glob} -result {failed to create an iconphoto with image *} -test wm-iconphoto-1.5.2 {usage} -constraints x11 -body { +test wm-iconphoto-1.6.2 {usage} -constraints x11 -body { wm iconphoto . -default [image create photo -file {}] } -result {} -test wm-iconphoto-1.6 {usage} -body { - wm iconphoto . -} -result {icon} + # All other iconphoto tests are platform specific -- cgit v0.12 From 97e37ff43dc8019c0b3e65d85c0506d80c049d06 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 19:28:47 +0000 Subject: Fix error message for 'wm iconbadge'. The 'badge' argument is not optional (according to the current implementation). --- macosx/tkMacOSXWm.c | 2 +- unix/tkUnixWm.c | 2 +- win/tkWinWm.c | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 182c661..d41b8cc 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2374,7 +2374,7 @@ WmIconbadgeCmd( { if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv,"window ? badge?"); + Tcl_WrongNumArgs(interp, 2, objv,"window badge"); return TCL_ERROR; } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 964c7a7..a8f9464 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2156,7 +2156,7 @@ WmIconbadgeCmd( if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, - "window ? badge?"); + "window badge"); return TCL_ERROR; } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 57527f9..e3b6dfe 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3898,7 +3898,7 @@ WmIconbadgeCmd( WmInfo *wmPtr; if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "window ? badge?"); + Tcl_WrongNumArgs(interp, 2, objv, "window badge"); return TCL_ERROR; } -- cgit v0.12 From 32c41ace2b39d60b6ea8927085843e8767c3831a Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 19:33:35 +0000 Subject: Fix manual for 'wm iconbadge'. The 'badge' argument is not optional (according to the current implementation). --- doc/wm.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/wm.n b/doc/wm.n index 0a358f7..95be755 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -407,7 +407,7 @@ specified then the command returns an empty string; otherwise it returns the path name of \fIwindow\fR's current group leader, or an empty string if \fIwindow\fR is not part of any group. .TP -\fBwm iconbadge \fIwindow\fR ?\fIbadge\fR? +\fBwm iconbadge \fIwindow\fR \fIbadge\fR . Sets a badge for the icon of the \fIwindow\fR. The badge can be a number, for instance the number of new or unread messages, or -- cgit v0.12 From 72c61ed5142f21c2962feb4aae1d6d733319bbc5 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 2 Sep 2021 19:43:31 +0000 Subject: Remove spaces at line ends. --- doc/wm.n | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/doc/wm.n b/doc/wm.n index 95be755..5db9f47 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -409,21 +409,21 @@ string if \fIwindow\fR is not part of any group. .TP \fBwm iconbadge \fIwindow\fR \fIbadge\fR . -Sets a badge for the icon of the \fIwindow\fR. The badge can be a number, +Sets a badge for the icon of the \fIwindow\fR. The badge can be a number, for instance the number of new or unread messages, or -an exclamation point denoting attention needed. If the badge is an empty +an exclamation point denoting attention needed. If the badge is an empty string, the badge image is removed from the application icon. Managing -these changes through bindings, such as , is the responsibility of the developer. +these changes through bindings, such as , is the responsibility of the developer. .RS .PP On X11, for this command to work, -the variable \fB::tk::icons::base_icon\fR must be set to the image that is -being used for the window icon, and the window's iconphoto must actually -be set via the \fBwm iconphoto\fR command. On Windows and X11, the iconphoto images work best at 32x32 or a similar dimension, as -the badge images are provided by Tk and drawn to overlay the icon images -using native (Windows) API's or Tk rendering. On macOS, the icon badge is -rendered by a system API and is not provided by Tk. The icon image itself -should be higher-resolution, preferably 512 pixels, to avoid being blurry. +the variable \fB::tk::icons::base_icon\fR must be set to the image that is +being used for the window icon, and the window's iconphoto must actually +be set via the \fBwm iconphoto\fR command. On Windows and X11, the iconphoto images work best at 32x32 or a similar dimension, as +the badge images are provided by Tk and drawn to overlay the icon images +using native (Windows) API's or Tk rendering. On macOS, the icon badge is +rendered by a system API and is not provided by Tk. The icon image itself +should be higher-resolution, preferably 512 pixels, to avoid being blurry. .RE .TP \fBwm iconbitmap \fIwindow\fR ?\fIbitmap\fR? @@ -489,26 +489,26 @@ as specified with the \fBwm title\fR command). .TP \fBwm iconphoto \fIwindow\fR ?\fB\-default\fR? \fIimage1\fR ?\fIimage2 ...\fR? . -Sets the titlebar icon for \fIwindow\fR based on the named photo images. +Sets the titlebar icon for \fIwindow\fR based on the named photo images. If \fB\-default\fR is specified, this is applied to all future created toplevels as well. The data in the images is taken as a snapshot at the time of invocation. If the images are later changed, this is not reflected to the titlebar icons. Multiple images are accepted to allow different images sizes (e.g., 16x16 and 32x32) to be provided. The window -manager may scale provided icons to an appropriate size. If this command -is called without an image argument, the current image set for the +manager may scale provided icons to an appropriate size. If this command +is called without an image argument, the current image set for the titlebar icon is returned. .RS .PP On Windows, the images are packed into a Windows icon structure. This will override an ico specified to \fBwm iconbitmap\fR, and -vice versa. This command sets the taskbar icon as the designated icon on +vice versa. This command sets the taskbar icon as the designated icon on Windows. .PP On X, the images are arranged into the _NET_WM_ICON X property, which most modern window managers support. A \fBwm iconbitmap\fR may exist simultaneously. It is recommended to use not more than 2 icons, placing -the larger icon first. This command also sets the panel icon for the +the larger icon first. This command also sets the panel icon for the application if the window manager or desktop environment supports it. .PP On Macintosh, the first image called is loaded into an OSX-native icon -- cgit v0.12 From 9aa714b50964297b970fb346c030d089f98320f9 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 19:29:26 +0000 Subject: Reformat data for icon image in wm.test --- tests/wm.test | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 62 insertions(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index 1529ae6..0ddf685 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -16,7 +16,68 @@ eval tcltest::configure $argv tcltest::loadTestedCommands image create photo icon -data { -iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJQElEQVRYw+WXW2xdV5nHf/ty7lcf2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNUSEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKqRJgBSikiuGlN22TqhsR27OPL8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614f/7MP6vC3O5f8L3G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8pHjvfS3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3G/7ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf/8hj5//5H97/YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3Vm9vfqc0WNi9evUKWr/xLh3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemxeCafxRcKw7TJxKC+12RpbYdAx7HsOCrSRNpg+sQQj1w8nS0N5h8JAvm+rWr99ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/++2P/eOFkV0FkJTDQgCaXTbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsPLyxU5orFTK1cfphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vliTCRxEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq1fn7A4yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8ThaQxRpIg0q6DGUNjg6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe2Hj1XoBLl55menqcbDb1haeeevyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAADSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7/uUSlk6Hed0oxG9HI9bm+Pjs2xsvIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUxSHyqSy+f31hzaRZRpMDKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu7zz54SCRinD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJGnTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZmYmMEIJmx6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtdEvEQrSN8IVEq5MSJ4YlSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3FUYyjxuEeELt7/NoP+eBVAipCFXEsYE4xcydYFIeSHKynOXhUwM0mh32egH1tsdL16oo007kcskHs7kYly49fRcALqby+fQopklkZ4jHY3g6gQgjHF/QcgQdV+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQCyZHrv0sUe4JwKFXMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibOvdJ7pSCiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYiTh1NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPlmuL4oIFWkbx8rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXDfZFII0NFIBW/XQiZHraoNbsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8tgW/sHynAxzcVTBQYzFp4v6boBjidwfcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6NacWIfD/yveDmXq3F3NxzdwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pYeh/C9QSOJ3EECGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCGrvNubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7jee6eN4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pjkxuVGo7Tw+1/MAh83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVjhO2e16q3fzR2cjQwDPPeZrSx8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEsQoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkkCHTQwa5WIjne9xY2mT+VouRfI7NxfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGnh0oHwktlZzmBq0SNsRQgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrTXdzf+9Nb8N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LSTRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE9wOIARmtw9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18tPSIhEfouwSuQ9cx2VxpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsrzZ1O13eMcSuezC61LJzQRgY+KvCJhI+WPpH0IAywIkEhaVIupAhdHS0t3F66Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL+fzEmalTsx+emjl3YWjsaMlMpcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leYwNoA01gr297BzVwv/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6XVae/Vqfbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuMVKjC0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZFDgot6Fe8eqfw3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0QXV0aG9yAHdhcnN6YXdpYW5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAgUHVibGljIERvbWFpbiBEZWRpY2F0aW9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/G4735AAAAIXRFWHRDcmVhdGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADIelRYdERlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhWHXUrd2pmLXr7tDrVpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mHoTeuJlUxYoly8nRRxHW4HahO30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sKhBuy2H4xUlM1i76+BhcBwwirLj/bAlJqjXXzP9UyxmuHzp8feiknLPW6Q/H9moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHRwczovL29wZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2ViLWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGFuZ28gaW5ldHJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGPC/xhBQAAA + CBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAABmJLR0QA/w + D/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJQElEQVRYw+WXW2xdV5nHf/ty7lc + f2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNUSEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKq + RJgBSikiuGlN22TqhsR27OPL8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614 + f/7MP6vC3O5f8L3G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8 + pHjvfS3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3G/7 + ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf/8hj5//5H97/ + YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3Vm9vfqc0WNi9evUKWr/xL + h3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemxeCafxRcKw7TJxKC+12RpbYdAx7HsOC + rSRNpg+sQQj1w8nS0N5h8JAvm+rWr99ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/ + ++2P/eOFkV0FkJTDQgCaXTbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsP + LyxU5orFTK1cfphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vli + TCRxEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq1fn7A4 + yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8ThaQxRpIg0q6DGUNjg + 6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe2Hj1XoBLl55menqcbDb1haee + evyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAADSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7 + /uUSlk6Hed0oxG9HI9bm+Pjs2xsvIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUx + SHyqSy+f31hzaRZRpMDKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu + 7zz54SCRinD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJG + nTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZmYmMEIJmx + 6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtdEvEQrSN8IVEq5MSJ4Y + lSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3FUYyjxuEeELt7/NoP+eBVAipCFX + EsYE4xcydYFIeSHKynOXhUwM0mh32egH1tsdL16oo007kcskHs7kYly49fRcALqby+fQo + pklkZ4jHY3g6gQgjHF/QcgQdV+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQ + CyZHrv0sUe4JwKFXMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibO + vdJ7pSCiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYiTh1 + NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPlmuL4oIFWkbx8 + rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXDfZFII0NFIBW/XQiZHraoN + bsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8 + tgW/sHynAxzcVTBQYzFp4v6boBjidwfcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6 + NacWIfD/yveDmXq3F3NxzdwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pY + eh/C9QSOJ3EECGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCG + rvNubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7jee6eN + 4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pjkxuVGo7Tw+1/MAh + 83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVjhO2e16q3fzR2cjQwDPPeZrSx + 8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEsQoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkk + CHTQwa5WIjne9xY2mT+VouRfI7NxfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGn + h0oHwktlZzmBq0SNsRQgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrT + Xdzf+9Nb8N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LS + TRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE9wOIARmtw + 9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18tPSIhEfouwSuQ9cx2V + xpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsrzZ1O13eMcSuezC61LJzQRgY+KvC + JhI+WPpH0IAywIkEhaVIupAhdHS0t3F66Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL + +fzEmalTsx+emjl3YWjsaMlMpcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leY + wNoA01gr297BzVwv/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6X + Vae/Vqfbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuMVKj + C0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZFDgot6Fe8eqfw + 3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0QXV0aG9yAHdhcnN6YXdpY + W5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAgUHVibGljIERvbWFpbiBEZWRpY2F0aW + 9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/ + G4735AAAAIXRFWHRDcmVhdGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAA + JXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0R + Vh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADIelRYdE + Rlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhWHXUrd2pmLXr7tDr + VpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mHoTeuJlUxYoly8nRRxHW4HahO + 30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sKhBuy2H4xUlM1i76+BhcBwwirLj/bAlJqj + XXzP9UyxmuHzp8feiknLPW6Q/H9moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAAB + l0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHR + wczovL29wZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2Vi + LWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGFuZ28gaW5ld + HJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC } wm deiconify . -- cgit v0.12 From 27cb8bf2eaa43adc600c106adafa6a50e4d9435d Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 20:07:29 +0000 Subject: Cosmetic: Indentation, and so on. --- macosx/tkMacOSXWm.c | 15 +++-- unix/tkUnixWm.c | 16 +++-- win/tkWinWm.c | 167 ++++++++++++++++++++++++++++------------------------ win/winMain.c | 1 - 4 files changed, 107 insertions(+), 92 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index d41b8cc..2a46f12 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -195,6 +195,7 @@ static int tkMacOSXWmAttrNotifyVal = 0; /* * The following stores the name of the "wm iconphoto" image. */ + char *base_icon = NULL; /* @@ -1287,7 +1288,7 @@ Tk_WmObjCmd( return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); - case WMOPT_ICONBADGE: + case WMOPT_ICONBADGE: return WmIconbadgeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); @@ -2372,17 +2373,20 @@ WmIconbadgeCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - + (void) winPtr; + NSString *label; + if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv,"window badge"); return TCL_ERROR; } - (void) winPtr; - NSString *label; label = [NSString stringWithUTF8String:Tcl_GetString(objv[3])]; - /* Set the icon badge on the Dock icon. */ + /* + * Set the icon badge on the Dock icon. + */ + NSDockTile *dockicon = [NSApp dockTile]; [dockicon setBadgeLabel: label]; return TCL_OK; @@ -2690,7 +2694,6 @@ WmIconphotoCmd( return TCL_OK; } - if ((objc == 3) && (base_icon !=NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); return TCL_OK; diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index a8f9464..dff23d2 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -337,6 +337,7 @@ typedef struct WaitRestrictInfo { /* * The following stores the name of the "wm iconphoto" image. */ + char *base_icon = NULL; /* @@ -2146,21 +2147,20 @@ WmGroupCmd( static int WmIconbadgeCmd( - TCL_UNUSED(Tk_Window), /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *tkWin, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { (void) tkWin; - + char cmd[4096]; + if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "window badge"); + Tcl_WrongNumArgs(interp, 2, objv, "window badge"); return TCL_ERROR; } - - char cmd[4096]; + sprintf(cmd, "::tk::icons::IconBadge {%s} {%s}", Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); @@ -2439,7 +2439,7 @@ WmIconphotoCmd( Tk_PhotoImageBlock block; int i, size = 0, width, height, index = 0, x, y, isDefault = 0; unsigned long *iconPropertyData; - + char *icon; if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); @@ -2451,7 +2451,6 @@ WmIconphotoCmd( return TCL_OK; } - if ((objc == 3) && (base_icon !=NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); return TCL_OK; @@ -2475,7 +2474,6 @@ WmIconphotoCmd( * Get icon name. We only use the first icon name. */ - char *icon; if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { icon = Tcl_GetString(objv[4]); } else { diff --git a/win/tkWinWm.c b/win/tkWinWm.c index e3b6dfe..08667ab 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -1739,7 +1739,10 @@ TkWinWmCleanup( } tsdPtr->initialized = 0; - /* COM library cleanup. */ + /* + * COM library cleanup. + */ + CoUninitialize(); UnregisterClassW(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance); @@ -1860,7 +1863,7 @@ UpdateWrapper( HICON hBigIcon = NULL; HRESULT hr; Tcl_DString titleString; - int *childStateInfo = NULL; + int *childStateInfo = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -2202,10 +2205,12 @@ UpdateWrapper( ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); - /* Load COM library for icon overlay. */ + /* + * Load COM library for icon overlay. + */ + hr = CoInitialize(0); if (SUCCEEDED(hr)) { - hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); if (FAILED(hr)) { printf("Unable to initialize ITaskbarList3 API"); @@ -2769,7 +2774,7 @@ Tk_WmObjCmd( return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); - case WMOPT_ICONBADGE: + case WMOPT_ICONBADGE: return WmIconbadgeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); @@ -3883,67 +3888,79 @@ WmIconbadgeCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - HWND hwnd; - Tk_PhotoHandle photo; - Tk_PhotoImageBlock block; - int width, height; - HICON overlayicon; - (void) winPtr; - int badgenumber; - char * badgestring = NULL; - char photoname[4096]; - LPCWSTR string; - HRESULT hr; - Tk_Window badgewindow; - WmInfo *wmPtr; - - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "window badge"); - return TCL_ERROR; - } - - /* Parse args, get native wrapper window, and determine image. */ - badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; - hwnd = wmPtr->wrapper; - badgestring = Tcl_GetString(objv[3]); - string = L"Alert"; - - badgenumber = atoi(badgestring); - if (badgenumber > 9) { - strcpy(photoname, "::tk::icons::9plus-badge"); - } else { - strcpy(photoname, "::tk::icons::"); - strcat(photoname, badgestring); - strcat(photoname, "-badge"); - } - - /* Get image. If NULL, remove badge icon. */ - photo = Tk_FindPhoto(interp, photoname); - if (photo == NULL) { - ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); - return TCL_OK; - } + HWND hwnd; + Tk_PhotoHandle photo; + Tk_PhotoImageBlock block; + int width, height; + HICON overlayicon; + (void) winPtr; + int badgenumber; + char * badgestring = NULL; + char photoname[4096]; + LPCWSTR string; + HRESULT hr; + Tk_Window badgewindow; + WmInfo *wmPtr; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window badge"); + return TCL_ERROR; + } + + /* + * Parse args, get native wrapper window, and determine image. + */ + + badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); + wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; + hwnd = wmPtr->wrapper; + badgestring = Tcl_GetString(objv[3]); + string = L"Alert"; + + badgenumber = atoi(badgestring); + if (badgenumber > 9) { + strcpy(photoname, "::tk::icons::9plus-badge"); + } else { + strcpy(photoname, "::tk::icons::"); + strcat(photoname, badgestring); + strcat(photoname, "-badge"); + } + + /* + * Get image. If NULL, remove badge icon. + */ + + photo = Tk_FindPhoto(interp, photoname); + if (photo == NULL) { + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); + return TCL_OK; + } - /* We have found the image. Convert to icon. */ - Tk_PhotoGetSize(photo, &width, &height); - Tk_PhotoGetImage(photo, &block); + /* + * We have found the image. Convert to icon. + */ - overlayicon = CreateIcoFromPhoto(width, height, block); - if (overlayicon == NULL) { - Tcl_SetResult(interp, "Failed to create badge icon", TCL_VOLATILE); - return TCL_ERROR; - } + Tk_PhotoGetSize(photo, &width, &height); + Tk_PhotoGetImage(photo, &block); - /* Place overlay icon on taskbar icon. */ - hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); - if (hr != S_OK) { - Tcl_SetResult(interp, "Failed to display badge icon", TCL_VOLATILE); - return TCL_ERROR; - } - DestroyIcon(overlayicon); + overlayicon = CreateIcoFromPhoto(width, height, block); + if (overlayicon == NULL) { + Tcl_SetResult(interp, "Failed to create badge icon", TCL_VOLATILE); + return TCL_ERROR; + } - return TCL_OK; + /* + * Place overlay icon on taskbar icon. + */ + + hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); + if (hr != S_OK) { + Tcl_SetResult(interp, "Failed to display badge icon", TCL_VOLATILE); + return TCL_ERROR; + } + DestroyIcon(overlayicon); + + return TCL_OK; } /* @@ -4293,13 +4310,14 @@ WmIconphotoCmd( WinIconPtr titlebaricon = NULL; HICON hIcon; unsigned size; + char* icon; (void)tkwin; if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); return TCL_ERROR; } - + if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "iconphoto") == 0) && base_icon == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); return TCL_OK; @@ -4311,25 +4329,22 @@ WmIconphotoCmd( } if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, - "window ?-default? image1 ?image2 ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; } - if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { - isDefault = 1; - if (objc == 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "window ?-default? image1 ?image2 ...?"); - return TCL_ERROR; - } + if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { + isDefault = 1; + if (objc == 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); + return TCL_ERROR; + } } - /* - * Get icon name. We only use the first icon name. - */ + /* + * Get icon name. We only use the first icon name. + */ - char *icon; if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { icon = Tcl_GetString(objv[4]); } else { diff --git a/win/winMain.c b/win/winMain.c index 3d691e1..a4e7c3d 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -181,7 +181,6 @@ _tWinMain( #endif Tk_Main(argc, argv, TK_LOCAL_APPINIT); - return 0; /* Needed only to prevent compiler warning. */ } -- cgit v0.12 From d75d3df1d204503b9d95e066d581d1bc4664451a Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 20:08:52 +0000 Subject: Remove useless includes. --- win/winMain.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/win/winMain.c b/win/winMain.c index a4e7c3d..1a93e2d 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -19,8 +19,6 @@ #include #include #include -#include -#include #if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 # define Tcl_LibraryInitProc Tcl_PackageInitProc # define Tcl_StaticLibrary Tcl_StaticPackage -- cgit v0.12 From 7b8792472cbed2e3ac3cf5eaeab222c83dfd6ab8 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 20:10:05 +0000 Subject: Cosmetic --- win/winMain.c | 1 - 1 file changed, 1 deletion(-) diff --git a/win/winMain.c b/win/winMain.c index 1a93e2d..9c23037 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -134,7 +134,6 @@ _tWinMain( (void)lpszCmdLine; (void)nCmdShow; - /* * Create the console channels and install them as the standard channels. * All I/O will be discarded until Tk_CreateConsoleWindow is called to -- cgit v0.12 From 7404dabe642853bb732dff6d065f6a6eba5be8cc Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 20:12:31 +0000 Subject: With this implementation, anything following 'wm iconphoto $win' is optional --- doc/wm.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/wm.n b/doc/wm.n index 5db9f47..a578a87 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -487,7 +487,7 @@ or an empty string if no icon name has been specified (in this case the window manager will normally display the window's title, as specified with the \fBwm title\fR command). .TP -\fBwm iconphoto \fIwindow\fR ?\fB\-default\fR? \fIimage1\fR ?\fIimage2 ...\fR? +\fBwm iconphoto \fIwindow\fR ??\fB\-default\fR? \fIimage1\fR ?\fIimage2 ...\fR?? . Sets the titlebar icon for \fIwindow\fR based on the named photo images. If \fB\-default\fR is specified, this is applied to all future created -- cgit v0.12 From b571415e3e6cc63b9fba6081dd14cdf9746dc9f1 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 20:15:11 +0000 Subject: Cosmetic --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index 0ddf685..1422013 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -793,7 +793,7 @@ test wm-group-2.1 {setting and reading values} -setup { lappend result [wm group .t] } -result [list {} . {}] -###wm iconbadge ### +### wm iconbadge ### test wm-iconbadge-1.1 {usage} -returnCodes error -body { wm iconbadge } -result {wrong # args: should be "wm option window ?arg ...?"} -- cgit v0.12 From b85fe279a2322d80ad5f418ab2b751810b76b487 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 20:33:30 +0000 Subject: Cosmetic --- macosx/tkMacOSXWm.c | 2 +- unix/tkUnixWm.c | 2 +- win/tkWinWm.c | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 2a46f12..dfc6bdb 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2685,7 +2685,7 @@ WmIconphotoCmd( NSImage *newIcon = NULL; if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); return TCL_ERROR; } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index dff23d2..1638eca 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2442,7 +2442,7 @@ WmIconphotoCmd( char *icon; if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); return TCL_ERROR; } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 08667ab..d1c0842 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -4314,7 +4314,7 @@ WmIconphotoCmd( (void)tkwin; if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); return TCL_ERROR; } -- cgit v0.12 From aa6d9e3cd129ce22fb339d7eb3ac7b07576300cb Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 20:35:08 +0000 Subject: Cosmetic --- macosx/tkMacOSXWm.c | 2 +- unix/tkUnixWm.c | 2 +- win/tkWinWm.c | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index dfc6bdb..5cbc474 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2694,7 +2694,7 @@ WmIconphotoCmd( return TCL_OK; } - if ((objc == 3) && (base_icon !=NULL)) { + if ((objc == 3) && (base_icon != NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); return TCL_OK; } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 1638eca..e460eb0 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2451,7 +2451,7 @@ WmIconphotoCmd( return TCL_OK; } - if ((objc == 3) && (base_icon !=NULL)) { + if ((objc == 3) && (base_icon != NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); return TCL_OK; } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index d1c0842..e343b6d 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -4323,7 +4323,7 @@ WmIconphotoCmd( return TCL_OK; } - if ((objc == 3) && (base_icon !=NULL)) { + if ((objc == 3) && (base_icon != NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); return TCL_OK; } -- cgit v0.12 From a7394d5e83a625fafd2a580e809fce8c48edde89 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 20:54:57 +0000 Subject: Remove useless statements --- library/iconbadges.tcl | 5 ----- 1 file changed, 5 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 0b7173a..0415d06 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -195,11 +195,6 @@ image create photo ::tk::icons::!-badge -data { if {[tk windowingsystem] eq "x11"} { - variable ::tk::icons::base_icon - - set ::tk::icons::base_icon "" - - # ::tk::icons::IconBadge -- # This procedure creates an icon with an overlay badge on systems that # do not have a native icon/badge API. -- cgit v0.12 From 93c02cc3902e597f0b5802809471133278dc815e Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 21:12:27 +0000 Subject: Simplify slightly --- library/iconbadges.tcl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 0415d06..7647e28 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -215,15 +215,14 @@ if {[tk windowingsystem] eq "x11"} { return -code error "You must set a Tk image as a window icon via the \"wm iconphoto\" command before setting an icon badge" } + wm iconphoto $win $::tk::icons::base_icon + if {$badgenumber eq ""} { - wm iconphoto $win $::tk::icons::base_icon return } image create photo overlay - wm iconphoto $win $::tk::icons::base_icon - switch -glob -- $badgenumber { ! { set badge ::tk::icons::!-badge -- cgit v0.12 From b0116f137a8931ebc8d631a75713d6ad8b5a8c8f Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 21:41:17 +0000 Subject: Attempt to support badges for multiple toplevels. Works on X11 at least. --- doc/wm.n | 19 +++++------ library/demos/windowicons.tcl | 79 ++++++++++++++++++++++++++++++++++++++++--- library/iconbadges.tcl | 10 +++--- macosx/tkMacOSXWm.c | 24 +------------ tests/unixWm.test | 2 +- tests/winWm.test | 2 +- tests/wm.test | 19 +++++------ unix/tkUnixWm.c | 36 +------------------- win/tkWinWm.c | 46 ++----------------------- 9 files changed, 104 insertions(+), 133 deletions(-) diff --git a/doc/wm.n b/doc/wm.n index a578a87..9b72187 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -413,13 +413,15 @@ Sets a badge for the icon of the \fIwindow\fR. The badge can be a number, for instance the number of new or unread messages, or an exclamation point denoting attention needed. If the badge is an empty string, the badge image is removed from the application icon. Managing -these changes through bindings, such as , is the responsibility of the developer. +these changes through bindings, such as , is the responsibility +of the developer. .RS .PP On X11, for this command to work, -the variable \fB::tk::icons::base_icon\fR must be set to the image that is -being used for the window icon, and the window's iconphoto must actually -be set via the \fBwm iconphoto\fR command. On Windows and X11, the iconphoto images work best at 32x32 or a similar dimension, as +the variable \fB::tk::icons::base_icon($window)\fR must be set to the image that is +being used for the window icon of $window, and the window's iconphoto must actually +be set via the \fBwm iconphoto\fR command. On Windows and X11, the iconphoto +images work best at 32x32 or a similar dimension, as the badge images are provided by Tk and drawn to overlay the icon images using native (Windows) API's or Tk rendering. On macOS, the icon badge is rendered by a system API and is not provided by Tk. The icon image itself @@ -487,7 +489,7 @@ or an empty string if no icon name has been specified (in this case the window manager will normally display the window's title, as specified with the \fBwm title\fR command). .TP -\fBwm iconphoto \fIwindow\fR ??\fB\-default\fR? \fIimage1\fR ?\fIimage2 ...\fR?? +\fBwm iconphoto \fIwindow\fR ?\fB\-default\fR? \fIimage1\fR ?\fIimage2 ...\fR? . Sets the titlebar icon for \fIwindow\fR based on the named photo images. If \fB\-default\fR is specified, this is applied to all future created @@ -495,15 +497,12 @@ toplevels as well. The data in the images is taken as a snapshot at the time of invocation. If the images are later changed, this is not reflected to the titlebar icons. Multiple images are accepted to allow different images sizes (e.g., 16x16 and 32x32) to be provided. The window -manager may scale provided icons to an appropriate size. If this command -is called without an image argument, the current image set for the -titlebar icon is returned. +manager may scale provided icons to an appropriate size. .RS .PP On Windows, the images are packed into a Windows icon structure. This will override an ico specified to \fBwm iconbitmap\fR, and -vice versa. This command sets the taskbar icon as the designated icon on -Windows. +vice versa. This command sets the taskbar icon for the window. .PP On X, the images are arranged into the _NET_WM_ICON X property, which most modern window managers support. A \fBwm iconbitmap\fR may exist diff --git a/library/demos/windowicons.tcl b/library/demos/windowicons.tcl index 82bfe38..f89d252 100644 --- a/library/demos/windowicons.tcl +++ b/library/demos/windowicons.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." } - set w .windowicons destroy $w toplevel $w @@ -15,13 +14,83 @@ wm title $w "Window Icon Demonstration" positionWindow $w image create photo icon -data { -iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJQElEQVRYw+WXW2xdV5nHf/ty7lcf2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNUSEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKqRJgBSikiuGlN22TqhsR27OPL8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614f/7MP6vC3O5f8L3G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8pHjvfS3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3G/7ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf/8hj5//5H97/YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3Vm9vfqc0WNi9evUKWr/xLh3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemxeCafxRcKw7TJxKC+12RpbYdAx7HsOCrSRNpg+sQQj1w8nS0N5h8JAvm+rWr99ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/++2P/eOFkV0FkJTDQgCaXTbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsPLyxU5orFTK1cfphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vliTCRxEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq1fn7A4yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8ThaQxRpIg0q6DGUNjg6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe2Hj1XoBLl55menqcbDb1haeeevyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAADSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7/uUSlk6Hed0oxG9HI9bm+Pjs2xsvIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUxSHyqSy+f31hzaRZRpMDKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu7zz54SCRinD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJGnTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZmYmMEIJmx6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtdEvEQrSN8IVEq5MSJ4YlSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3FUYyjxuEeELt7/NoP+eBVAipCFXEsYE4xcydYFIeSHKynOXhUwM0mh32egH1tsdL16oo007kcskHs7kYly49fRcALqby+fQopklkZ4jHY3g6gQgjHF/QcgQdV+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQCyZHrv0sUe4JwKFXMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibOvdJ7pSCiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYiTh1NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPlmuL4oIFWkbx8rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXDfZFII0NFIBW/XQiZHraoNbsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8tgW/sHynAxzcVTBQYzFp4v6boBjidwfcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6NacWIfD/yveDmXq3F3NxzdwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pYeh/C9QSOJ3EECGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCGrvNubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7jee6eN4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pjkxuVGo7Tw+1/MAh83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVjhO2e16q3fzR2cjQwDPPeZrSx8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEsQoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkkCHTQwa5WIjne9xY2mT+VouRfI7NxfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGnh0oHwktlZzmBq0SNsRQgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrTXdzf+9Nb8N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LSTRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE9wOIARmtw9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18tPSIhEfouwSuQ9cx2VxpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsrzZ1O13eMcSuezC61LJzQRgY+KvCJhI+WPpH0IAywIkEhaVIupAhdHS0t3F66Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL+fzEmalTsx+emjl3YWjsaMlMpcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leYwNoA01gr297BzVwv/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6XVae/Vqfbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuMVKjC0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZFDgot6Fe8eqfw3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0QXV0aG9yAHdhcnN6YXdpYW5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAgUHVibGljIERvbWFpbiBEZWRpY2F0aW9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/G4735AAAAIXRFWHRDcmVhdGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADIelRYdERlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhWHXUrd2pmLXr7tDrVpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mHoTeuJlUxYoly8nRRxHW4HahO30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sKhBuy2H4xUlM1i76+BhcBwwirLj/bAlJqjXXzP9UyxmuHzp8feiknLPW6Q/H9moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHRwczovL29wZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2ViLWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGFuZ28gaW5ldHJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGP + C/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3Cc + ulE8AAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJ + QElEQVRYw+WXW2xdV5nHf/ty7lcf2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNU + SEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKqRJgBSikiuGlN22TqhsR27OPL + 8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614f/7MP6vC3O5f8L3 + G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8pHjvfS + 3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3 + G/7ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf + /8hj5//5H97/YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3 + Vm9vfqc0WNi9evUKWr/xLh3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemx + eCafxRcKw7TJxKC+12RpbYdAx7HsOCrSRNpg+sQQj1w8nS0N5h8JAvm+rWr9 + 9ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/++2P/eOFkV0FkJTDQgCaX + TbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsPLyxU5orFTK1c + fphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vliTCR + xEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq + 1fn7A4yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8Tha + QxRpIg0q6DGUNjg6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe + 2Hj1XoBLl55menqcbDb1haeeevyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAA + DSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7/uUSlk6Hed0oxG9HI9bm+Pjs2xs + vIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUxSHyqSy+f31hzaRZRpM + DKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu7zz54SCRi + nD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJG + nTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZ + mYmMEIJmx6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtd + EvEQrSN8IVEq5MSJ4YlSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3 + FUYyjxuEeELt7/NoP+eBVAipCFXEsYE4xcydYFIeSHKynOXhUwM0mh32egH1 + tsdL16oo007kcskHs7kYly49fRcALqby+fQopklkZ4jHY3g6gQgjHF/QcgQd + V+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQCyZHrv0sUe4JwKF + XMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibOvdJ7pS + CiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYi + Th1NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPl + muL4oIFWkbx8rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXD + fZFII0NFIBW/XQiZHraoNbsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2 + ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8tgW/sHynAxzcVTBQYzFp4v6boBjidw + fcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6NacWIfD/yveDmXq3F3Nxz + dwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pYeh/C9QSOJ3EE + CGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCGrvN + ubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7 + jee6eN4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pj + kxuVGo7Tw+1/MAh83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVj + hO2e16q3fzR2cjQwDPPeZrSx8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEs + QoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkkCHTQwa5WIjne9xY2mT+VouRfI7N + xfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGnh0oHwktlZzmBq0SNsR + QgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrTXdzf+9Nb8 + N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LS + TRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE + 9wOIARmtw9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18 + tPSIhEfouwSuQ9cx2VxpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsr + zZ1O13eMcSuezC61LJzQRgY+KvCJhI+WPpH0IAywIkEhaVIupAhdHS0t3F66 + Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL+fzEmalTsx+emjl3YWjsaMlM + pcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leYwNoA01gr297BzVw + v/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6XVae/Vq + fbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuM + VKjC0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZF + Dgot6Fe8eqfw3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0 + QXV0aG9yAHdhcnN6YXdpYW5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAg + UHVibGljIERvbWFpbiBEZWRpY2F0aW9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1v + bnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/G4735AAAAIXRFWHRDcmVh + dGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAAJXRFWHRkYXRl + OmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0RVh0 + ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADI + elRYdERlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhW + HXUrd2pmLXr7tDrVpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mH + oTeuJlUxYoly8nRRxHW4HahO30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sK + hBuy2H4xUlM1i76+BhcBwwirLj/bAlJqjXXzP9UyxmuHzp8feiknLPW6Q/H9 + moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAABl0RVh0U29mdHdhcmUA + d3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHRwczovL29w + ZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2Vi + LWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGF + uZ28gaW5ldHJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC } +set ::tk::icons::base_icon(.) icon -set ::tk::icons::base_icon icon - -pack [button $w.i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon -compound top -command {wm iconphoto . $::tk::icons::base_icon }] +pack [button $w.i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon(.) \ + -compound top -command {wm iconphoto . $::tk::icons::base_icon(.) }] pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge . 3}] pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge . 11}] pack [button $w.f -text "Reset Badge" -command {wm iconbadge . ""}] diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 7647e28..4715119 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -207,15 +207,17 @@ if {[tk windowingsystem] eq "x11"} { variable ::tk::icons::base_icon - if {$::tk::icons::base_icon eq ""} { - return -code error "You must set the value of \"::tk::icons::base_icon\" to a Tk photo before setting an icon badge" + if {![info exists ::tk::icons::base_icon($win)]} { + return -code error "You must set the value of \"::tk::icons::base_icon(\$win)\" to a Tk photo before setting an icon badge" } +if 0 { if {[wm iconphoto $win] eq ""} { return -code error "You must set a Tk image as a window icon via the \"wm iconphoto\" command before setting an icon badge" } +} - wm iconphoto $win $::tk::icons::base_icon + wm iconphoto $win $::tk::icons::base_icon($win) if {$badgenumber eq ""} { return @@ -236,7 +238,7 @@ if {[tk windowingsystem] eq "x11"} { } - overlay copy $::tk::icons::base_icon + overlay copy $::tk::icons::base_icon($win) overlay copy $badge -from 0 0 18 18 -to 18 0 wm iconphoto $win overlay diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 5cbc474..8f5b8f2 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -193,12 +193,6 @@ static const Tk_GeomMgr wmMgrType = { static int tkMacOSXWmAttrNotifyVal = 0; /* - * The following stores the name of the "wm iconphoto" image. - */ - -char *base_icon = NULL; - -/* * Forward declarations for procedures defined in this file: */ @@ -2684,22 +2678,7 @@ WmIconphotoCmd( int width, height, isDefault = 0; NSImage *newIcon = NULL; - if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); - return TCL_ERROR; - } - - if ((objc == 3) && (base_icon == NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); - return TCL_OK; - } - - if ((objc == 3) && (base_icon != NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); - return TCL_OK; - } - - if (objc < 3) { + if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; @@ -2756,7 +2735,6 @@ WmIconphotoCmd( return TCL_ERROR; } [NSApp setApplicationIconImage: newIcon]; - base_icon = icon; return TCL_OK; } diff --git a/tests/unixWm.test b/tests/unixWm.test index 84eafff..2adf03f 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -2539,7 +2539,7 @@ test unixWm-60.5 {wm attributes - bad attribute} -constraints unix -body { test unixWm-61.1 {Tk_WmCmd procedure, "iconphoto" option} unix { list [catch {wm iconph .} msg] $msg -} {1 {Argument should be "iconphoto"}} +} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}} test unixWm-61.2 {Tk_WmCmd procedure, "iconphoto" option} unix { destroy .t toplevel .t diff --git a/tests/winWm.test b/tests/winWm.test index 3effef9..f659a13 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -431,7 +431,7 @@ test winWm-7.4 {UpdateWrapper must maintain focus} -constraints win -setup { test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -body { wm iconph . -} -returnCodes error -result {Argument should be "iconphoto"} +} -returnCodes error -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -setup { destroy .t } -body { diff --git a/tests/wm.test b/tests/wm.test index 1422013..fadc060 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -799,8 +799,8 @@ test wm-iconbadge-1.1 {usage} -returnCodes error -body { } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-iconbadge-1.2 {usage} -body { toplevel .top - set ::tk::icons::base_icon icon - wm iconphoto .top $::tk::icons::base_icon + set ::tk::icons::base_icon(.top) icon + wm iconphoto .top $::tk::icons::base_icon(.top) wm iconbadge .top 14 } -cleanup { destroy .top @@ -945,23 +945,20 @@ test wm-iconname-2.1 {setting and reading values} -setup { test wm-iconphoto-1.1 {usage} -returnCodes error -body { wm iconphoto } -result {wrong # args: should be "wm option window ?arg ...?"} -test wm-iconphoto-1.2 {usage} -body { - wm iconphoto . icon -} -result {} -test wm-iconphoto-1.3 {usage} -body { +test wm-iconphoto-1.2 {usage} -returnCodes error -body { wm iconphoto . -} -result {icon} -test wm-iconphoto-1.4 {usage} -returnCodes error -body { +} -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} +test wm-iconphoto-1.3 {usage} -returnCodes error -body { wm iconphoto . notanimage } -result {can't use "notanimage" as iconphoto: not a photo image} -test wm-iconphoto-1.5 {usage} -returnCodes error -body { +test wm-iconphoto-1.4 {usage} -returnCodes error -body { # we currently have no return info wm iconphoto . -default } -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} -test wm-iconphoto-1.6.1 {usage} -constraints aquaOrWin32 -returnCodes error -body { +test wm-iconphoto-1.5.1 {usage} -constraints aquaOrWin32 -returnCodes error -body { wm iconphoto . -default [image create photo -file {}] } -match {glob} -result {failed to create an iconphoto with image *} -test wm-iconphoto-1.6.2 {usage} -constraints x11 -body { +test wm-iconphoto-1.5.2 {usage} -constraints x11 -body { wm iconphoto . -default [image create photo -file {}] } -result {} diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index e460eb0..581c3cc 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -335,12 +335,6 @@ typedef struct WaitRestrictInfo { } WaitRestrictInfo; /* - * The following stores the name of the "wm iconphoto" image. - */ - -char *base_icon = NULL; - -/* * Forward declarations for functions defined in this file: */ @@ -2439,24 +2433,8 @@ WmIconphotoCmd( Tk_PhotoImageBlock block; int i, size = 0, width, height, index = 0, x, y, isDefault = 0; unsigned long *iconPropertyData; - char *icon; - if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); - return TCL_ERROR; - } - - if ((objc == 3) && (base_icon == NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); - return TCL_OK; - } - - if ((objc == 3) && (base_icon != NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); - return TCL_OK; - } - - if (objc < 3) { + if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; @@ -2470,16 +2448,6 @@ WmIconphotoCmd( } } - /* - * Get icon name. We only use the first icon name. - */ - - if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { - icon = Tcl_GetString(objv[4]); - } else { - icon = Tcl_GetString(objv[3]); - } - /* * Iterate over all images to retrieve their sizes, in order to allocate a * buffer large enough to hold all images. @@ -2582,8 +2550,6 @@ WmIconphotoCmd( if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdatePhotoIcon(winPtr); } - - base_icon = icon; return TCL_OK; } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index e343b6d..fa0326d 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -349,11 +349,6 @@ static int initialized; /* Flag indicating whether module has been TCL_DECLARE_MUTEX(winWmMutex) -/* - * The following stores the name of the "wm iconphoto" image. - */ -char *base_icon = NULL; - /* * The following records the "TaskbarButtonCreated" message ID * for overlay icons. @@ -4310,47 +4305,14 @@ WmIconphotoCmd( WinIconPtr titlebaricon = NULL; HICON hIcon; unsigned size; - char* icon; (void)tkwin; - if (strcmp(Tcl_GetString(objv[1]), "iconphoto") != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("Argument should be \"iconphoto\"", -1)); - return TCL_ERROR; - } - - if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "iconphoto") == 0) && base_icon == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1)); - return TCL_OK; - } - - if ((objc == 3) && (base_icon != NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(base_icon, -1)); - return TCL_OK; - } - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; } - if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { - isDefault = 1; - if (objc == 4) { - Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); - return TCL_ERROR; - } - } - - /* - * Get icon name. We only use the first icon name. - */ - - if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { - icon = Tcl_GetString(objv[4]); - } else { - icon = Tcl_GetString(objv[3]); - } - /* * Iterate over all images to validate their existence. */ @@ -4419,8 +4381,6 @@ WmIconphotoCmd( DecrIconRefCount(titlebaricon); return TCL_ERROR; } - base_icon = icon; - return TCL_OK; } -- cgit v0.12 From 3d6198bdf9490f9d030ebeb2a1854cfe97fde5e8 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 21:50:10 +0000 Subject: Remove leftover code in previous commit --- win/tkWinWm.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index fa0326d..16f85f7 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -4300,7 +4300,7 @@ WmIconphotoCmd( TkWindow *useWinPtr = winPtr; /* window to apply to (NULL if -default) */ Tk_PhotoHandle photo; Tk_PhotoImageBlock block; - int i, width, height, startObj = 3, isDefault = 0; + int i, width, height, startObj = 3; BlockOfIconImagesPtr lpIR; WinIconPtr titlebaricon = NULL; HICON hIcon; @@ -4312,7 +4312,7 @@ WmIconphotoCmd( "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; } - + /* * Iterate over all images to validate their existence. */ -- cgit v0.12 From fb3a3b6d4bd20d5e04ab1355efadea6fe35d5b93 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 21:52:29 +0000 Subject: Remove commented out code --- library/iconbadges.tcl | 6 ------ 1 file changed, 6 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 4715119..44330f8 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -211,12 +211,6 @@ if {[tk windowingsystem] eq "x11"} { return -code error "You must set the value of \"::tk::icons::base_icon(\$win)\" to a Tk photo before setting an icon badge" } -if 0 { - if {[wm iconphoto $win] eq ""} { - return -code error "You must set a Tk image as a window icon via the \"wm iconphoto\" command before setting an icon badge" - } -} - wm iconphoto $win $::tk::icons::base_icon($win) if {$badgenumber eq ""} { -- cgit v0.12 From eab0914e43efc9039b1c153dfd240be945bba5b3 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 22:07:38 +0000 Subject: More accurate man page --- doc/wm.n | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/doc/wm.n b/doc/wm.n index 9b72187..0ed1660 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -419,8 +419,7 @@ of the developer. .PP On X11, for this command to work, the variable \fB::tk::icons::base_icon($window)\fR must be set to the image that is -being used for the window icon of $window, and the window's iconphoto must actually -be set via the \fBwm iconphoto\fR command. On Windows and X11, the iconphoto +being used for the window icon of $window. On Windows and X11, the iconphoto images work best at 32x32 or a similar dimension, as the badge images are provided by Tk and drawn to overlay the icon images using native (Windows) API's or Tk rendering. On macOS, the icon badge is -- cgit v0.12 From d12feca9c033fa1c8bca1435fd1cc8e9c2c03a55 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 3 Sep 2021 22:16:49 +0000 Subject: Better error reporting --- library/iconbadges.tcl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 44330f8..3a23fee 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -208,7 +208,8 @@ if {[tk windowingsystem] eq "x11"} { variable ::tk::icons::base_icon if {![info exists ::tk::icons::base_icon($win)]} { - return -code error "You must set the value of \"::tk::icons::base_icon(\$win)\" to a Tk photo before setting an icon badge" + puts "You must set the value of \"::tk::icons::base_icon($win)\" to a Tk photo before setting an icon badge" + return -code error } wm iconphoto $win $::tk::icons::base_icon($win) -- cgit v0.12 From 670f2ce2befbe28088e3f97bd73707936b245bdb Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 4 Sep 2021 01:29:40 +0000 Subject: Add explanation of icon badge behavior to man page --- doc/wm.n | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/wm.n b/doc/wm.n index 0ed1660..444ac8e 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -425,6 +425,14 @@ the badge images are provided by Tk and drawn to overlay the icon images using native (Windows) API's or Tk rendering. On macOS, the icon badge is rendered by a system API and is not provided by Tk. The icon image itself should be higher-resolution, preferably 512 pixels, to avoid being blurry. +.RS +.PP +The icon badge is intended for display in the Dock (macOS), +taskbar (Windows) or app panel (X11). On macOS and Windows, the last badge +called will be displayed in the Dock/taskbar, regardless of how many +different icon badges may be assigned to different windows. Taskbar/panel +display behavioron X11 will depend on the window manager and/or desktop +environment. .RE .TP \fBwm iconbitmap \fIwindow\fR ?\fIbitmap\fR? -- cgit v0.12 From e48471fa6d732451ebe08c1b4bc5a6d5292d3d90 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 4 Sep 2021 01:31:39 +0000 Subject: Fix typo --- doc/wm.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/wm.n b/doc/wm.n index 444ac8e..16616a8 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -431,7 +431,7 @@ The icon badge is intended for display in the Dock (macOS), taskbar (Windows) or app panel (X11). On macOS and Windows, the last badge called will be displayed in the Dock/taskbar, regardless of how many different icon badges may be assigned to different windows. Taskbar/panel -display behavioron X11 will depend on the window manager and/or desktop +display behavior on X11 will depend on the window manager and/or desktop environment. .RE .TP -- cgit v0.12 From 962b495e1646eb6529ebb3142b5b09a56a87c524 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 4 Sep 2021 07:56:46 +0000 Subject: More accurate documentation of the taskbar behavior for Windows. --- doc/wm.n | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/doc/wm.n b/doc/wm.n index 16616a8..cedeee4 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -427,12 +427,15 @@ rendered by a system API and is not provided by Tk. The icon image itself should be higher-resolution, preferably 512 pixels, to avoid being blurry. .RS .PP -The icon badge is intended for display in the Dock (macOS), -taskbar (Windows) or app panel (X11). On macOS and Windows, the last badge -called will be displayed in the Dock/taskbar, regardless of how many -different icon badges may be assigned to different windows. Taskbar/panel -display behavior on X11 will depend on the window manager and/or desktop -environment. +The icon badge is intended for display in the Dock (macOS), taskbar +(Windows) or app panel (X11). On macOS, the last badge called will be +displayed in the Dock, regardless of how many different icon badges may be +assigned to different windows. On Windows, the taskbar display depends on +whether the taskbar buttons are combined or not (this is an OS setting +available to the user): if combined the behavior is the same as on macOS, +otherwise each button in the taskbar shows the badge it was assigned. App +panel display behavior on X11 will depend on the window manager and/or +desktop environment. .RE .TP \fBwm iconbitmap \fIwindow\fR ?\fIbitmap\fR? -- cgit v0.12 From f7b032a48530507c1abc53a169faab20c7cce31f Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 4 Sep 2021 08:31:12 +0000 Subject: More tests of wm iconbadge. The one constrained to x11 currently fails because the error reporting is not polished. --- tests/wm.test | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/tests/wm.test b/tests/wm.test index fadc060..759f6c8 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -793,18 +793,42 @@ test wm-group-2.1 {setting and reading values} -setup { lappend result [wm group .t] } -result [list {} . {}] + ### wm iconbadge ### test wm-iconbadge-1.1 {usage} -returnCodes error -body { wm iconbadge } -result {wrong # args: should be "wm option window ?arg ...?"} -test wm-iconbadge-1.2 {usage} -body { +test wm-iconbadge-1.2 {usage} -returnCodes error -body { + frame .f + set ::tk::icons::base_icon(.f) icon + wm iconbadge .f icon +} -cleanup { + destroy .f + unset ::tk::icons::base_icon(.f) +} -result {window ".f" isn't a top-level window} +test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constraints x11 -returnCodes error -body { + unset ::tk::icons::base_icon(.) + wm iconbadge . ! +} -result {Unable to set iconbadge. You must set the value of ::tk::icons::base_icon(.) to a Tk photo before setting an icon badge} +test wm-iconbadge-1.4 {usage} -body { + image create photo book -data { + R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC + wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM + QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc + 0yv+DVSEUuFxIAOw== + } toplevel .top set ::tk::icons::base_icon(.top) icon wm iconphoto .top $::tk::icons::base_icon(.top) wm iconbadge .top 14 + set ::tk::icons::base_icon(.) book + wm iconphoto . $::tk::icons::base_icon(.) + wm iconbadge . ! } -cleanup { destroy .top -} + wm iconbadge . "" +} -result {} + ### wm iconbitmap ### test wm-iconbitmap-1.1 {usage} -returnCodes error -body { -- cgit v0.12 From 894252ca2c5ae2933826511174599c3d0e836550 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 4 Sep 2021 08:33:50 +0000 Subject: Forgot it should not complain when unsetting. --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index 759f6c8..e75bd71 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -807,7 +807,7 @@ test wm-iconbadge-1.2 {usage} -returnCodes error -body { unset ::tk::icons::base_icon(.f) } -result {window ".f" isn't a top-level window} test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constraints x11 -returnCodes error -body { - unset ::tk::icons::base_icon(.) + unset -nocomplain ::tk::icons::base_icon(.) wm iconbadge . ! } -result {Unable to set iconbadge. You must set the value of ::tk::icons::base_icon(.) to a Tk photo before setting an icon badge} test wm-iconbadge-1.4 {usage} -body { -- cgit v0.12 From 30c00b0649fd399f2f4ca04beac8306aaf885274 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 4 Sep 2021 08:52:38 +0000 Subject: One more test --- tests/wm.test | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/wm.test b/tests/wm.test index e75bd71..f20e4f8 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -828,6 +828,11 @@ test wm-iconbadge-1.4 {usage} -body { destroy .top wm iconbadge . "" } -result {} +test wm-iconbadge-1.5 {usage, no need to call iconphoto on aqua or win32} -constraints aquaOrWin32 -body { + wm iconbadge . 3 +} -cleanup { + wm iconbadge . "" +} -result {} ### wm iconbitmap ### -- cgit v0.12 From 5b56859570703bcfa8894683f76be40011aa0a44 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 4 Sep 2021 09:00:03 +0000 Subject: Fix syntax error in man page --- doc/wm.n | 1 - 1 file changed, 1 deletion(-) diff --git a/doc/wm.n b/doc/wm.n index cedeee4..f7b1aa2 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -425,7 +425,6 @@ the badge images are provided by Tk and drawn to overlay the icon images using native (Windows) API's or Tk rendering. On macOS, the icon badge is rendered by a system API and is not provided by Tk. The icon image itself should be higher-resolution, preferably 512 pixels, to avoid being blurry. -.RS .PP The icon badge is intended for display in the Dock (macOS), taskbar (Windows) or app panel (X11). On macOS, the last badge called will be -- cgit v0.12 From b5863d42cec89584671af8e12ba86e1faf644e82 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 4 Sep 2021 12:28:23 +0000 Subject: Update docs --- doc/wm.n | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/wm.n b/doc/wm.n index f7b1aa2..7868419 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -432,7 +432,8 @@ displayed in the Dock, regardless of how many different icon badges may be assigned to different windows. On Windows, the taskbar display depends on whether the taskbar buttons are combined or not (this is an OS setting available to the user): if combined the behavior is the same as on macOS, -otherwise each button in the taskbar shows the badge it was assigned. App +otherwise each button in the taskbar shows the badge it was assigned. +Badge display on macOS is configured in the system preferences. App panel display behavior on X11 will depend on the window manager and/or desktop environment. .RE -- cgit v0.12 From ff7a93ca80f796546f8d106a473ca70a3128f3e0 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 4 Sep 2021 12:38:31 +0000 Subject: Update error handling --- unix/tkUnixWm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 581c3cc..30d5090 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2159,7 +2159,7 @@ WmIconbadgeCmd( Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { - Tcl_SetResult(interp,"Unable to set icon badge",TCL_VOLATILE); + Tcl_SetResult(interp,"You must set the value of \"::tk::icons::base_icon($win)\" to a Tk photo before setting an icon badge",TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; -- cgit v0.12 From cdcccd096b3aecce0add1a0e99d459d6452d2981 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 4 Sep 2021 12:44:40 +0000 Subject: Sync error messages on X11 for icon badge --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index f20e4f8..225bcb5 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -809,7 +809,7 @@ test wm-iconbadge-1.2 {usage} -returnCodes error -body { test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constraints x11 -returnCodes error -body { unset -nocomplain ::tk::icons::base_icon(.) wm iconbadge . ! -} -result {Unable to set iconbadge. You must set the value of ::tk::icons::base_icon(.) to a Tk photo before setting an icon badge} +} -result {You must set the value of "::tk::icons::base_icon($win)" to a Tk photo before setting an icon badge} test wm-iconbadge-1.4 {usage} -body { image create photo book -data { R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC -- cgit v0.12 From 2a35223e6838ee116fc190ece7446318603882e4 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 4 Sep 2021 13:16:28 +0000 Subject: Add more (failing) tests, demonstrating that error management is not yet correct. --- tests/wm.test | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/tests/wm.test b/tests/wm.test index 225bcb5..3aa6e96 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -810,7 +810,24 @@ test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constra unset -nocomplain ::tk::icons::base_icon(.) wm iconbadge . ! } -result {You must set the value of "::tk::icons::base_icon($win)" to a Tk photo before setting an icon badge} -test wm-iconbadge-1.4 {usage} -body { +test wm-iconbadge-1.4 {other failure mode than ::tk::icons::base_icon($win)} -returnCodes error -body { + catch {image delete book} + set ::tk::icons::base_icon(.) book + wm iconbadge . 27 +} -result {can't use "book" as iconphoto: not a photo image} +test wm-iconbadge-1.5 {unknown badge} -returnCodes error -body { + image create photo book -data { + R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC + wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM + QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc + 0yv+DVSEUuFxIAOw== + } + set ::tk::icons::base_icon(.) book + wm iconbadge . unknown +} -cleanup { + image delete book +} -result {please fill in appropriate error message here} +test wm-iconbadge-1.6 {usage} -body { image create photo book -data { R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM @@ -825,10 +842,11 @@ test wm-iconbadge-1.4 {usage} -body { wm iconphoto . $::tk::icons::base_icon(.) wm iconbadge . ! } -cleanup { + image delete book destroy .top wm iconbadge . "" } -result {} -test wm-iconbadge-1.5 {usage, no need to call iconphoto on aqua or win32} -constraints aquaOrWin32 -body { +test wm-iconbadge-1.7 {usage, no need to call iconphoto on aqua or win32} -constraints aquaOrWin32 -body { wm iconbadge . 3 } -cleanup { wm iconbadge . "" -- cgit v0.12 From 1ca56b240164a394dc866799f5fa787531309ebe Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 4 Sep 2021 13:26:14 +0000 Subject: Update error messages --- library/iconbadges.tcl | 2 +- tests/wm.test | 6 +++--- unix/tkUnixWm.c | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 3a23fee..964ef4b 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -208,7 +208,7 @@ if {[tk windowingsystem] eq "x11"} { variable ::tk::icons::base_icon if {![info exists ::tk::icons::base_icon($win)]} { - puts "You must set the value of \"::tk::icons::base_icon($win)\" to a Tk photo before setting an icon badge" + puts "Unable to set icon badge" return -code error } diff --git a/tests/wm.test b/tests/wm.test index 3aa6e96..088dfdb 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -809,12 +809,12 @@ test wm-iconbadge-1.2 {usage} -returnCodes error -body { test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constraints x11 -returnCodes error -body { unset -nocomplain ::tk::icons::base_icon(.) wm iconbadge . ! -} -result {You must set the value of "::tk::icons::base_icon($win)" to a Tk photo before setting an icon badge} +} -result {Unable to set icon badge} test wm-iconbadge-1.4 {other failure mode than ::tk::icons::base_icon($win)} -returnCodes error -body { catch {image delete book} set ::tk::icons::base_icon(.) book wm iconbadge . 27 -} -result {can't use "book" as iconphoto: not a photo image} +} -result {Unable to set icon badge} test wm-iconbadge-1.5 {unknown badge} -returnCodes error -body { image create photo book -data { R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC @@ -826,7 +826,7 @@ test wm-iconbadge-1.5 {unknown badge} -returnCodes error -body { wm iconbadge . unknown } -cleanup { image delete book -} -result {please fill in appropriate error message here} +} -result {Unable to set icon badge} test wm-iconbadge-1.6 {usage} -body { image create photo book -data { R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 30d5090..581c3cc 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2159,7 +2159,7 @@ WmIconbadgeCmd( Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { - Tcl_SetResult(interp,"You must set the value of \"::tk::icons::base_icon($win)\" to a Tk photo before setting an icon badge",TCL_VOLATILE); + Tcl_SetResult(interp,"Unable to set icon badge",TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; -- cgit v0.12 From 698a69c2c681aff33189510cec88aa142be86d42 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 4 Sep 2021 13:45:36 +0000 Subject: More cleanup of errors --- library/iconbadges.tcl | 7 ++++++- tests/wm.test | 6 +++--- unix/tkUnixWm.c | 3 ++- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index 964ef4b..d9d81ac 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -208,12 +208,17 @@ if {[tk windowingsystem] eq "x11"} { variable ::tk::icons::base_icon if {![info exists ::tk::icons::base_icon($win)]} { - puts "Unable to set icon badge" + puts "::tk::icons::base_icon($win) must be set on X11" return -code error } wm iconphoto $win $::tk::icons::base_icon($win) + if {$::tk::icons::base_icon($win) ni [image names]} { + puts "can't use \"$::tk::icons::base_icon($win)\" as iconphoto: not a photo image" + return -code error + } + if {$badgenumber eq ""} { return } diff --git a/tests/wm.test b/tests/wm.test index 088dfdb..80949ad 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -809,12 +809,12 @@ test wm-iconbadge-1.2 {usage} -returnCodes error -body { test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constraints x11 -returnCodes error -body { unset -nocomplain ::tk::icons::base_icon(.) wm iconbadge . ! -} -result {Unable to set icon badge} +} -result {::tk::icons::base_icon($win) must be set on X11} test wm-iconbadge-1.4 {other failure mode than ::tk::icons::base_icon($win)} -returnCodes error -body { catch {image delete book} set ::tk::icons::base_icon(.) book wm iconbadge . 27 -} -result {Unable to set icon badge} +} -result {can't use "book" as iconphoto: not a photo image} test wm-iconbadge-1.5 {unknown badge} -returnCodes error -body { image create photo book -data { R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC @@ -826,7 +826,7 @@ test wm-iconbadge-1.5 {unknown badge} -returnCodes error -body { wm iconbadge . unknown } -cleanup { image delete book -} -result {Unable to set icon badge} +} -result {can't use "unknown" as iconphoto: not a photo image} test wm-iconbadge-1.6 {usage} -body { image create photo book -data { R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 581c3cc..961944b 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2159,7 +2159,8 @@ WmIconbadgeCmd( Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { - Tcl_SetResult(interp,"Unable to set icon badge",TCL_VOLATILE); + char *msg = Tcl_GetStringResult(interp); + Tcl_SetResult(interp,msg, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; -- cgit v0.12 From 1255a248fcde7379e21cc1164396217a0d04b10b Mon Sep 17 00:00:00 2001 From: oehhar Date: Sun, 5 Sep 2021 18:08:54 +0000 Subject: svgnano upstream changes: Fix decimal values in color fields (nsvg__parseColorRGB, nsvg__parseColorHex). https://github.com/memononen/nanosvg/commit/ccdb1995134d340a93fb20e3a3d323ccb3838dd0 --- generic/nanosvg.h | 37 ++++++++++++------------------------- 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/generic/nanosvg.h b/generic/nanosvg.h index 9a6eb3f..bb5ba25 100644 --- a/generic/nanosvg.h +++ b/generic/nanosvg.h @@ -1287,35 +1287,22 @@ static const char* nsvg__getNextPathItem(const char* s, char* it) static unsigned int nsvg__parseColorHex(const char* str) { - unsigned int c = 0, r = 0, g = 0, b = 0; - int n = 0; - str++; /* skip # */ - /* Calculate number of characters. */ - while(str[n] && !nsvg__isspace(str[n])) - n++; - if (n == 6) { - sscanf(str, "%x", &c); - } else if (n == 3) { - sscanf(str, "%x", &c); - c = (c&0xf) | ((c&0xf0) << 4) | ((c&0xf00) << 8); - c |= c<<4; - } - r = (c >> 16) & 0xff; - g = (c >> 8) & 0xff; - b = c & 0xff; - return NSVG_RGB(r,g,b); + unsigned int r=0, g=0, b=0; + if (sscanf(str, "#%2x%2x%2x", &r, &g, &b) == 3 ) /* 2 digit hex */ + return NSVG_RGB(r, g, b); + if (sscanf(str, "#%1x%1x%1x", &r, &g, &b) == 3 ) /* 1 digit hex, e.g. #abc -> 0xccbbaa */ + return NSVG_RGB(r*17, g*17, b*17); /* same effect as (r<<4|r), (g<<4|g), .. */ + return NSVG_RGB(128, 128, 128); } static unsigned int nsvg__parseColorRGB(const char* str) { - int r = -1, g = -1, b = -1; - char s1[32]="", s2[32]=""; - sscanf(str + 4, "%d%[%%, \t]%d%[%%, \t]%d", &r, s1, &g, s2, &b); - if (strchr(s1, '%')) { - return NSVG_RGB((r*255)/100,(g*255)/100,(b*255)/100); - } else { - return NSVG_RGB(r,g,b); - } + unsigned int r=0, g=0, b=0; + if (sscanf(str, "rgb(%u, %u, %u)", &r, &g, &b) == 3) /* decimal integers */ + return NSVG_RGB(r, g, b); + if (sscanf(str, "rgb(%u%%, %u%%, %u%%)", &r, &g, &b) == 3) /* decimal integer percentage */ + return NSVG_RGB(r*255/100, g*255/100, b*255/100); + return NSVG_RGB(128, 128, 128); } typedef struct NSVGNamedColor { -- cgit v0.12 From 05cff62235926b5bc5fc8299c4980c979558a285 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 6 Sep 2021 02:12:15 +0000 Subject: Improve error handling; remove two unnecessary icon badge tests --- library/iconbadges.tcl | 17 ++++++++++++----- tests/wm.test | 33 +++++---------------------------- 2 files changed, 17 insertions(+), 33 deletions(-) diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index d9d81ac..dd9018a 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -207,18 +207,25 @@ if {[tk windowingsystem] eq "x11"} { variable ::tk::icons::base_icon + if {![info exists ::tk::icons::base_icon]} { + return -code error "::tk::icons::base_icon($win) must be set on X11" + } + if {![info exists ::tk::icons::base_icon($win)]} { - puts "::tk::icons::base_icon($win) must be set on X11" - return -code error + return -code error "::tk::icons::base_icon($win) must be set on X11" } wm iconphoto $win $::tk::icons::base_icon($win) - if {$::tk::icons::base_icon($win) ni [image names]} { - puts "can't use \"$::tk::icons::base_icon($win)\" as iconphoto: not a photo image" - return -code error + if {[lsearch -exact [image names] $::tk::icons::base_icon($win)] <= 0} { + return -code error "can't use \"$::tk::icons::base_icon($win)\" as iconphoto: not a photo image" } + if {![string is integer $badgenumber] && [string match $badgenumber "!"] == 0} { + return -code error "can't use \"$badgenumber\" as iconphoto: not a photo image" + } + + if {$badgenumber eq ""} { return } diff --git a/tests/wm.test b/tests/wm.test index 80949ad..7d9589b 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -806,16 +806,12 @@ test wm-iconbadge-1.2 {usage} -returnCodes error -body { destroy .f unset ::tk::icons::base_icon(.f) } -result {window ".f" isn't a top-level window} -test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constraints x11 -returnCodes error -body { - unset -nocomplain ::tk::icons::base_icon(.) - wm iconbadge . ! -} -result {::tk::icons::base_icon($win) must be set on X11} -test wm-iconbadge-1.4 {other failure mode than ::tk::icons::base_icon($win)} -returnCodes error -body { +test wm-iconbadge-1.3 {other failure mode than ::tk::icons::base_icon($win)} -returnCodes error -body { catch {image delete book} set ::tk::icons::base_icon(.) book wm iconbadge . 27 } -result {can't use "book" as iconphoto: not a photo image} -test wm-iconbadge-1.5 {unknown badge} -returnCodes error -body { +test wm-iconbadge-1.4 {unknown badge} -returnCodes error -body { image create photo book -data { R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM @@ -823,30 +819,11 @@ test wm-iconbadge-1.5 {unknown badge} -returnCodes error -body { 0yv+DVSEUuFxIAOw== } set ::tk::icons::base_icon(.) book - wm iconbadge . unknown + wm iconbadge . notknown } -cleanup { image delete book -} -result {can't use "unknown" as iconphoto: not a photo image} -test wm-iconbadge-1.6 {usage} -body { - image create photo book -data { - R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC - wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM - QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc - 0yv+DVSEUuFxIAOw== - } - toplevel .top - set ::tk::icons::base_icon(.top) icon - wm iconphoto .top $::tk::icons::base_icon(.top) - wm iconbadge .top 14 - set ::tk::icons::base_icon(.) book - wm iconphoto . $::tk::icons::base_icon(.) - wm iconbadge . ! -} -cleanup { - image delete book - destroy .top - wm iconbadge . "" -} -result {} -test wm-iconbadge-1.7 {usage, no need to call iconphoto on aqua or win32} -constraints aquaOrWin32 -body { +} -result {can't use "notknown" as iconphoto: not a photo image} +test wm-iconbadge-1. {usage, no need to call iconphoto on aqua or win32} -constraints aquaOrWin32 -body { wm iconbadge . 3 } -cleanup { wm iconbadge . "" -- cgit v0.12 From f73e9ab00cf90b7708bdf95e64a3272d7744d04a Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 6 Sep 2021 02:15:56 +0000 Subject: Formatting --- tests/wm.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/wm.test b/tests/wm.test index 7d9589b..5257738 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -823,7 +823,7 @@ test wm-iconbadge-1.4 {unknown badge} -returnCodes error -body { } -cleanup { image delete book } -result {can't use "notknown" as iconphoto: not a photo image} -test wm-iconbadge-1. {usage, no need to call iconphoto on aqua or win32} -constraints aquaOrWin32 -body { +test wm-iconbadge-1.5 {usage, no need to call iconphoto on aqua or win32} -constraints aquaOrWin32 -body { wm iconbadge . 3 } -cleanup { wm iconbadge . "" -- cgit v0.12 From cdfe65dd77a69d17c657a3c07104728b08d861a7 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 6 Sep 2021 20:17:35 +0000 Subject: More complete and correct testing of 'wm iconbadge' parameters. Tests pass on x11 at this stage. --- doc/wm.n | 4 ++-- library/iconbadges.tcl | 9 +++++---- tests/wm.test | 55 ++++++++++++++++++++++++++++++++++++++++---------- unix/tkUnixWm.c | 2 -- 4 files changed, 51 insertions(+), 19 deletions(-) diff --git a/doc/wm.n b/doc/wm.n index 7868419..6c40f5c 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -409,8 +409,8 @@ string if \fIwindow\fR is not part of any group. .TP \fBwm iconbadge \fIwindow\fR \fIbadge\fR . -Sets a badge for the icon of the \fIwindow\fR. The badge can be a number, -for instance the number of new or unread messages, or +Sets a badge for the icon of the \fIwindow\fR. The badge can be a positive +integer number, for instance the number of new or unread messages, or an exclamation point denoting attention needed. If the badge is an empty string, the badge image is removed from the application icon. Managing these changes through bindings, such as , is the responsibility diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index dd9018a..820e040 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -215,16 +215,17 @@ if {[tk windowingsystem] eq "x11"} { return -code error "::tk::icons::base_icon($win) must be set on X11" } - wm iconphoto $win $::tk::icons::base_icon($win) - if {[lsearch -exact [image names] $::tk::icons::base_icon($win)] <= 0} { return -code error "can't use \"$::tk::icons::base_icon($win)\" as iconphoto: not a photo image" } - if {![string is integer $badgenumber] && [string match $badgenumber "!"] == 0} { - return -code error "can't use \"$badgenumber\" as iconphoto: not a photo image" + if {!([string is integer $badgenumber] && $badgenumber > 0) + && [string match $badgenumber "!"] == 0 + && $badgenumber ne ""} { + return -code error "can't use \"$badgenumber\" as icon badge" } + wm iconphoto $win $::tk::icons::base_icon($win) if {$badgenumber eq ""} { return diff --git a/tests/wm.test b/tests/wm.test index 5257738..f34dab1 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -795,23 +795,31 @@ test wm-group-2.1 {setting and reading values} -setup { ### wm iconbadge ### -test wm-iconbadge-1.1 {usage} -returnCodes error -body { +test wm-iconbadge-1.1 {usage} -body { wm iconbadge -} -result {wrong # args: should be "wm option window ?arg ...?"} -test wm-iconbadge-1.2 {usage} -returnCodes error -body { +} -returnCodes error -result {wrong # args: should be "wm option window ?arg ...?"} +test wm-iconbadge-1.2 {usage} -body { frame .f set ::tk::icons::base_icon(.f) icon wm iconbadge .f icon } -cleanup { destroy .f unset ::tk::icons::base_icon(.f) -} -result {window ".f" isn't a top-level window} -test wm-iconbadge-1.3 {other failure mode than ::tk::icons::base_icon($win)} -returnCodes error -body { +} -returnCodes error -result {window ".f" isn't a top-level window} +test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constraints { + x11 +} -setup { + unset -nocomplain ::tk::icons::base_icon(.) +} -body { + wm iconbadge . ! +} -returnCodes error -result {::tk::icons::base_icon(.) must be set on X11} +test wm-iconbadge-1.4 {::tk::icons::base_icon($win) must be a Tk photo} -setup { catch {image delete book} +} -body { set ::tk::icons::base_icon(.) book wm iconbadge . 27 -} -result {can't use "book" as iconphoto: not a photo image} -test wm-iconbadge-1.4 {unknown badge} -returnCodes error -body { +} -returnCodes error -result {can't use "book" as iconphoto: not a photo image} +test wm-iconbadge-1.5 {illegal badge number} -body { image create photo book -data { R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM @@ -819,13 +827,38 @@ test wm-iconbadge-1.4 {unknown badge} -returnCodes error -body { 0yv+DVSEUuFxIAOw== } set ::tk::icons::base_icon(.) book - wm iconbadge . notknown + wm iconbadge . illegal } -cleanup { image delete book -} -result {can't use "notknown" as iconphoto: not a photo image} -test wm-iconbadge-1.5 {usage, no need to call iconphoto on aqua or win32} -constraints aquaOrWin32 -body { - wm iconbadge . 3 +} -returnCodes error -result {can't use "illegal" as icon badge} +test wm-iconbadge-1.6 {non-integer badge number} -body { + image create photo book -data { + R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC + wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM + QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc + 0yv+DVSEUuFxIAOw== + } + set ::tk::icons::base_icon(.) book + wm iconbadge . 3.2 } -cleanup { + image delete book +} -returnCodes error -result {can't use "3.2" as icon badge} +test wm-iconbadge-1.7 {negative or zero badge number} -body { + image create photo book -data { + R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC + wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM + QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc + 0yv+DVSEUuFxIAOw== + } + set ::tk::icons::base_icon(.) book + wm iconbadge . 0 +} -cleanup { + image delete book +} -returnCodes error -result {can't use "0" as icon badge} +test wm-iconbadge-1.8 {usage, no need to call iconphoto on aqua or win32} -constraints { + aquaOrWin32 +} -body { + wm iconbadge . 3 wm iconbadge . "" } -result {} diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 961944b..8e9d816 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2159,8 +2159,6 @@ WmIconbadgeCmd( Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { - char *msg = Tcl_GetStringResult(interp); - Tcl_SetResult(interp,msg, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; -- cgit v0.12 From 4a9be14f90ab0a76e8058fe5f0f5b49c9553b1f2 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 6 Sep 2021 20:49:51 +0000 Subject: Fix argument error management on Windows. --- tests/wm.test | 4 +++- win/tkWinWm.c | 18 ++++++++++++++---- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/tests/wm.test b/tests/wm.test index f34dab1..deb1eb8 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -813,7 +813,9 @@ test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constra } -body { wm iconbadge . ! } -returnCodes error -result {::tk::icons::base_icon(.) must be set on X11} -test wm-iconbadge-1.4 {::tk::icons::base_icon($win) must be a Tk photo} -setup { +test wm-iconbadge-1.4 {::tk::icons::base_icon($win) must be a Tk photo on X11} -constraints { + x11 +} -setup { catch {image delete book} } -body { set ::tk::icons::base_icon(.) book diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 16f85f7..50828dc 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3890,7 +3890,7 @@ WmIconbadgeCmd( HICON overlayicon; (void) winPtr; int badgenumber; - char * badgestring = NULL; + char *badgestring = NULL; char photoname[4096]; LPCWSTR string; HRESULT hr; @@ -3909,10 +3909,19 @@ WmIconbadgeCmd( badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; hwnd = wmPtr->wrapper; - badgestring = Tcl_GetString(objv[3]); - string = L"Alert"; + if (Tcl_GetIntFromObj(interp, objv[3], &badgenumber) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONBADGE", "OPTION", NULL); + return TCL_ERROR; + } + if (badgenumber <= 0) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%d\" as icon badge", badgenumber)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONBADGE", "OPTION", NULL); + return TCL_ERROR; + } - badgenumber = atoi(badgestring); if (badgenumber > 9) { strcpy(photoname, "::tk::icons::9plus-badge"); } else { @@ -3948,6 +3957,7 @@ WmIconbadgeCmd( * Place overlay icon on taskbar icon. */ + string = L"Alert"; hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); if (hr != S_OK) { Tcl_SetResult(interp, "Failed to display badge icon", TCL_VOLATILE); -- cgit v0.12 From 4f897e1e8d3b957bbe7b8f4bea455d0344c7cfbc Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 6 Sep 2021 20:54:44 +0000 Subject: More compact code. --- win/tkWinWm.c | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 50828dc..0dea270 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3909,18 +3909,13 @@ WmIconbadgeCmd( badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; hwnd = wmPtr->wrapper; - if (Tcl_GetIntFromObj(interp, objv[3], &badgenumber) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[3], &badgenumber) != TCL_OK || + badgenumber <= 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); Tcl_SetErrorCode(interp, "TK", "WM", "ICONBADGE", "OPTION", NULL); return TCL_ERROR; } - if (badgenumber <= 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use \"%d\" as icon badge", badgenumber)); - Tcl_SetErrorCode(interp, "TK", "WM", "ICONBADGE", "OPTION", NULL); - return TCL_ERROR; - } if (badgenumber > 9) { strcpy(photoname, "::tk::icons::9plus-badge"); -- cgit v0.12 From 3236045c1ab01720ff6e93c4a2c4c06368f0c555 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 7 Sep 2021 00:30:02 +0000 Subject: Revert some Windows changes, wm tests now pass on Windows --- win/tkWinWm.c | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 0dea270..5b8b97e 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3890,7 +3890,7 @@ WmIconbadgeCmd( HICON overlayicon; (void) winPtr; int badgenumber; - char *badgestring = NULL; + char * badgestring = NULL; char photoname[4096]; LPCWSTR string; HRESULT hr; @@ -3909,14 +3909,10 @@ WmIconbadgeCmd( badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; hwnd = wmPtr->wrapper; - if (Tcl_GetIntFromObj(interp, objv[3], &badgenumber) != TCL_OK || - badgenumber <= 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); - Tcl_SetErrorCode(interp, "TK", "WM", "ICONBADGE", "OPTION", NULL); - return TCL_ERROR; - } + badgestring = Tcl_GetString(objv[3]); + string = L"Alert"; + badgenumber = atoi(badgestring); if (badgenumber > 9) { strcpy(photoname, "::tk::icons::9plus-badge"); } else { @@ -3926,13 +3922,22 @@ WmIconbadgeCmd( } /* - * Get image. If NULL, remove badge icon. + * if badgestring is empty string, remove icon. */ - + + if (strcmp("", badgestring)==0) { + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); + return TCL_OK; + } + + /* + * If photo does not exist, return error. + */ photo = Tk_FindPhoto(interp, photoname); if (photo == NULL) { - ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", badgestring)); + return TCL_ERROR; } /* @@ -3952,7 +3957,6 @@ WmIconbadgeCmd( * Place overlay icon on taskbar icon. */ - string = L"Alert"; hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); if (hr != S_OK) { Tcl_SetResult(interp, "Failed to display badge icon", TCL_VOLATILE); @@ -3962,7 +3966,6 @@ WmIconbadgeCmd( return TCL_OK; } - /* *---------------------------------------------------------------------- * -- cgit v0.12 From 6a38238e255ed7b75e1f77fbc134e33156b9cf86 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 7 Sep 2021 02:44:06 +0000 Subject: wm test suite passes on macOS; other tweaks to Windows --- macosx/tkMacOSXWm.c | 33 +++++++++++++++++++++++++++++---- win/tkWinWm.c | 26 ++++++++++++++------------ 2 files changed, 43 insertions(+), 16 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 8f5b8f2..782bc9d 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2374,15 +2374,40 @@ WmIconbadgeCmd( Tcl_WrongNumArgs(interp, 2, objv,"window badge"); return TCL_ERROR; } - + label = [NSString stringWithUTF8String:Tcl_GetString(objv[3])]; + int number = [label intValue]; + NSDockTile *dockicon = [NSApp dockTile]; + /* - * Set the icon badge on the Dock icon. + * First, check that the label is not a decimal. If it is, + * return an error. */ - NSDockTile *dockicon = [NSApp dockTile]; - [dockicon setBadgeLabel: label]; + if ([label containsString:@"."]) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); + return TCL_ERROR; + } + + /* + * Next, check that label is an int, empty string, or exclamation + * point. If so, set the icon badge on the Dock icon. Otherwise, + * return an error. + */ + + NSArray *array = @[@"", @"!"]; + if ([array containsObject: label]) { + [dockicon setBadgeLabel: label]; + } else if (number > 0) { + NSString *str = [@(number) stringValue]; + [dockicon setBadgeLabel:str]; + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); + return TCL_ERROR; + } return TCL_OK; } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 5b8b97e..70d0f80 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3925,20 +3925,22 @@ WmIconbadgeCmd( * if badgestring is empty string, remove icon. */ - if (strcmp("", badgestring)==0) { - ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); - return TCL_OK; + if (strcmp("", badgestring)==0) { + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); + return TCL_OK; } - /* - * If photo does not exist, return error. - */ - photo = Tk_FindPhoto(interp, photoname); - if (photo == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use \"%s\" as icon badge", badgestring)); - return TCL_ERROR; - } + /* + * If photo does not exist, return error. This means we do not have + * to test for decimal or negative values; no photo for such values + * is present. + */ + photo = Tk_FindPhoto(interp, photoname); + if (photo == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", badgestring)); + return TCL_ERROR; + } /* * We have found the image. Convert to icon. -- cgit v0.12 From d1c4ef38dc3509557e1a52e5dc3f86ff1b655688 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 7 Sep 2021 02:50:32 +0000 Subject: Format tweaks --- win/tkWinWm.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 70d0f80..c0b4187 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3928,13 +3928,14 @@ WmIconbadgeCmd( if (strcmp("", badgestring)==0) { ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); return TCL_OK; - } + } /* * If photo does not exist, return error. This means we do not have * to test for decimal or negative values; no photo for such values * is present. - */ + */ + photo = Tk_FindPhoto(interp, photoname); if (photo == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( -- cgit v0.12 From 0a06dd45c40b25a43147054901f36fcaacfee637 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 7 Sep 2021 02:50:41 +0000 Subject: Format tweaks --- win/tkWinWm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index c0b4187..72ba6e0 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3922,7 +3922,7 @@ WmIconbadgeCmd( } /* - * if badgestring is empty string, remove icon. + * If badgestring is empty string, remove icon. */ if (strcmp("", badgestring)==0) { -- cgit v0.12 From 4a57a3f5d91e10c3cfe7cb28bb038d2e9cd1d179 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 7 Sep 2021 06:00:07 +0000 Subject: Cosmetic changes --- macosx/tkMacOSXWm.c | 6 +++--- win/tkWinWm.c | 28 ++++++++++++++-------------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 782bc9d..4954729 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2387,7 +2387,7 @@ WmIconbadgeCmd( if ([label containsString:@"."]) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); + "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); return TCL_ERROR; } @@ -2399,13 +2399,13 @@ WmIconbadgeCmd( NSArray *array = @[@"", @"!"]; if ([array containsObject: label]) { - [dockicon setBadgeLabel: label]; + [dockicon setBadgeLabel:label]; } else if (number > 0) { NSString *str = [@(number) stringValue]; [dockicon setBadgeLabel:str]; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); + "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); return TCL_ERROR; } return TCL_OK; diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 72ba6e0..db775f7 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3890,8 +3890,8 @@ WmIconbadgeCmd( HICON overlayicon; (void) winPtr; int badgenumber; - char * badgestring = NULL; - char photoname[4096]; + char *badgestring = NULL; + char photoname[4096]; LPCWSTR string; HRESULT hr; Tk_Window badgewindow; @@ -3909,8 +3909,7 @@ WmIconbadgeCmd( badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; hwnd = wmPtr->wrapper; - badgestring = Tcl_GetString(objv[3]); - string = L"Alert"; + badgestring = Tcl_GetString(objv[3]); badgenumber = atoi(badgestring); if (badgenumber > 9) { @@ -3924,24 +3923,24 @@ WmIconbadgeCmd( /* * If badgestring is empty string, remove icon. */ - - if (strcmp("", badgestring)==0) { + + if (strcmp("", badgestring) == 0) { ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); return TCL_OK; } - + /* * If photo does not exist, return error. This means we do not have * to test for decimal or negative values; no photo for such values * is present. */ - - photo = Tk_FindPhoto(interp, photoname); - if (photo == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use \"%s\" as icon badge", badgestring)); - return TCL_ERROR; - } + + photo = Tk_FindPhoto(interp, photoname); + if (photo == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", badgestring)); + return TCL_ERROR; + } /* * We have found the image. Convert to icon. @@ -3960,6 +3959,7 @@ WmIconbadgeCmd( * Place overlay icon on taskbar icon. */ + string = L"Alert"; hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); if (hr != S_OK) { Tcl_SetResult(interp, "Failed to display badge icon", TCL_VOLATILE); -- cgit v0.12 From 8133fdf2f4683a8846412fac09be36594852584d Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 7 Sep 2021 06:01:46 +0000 Subject: Cosmetic changes once more --- macosx/tkMacOSXWm.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 4954729..12799c3 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2374,14 +2374,14 @@ WmIconbadgeCmd( Tcl_WrongNumArgs(interp, 2, objv,"window badge"); return TCL_ERROR; } - + label = [NSString stringWithUTF8String:Tcl_GetString(objv[3])]; int number = [label intValue]; NSDockTile *dockicon = [NSApp dockTile]; /* - * First, check that the label is not a decimal. If it is, + * First, check that the label is not a decimal. If it is, * return an error. */ @@ -2392,11 +2392,11 @@ WmIconbadgeCmd( } /* - * Next, check that label is an int, empty string, or exclamation + * Next, check that label is an int, empty string, or exclamation * point. If so, set the icon badge on the Dock icon. Otherwise, * return an error. */ - + NSArray *array = @[@"", @"!"]; if ([array containsObject: label]) { [dockicon setBadgeLabel:label]; -- cgit v0.12 From b052ad9b3f9e05b7ab5aba288c8d15c8a9f571eb Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 7 Sep 2021 06:15:02 +0000 Subject: Cosmetic (new page for each function when printing) --- macosx/tkMacOSXWm.c | 2 +- unix/tkUnixWm.c | 1 + win/tkWinWm.c | 1 + 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 12799c3..d827552 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -2342,7 +2342,7 @@ WmGroupCmd( } return TCL_OK; } - + /*---------------------------------------------------------------------- * * WmIconbadgeCmd -- diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 8e9d816..6463076 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -2163,6 +2163,7 @@ WmIconbadgeCmd( } return TCL_OK; } + /* *---------------------------------------------------------------------- * diff --git a/win/tkWinWm.c b/win/tkWinWm.c index db775f7..68b44a8 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3969,6 +3969,7 @@ WmIconbadgeCmd( return TCL_OK; } + /* *---------------------------------------------------------------------- * -- cgit v0.12 From 2f0c939342f37d8fd746582e24977679dc4f3394 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 7 Sep 2021 08:03:13 +0000 Subject: Eliminate (almost) duplicate functions --- win/tkWinGDI.c | 1120 +------------------------------------------------------- 1 file changed, 9 insertions(+), 1111 deletions(-) diff --git a/win/tkWinGDI.c b/win/tkWinGDI.c index 3f36363..7c6705a 100644 --- a/win/tkWinGDI.c +++ b/win/tkWinGDI.c @@ -63,10 +63,7 @@ static int GdiCopyBits(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* Local copies of similar routines elsewhere in Tcl/Tk. */ -static int GdiParseColor(const char *name, unsigned long *color); -static int GdiGetColor(const char *name, unsigned long *color); -static int TkGdiMakeBezierCurve(Tk_Canvas, double *, int, int, - XPoint[], double[]); +static int GdiGetColor(const char *name, COLORREF *color); /* * Helper functions. @@ -620,7 +617,7 @@ int Bezierize( return 0; } - nbpoints = TkGdiMakeBezierCurve(NULL, inPointList, npoly, nStep, + nbpoints = TkMakeBezierCurve(NULL, inPointList, npoly, nStep, NULL, outPointList); Tcl_Free((void *) inPointList); @@ -2869,7 +2866,6 @@ static int GdiFreeBrush( * Functions have removed reliance on X and Tk libraries, as well as removing * the need for TkWindows. * GdiGetColor is a copy of a TkpGetColor from tkWinColor.c - * GdiParseColor is a copy of XParseColor from xcolors.c */ typedef struct { const char *name; @@ -2906,756 +2902,6 @@ static const SystemColorEntry sysColors[] = { }; static int numsyscolors = 0; - -typedef struct { - const char *name; - unsigned char red; - unsigned char green; - unsigned char blue; -} XColorEntry; - -static const XColorEntry xColors[] = { - {"alice blue", 240, 248, 255}, - {"AliceBlue", 240, 248, 255}, - {"antique white", 250, 235, 215}, - {"AntiqueWhite", 250, 235, 215}, - {"AntiqueWhite1", 255, 239, 219}, - {"AntiqueWhite2", 238, 223, 204}, - {"AntiqueWhite3", 205, 192, 176}, - {"AntiqueWhite4", 139, 131, 120}, - {"aquamarine", 127, 255, 212}, - {"aquamarine1", 127, 255, 212}, - {"aquamarine2", 118, 238, 198}, - {"aquamarine3", 102, 205, 170}, - {"aquamarine4", 69, 139, 116}, - {"azure", 240, 255, 255}, - {"azure1", 240, 255, 255}, - {"azure2", 224, 238, 238}, - {"azure3", 193, 205, 205}, - {"azure4", 131, 139, 139}, - {"beige", 245, 245, 220}, - {"bisque", 255, 228, 196}, - {"bisque1", 255, 228, 196}, - {"bisque2", 238, 213, 183}, - {"bisque3", 205, 183, 158}, - {"bisque4", 139, 125, 107}, - {"black", 0, 0, 0}, - {"blanched almond", 255, 235, 205}, - {"BlanchedAlmond", 255, 235, 205}, - {"blue", 0, 0, 255}, - {"blue violet", 138, 43, 226}, - {"blue1", 0, 0, 255}, - {"blue2", 0, 0, 238}, - {"blue3", 0, 0, 205}, - {"blue4", 0, 0, 139}, - {"BlueViolet", 138, 43, 226}, - {"brown", 165, 42, 42}, - {"brown1", 255, 64, 64}, - {"brown2", 238, 59, 59}, - {"brown3", 205, 51, 51}, - {"brown4", 139, 35, 35}, - {"burlywood", 222, 184, 135}, - {"burlywood1", 255, 211, 155}, - {"burlywood2", 238, 197, 145}, - {"burlywood3", 205, 170, 125}, - {"burlywood4", 139, 115, 85}, - {"cadet blue", 95, 158, 160}, - {"CadetBlue", 95, 158, 160}, - {"CadetBlue1", 152, 245, 255}, - {"CadetBlue2", 142, 229, 238}, - {"CadetBlue3", 122, 197, 205}, - {"CadetBlue4", 83, 134, 139}, - {"chartreuse", 127, 255, 0}, - {"chartreuse1", 127, 255, 0}, - {"chartreuse2", 118, 238, 0}, - {"chartreuse3", 102, 205, 0}, - {"chartreuse4", 69, 139, 0}, - {"chocolate", 210, 105, 30}, - {"chocolate1", 255, 127, 36}, - {"chocolate2", 238, 118, 33}, - {"chocolate3", 205, 102, 29}, - {"chocolate4", 139, 69, 19}, - {"coral", 255, 127, 80}, - {"coral1", 255, 114, 86}, - {"coral2", 238, 106, 80}, - {"coral3", 205, 91, 69}, - {"coral4", 139, 62, 47}, - {"cornflower blue", 100, 149, 237}, - {"CornflowerBlue", 100, 149, 237}, - {"cornsilk", 255, 248, 220}, - {"cornsilk1", 255, 248, 220}, - {"cornsilk2", 238, 232, 205}, - {"cornsilk3", 205, 200, 177}, - {"cornsilk4", 139, 136, 120}, - {"cyan", 0, 255, 255}, - {"cyan1", 0, 255, 255}, - {"cyan2", 0, 238, 238}, - {"cyan3", 0, 205, 205}, - {"cyan4", 0, 139, 139}, - {"dark goldenrod", 184, 134, 11}, - {"dark green", 0, 100, 0}, - {"dark khaki", 189, 183, 107}, - {"dark olive green", 85, 107, 47}, - {"dark orange", 255, 140, 0}, - {"dark orchid", 153, 50, 204}, - {"dark salmon", 233, 150, 122}, - {"dark sea green", 143, 188, 143}, - {"dark slate blue", 72, 61, 139}, - {"dark slate gray", 47, 79, 79}, - {"dark slate grey", 47, 79, 79}, - {"dark turquoise", 0, 206, 209}, - {"dark violet", 148, 0, 211}, - {"DarkGoldenrod", 184, 134, 11}, - {"DarkGoldenrod1", 255, 185, 15}, - {"DarkGoldenrod2", 238, 173, 14}, - {"DarkGoldenrod3", 205, 149, 12}, - {"DarkGoldenrod4", 139, 101, 8}, - {"DarkGreen", 0, 100, 0}, - {"DarkKhaki", 189, 183, 107}, - {"DarkOliveGreen", 85, 107, 47}, - {"DarkOliveGreen1", 202, 255, 112}, - {"DarkOliveGreen2", 188, 238, 104}, - {"DarkOliveGreen3", 162, 205, 90}, - {"DarkOliveGreen4", 110, 139, 61}, - {"DarkOrange", 255, 140, 0}, - {"DarkOrange1", 255, 127, 0}, - {"DarkOrange2", 238, 118, 0}, - {"DarkOrange3", 205, 102, 0}, - {"DarkOrange4", 139, 69, 0}, - {"DarkOrchid", 153, 50, 204}, - {"DarkOrchid1", 191, 62, 255}, - {"DarkOrchid2", 178, 58, 238}, - {"DarkOrchid3", 154, 50, 205}, - {"DarkOrchid4", 104, 34, 139}, - {"DarkSalmon", 233, 150, 122}, - {"DarkSeaGreen", 143, 188, 143}, - {"DarkSeaGreen1", 193, 255, 193}, - {"DarkSeaGreen2", 180, 238, 180}, - {"DarkSeaGreen3", 155, 205, 155}, - {"DarkSeaGreen4", 105, 139, 105}, - {"DarkSlateBlue", 72, 61, 139}, - {"DarkSlateGray", 47, 79, 79}, - {"DarkSlateGray1", 151, 255, 255}, - {"DarkSlateGray2", 141, 238, 238}, - {"DarkSlateGray3", 121, 205, 205}, - {"DarkSlateGray4", 82, 139, 139}, - {"DarkSlateGrey", 47, 79, 79}, - {"DarkTurquoise", 0, 206, 209}, - {"DarkViolet", 148, 0, 211}, - {"deep pink", 255, 20, 147}, - {"deep sky blue", 0, 191, 255}, - {"DeepPink", 255, 20, 147}, - {"DeepPink1", 255, 20, 147}, - {"DeepPink2", 238, 18, 137}, - {"DeepPink3", 205, 16, 118}, - {"DeepPink4", 139, 10, 80}, - {"DeepSkyBlue", 0, 191, 255}, - {"DeepSkyBlue1", 0, 191, 255}, - {"DeepSkyBlue2", 0, 178, 238}, - {"DeepSkyBlue3", 0, 154, 205}, - {"DeepSkyBlue4", 0, 104, 139}, - {"dim gray", 105, 105, 105}, - {"dim grey", 105, 105, 105}, - {"DimGray", 105, 105, 105}, - {"DimGrey", 105, 105, 105}, - {"dodger blue", 30, 144, 255}, - {"DodgerBlue", 30, 144, 255}, - {"DodgerBlue1", 30, 144, 255}, - {"DodgerBlue2", 28, 134, 238}, - {"DodgerBlue3", 24, 116, 205}, - {"DodgerBlue4", 16, 78, 139}, - {"firebrick", 178, 34, 34}, - {"firebrick1", 255, 48, 48}, - {"firebrick2", 238, 44, 44}, - {"firebrick3", 205, 38, 38}, - {"firebrick4", 139, 26, 26}, - {"floral white", 255, 250, 240}, - {"FloralWhite", 255, 250, 240}, - {"forest green", 34, 139, 34}, - {"ForestGreen", 34, 139, 34}, - {"gainsboro", 220, 220, 220}, - {"ghost white", 248, 248, 255}, - {"GhostWhite", 248, 248, 255}, - {"gold", 255, 215, 0}, - {"gold1", 255, 215, 0}, - {"gold2", 238, 201, 0}, - {"gold3", 205, 173, 0}, - {"gold4", 139, 117, 0}, - {"goldenrod", 218, 165, 32}, - {"goldenrod1", 255, 193, 37}, - {"goldenrod2", 238, 180, 34}, - {"goldenrod3", 205, 155, 29}, - {"goldenrod4", 139, 105, 20}, - {"gray", 190, 190, 190}, - {"gray0", 0, 0, 0}, - {"gray1", 3, 3, 3}, - {"gray10", 26, 26, 26}, - {"gray100", 255, 255, 255}, - {"gray11", 28, 28, 28}, - {"gray12", 31, 31, 31}, - {"gray13", 33, 33, 33}, - {"gray14", 36, 36, 36}, - {"gray15", 38, 38, 38}, - {"gray16", 41, 41, 41}, - {"gray17", 43, 43, 43}, - {"gray18", 46, 46, 46}, - {"gray19", 48, 48, 48}, - {"gray2", 5, 5, 5}, - {"gray20", 51, 51, 51}, - {"gray21", 54, 54, 54}, - {"gray22", 56, 56, 56}, - {"gray23", 59, 59, 59}, - {"gray24", 61, 61, 61}, - {"gray25", 64, 64, 64}, - {"gray26", 66, 66, 66}, - {"gray27", 69, 69, 69}, - {"gray28", 71, 71, 71}, - {"gray29", 74, 74, 74}, - {"gray3", 8, 8, 8}, - {"gray30", 77, 77, 77}, - {"gray31", 79, 79, 79}, - {"gray32", 82, 82, 82}, - {"gray33", 84, 84, 84}, - {"gray34", 87, 87, 87}, - {"gray35", 89, 89, 89}, - {"gray36", 92, 92, 92}, - {"gray37", 94, 94, 94}, - {"gray38", 97, 97, 97}, - {"gray39", 99, 99, 99}, - {"gray4", 10, 10, 10}, - {"gray40", 102, 102, 102}, - {"gray41", 105, 105, 105}, - {"gray42", 107, 107, 107}, - {"gray43", 110, 110, 110}, - {"gray44", 112, 112, 112}, - {"gray45", 115, 115, 115}, - {"gray46", 117, 117, 117}, - {"gray47", 120, 120, 120}, - {"gray48", 122, 122, 122}, - {"gray49", 125, 125, 125}, - {"gray5", 13, 13, 13}, - {"gray50", 127, 127, 127}, - {"gray51", 130, 130, 130}, - {"gray52", 133, 133, 133}, - {"gray53", 135, 135, 135}, - {"gray54", 138, 138, 138}, - {"gray55", 140, 140, 140}, - {"gray56", 143, 143, 143}, - {"gray57", 145, 145, 145}, - {"gray58", 148, 148, 148}, - {"gray59", 150, 150, 150}, - {"gray6", 15, 15, 15}, - {"gray60", 153, 153, 153}, - {"gray61", 156, 156, 156}, - {"gray62", 158, 158, 158}, - {"gray63", 161, 161, 161}, - {"gray64", 163, 163, 163}, - {"gray65", 166, 166, 166}, - {"gray66", 168, 168, 168}, - {"gray67", 171, 171, 171}, - {"gray68", 173, 173, 173}, - {"gray69", 176, 176, 176}, - {"gray7", 18, 18, 18}, - {"gray70", 179, 179, 179}, - {"gray71", 181, 181, 181}, - {"gray72", 184, 184, 184}, - {"gray73", 186, 186, 186}, - {"gray74", 189, 189, 189}, - {"gray75", 191, 191, 191}, - {"gray76", 194, 194, 194}, - {"gray77", 196, 196, 196}, - {"gray78", 199, 199, 199}, - {"gray79", 201, 201, 201}, - {"gray8", 20, 20, 20}, - {"gray80", 204, 204, 204}, - {"gray81", 207, 207, 207}, - {"gray82", 209, 209, 209}, - {"gray83", 212, 212, 212}, - {"gray84", 214, 214, 214}, - {"gray85", 217, 217, 217}, - {"gray86", 219, 219, 219}, - {"gray87", 222, 222, 222}, - {"gray88", 224, 224, 224}, - {"gray89", 227, 227, 227}, - {"gray9", 23, 23, 23}, - {"gray90", 229, 229, 229}, - {"gray91", 232, 232, 232}, - {"gray92", 235, 235, 235}, - {"gray93", 237, 237, 237}, - {"gray94", 240, 240, 240}, - {"gray95", 242, 242, 242}, - {"gray96", 245, 245, 245}, - {"gray97", 247, 247, 247}, - {"gray98", 250, 250, 250}, - {"gray99", 252, 252, 252}, - {"green", 0, 255, 0}, - {"green yellow", 173, 255, 47}, - {"green1", 0, 255, 0}, - {"green2", 0, 238, 0}, - {"green3", 0, 205, 0}, - {"green4", 0, 139, 0}, - {"GreenYellow", 173, 255, 47}, - {"grey", 190, 190, 190}, - {"grey0", 0, 0, 0}, - {"grey1", 3, 3, 3}, - {"grey10", 26, 26, 26}, - {"grey100", 255, 255, 255}, - {"grey11", 28, 28, 28}, - {"grey12", 31, 31, 31}, - {"grey13", 33, 33, 33}, - {"grey14", 36, 36, 36}, - {"grey15", 38, 38, 38}, - {"grey16", 41, 41, 41}, - {"grey17", 43, 43, 43}, - {"grey18", 46, 46, 46}, - {"grey19", 48, 48, 48}, - {"grey2", 5, 5, 5}, - {"grey20", 51, 51, 51}, - {"grey21", 54, 54, 54}, - {"grey22", 56, 56, 56}, - {"grey23", 59, 59, 59}, - {"grey24", 61, 61, 61}, - {"grey25", 64, 64, 64}, - {"grey26", 66, 66, 66}, - {"grey27", 69, 69, 69}, - {"grey28", 71, 71, 71}, - {"grey29", 74, 74, 74}, - {"grey3", 8, 8, 8}, - {"grey30", 77, 77, 77}, - {"grey31", 79, 79, 79}, - {"grey32", 82, 82, 82}, - {"grey33", 84, 84, 84}, - {"grey34", 87, 87, 87}, - {"grey35", 89, 89, 89}, - {"grey36", 92, 92, 92}, - {"grey37", 94, 94, 94}, - {"grey38", 97, 97, 97}, - {"grey39", 99, 99, 99}, - {"grey4", 10, 10, 10}, - {"grey40", 102, 102, 102}, - {"grey41", 105, 105, 105}, - {"grey42", 107, 107, 107}, - {"grey43", 110, 110, 110}, - {"grey44", 112, 112, 112}, - {"grey45", 115, 115, 115}, - {"grey46", 117, 117, 117}, - {"grey47", 120, 120, 120}, - {"grey48", 122, 122, 122}, - {"grey49", 125, 125, 125}, - {"grey5", 13, 13, 13}, - {"grey50", 127, 127, 127}, - {"grey51", 130, 130, 130}, - {"grey52", 133, 133, 133}, - {"grey53", 135, 135, 135}, - {"grey54", 138, 138, 138}, - {"grey55", 140, 140, 140}, - {"grey56", 143, 143, 143}, - {"grey57", 145, 145, 145}, - {"grey58", 148, 148, 148}, - {"grey59", 150, 150, 150}, - {"grey6", 15, 15, 15}, - {"grey60", 153, 153, 153}, - {"grey61", 156, 156, 156}, - {"grey62", 158, 158, 158}, - {"grey63", 161, 161, 161}, - {"grey64", 163, 163, 163}, - {"grey65", 166, 166, 166}, - {"grey66", 168, 168, 168}, - {"grey67", 171, 171, 171}, - {"grey68", 173, 173, 173}, - {"grey69", 176, 176, 176}, - {"grey7", 18, 18, 18}, - {"grey70", 179, 179, 179}, - {"grey71", 181, 181, 181}, - {"grey72", 184, 184, 184}, - {"grey73", 186, 186, 186}, - {"grey74", 189, 189, 189}, - {"grey75", 191, 191, 191}, - {"grey76", 194, 194, 194}, - {"grey77", 196, 196, 196}, - {"grey78", 199, 199, 199}, - {"grey79", 201, 201, 201}, - {"grey8", 20, 20, 20}, - {"grey80", 204, 204, 204}, - {"grey81", 207, 207, 207}, - {"grey82", 209, 209, 209}, - {"grey83", 212, 212, 212}, - {"grey84", 214, 214, 214}, - {"grey85", 217, 217, 217}, - {"grey86", 219, 219, 219}, - {"grey87", 222, 222, 222}, - {"grey88", 224, 224, 224}, - {"grey89", 227, 227, 227}, - {"grey9", 23, 23, 23}, - {"grey90", 229, 229, 229}, - {"grey91", 232, 232, 232}, - {"grey92", 235, 235, 235}, - {"grey93", 237, 237, 237}, - {"grey94", 240, 240, 240}, - {"grey95", 242, 242, 242}, - {"grey96", 245, 245, 245}, - {"grey97", 247, 247, 247}, - {"grey98", 250, 250, 250}, - {"grey99", 252, 252, 252}, - {"honeydew", 240, 255, 240}, - {"honeydew1", 240, 255, 240}, - {"honeydew2", 224, 238, 224}, - {"honeydew3", 193, 205, 193}, - {"honeydew4", 131, 139, 131}, - {"hot pink", 255, 105, 180}, - {"HotPink", 255, 105, 180}, - {"HotPink1", 255, 110, 180}, - {"HotPink2", 238, 106, 167}, - {"HotPink3", 205, 96, 144}, - {"HotPink4", 139, 58, 98}, - {"indian red", 205, 92, 92}, - {"IndianRed", 205, 92, 92}, - {"IndianRed1", 255, 106, 106}, - {"IndianRed2", 238, 99, 99}, - {"IndianRed3", 205, 85, 85}, - {"IndianRed4", 139, 58, 58}, - {"ivory", 255, 255, 240}, - {"ivory1", 255, 255, 240}, - {"ivory2", 238, 238, 224}, - {"ivory3", 205, 205, 193}, - {"ivory4", 139, 139, 131}, - {"khaki", 240, 230, 140}, - {"khaki1", 255, 246, 143}, - {"khaki2", 238, 230, 133}, - {"khaki3", 205, 198, 115}, - {"khaki4", 139, 134, 78}, - {"lavender", 230, 230, 250}, - {"lavender blush", 255, 240, 245}, - {"LavenderBlush", 255, 240, 245}, - {"LavenderBlush1", 255, 240, 245}, - {"LavenderBlush2", 238, 224, 229}, - {"LavenderBlush3", 205, 193, 197}, - {"LavenderBlush4", 139, 131, 134}, - {"lawn green", 124, 252, 0}, - {"LawnGreen", 124, 252, 0}, - {"lemon chiffon", 255, 250, 205}, - {"LemonChiffon", 255, 250, 205}, - {"LemonChiffon1", 255, 250, 205}, - {"LemonChiffon2", 238, 233, 191}, - {"LemonChiffon3", 205, 201, 165}, - {"LemonChiffon4", 139, 137, 112}, - {"light blue", 173, 216, 230}, - {"light coral", 240, 128, 128}, - {"light cyan", 224, 255, 255}, - {"light goldenrod", 238, 221, 130}, - {"light goldenrod yellow", 250, 250, 210}, - {"light gray", 211, 211, 211}, - {"light grey", 211, 211, 211}, - {"light pink", 255, 182, 193}, - {"light salmon", 255, 160, 122}, - {"light sea green", 32, 178, 170}, - {"light sky blue", 135, 206, 250}, - {"light slate blue", 132, 112, 255}, - {"light slate gray", 119, 136, 153}, - {"light slate grey", 119, 136, 153}, - {"light steel blue", 176, 196, 222}, - {"light yellow", 255, 255, 224}, - {"LightBlue", 173, 216, 230}, - {"LightBlue1", 191, 239, 255}, - {"LightBlue2", 178, 223, 238}, - {"LightBlue3", 154, 192, 205}, - {"LightBlue4", 104, 131, 139}, - {"LightCoral", 240, 128, 128}, - {"LightCyan", 224, 255, 255}, - {"LightCyan1", 224, 255, 255}, - {"LightCyan2", 209, 238, 238}, - {"LightCyan3", 180, 205, 205}, - {"LightCyan4", 122, 139, 139}, - {"LightGoldenrod", 238, 221, 130}, - {"LightGoldenrod1", 255, 236, 139}, - {"LightGoldenrod2", 238, 220, 130}, - {"LightGoldenrod3", 205, 190, 112}, - {"LightGoldenrod4", 139, 129, 76}, - {"LightGoldenrodYellow", 250, 250, 210}, - {"LightGray", 211, 211, 211}, - {"LightGrey", 211, 211, 211}, - {"LightPink", 255, 182, 193}, - {"LightPink1", 255, 174, 185}, - {"LightPink2", 238, 162, 173}, - {"LightPink3", 205, 140, 149}, - {"LightPink4", 139, 95, 101}, - {"LightSalmon", 255, 160, 122}, - {"LightSalmon1", 255, 160, 122}, - {"LightSalmon2", 238, 149, 114}, - {"LightSalmon3", 205, 129, 98}, - {"LightSalmon4", 139, 87, 66}, - {"LightSeaGreen", 32, 178, 170}, - {"LightSkyBlue", 135, 206, 250}, - {"LightSkyBlue1", 176, 226, 255}, - {"LightSkyBlue2", 164, 211, 238}, - {"LightSkyBlue3", 141, 182, 205}, - {"LightSkyBlue4", 96, 123, 139}, - {"LightSlateBlue", 132, 112, 255}, - {"LightSlateGray", 119, 136, 153}, - {"LightSlateGrey", 119, 136, 153}, - {"LightSteelBlue", 176, 196, 222}, - {"LightSteelBlue1", 202, 225, 255}, - {"LightSteelBlue2", 188, 210, 238}, - {"LightSteelBlue3", 162, 181, 205}, - {"LightSteelBlue4", 110, 123, 139}, - {"LightYellow", 255, 255, 224}, - {"LightYellow1", 255, 255, 224}, - {"LightYellow2", 238, 238, 209}, - {"LightYellow3", 205, 205, 180}, - {"LightYellow4", 139, 139, 122}, - {"lime green", 50, 205, 50}, - {"LimeGreen", 50, 205, 50}, - {"linen", 250, 240, 230}, - {"magenta", 255, 0, 255}, - {"magenta1", 255, 0, 255}, - {"magenta2", 238, 0, 238}, - {"magenta3", 205, 0, 205}, - {"magenta4", 139, 0, 139}, - {"maroon", 176, 48, 96}, - {"maroon1", 255, 52, 179}, - {"maroon2", 238, 48, 167}, - {"maroon3", 205, 41, 144}, - {"maroon4", 139, 28, 98}, - {"medium aquamarine", 102, 205, 170}, - {"medium blue", 0, 0, 205}, - {"medium orchid", 186, 85, 211}, - {"medium purple", 147, 112, 219}, - {"medium sea green", 60, 179, 113}, - {"medium slate blue", 123, 104, 238}, - {"medium spring green", 0, 250, 154}, - {"medium turquoise", 72, 209, 204}, - {"medium violet red", 199, 21, 133}, - {"MediumAquamarine", 102, 205, 170}, - {"MediumBlue", 0, 0, 205}, - {"MediumOrchid", 186, 85, 211}, - {"MediumOrchid1", 224, 102, 255}, - {"MediumOrchid2", 209, 95, 238}, - {"MediumOrchid3", 180, 82, 205}, - {"MediumOrchid4", 122, 55, 139}, - {"MediumPurple", 147, 112, 219}, - {"MediumPurple1", 171, 130, 255}, - {"MediumPurple2", 159, 121, 238}, - {"MediumPurple3", 137, 104, 205}, - {"MediumPurple4", 93, 71, 139}, - {"MediumSeaGreen", 60, 179, 113}, - {"MediumSlateBlue", 123, 104, 238}, - {"MediumSpringGreen", 0, 250, 154}, - {"MediumTurquoise", 72, 209, 204}, - {"MediumVioletRed", 199, 21, 133}, - {"midnight blue", 25, 25, 112}, - {"MidnightBlue", 25, 25, 112}, - {"mint cream", 245, 255, 250}, - {"MintCream", 245, 255, 250}, - {"misty rose", 255, 228, 225}, - {"MistyRose", 255, 228, 225}, - {"MistyRose1", 255, 228, 225}, - {"MistyRose2", 238, 213, 210}, - {"MistyRose3", 205, 183, 181}, - {"MistyRose4", 139, 125, 123}, - {"moccasin", 255, 228, 181}, - {"navajo white", 255, 222, 173}, - {"NavajoWhite", 255, 222, 173}, - {"NavajoWhite1", 255, 222, 173}, - {"NavajoWhite2", 238, 207, 161}, - {"NavajoWhite3", 205, 179, 139}, - {"NavajoWhite4", 139, 121, 94}, - {"navy", 0, 0, 128}, - {"navy blue", 0, 0, 128}, - {"NavyBlue", 0, 0, 128}, - {"old lace", 253, 245, 230}, - {"OldLace", 253, 245, 230}, - {"olive drab", 107, 142, 35}, - {"OliveDrab", 107, 142, 35}, - {"OliveDrab1", 192, 255, 62}, - {"OliveDrab2", 179, 238, 58}, - {"OliveDrab3", 154, 205, 50}, - {"OliveDrab4", 105, 139, 34}, - {"orange", 255, 165, 0}, - {"orange red", 255, 69, 0}, - {"orange1", 255, 165, 0}, - {"orange2", 238, 154, 0}, - {"orange3", 205, 133, 0}, - {"orange4", 139, 90, 0}, - {"OrangeRed", 255, 69, 0}, - {"OrangeRed1", 255, 69, 0}, - {"OrangeRed2", 238, 64, 0}, - {"OrangeRed3", 205, 55, 0}, - {"OrangeRed4", 139, 37, 0}, - {"orchid", 218, 112, 214}, - {"orchid1", 255, 131, 250}, - {"orchid2", 238, 122, 233}, - {"orchid3", 205, 105, 201}, - {"orchid4", 139, 71, 137}, - {"pale goldenrod", 238, 232, 170}, - {"pale green", 152, 251, 152}, - {"pale turquoise", 175, 238, 238}, - {"pale violet red", 219, 112, 147}, - {"PaleGoldenrod", 238, 232, 170}, - {"PaleGreen", 152, 251, 152}, - {"PaleGreen1", 154, 255, 154}, - {"PaleGreen2", 144, 238, 144}, - {"PaleGreen3", 124, 205, 124}, - {"PaleGreen4", 84, 139, 84}, - {"PaleTurquoise", 175, 238, 238}, - {"PaleTurquoise1", 187, 255, 255}, - {"PaleTurquoise2", 174, 238, 238}, - {"PaleTurquoise3", 150, 205, 205}, - {"PaleTurquoise4", 102, 139, 139}, - {"PaleVioletRed", 219, 112, 147}, - {"PaleVioletRed1", 255, 130, 171}, - {"PaleVioletRed2", 238, 121, 159}, - {"PaleVioletRed3", 205, 104, 137}, - {"PaleVioletRed4", 139, 71, 93}, - {"papaya whip", 255, 239, 213}, - {"PapayaWhip", 255, 239, 213}, - {"peach puff", 255, 218, 185}, - {"PeachPuff", 255, 218, 185}, - {"PeachPuff1", 255, 218, 185}, - {"PeachPuff2", 238, 203, 173}, - {"PeachPuff3", 205, 175, 149}, - {"PeachPuff4", 139, 119, 101}, - {"peru", 205, 133, 63}, - {"pink", 255, 192, 203}, - {"pink1", 255, 181, 197}, - {"pink2", 238, 169, 184}, - {"pink3", 205, 145, 158}, - {"pink4", 139, 99, 108}, - {"plum", 221, 160, 221}, - {"plum1", 255, 187, 255}, - {"plum2", 238, 174, 238}, - {"plum3", 205, 150, 205}, - {"plum4", 139, 102, 139}, - {"powder blue", 176, 224, 230}, - {"PowderBlue", 176, 224, 230}, - {"purple", 160, 32, 240}, - {"purple1", 155, 48, 255}, - {"purple2", 145, 44, 238}, - {"purple3", 125, 38, 205}, - {"purple4", 85, 26, 139}, - {"red", 255, 0, 0}, - {"red1", 255, 0, 0}, - {"red2", 238, 0, 0}, - {"red3", 205, 0, 0}, - {"red4", 139, 0, 0}, - {"rosy brown", 188, 143, 143}, - {"RosyBrown", 188, 143, 143}, - {"RosyBrown1", 255, 193, 193}, - {"RosyBrown2", 238, 180, 180}, - {"RosyBrown3", 205, 155, 155}, - {"RosyBrown4", 139, 105, 105}, - {"royal blue", 65, 105, 225}, - {"RoyalBlue", 65, 105, 225}, - {"RoyalBlue1", 72, 118, 255}, - {"RoyalBlue2", 67, 110, 238}, - {"RoyalBlue3", 58, 95, 205}, - {"RoyalBlue4", 39, 64, 139}, - {"saddle brown", 139, 69, 19}, - {"SaddleBrown", 139, 69, 19}, - {"salmon", 250, 128, 114}, - {"salmon1", 255, 140, 105}, - {"salmon2", 238, 130, 98}, - {"salmon3", 205, 112, 84}, - {"salmon4", 139, 76, 57}, - {"sandy brown", 244, 164, 96}, - {"SandyBrown", 244, 164, 96}, - {"sea green", 46, 139, 87}, - {"SeaGreen", 46, 139, 87}, - {"SeaGreen1", 84, 255, 159}, - {"SeaGreen2", 78, 238, 148}, - {"SeaGreen3", 67, 205, 128}, - {"SeaGreen4", 46, 139, 87}, - {"seashell", 255, 245, 238}, - {"seashell1", 255, 245, 238}, - {"seashell2", 238, 229, 222}, - {"seashell3", 205, 197, 191}, - {"seashell4", 139, 134, 130}, - {"sienna", 160, 82, 45}, - {"sienna1", 255, 130, 71}, - {"sienna2", 238, 121, 66}, - {"sienna3", 205, 104, 57}, - {"sienna4", 139, 71, 38}, - {"sky blue", 135, 206, 235}, - {"SkyBlue", 135, 206, 235}, - {"SkyBlue1", 135, 206, 255}, - {"SkyBlue2", 126, 192, 238}, - {"SkyBlue3", 108, 166, 205}, - {"SkyBlue4", 74, 112, 139}, - {"slate blue", 106, 90, 205}, - {"slate gray", 112, 128, 144}, - {"slate grey", 112, 128, 144}, - {"SlateBlue", 106, 90, 205}, - {"SlateBlue1", 131, 111, 255}, - {"SlateBlue2", 122, 103, 238}, - {"SlateBlue3", 105, 89, 205}, - {"SlateBlue4", 71, 60, 139}, - {"SlateGray", 112, 128, 144}, - {"SlateGray1", 198, 226, 255}, - {"SlateGray2", 185, 211, 238}, - {"SlateGray3", 159, 182, 205}, - {"SlateGray4", 108, 123, 139}, - {"SlateGrey", 112, 128, 144}, - {"snow", 255, 250, 250}, - {"snow1", 255, 250, 250}, - {"snow2", 238, 233, 233}, - {"snow3", 205, 201, 201}, - {"snow4", 139, 137, 137}, - {"spring green", 0, 255, 127}, - {"SpringGreen", 0, 255, 127}, - {"SpringGreen1", 0, 255, 127}, - {"SpringGreen2", 0, 238, 118}, - {"SpringGreen3", 0, 205, 102}, - {"SpringGreen4", 0, 139, 69}, - {"steel blue", 70, 130, 180}, - {"SteelBlue", 70, 130, 180}, - {"SteelBlue1", 99, 184, 255}, - {"SteelBlue2", 92, 172, 238}, - {"SteelBlue3", 79, 148, 205}, - {"SteelBlue4", 54, 100, 139}, - {"tan", 210, 180, 140}, - {"tan1", 255, 165, 79}, - {"tan2", 238, 154, 73}, - {"tan3", 205, 133, 63}, - {"tan4", 139, 90, 43}, - {"thistle", 216, 191, 216}, - {"thistle1", 255, 225, 255}, - {"thistle2", 238, 210, 238}, - {"thistle3", 205, 181, 205}, - {"thistle4", 139, 123, 139}, - {"tomato", 255, 99, 71}, - {"tomato1", 255, 99, 71}, - {"tomato2", 238, 92, 66}, - {"tomato3", 205, 79, 57}, - {"tomato4", 139, 54, 38}, - {"turquoise", 64, 224, 208}, - {"turquoise1", 0, 245, 255}, - {"turquoise2", 0, 229, 238}, - {"turquoise3", 0, 197, 205}, - {"turquoise4", 0, 134, 139}, - {"violet", 238, 130, 238}, - {"violet red", 208, 32, 144}, - {"VioletRed", 208, 32, 144}, - {"VioletRed1", 255, 62, 150}, - {"VioletRed2", 238, 58, 140}, - {"VioletRed3", 205, 50, 120}, - {"VioletRed4", 139, 34, 82}, - {"wheat", 245, 222, 179}, - {"wheat1", 255, 231, 186}, - {"wheat2", 238, 216, 174}, - {"wheat3", 205, 186, 150}, - {"wheat4", 139, 126, 102}, - {"white", 255, 255, 255}, - {"white smoke", 245, 245, 245}, - {"WhiteSmoke", 245, 245, 245}, - {"yellow", 255, 255, 0}, - {"yellow green", 154, 205, 50}, - {"yellow1", 255, 255, 0}, - {"yellow2", 238, 238, 0}, - {"yellow3", 205, 205, 0}, - {"yellow4", 139, 139, 0}, - {"YellowGreen", 154, 205, 50}, -}; - -static int numxcolors = 0; /* *---------------------------------------------------------------------- @@ -3672,7 +2918,7 @@ static int numxcolors = 0; static int GdiGetColor( const char *name, - unsigned long *color) + COLORREF *color) { if (numsyscolors == 0) { numsyscolors = sizeof(sysColors) / sizeof(SystemColorEntry); @@ -3699,89 +2945,12 @@ static int GdiGetColor( *color = GetSysColor(sysColors[i].index); return 1; } else { - return GdiParseColor(name, color); - } -} - -/* - *---------------------------------------------------------------------- - * - * GdiParseColor -- - * - * Convert color specification string (which could be an RGB string) - * to a color RGB triple. - * - * Results: - * Color specification converted. - * - *---------------------------------------------------------------------- - */ - -static int GdiParseColor( - const char *name, - unsigned long *color) -{ - /* TODO: replace with XParseColor, used by rest of Tk */ - if (name[0] == '#') { - char fmt[40]; - int i; - unsigned red, green, blue; - - if ((i = strlen(name+1))%3 != 0 || i > 12 || i < 3) { - return 0; - } - i /= 3; - sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i); - if (sscanf(name+1, fmt, &red, &green, &blue) != 3) { - return 0; - } - /* Now this is Windows-specific -- each component is at most 8 bits. */ - switch (i) { - case 1: - red <<= 4; - green <<= 4; - blue <<= 4; - break; - case 2: - break; - case 3: - red >>= 4; - green >>= 4; - blue >>= 4; - break; - case 4: - red >>= 8; - green >>= 8; - blue >>= 8; - break; - } - *color = RGB(red, green, blue); - return 1; - } else { - int i, u, r, l; - - if (numxcolors == 0) { - numxcolors = sizeof(xColors) / sizeof(XColorEntry); - } - l = 0; - u = numxcolors; - - while (l <= u) { - i = (l + u) / 2; - if ((r = _strcmpi(name, xColors[i].name)) == 0) { - break; - } - if (r < 0) { - u = i - 1; - } else { - l = i + 1; - } - } - if (l > u) { - return 0; - } - *color = RGB(xColors[i].red, xColors[i].green, xColors[i].blue); - return 1; + int result; + XColor xcolor; + result = XParseColor(NULL, 0, name, &xcolor); + *color = ((xcolor.red & 0xFF00)>>8) | (xcolor.green & 0xFF00) + | ((xcolor.blue & 0xFF00)<<8); + return result; } } @@ -4401,277 +3570,6 @@ int Winprint_Init( return TCL_OK; } -/* - * The following functions are adapted from tkTrig.c. - */ - -/* - *-------------------------------------------------------------- - * - * TkGdiBezierScreenPoints -- - * - * Given four control points, create a larger set of XPoints for a Bezier - * spline based on the points. - * - * Results: - * The array at *xPointPtr gets filled in with numSteps XPoints - * corresponding to the Bezier spline defined by the four control points. - * - * Note: no output point is generated for the first input point, but an - * output point *is* generated for the last input point. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ - -static void -TkGdiBezierScreenPoints( - Tk_Canvas canvas, /* Canvas in which curve is to be drawn.. */ - double control[], /* Array of coordinates for four control - * points: x0, y0, x1, y1, ... x3 y3.. */ - int numSteps, /* Number of curve points to generate. */ - register XPoint *xPointPtr) /* Where to put new points.. */ -{ - int i; - double u, u2, u3, t, t2, t3; - - for (i = 1; i <= numSteps; i++, xPointPtr++) { - t = ((double) i)/((double) numSteps); - t2 = t*t; - t3 = t2*t; - u = 1.0 - t; - u2 = u*u; - u3 = u2*u; - Tk_CanvasDrawableCoords(canvas, - (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) - + control[6]*t3), - (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) - + control[7]*t3), - &xPointPtr->x, &xPointPtr->y); - } -} - -/* - *-------------------------------------------------------------- - * - * TkGdiBezierPoints -- - * - * Given four control points, create a larger set of points for a Bezier - * spline based on the points. - * - * Results: - * The array at *coordPtr gets filled in with 2*numSteps coordinates, - * which correspond to the Bezier spline defined by the four control - * points. - * - * Note: no output point is generated for the first input point, but an - * output point *is* generated for the last input point. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ - -static void -TkGdiBezierPoints( - double control[], /* Array of coordinates for four control - * points: x0, y0, x1, y1, ... x3 y3.. */ - int numSteps, /* Number of curve points to generate. */ - register double *coordPtr) /* Where to put new points.. */ -{ - int i; - double u, u2, u3, t, t2, t3; - - for (i = 1; i <= numSteps; i++, coordPtr += 2) { - t = ((double) i)/((double) numSteps); - t2 = t*t; - t3 = t2*t; - u = 1.0 - t; - u2 = u*u; - u3 = u2*u; - coordPtr[0] = control[0]*u3 - + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; - coordPtr[1] = control[1]*u3 - + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; - } -} - -/* - *-------------------------------------------------------------- - * - * TkGdiMakeBezierCurve -- - * - * Given a set of points, create a new set of points that fit parabolic - * splines to the line segments connecting the original points. Produces - * output points in either of two forms. - * - * Note: in spite of this procedure's name, it does *not* generate Bezier - * curves. Since only three control points are used for each curve - * segment, not four, the curves are actually just parabolic. - * - * Results: - * - * Either or both of the xPoints or dblPoints arrays are filled in. The - * return value is the number of points placed in the arrays. - * - * Note: if the first and last points are the same, then a closed curve - * is generated. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ -static int -TkGdiMakeBezierCurve( - Tk_Canvas canvas, /* Canvas in which curve is to be drawn.*/ - double *pointPtr, /* Array of input coordinates: - * x0, y0, x1, y1, etc... */ - int numPoints, /* Number of points at pointPtr.. */ - int numSteps, /* Number of steps to use for each spline - * segments. */ - XPoint xPoints[], /* Array of XPoints to fill in. */ - double dblPoints[]) /* Array of points to fill in as doubles, in - * the form x0, y0, x1, y1. */ - -{ - int closed, outputPoints, i; - int numCoords = numPoints*2; - double control[8]; - - /* - * If the curve is a closed one then generate a special spline that spans - * the last points and the first ones. Otherwise just put the first point - * into the output. - */ - - if (!pointPtr) { - /* - * Of pointPtr == NULL, this function returns an upper limit of the - * array size to store the coordinates. This can be used to allocate - * storage, before the actual coordinates are calculated. - */ - return 1 + numPoints * numSteps; - } - - outputPoints = 0; - if ((pointPtr[0] == pointPtr[numCoords-2]) - && (pointPtr[1] == pointPtr[numCoords-1])) { - closed = 1; - control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0]; - control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1]; - control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0]; - control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1]; - control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2]; - control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3]; - control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; - control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; - if (xPoints != NULL) { - Tk_CanvasDrawableCoords(canvas, control[0], control[1], - &xPoints->x, &xPoints->y); - TkGdiBezierScreenPoints(canvas, control, numSteps, xPoints+1); - xPoints += numSteps+1; - } - if (dblPoints != NULL) { - dblPoints[0] = control[0]; - dblPoints[1] = control[1]; - TkGdiBezierPoints(control, numSteps, dblPoints+2); - dblPoints += 2*(numSteps+1); - } - outputPoints += numSteps+1; - } else { - closed = 0; - if (xPoints != NULL) { - Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1], - &xPoints->x, &xPoints->y); - xPoints += 1; - } - if (dblPoints != NULL) { - dblPoints[0] = pointPtr[0]; - dblPoints[1] = pointPtr[1]; - dblPoints += 2; - } - outputPoints += 1; - } - - for (i = 2; i < numPoints; i++, pointPtr += 2) { - /* - * Set up the first two control points. This is done differently for - * the first spline of an open curve than for other cases. - */ - - if ((i == 2) && !closed) { - control[0] = pointPtr[0]; - control[1] = pointPtr[1]; - control[2] = 0.333*pointPtr[0] + 0.667*pointPtr[2]; - control[3] = 0.333*pointPtr[1] + 0.667*pointPtr[3]; - } else { - control[0] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; - control[1] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; - control[2] = 0.167*pointPtr[0] + 0.833*pointPtr[2]; - control[3] = 0.167*pointPtr[1] + 0.833*pointPtr[3]; - } - - /* - * Set up the last two control points. This is done differently for - * the last spline of an open curve than for other cases. - */ - - if ((i == (numPoints-1)) && !closed) { - control[4] = .667*pointPtr[2] + .333*pointPtr[4]; - control[5] = .667*pointPtr[3] + .333*pointPtr[5]; - control[6] = pointPtr[4]; - control[7] = pointPtr[5]; - } else { - control[4] = .833*pointPtr[2] + .167*pointPtr[4]; - control[5] = .833*pointPtr[3] + .167*pointPtr[5]; - control[6] = 0.5*pointPtr[2] + 0.5*pointPtr[4]; - control[7] = 0.5*pointPtr[3] + 0.5*pointPtr[5]; - } - - /* - * If the first two points coincide, or if the last two points - * coincide, then generate a single straight-line segment by - * outputting the last control point. - */ - - if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3])) - || ((pointPtr[2] == pointPtr[4]) - && (pointPtr[3] == pointPtr[5]))) { - if (xPoints != NULL) { - Tk_CanvasDrawableCoords(canvas, control[6], control[7], - &xPoints[0].x, &xPoints[0].y); - xPoints++; - } - if (dblPoints != NULL) { - dblPoints[0] = control[6]; - dblPoints[1] = control[7]; - dblPoints += 2; - } - outputPoints += 1; - continue; - } - - /* - * Generate a Bezier spline using the control points. - */ - - if (xPoints != NULL) { - TkGdiBezierScreenPoints(canvas, control, numSteps, xPoints); - xPoints += numSteps; - } - if (dblPoints != NULL) { - TkGdiBezierPoints(control, numSteps, dblPoints); - dblPoints += 2*numSteps; - } - outputPoints += numSteps; - } - return outputPoints; -} - /* Print API functions. */ /*---------------------------------------------------------------------- -- cgit v0.12 From cef404441f9f60077c955c965037f758b97bead6 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 8 Sep 2021 05:49:45 +0000 Subject: Add more codepaths checks in wm.test for wm iconbadge. --- tests/wm.test | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/wm.test b/tests/wm.test index deb1eb8..73dcbbf 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -861,6 +861,8 @@ test wm-iconbadge-1.8 {usage, no need to call iconphoto on aqua or win32} -const aquaOrWin32 } -body { wm iconbadge . 3 + wm iconbadge . 5000 + wm iconbadge . ! wm iconbadge . "" } -result {} -- cgit v0.12 From a3561e3753f30dbcd0ef5db6dcc61146219fc513 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 12 Sep 2021 18:52:08 +0000 Subject: Add new test textIndex-19.14 for [934cab5005]. This test does not fail with the legacy text widget but fails with revised_text. --- tests/textIndex.test | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/textIndex.test b/tests/textIndex.test index 31ae495..44b4184 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -834,6 +834,18 @@ test textIndex-19.13 {Display lines} { destroy .txt .sbar } {} +test textIndex-19.14 {Display lines with elided lines} { + catch {destroy .t} + pack [text .t] + for {set n 1} {$n <= 1000} {incr n} { + .t insert end "Line $n\n" + } + .t tag configure Elided -elide 1 + .t tag add Elided 6.0 951.0 + update + set res [.t index "951.0 + 1 displaylines"] +} {952.0} + proc text_test_word {startend chars start} { destroy .t text .t -- cgit v0.12 From d9112839a88e25fdc849732b331ef56da48e192b Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 14 Sep 2021 19:42:25 +0000 Subject: Fix [489b69a820]: Slightly wrong error message on 'wm attributes $w -junk' --- tests/winWm.test | 3 +-- tests/wm.test | 8 ++------ win/tkWinWm.c | 9 ++++++--- 3 files changed, 9 insertions(+), 11 deletions(-) diff --git a/tests/winWm.test b/tests/winWm.test index e19fcf2..030d11a 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -279,12 +279,11 @@ test winWm-6.2 {wm attributes} -constraints win -setup { test winWm-6.3 {wm attributes} -constraints win -setup { destroy .t } -body { - # This isn't quite the correct error message yet, but it works. toplevel .t wm attributes .t -foo } -cleanup { destroy .t -} -returnCodes error -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} +} -returnCodes error -result {bad attribute "-foo": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} test winWm-6.4 {wm attributes -alpha} -constraints win -setup { destroy .t diff --git a/tests/wm.test b/tests/wm.test index 7959302..52a2422 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -128,18 +128,14 @@ test wm-attributes-1.1 {usage} -returnCodes error -body { wm attributes } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-attributes-1.2.1 {usage} -constraints win -returnCodes error -body { - # This is the wrong error to output - unix has it right, but it's - # not critical. wm attributes . _ -} -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} +} -result {bad attribute "_": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} test wm-attributes-1.2.2 {usage} -constraints win -returnCodes error -body { wm attributes . -alpha 1.0 -disabled } -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} test wm-attributes-1.2.3 {usage} -constraints win -returnCodes error -body { - # This is the wrong error to output - unix has it right, but it's - # not critical. wm attributes . -to -} -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} +} -result {bad attribute "-to": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} test wm-attributes-1.2.4 {usage} -constraints {unix notAqua} -returnCodes error -body { wm attributes . _ } -result {bad attribute "_": must be -alpha, -topmost, -zoomed, -fullscreen, or -type} diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 414df3e..d2602f7 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3072,9 +3072,6 @@ WmAttributesCmd( } for (i = 3; i < objc; i += 2) { string = Tcl_GetStringFromObj(objv[i], &length); - if ((length < 2) || (string[0] != '-')) { - goto configArgs; - } if (strncmp(string, "-disabled", length) == 0) { stylePtr = &style; styleBit = WS_DISABLED; @@ -3107,6 +3104,12 @@ WmAttributesCmd( Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "TOPMOST", NULL); return TCL_ERROR; } + } else if (i == 3) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad attribute \"%s\": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost", + string)); + Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "UNRECOGNIZED", NULL); + return TCL_ERROR; } else { goto configArgs; } -- cgit v0.12 From 386ce84f14735c90a4fea74e185126dcd7acd93b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Sep 2021 08:05:09 +0000 Subject: Sort options alphabetical --- tests/unixWm.test | 2 +- tests/winWm.test | 2 +- tests/wm.test | 6 +++--- unix/tkUnixWm.c | 8 ++++---- win/tkWinWm.c | 2 +- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/tests/unixWm.test b/tests/unixWm.test index d54bc69..5d331b8 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -2504,7 +2504,7 @@ if {[tk windowingsystem] == "aqua"} { -titlepath {} -topmost 0 -transparent 0\ -type unsupported} } else { - set result_60_1 {-alpha 1.0 -topmost 0 -zoomed 0 -fullscreen 0 -type {}} + set result_60_1 {-alpha 1.0 -fullscreen 0 -topmost 0 -type {} -zoomed 0} } test unixWm-60.1 {wm attributes - test} -constraints unix -body { destroy .t diff --git a/tests/winWm.test b/tests/winWm.test index 1e2c02e..35775a2 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -284,7 +284,7 @@ test winWm-6.3 {wm attributes} -constraints win -setup { wm attributes .t -foo } -cleanup { destroy .t -} -returnCodes error -result {bad attribute "-foo": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} +} -returnCodes error -result {bad attribute "-foo": must be -alpha, -disabled, -fullscreen, -toolwindow, -topmost, or -transparentcolor} test winWm-6.4 {wm attributes -alpha} -constraints win -setup { destroy .t diff --git a/tests/wm.test b/tests/wm.test index dd198b8..155f5b7 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -129,16 +129,16 @@ test wm-attributes-1.1 {usage} -returnCodes error -body { } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-attributes-1.2.1 {usage} -constraints win -returnCodes error -body { wm attributes . _ -} -result {bad attribute "_": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} +} -result {bad attribute "_": must be -alpha, -disabled, -fullscreen, -toolwindow, -topmost, or -transparentcolor} test wm-attributes-1.2.2 {usage} -constraints win -returnCodes error -body { wm attributes . -alpha 1.0 -disabled } -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} test wm-attributes-1.2.3 {usage} -constraints win -returnCodes error -body { wm attributes . -to -} -result {bad attribute "-to": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} +} -result {bad attribute "-to": must be -alpha, -disabled, -fullscreen, -toolwindow, -topmost, or -transparentcolor} test wm-attributes-1.2.4 {usage} -constraints {unix notAqua} -returnCodes error -body { wm attributes . _ -} -result {bad attribute "_": must be -alpha, -topmost, -zoomed, -fullscreen, or -type} +} -result {bad attribute "_": must be -alpha, -fullscreen, -topmost, -type, or -zoomed} test wm-attributes-1.2.5 {usage} -constraints aqua -returnCodes error -body { wm attributes . _ } -result {bad attribute "_": must be -alpha, -fullscreen, -modified, -notify, -titlepath, -topmost, -transparent, or -type} diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 7ef3667..7373e49 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -50,13 +50,13 @@ typedef struct { } WmAttributes; typedef enum { - WMATT_ALPHA, WMATT_TOPMOST, WMATT_ZOOMED, WMATT_FULLSCREEN, - WMATT_TYPE, _WMATT_LAST_ATTRIBUTE + WMATT_ALPHA, WMATT_FULLSCREEN, WMATT_TOPMOST, WMATT_TYPE, + WMATT_ZOOMED, _WMATT_LAST_ATTRIBUTE } WmAttribute; static const char *const WmAttributeNames[] = { - "-alpha", "-topmost", "-zoomed", "-fullscreen", - "-type", NULL + "-alpha", "-fullscreen", "-topmost", "-type", + "-zoomed", NULL }; /* diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 28f4838..5ffce84 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -2946,7 +2946,7 @@ WmAttributesCmd( } } else if (i == 3) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad attribute \"%s\": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost", + "bad attribute \"%s\": must be -alpha, -disabled, -fullscreen, -toolwindow, -topmost, or -transparentcolor", string)); Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "UNRECOGNIZED", NULL); return TCL_ERROR; -- cgit v0.12 From f8ca82ac5b16009ef945379f1f3ac64544c2590b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Sep 2021 12:29:39 +0000 Subject: Fix crash, seen on Cygwin: Tcl_Time still has 32-bit fields on Windows, this leads to a crash with gcc-11+ when loading win32 Tk in Cygwin Tcl. --- generic/tkBind.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/generic/tkBind.c b/generic/tkBind.c index da52c61..ba16aa3 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -792,9 +792,12 @@ GetButtonNumber( static Time CurrentTimeInMilliSecs(void) { - Tcl_Time now; - Tcl_GetTime(&now); - return ((Time) now.sec)*1000 + ((Time) now.usec)/1000; + struct { + Tcl_Time now; + Tcl_Time dummy; /* Spare, in case Tcl_Time has 32-bit fields */ + } t; + Tcl_GetTime(&t.now); + return ((Time) t.now.sec)*1000 + ((Time) t.now.usec)/1000; } static Info -- cgit v0.12 From 3b5560d0e3e51e8b8a862ebbde29d365a7c69d96 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 20 Sep 2021 20:35:14 +0000 Subject: Fix [0338867c74]: Windows text widget hang Phaistos font installed --- win/tkWinFont.c | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/win/tkWinFont.c b/win/tkWinFont.c index 5eed32c..c24cd5f 100644 --- a/win/tkWinFont.c +++ b/win/tkWinFont.c @@ -2748,7 +2748,7 @@ LoadFontRanges( * range information. */ int *symbolPtr) { - int n, i, swapped, offset, cbData, segCount; + int n, i, j, k, swapped, offset, cbData, segCount; DWORD cmapKey; USHORT *startCount, *endCount; CMAPTABLE cmapTable; @@ -2824,9 +2824,9 @@ LoadFontRanges( offset += cbData + sizeof(USHORT); GetFontData(hdc, cmapKey, (DWORD) offset, startCount, cbData); if (swapped) { - for (i = 0; i < segCount; i++) { - SwapShort(&endCount[i]); - SwapShort(&startCount[i]); + for (j = 0; j < segCount; j++) { + SwapShort(&endCount[j]); + SwapShort(&startCount[j]); } } if (*symbolPtr != 0) { @@ -2842,11 +2842,11 @@ LoadFontRanges( * 8-bit characters [note Bug: 2406] */ - for (i = 0; i < segCount; i++) { - if (((startCount[i] & 0xff00) == 0xf000) - && ((endCount[i] & 0xff00) == 0xf000)) { - startCount[i] &= 0xff; - endCount[i] &= 0xff; + for (k = 0; k < segCount; k++) { + if (((startCount[k] & 0xff00) == 0xf000) + && ((endCount[k] & 0xff00) == 0xf000)) { + startCount[k] &= 0xff; + endCount[k] &= 0xff; } } } -- cgit v0.12 From 1a857a4b46eea001e583cf67b5be4a22beefaa45 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Sep 2021 09:16:35 +0000 Subject: Fully handle 64-bit sec/usec values when Win64 Tk is loaded in Cygwin64 Tclsh --- generic/tkBind.c | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/generic/tkBind.c b/generic/tkBind.c index e8f15c9..b338918 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -817,11 +817,21 @@ GetButtonNumber( static Time CurrentTimeInMilliSecs(void) { - struct { + union { Tcl_Time now; - Tcl_Time dummy; /* Spare, in case Tcl_Time has 32-bit fields */ + struct { + long long sec; /* reserve stack space enough for 64-bit fields */ + long long usec; + } lnow; } t; + t.lnow.usec = -1; /* Invalid usec value, so we can see if Tcl_GetTime overwrites it */ Tcl_GetTime(&t.now); +#ifdef __WIN64 + if (t.lnow.usec != -1) { + /* Win64 Tk loaded in Cygwin-64: Tcl_GetTime() returns 64-bit fields */ + return ((Time) t.lnow.sec)*1000 + ((Time) t.lnow.usec)/1000; + } +#endif return ((Time) t.now.sec)*1000 + ((Time) t.now.usec)/1000; } -- cgit v0.12 From 11f08c7158cf4b8acf2b6aacec7d489a604ae9d0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Sep 2021 09:33:50 +0000 Subject: __WIN64 -> _WIN64 (since that's the official documented macro which should always exist on Win64) --- win/tkWin32Dll.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tkWin32Dll.c b/win/tkWin32Dll.c index 8cfddee..802b1f3 100644 --- a/win/tkWin32Dll.c +++ b/win/tkWin32Dll.c @@ -119,11 +119,11 @@ DllMain( case DLL_PROCESS_DETACH: /* * Protect the call to TkFinalize in an SEH block. We can't be - * guarenteed Tk is always being unloaded from a stable condition. + * guaranteed Tk is always being unloaded from a stable condition. */ #ifdef HAVE_NO_SEH -# ifdef __WIN64 +# ifdef _WIN64 __asm__ __volatile__ ( /* -- cgit v0.12 From aafb5a30deccbfbc11e495c6ef9580225ce10a45 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Sep 2021 11:58:12 +0000 Subject: Fully handle 64-bit sec/usec values when Win64 Tk is loaded in Cygwin64 Tclsh --- generic/tkBind.c | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/generic/tkBind.c b/generic/tkBind.c index ba16aa3..e4e2b99 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -792,11 +792,21 @@ GetButtonNumber( static Time CurrentTimeInMilliSecs(void) { - struct { + union { Tcl_Time now; - Tcl_Time dummy; /* Spare, in case Tcl_Time has 32-bit fields */ + struct { + Tcl_WideInt sec; /* reserve stack space enough for 64-bit fields */ + Tcl_WideInt usec; + } lnow; } t; + t.lnow.usec = -1; /* Invalid usec value, so we can see if Tcl_GetTime overwrites it */ Tcl_GetTime(&t.now); +#ifdef _WIN64 + if (t.lnow.usec != -1) { + /* Win64 Tk loaded in Cygwin-64: Tcl_GetTime() returns 64-bit fields */ + return ((Time) t.lnow.sec)*1000 + ((Time) t.lnow.usec)/1000; + } +#endif return ((Time) t.now.sec)*1000 + ((Time) t.now.usec)/1000; } @@ -949,6 +959,7 @@ FreePatSeqEntry( PSEntry *entry) { PSEntry *next = PSList_Next(entry); + PSModMaskArr_Free(&entry->lastModMaskArr); ckfree(entry); return next; @@ -1624,7 +1635,7 @@ Tk_CreateBinding( ClientData object, /* Token for object with which binding is associated. */ const char *eventString, /* String describing event sequence that triggers binding. */ const char *script, /* Contains Tcl script to execute when binding triggers. */ - int append) /* 0 means replace any existing binding for eventString; + int append) /* 0 means replace any existing binding for eventString; * 1 means append to that binding. If the existing binding is * for a callback function and not a Tcl command string, the * existing binding will always be replaced. */ @@ -4613,7 +4624,7 @@ FindSequence( * associated. For virtual event table, NULL. */ const char *eventString, /* String description of pattern to match on. See user * documentation for details. */ - int create, /* 0 means don't create the entry if it doesn't already exist. + int create, /* 0 means don't create the entry if it doesn't already exist. * 1 means create. */ int allowVirtual, /* 0 means that virtual events are not allowed in the sequence. * 1 otherwise. */ -- cgit v0.12 From 4af4b242bba3b66fc9db8237966ca8e90d26c094 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 24 Sep 2021 15:01:44 +0000 Subject: Make IME bindings not leak into global variables --- library/entry.tcl | 23 ++++++++--- library/menu.tcl | 6 ++- library/print.tcl | 4 +- library/text.tcl | 26 +++++++++--- library/ttk/entry.tcl | 13 ++++++ library/ttk/fonts.tcl | 107 ++++++++++++++++++++++++-------------------------- 6 files changed, 108 insertions(+), 71 deletions(-) diff --git a/library/entry.tcl b/library/entry.tcl index 99f6eb4..1af9e65 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -276,11 +276,7 @@ bind Entry <> { dict set ::tk::Priv(IMETextMark) "%W" [%W index insert] } bind Entry <> { - if {[catch {dict get $::tk::Priv(IMETextMark) "%W"} mark]} { - bell - } else { - %W selection range $mark insert - } + ::tk::EntryEndIMEMarkedText %W } bind Entry <> { %W delete [dict get $::tk::Priv(IMETextMark) "%W"] [%W index insert] @@ -289,6 +285,23 @@ bind Entry <> { tk::EntryBackspace %W } +# ::tk::EntryEndIMEMarkedText -- +# Handles input method text marking in an entry +# +# Arguments: +# w - The entry window. + +proc ::tk::EntryEndIMEMarkedText {w} { + variable Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w selection range $mark insert +} + # A few additional bindings of my own. bind Entry { diff --git a/library/menu.tcl b/library/menu.tcl index 75e173d..7875afe 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -497,10 +497,12 @@ proc ::tk::MenuMotion {menu x y state} { # Catch these postcascade commands since the menu could be # destroyed before they run. set Priv(menuActivatedTimer) \ - [after $delay "catch {$menu postcascade active}"] + [after $delay [list catch [list \ + $menu postcascade active]]] } else { set Priv(menuDeactivatedTimer) \ - [after $delay "catch {$menu postcascade none}"] + [after $delay [list catch [list + $menu postcascade none]]] } } } diff --git a/library/print.tcl b/library/print.tcl index 7820a5f..1c2fd20 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -676,8 +676,8 @@ namespace eval ::tk::print { for your system." return } - set notfound "No destinations added" - if {[string first $notfound $msg] != -1} { + set notfound "No destinations added" + if {[string first $notfound $msg] != -1} { error "Please check or update your CUPS installation." return } diff --git a/library/text.tcl b/library/text.tcl index 9af3816..795a1d3 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -395,12 +395,7 @@ bind Text <> { dict set ::tk::Priv(IMETextMark) "%W" [%W index insert] } bind Text <> { - if { [catch {dict get $::tk::Priv(IMETextMark) "%W"} mark] } { - bell - } else { - %W tag add IMEmarkedtext $mark insert - %W tag configure IMEmarkedtext -underline on - } + ::tk::TextEndIMEMarkedText %W } bind Text <> { %W delete IMEmarkedtext.first IMEmarkedtext.last @@ -409,6 +404,25 @@ bind Text <> { %W delete insert-1c } +# ::tk::TextEndIMEMarkedText -- +# +# Handles input method text marking in a text widget. +# +# Arguments: +# w - The text widget + +proc ::tk::TextEndIMEMarkedText {w} { + variable Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w tag add IMEmarkedtext $mark insert + $w tag configure IMEmarkedtext -underline on +} + # Macintosh only bindings: if {[tk windowingsystem] eq "aqua"} { diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index fb49055..f10c194 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -161,6 +161,19 @@ bind TEntry <> { ttk::entry::Backspace %W } +## EndIMEMarkedText -- Handle the end of input method selection. +# +proc ::ttk::entry::EndIMEMarkedText {w} { + variable ::tk::Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w selection range $mark insert +} + ### Clipboard procedures. # diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl index 65f2c5e..2526fac 100644 --- a/library/ttk/fonts.tcl +++ b/library/ttk/fonts.tcl @@ -66,87 +66,82 @@ catch {font create TkIconFont} catch {font create TkMenuFont} catch {font create TkSmallCaptionFont} -if {!$tip145} { -variable F ;# miscellaneous platform-specific font parameters +if {!$tip145} {apply {{} { +global tcl_platform switch -- [tk windowingsystem] { win32 { # In safe interps there is no osVersion element. if {[info exists tcl_platform(osVersion)]} { if {$tcl_platform(osVersion) >= 5.0} { - set F(family) "Tahoma" + set family "Tahoma" } else { - set F(family) "MS Sans Serif" + set family "MS Sans Serif" } } else { if {[lsearch -exact [font families] Tahoma] >= 0} { - set F(family) "Tahoma" + set family "Tahoma" } else { - set F(family) "MS Sans Serif" + set family "MS Sans Serif" } } - set F(size) 8 + set size 8 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(size) - font configure TkCaptionFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(size) + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $size + font configure TkCaptionFont -family $family -size $size -weight bold + font configure TkTooltipFont -family $family -size $size font configure TkFixedFont -family Courier -size 10 - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(size) - font configure TkSmallCaptionFont -family $F(family) -size $F(size) + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $size + font configure TkSmallCaptionFont -family $family -size $size } aqua { - set F(family) "Lucida Grande" - set F(fixed) "Monaco" - set F(menusize) 14 - set F(size) 13 - set F(viewsize) 12 - set F(smallsize) 11 - set F(labelsize) 10 - set F(fixedsize) 11 + set family "Lucida Grande" + set fixed "Monaco" + set menusize 14 + set size 13 + set viewsize 12 + set smallsize 11 + set labelsize 10 + set fixedsize 11 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(smallsize) - font configure TkCaptionFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(smallsize) - font configure TkFixedFont -family $F(fixed) -size $F(fixedsize) - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(menusize) - font configure TkSmallCaptionFont -family $F(family) -size $F(labelsize) + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $smallsize + font configure TkCaptionFont -family $family -size $size -weight bold + font configure TkTooltipFont -family $family -size $smallsize + font configure TkFixedFont -family $fixed -size $fixedsize + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $menusize + font configure TkSmallCaptionFont -family $family -size $labelsize } default - x11 { - if {![catch {tk::pkgconfig get fontsystem} F(fs)] && $F(fs) eq "xft"} { - set F(family) "sans-serif" - set F(fixed) "monospace" + if {![catch {tk::pkgconfig get fontsystem} fs] && $fs eq "xft"} { + set family "sans-serif" + set fixed "monospace" } else { - set F(family) "Helvetica" - set F(fixed) "courier" + set family "Helvetica" + set fixed "courier" } - set F(size) 10 - set F(ttsize) 9 - set F(capsize) 12 - set F(fixedsize) 10 + set size 10 + set ttsize 9 + set capsize 12 + set fixedsize 10 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkCaptionFont -family $F(family) -size $F(capsize) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(ttsize) - font configure TkFixedFont -family $F(fixed) -size $F(fixedsize) - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(size) - font configure TkSmallCaptionFont -family $F(family) -size $F(ttsize) + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $size -weight bold + font configure TkCaptionFont -family $family -size $capsize -weight bold + font configure TkTooltipFont -family $family -size $ttsize + font configure TkFixedFont -family $fixed -size $fixedsize + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $size + font configure TkSmallCaptionFont -family $family -size $ttsize } } -unset -nocomplain F -} +} ::ttk}} } -- cgit v0.12 From 6ae300df9464b88374198e5dbdc29143d44c4996 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 24 Sep 2021 15:40:49 +0000 Subject: Change "!= -1" into ">= 0" --- library/print.tcl | 6 +++--- unix/tkUnixWm.c | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/library/print.tcl b/library/print.tcl index 1c2fd20..b0f6f10 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -117,7 +117,7 @@ namespace eval ::tk::print { set linestring [string range $data $curlen end] if {$breaklines} { set endind [string first "\n" $linestring] - if {$endind != -1} { + if {$endind >= 0} { set linestring [string range $linestring 0 $endind] # handle blank lines.... if {$linestring eq ""} { @@ -671,13 +671,13 @@ namespace eval ::tk::print { catch {exec lpstat -a} msg set notfound "command not found" - if {[string first $notfound $msg] != -1} { + if {[string first $notfound $msg] >= 0} { error "Unable to obtain list of printers. Please install the CUPS package \ for your system." return } set notfound "No destinations added" - if {[string first $notfound $msg] != -1} { + if {[string first $notfound $msg] >= 0} { error "Please check or update your CUPS installation." return } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 7661155..a67684c 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -416,7 +416,7 @@ static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Obj *const objv[]); static int WmIconbadgeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); + Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -- cgit v0.12 From 2017797e321a9289a5919b7bfe76b722a3af069e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 28 Sep 2021 14:59:10 +0000 Subject: Fix gcc warning, use more TCL_UNUSED --- win/tkWinInit.c | 1 - win/tkWinWm.c | 167 ++++++++++++++++++++++---------------------------------- 2 files changed, 66 insertions(+), 102 deletions(-) diff --git a/win/tkWinInit.c b/win/tkWinInit.c index 42ff46f..dae47ed 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -35,7 +35,6 @@ int TkpInit( Tcl_Interp *interp) { - (void)interp; /* * This is necessary for static initialization, and is ok otherwise * because TkWinXInit flips a static bit to do its work just once. Also, diff --git a/win/tkWinWm.c b/win/tkWinWm.c index fc62bf6..cca8fb0 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -310,7 +310,7 @@ typedef struct TkWmInfo { * of top-level windows. */ -static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); +static void TopLevelReqProc(void *dummy, Tk_Window tkwin); static void RemapWindows(TkWindow *winPtr, HWND parentHWND); static const Tk_GeomMgr wmMgrType = { @@ -385,14 +385,14 @@ static void TkWmStackorderToplevelWrapperMap(TkWindow *winPtr, Display *display, Tcl_HashTable *table); static LRESULT CALLBACK TopLevelProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); -static void TopLevelEventProc(ClientData clientData, +static void TopLevelEventProc(void *clientData, XEvent *eventPtr); -static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); -static void UpdateGeometryInfo(ClientData clientData); +static void TopLevelReqProc(void *dummy, Tk_Window tkwin); +static void UpdateGeometryInfo(void *clientData); static void UpdateWrapper(TkWindow *winPtr); static LRESULT CALLBACK WmProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); -static void WmWaitVisibilityOrMapProc(ClientData clientData, +static void WmWaitVisibilityOrMapProc(void *clientData, XEvent *eventPtr); static BlockOfIconImagesPtr ReadIconOrCursorFromFile(Tcl_Interp *interp, Tcl_Obj* fileName, BOOL isIcon); @@ -2191,28 +2191,29 @@ UpdateWrapper( * Start with TaskbarButtonCreated message. */ - TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); + TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); - /* - * In case the application is run elevated, allow the - * TaskbarButtonCreated message through. - */ + /* + * In case the application is run elevated, allow the + * TaskbarButtonCreated message through. + */ - ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); + ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); - /* - * Load COM library for icon overlay. - */ + /* + * Load COM library for icon overlay. + */ - hr = CoInitialize(0); - if (SUCCEEDED(hr)) { - hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); - if (FAILED(hr)) { - printf("Unable to initialize ITaskbarList3 API"); - ptbl->lpVtbl->Release(NULL); - ptbl = NULL; - } - } + hr = CoInitialize(0); + if (SUCCEEDED(hr)) { + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, + CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, (void **) &ptbl); + if (FAILED(hr)) { + printf("Unable to initialize ITaskbarList3 API"); + ptbl->lpVtbl->Release(NULL); + ptbl = NULL; + } + } } /* @@ -2628,10 +2629,8 @@ TkWmDeadWindow( void TkWmSetClass( - TkWindow *winPtr) /* Newly-created top-level window. */ + TCL_UNUSED(TkWindow *)) /* Newly-created top-level window. */ { - (void)winPtr; - /* Do nothing */ return; } @@ -2655,7 +2654,7 @@ TkWmSetClass( int Tk_WmObjCmd( - ClientData clientData, /* Main window associated with interpreter. */ + void *clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2836,7 +2835,7 @@ Tk_WmObjCmd( static int WmAspectCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2844,7 +2843,6 @@ WmAspectCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int numer1, denom1, numer2, denom2; - (void)tkwin; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, @@ -3206,7 +3204,7 @@ WmAttributesCmd( static int WmClientCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3215,7 +3213,6 @@ WmClientCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; const char *argv3; TkSizeT length; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name?"); @@ -3371,7 +3368,7 @@ WmColormapwindowsCmd( static int WmCommandCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3381,7 +3378,6 @@ WmCommandCmd( const char *argv3; int cmdArgc; const char **cmdArgv; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?value?"); @@ -3441,14 +3437,13 @@ WmCommandCmd( static int WmDeiconifyCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; - (void)tkwin; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -3494,7 +3489,7 @@ WmDeiconifyCmd( static int WmFocusmodelCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3508,7 +3503,6 @@ WmFocusmodelCmd( OPT_ACTIVE, OPT_PASSIVE }; int index; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?"); @@ -3551,17 +3545,13 @@ WmFocusmodelCmd( static int WmForgetCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel or Frame to work with */ - Tcl_Interp *dummy, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + TCL_UNUSED(Tcl_Interp *), /* Current interpreter. */ + TCL_UNUSED(int), /* Number of arguments. */ + TCL_UNUSED(Tcl_Obj *const *)) /* Argument objects. */ { Tk_Window frameWin = (Tk_Window) winPtr; - (void)tkwin; - (void)dummy; - (void)objc; - (void)objv; if (Tk_IsTopLevel(frameWin)) { Tk_UnmapWindow(frameWin); @@ -3569,10 +3559,10 @@ WmForgetCmd( Tk_MakeWindowExist((Tk_Window)winPtr->parentPtr); RemapWindows(winPtr, Tk_GetHWND(winPtr->parentPtr->window)); - /* - * Make sure wm no longer manages this window - */ - Tk_ManageGeometry(frameWin, NULL, NULL); + /* + * Make sure wm no longer manages this window + */ + Tk_ManageGeometry(frameWin, NULL, NULL); TkWmDeadWindow(winPtr); /* flags (above) must be cleared before calling */ @@ -3603,7 +3593,7 @@ WmForgetCmd( static int WmFrameCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3612,7 +3602,6 @@ WmFrameCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; HWND hwnd; char buf[TCL_INTEGER_SPACE]; - (void)tkwin; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -3649,7 +3638,7 @@ WmFrameCmd( static int WmGeometryCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3659,7 +3648,6 @@ WmGeometryCmd( char xSign, ySign; int width, height; const char *argv3; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?"); @@ -3718,7 +3706,7 @@ WmGeometryCmd( static int WmGridCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3726,7 +3714,6 @@ WmGridCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int reqWidth, reqHeight, widthInc, heightInc; - (void)tkwin; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, @@ -3881,7 +3868,7 @@ WmGroupCmd( static int WmIconbadgeCmd( Tk_Window tkwin, /* Main window of the application. */ - TkWindow *winPtr, /* Toplevel to work with */ + TCL_UNUSED(TkWindow *), /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3891,7 +3878,6 @@ WmIconbadgeCmd( Tk_PhotoImageBlock block; int width, height; HICON overlayicon; - (void) winPtr; int badgenumber; char *badgestring = NULL; char photoname[4096]; @@ -3992,7 +3978,7 @@ WmIconbadgeCmd( static int WmIconbitmapCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4001,7 +3987,6 @@ WmIconbitmapCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; TkWindow *useWinPtr = winPtr; /* window to apply to (NULL if -default) */ const char *string; - (void)tkwin; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? ?image?"); @@ -4129,14 +4114,13 @@ WmIconbitmapCmd( static int WmIconifyCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; - (void)tkwin; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -4254,7 +4238,7 @@ WmIconmaskCmd( static int WmIconnameCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4263,7 +4247,6 @@ WmIconnameCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; const char *argv3; TkSizeT length; - (void)tkwin; if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?"); @@ -4306,7 +4289,7 @@ WmIconnameCmd( static int WmIconphotoCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4320,7 +4303,6 @@ WmIconphotoCmd( WinIconPtr titlebaricon = NULL; HICON hIcon; unsigned size; - (void)tkwin; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, @@ -4420,7 +4402,7 @@ WmIconphotoCmd( static int WmIconpositionCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4428,7 +4410,6 @@ WmIconpositionCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y; - (void)tkwin; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?"); @@ -4587,17 +4568,14 @@ WmIconwindowCmd( static int WmManageCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel or Frame to work with */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + TCL_UNUSED(int), /* Number of arguments. */ + TCL_UNUSED(Tcl_Obj *const *)) /* Argument objects. */ { Tk_Window frameWin = (Tk_Window) winPtr; WmInfo *wmPtr = winPtr->wmInfoPtr; - (void)tkwin; - (void)objc; - (void)objv; if (!Tk_IsTopLevel(frameWin)) { if (!Tk_IsManageable(frameWin)) { @@ -4644,7 +4622,7 @@ WmManageCmd( static int WmMaxsizeCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4652,7 +4630,6 @@ WmMaxsizeCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; - (void)tkwin; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); @@ -4696,7 +4673,7 @@ WmMaxsizeCmd( static int WmMinsizeCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4704,7 +4681,6 @@ WmMinsizeCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; - (void)tkwin; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); @@ -4748,7 +4724,7 @@ WmMinsizeCmd( static int WmOverrideredirectCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4757,7 +4733,6 @@ WmOverrideredirectCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; int boolean, curValue; XSetWindowAttributes atts; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?"); @@ -4821,7 +4796,7 @@ WmOverrideredirectCmd( static int WmPositionfromCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4835,7 +4810,6 @@ WmPositionfromCmd( OPT_PROGRAM, OPT_USER }; int index; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?"); @@ -4890,7 +4864,7 @@ WmPositionfromCmd( static int WmProtocolCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4902,7 +4876,6 @@ WmProtocolCmd( const char *cmd; TkSizeT cmdLength; Tcl_Obj *resultObj; - (void)tkwin; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); @@ -4987,7 +4960,7 @@ WmProtocolCmd( static int WmResizableCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4995,7 +4968,6 @@ WmResizableCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; - (void)tkwin; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); @@ -5050,7 +5022,7 @@ WmResizableCmd( static int WmSizefromCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -5064,7 +5036,6 @@ WmSizefromCmd( OPT_PROGRAM, OPT_USER }; int index; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?"); @@ -5248,7 +5219,7 @@ WmStackorderCmd( static int WmStateCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -5262,7 +5233,6 @@ WmStateCmd( OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN, OPT_ZOOMED }; int index; - (void)tkwin; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?state?"); @@ -5389,7 +5359,7 @@ WmStateCmd( static int WmTitleCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -5399,7 +5369,6 @@ WmTitleCmd( const char *argv3; TkSizeT length; HWND wrapper; - (void)tkwin; if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?"); @@ -5595,14 +5564,13 @@ WmTransientCmd( static int WmWithdrawCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; - (void)tkwin; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -5649,7 +5617,7 @@ WmUpdateGeom( static void WmWaitVisibilityOrMapProc( - ClientData clientData, /* Pointer to window. */ + void *clientData, /* Pointer to window. */ XEvent *eventPtr) /* Information about event. */ { TkWindow *winPtr = (TkWindow *)clientData; @@ -5866,7 +5834,7 @@ Tk_UnsetGrid( static void TopLevelEventProc( - ClientData clientData, /* Window for which event occurred. */ + void *clientData, /* Window for which event occurred. */ XEvent *eventPtr) /* Event that just happened. */ { TkWindow *winPtr = (TkWindow *)clientData; @@ -5911,12 +5879,11 @@ TopLevelEventProc( static void TopLevelReqProc( - ClientData dummy, /* Not used. */ + TCL_UNUSED(void *), /* Not used. */ Tk_Window tkwin) /* Information about window. */ { TkWindow *winPtr = (TkWindow *) tkwin; WmInfo *wmPtr; - (void)dummy; wmPtr = winPtr->wmInfoPtr; if (wmPtr) { @@ -5954,7 +5921,7 @@ TopLevelReqProc( static void UpdateGeometryInfo( - ClientData clientData) /* Pointer to the window's record. */ + void *clientData) /* Pointer to the window's record. */ { int x, y; /* Position of border on desktop. */ int width, height; /* Size of client area. */ @@ -6463,15 +6430,13 @@ Tk_CoordsToWindow( void Tk_GetVRootGeometry( - Tk_Window tkwin, /* Window whose virtual root is to be + TCL_UNUSED(Tk_Window),/* Window whose virtual root is to be * queried. */ int *xPtr, int *yPtr, /* Store x and y offsets of virtual root * here. */ int *widthPtr, int *heightPtr) /* Store dimensions of virtual root here. */ { - (void)tkwin; - *xPtr = GetSystemMetrics(SM_XVIRTUALSCREEN); *yPtr = GetSystemMetrics(SM_YVIRTUALSCREEN); *widthPtr = GetSystemMetrics(SM_CXVIRTUALSCREEN); -- cgit v0.12 From 50c34e54dc3e5a32c2c712809d133b23b99f5e12 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 30 Sep 2021 07:54:30 +0000 Subject: Set activeCodePage to UTF-8, for (Windows) systems that support it --- win/wish.exe.manifest.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/wish.exe.manifest.in b/win/wish.exe.manifest.in index 9fefac9..762d82d 100644 --- a/win/wish.exe.manifest.in +++ b/win/wish.exe.manifest.in @@ -31,9 +31,9 @@ - + true + UTF-8 -- cgit v0.12 From 60890ac1a7964bd9cbc807459ddeebc478cbdf8c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Oct 2021 14:12:04 +0000 Subject: Sync windows application manifest with Tcl --- win/wish.exe.manifest.in | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/win/wish.exe.manifest.in b/win/wish.exe.manifest.in index 762d82d..20a79a4 100644 --- a/win/wish.exe.manifest.in +++ b/win/wish.exe.manifest.in @@ -31,8 +31,12 @@ - + true + + UTF-8 -- cgit v0.12 From 88bcb221923fb169035a482c8e6b6d6de06f592f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Oct 2021 16:09:11 +0000 Subject: Fix [32bda06ec0]: Tk build failure at branch "main" (2021-10-04) using mingw 6.0 (missing include at tkWinWm.c) --- win/tkWinWm.c | 2 +- win/ttkWinMonitor.c | 2 +- win/ttkWinTheme.c | 2 +- win/ttkWinXPTheme.c | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tkWinWm.c b/win/tkWinWm.c index cca8fb0..95ec190 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -13,12 +13,12 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include "tkWinInt.h" #include #include #include #include #include -#include "tkWinInt.h" #include "tkWinIco.h" /* * These next two defines are only valid on Win2K/XP+. diff --git a/win/ttkWinMonitor.c b/win/ttkWinMonitor.c index 1d31c1c..2db00b5 100644 --- a/win/ttkWinMonitor.c +++ b/win/ttkWinMonitor.c @@ -2,7 +2,7 @@ #define WIN32_LEAN_AND_MEAN #endif -#include +#include "tkWinInt.h" #include "ttk/ttkTheme.h" #if !defined(WM_THEMECHANGED) diff --git a/win/ttkWinTheme.c b/win/ttkWinTheme.c index d3277f2..56e6882 100644 --- a/win/ttkWinTheme.c +++ b/win/ttkWinTheme.c @@ -5,7 +5,7 @@ #define WIN32_LEAN_AND_MEAN #endif -#include +#include "tkWinInt.h" #ifndef DFCS_HOT /* Windows 98/Me, Windows 2000/XP only */ #define DFCS_HOT 0 diff --git a/win/ttkWinXPTheme.c b/win/ttkWinXPTheme.c index 3fedff7..2500ea2 100644 --- a/win/ttkWinXPTheme.c +++ b/win/ttkWinXPTheme.c @@ -15,7 +15,7 @@ * shellcc/platform/commctls/userex/refentry.asp > */ -#include +#include "tkWinInt.h" #ifndef HAVE_UXTHEME_H /* Stub for platforms that lack the XP theme API headers: */ int TtkXPTheme_Init(Tcl_Interp *interp, HWND hwnd) { return TCL_OK; } -- cgit v0.12 From f37694250c1164741ebb0085811291ffb0f11e51 Mon Sep 17 00:00:00 2001 From: culler Date: Sun, 10 Oct 2021 16:46:26 +0000 Subject: Fix error generated by the open file dialog on Monterey, caused by Apple reversing course and reverting to [NSApp runModalForWindow]. --- macosx/tkMacOSXDialog.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 4bcaedf..05bdf7f 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -352,6 +352,7 @@ static NSInteger showOpenSavePanel( NSInteger modalReturnCode; if (parent && ![parent attachedSheet]) { + int osVersion = [NSApp macOSVersion]; [panel beginSheetModalForWindow:parent completionHandler:^(NSModalResponse returnCode) { [NSApp tkFilePanelDidEnd:panel @@ -364,10 +365,15 @@ static NSInteger showOpenSavePanel( * window. Using [NSApp runModalForWindow:] on macOS 10.15 or later * generates warnings on stderr. But using [NSOpenPanel runModal] or * [NSSavePanel runModal] on 10.14 or earler does not cause the - * completion handler to run when the panel is closed. + * completion handler to run when the panel is closed. Apple apparently + * decided to go back to using runModalForWindow with the release of + * macOS 12.0. The warnings do not appear in that OS, and using + * runModal produces an error dialog that says "The open file operation + * failed to connect to the open and save panel service." along with an + * assertion error. */ - if ([NSApp macOSVersion] > 101400) { + if ( osVersion >= 101400 && osVersion < 120000) { modalReturnCode = [panel runModal]; } else { modalReturnCode = [NSApp runModalForWindow:panel]; -- cgit v0.12 From 5e9592bc08da2424a5b180e1ee18f0ba564c672f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 11 Oct 2021 14:27:09 +0000 Subject: Backout [https://core.tcl-lang.org/tk/info/6ffcea9b093deb5a|6ffcea9b09]: Better solution built into Tcl (Win64 only) now. --- generic/tkBind.c | 20 ++++---------------- 1 file changed, 4 insertions(+), 16 deletions(-) diff --git a/generic/tkBind.c b/generic/tkBind.c index e4e2b99..7873d29 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -792,22 +792,10 @@ GetButtonNumber( static Time CurrentTimeInMilliSecs(void) { - union { - Tcl_Time now; - struct { - Tcl_WideInt sec; /* reserve stack space enough for 64-bit fields */ - Tcl_WideInt usec; - } lnow; - } t; - t.lnow.usec = -1; /* Invalid usec value, so we can see if Tcl_GetTime overwrites it */ - Tcl_GetTime(&t.now); -#ifdef _WIN64 - if (t.lnow.usec != -1) { - /* Win64 Tk loaded in Cygwin-64: Tcl_GetTime() returns 64-bit fields */ - return ((Time) t.lnow.sec)*1000 + ((Time) t.lnow.usec)/1000; - } -#endif - return ((Time) t.now.sec)*1000 + ((Time) t.now.usec)/1000; + Tcl_Time now; + + Tcl_GetTime(&now); + return ((Time) now.sec)*1000 + ((Time) now.usec)/1000; } static Info -- cgit v0.12 From 457456e2e721dd032dfed9ed2a6c851536a24b66 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 14 Oct 2021 10:00:17 +0000 Subject: Fix [8ebed330ed]: doing some Tk inside of several threads crashes --- macosx/tkMacOSXDialog.c | 2 +- unix/tkUnixRFont.c | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 1 deletion(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 05bdf7f..2ad88e9 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -352,7 +352,7 @@ static NSInteger showOpenSavePanel( NSInteger modalReturnCode; if (parent && ![parent attachedSheet]) { - int osVersion = [NSApp macOSVersion]; + int osVersion = [NSApp macOSVersion]; [panel beginSheetModalForWindow:parent completionHandler:^(NSModalResponse returnCode) { [NSApp tkFilePanelDidEnd:panel diff --git a/unix/tkUnixRFont.c b/unix/tkUnixRFont.c index 226445c..8eb6f53 100644 --- a/unix/tkUnixRFont.c +++ b/unix/tkUnixRFont.c @@ -53,6 +53,10 @@ typedef struct { Region clipRegion; /* The clipping region, or None. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; + +TCL_DECLARE_MUTEX(xftMutex); +#define LOCK Tcl_MutexLock(&xftMutex) +#define UNLOCK Tcl_MutexUnlock(&xftMutex) /* * Package initialization: @@ -122,7 +126,9 @@ GetFont( if (angle != 0.0) { FcPatternAddMatrix(pat, FC_MATRIX, &mat); } + LOCK; ftFont = XftFontOpenPattern(fontPtr->display, pat); + UNLOCK; if (!ftFont) { /* * The previous call to XftFontOpenPattern() should not fail, but @@ -131,11 +137,13 @@ GetFont( * fallback: */ + LOCK; ftFont = XftFontOpen(fontPtr->display, fontPtr->screen, FC_FAMILY, FcTypeString, "sans", FC_SIZE, FcTypeDouble, 12.0, FC_MATRIX, FcTypeMatrix, &mat, NULL); + UNLOCK; } if (!ftFont) { /* @@ -150,7 +158,9 @@ GetFont( fontPtr->faces[i].ft0Font = ftFont; } else { if (fontPtr->faces[i].ftFont) { + LOCK; XftFontClose(fontPtr->display, fontPtr->faces[i].ftFont); + UNLOCK; } fontPtr->faces[i].ftFont = ftFont; fontPtr->faces[i].angle = angle; @@ -409,10 +419,14 @@ FinishedWithFont( for (i = 0; i < fontPtr->nfaces; i++) { if (fontPtr->faces[i].ftFont) { + LOCK; XftFontClose(fontPtr->display, fontPtr->faces[i].ftFont); + UNLOCK; } if (fontPtr->faces[i].ft0Font) { + LOCK; XftFontClose(fontPtr->display, fontPtr->faces[i].ft0Font); + UNLOCK; } if (fontPtr->faces[i].charset) { FcCharSetDestroy(fontPtr->faces[i].charset); @@ -751,7 +765,9 @@ Tk_MeasureChars( ftFont = GetFont(fontPtr, c, 0.0); if (!errorFlag) { + LOCK; XftTextExtents32(fontPtr->display, ftFont, &c, 1, &extents); + UNLOCK; } else { extents.xOff = 0; errorFlag = 0; @@ -962,8 +978,10 @@ Tk_DrawChars( ftFont = GetFont(fontPtr, c, 0.0); if (ftFont) { specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); + LOCK; XftGlyphExtents(fontPtr->display, ftFont, &specs[nspec].glyph, 1, &metrics); + UNLOCK; /* * Draw glyph only when it fits entirely into 16 bit coords. @@ -976,8 +994,10 @@ Tk_DrawChars( specs[nspec].x = x; specs[nspec].y = y; if (++nspec == NUM_SPEC) { + LOCK; XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, specs, nspec); + UNLOCK; nspec = 0; } } @@ -986,7 +1006,9 @@ Tk_DrawChars( } } if (nspec) { + LOCK; XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, specs, nspec); + UNLOCK; } doUnderlineStrikeout: @@ -1113,8 +1135,11 @@ TkDrawAngledChars( * this information... but we'll be ready when it does! */ + LOCK; XftGlyphExtents(fontPtr->display, currentFtFont, glyphs, nglyph, &metrics); + UNLOCK; + /* * Draw glyph only when it fits entirely into 16 bit coords. */ @@ -1137,8 +1162,10 @@ TkDrawAngledChars( * a very small barely readable font) */ + LOCK; XftDrawGlyphs(fontPtr->ftDraw, xftcolor, currentFtFont, originX, originY, glyphs, nglyph); + UNLOCK; } } originX = ROUND16(x); @@ -1148,8 +1175,10 @@ TkDrawAngledChars( glyphs[nglyph++] = XftCharIndex(fontPtr->display, ftFont, c); } if (nglyph) { + LOCK; XftGlyphExtents(fontPtr->display, currentFtFont, glyphs, nglyph, &metrics); + UNLOCK; /* * Draw glyph only when it fits entirely into 16 bit coords. @@ -1158,8 +1187,10 @@ TkDrawAngledChars( if (x >= minCoord && y >= minCoord && x <= maxCoord - metrics.width && y <= maxCoord - metrics.height) { + LOCK; XftDrawGlyphs(fontPtr->ftDraw, xftcolor, currentFtFont, originX, originY, glyphs, nglyph); + UNLOCK; } } #else /* !XFT_HAS_FIXED_ROTATED_PLACEMENT */ @@ -1207,8 +1238,10 @@ TkDrawAngledChars( ft0Font = GetFont(fontPtr, c, 0.0); if (ftFont && ft0Font) { specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); + LOCK; XftGlyphExtents(fontPtr->display, ft0Font, &specs[nspec].glyph, 1, &metrics); + UNLOCK; /* * Draw glyph only when it fits entirely into 16 bit coords. @@ -1221,8 +1254,10 @@ TkDrawAngledChars( specs[nspec].x = ROUND16(x); specs[nspec].y = ROUND16(y); if (++nspec == NUM_SPEC) { + LOCK; XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, specs, nspec); + UNLOCK; nspec = 0; } } @@ -1231,7 +1266,9 @@ TkDrawAngledChars( } } if (nspec) { + LOCK; XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, specs, nspec); + UNLOCK; } #endif /* XFT_HAS_FIXED_ROTATED_PLACEMENT */ -- cgit v0.12 From 950b53c38fcd073114b9817adc2b34120855329c Mon Sep 17 00:00:00 2001 From: max Date: Mon, 18 Oct 2021 16:07:19 +0000 Subject: Let the font chooser dialog also expand in Y direction --- library/fontchooser.tcl | 1 + 1 file changed, 1 insertion(+) diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 9d49c57..e735ae4 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -247,6 +247,7 @@ proc ::tk::fontchooser::Create {} { grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news grid $WE x $WS - - x ^ -in $outer -sticky news -pady {15 30} grid configure $bbox -sticky n + grid rowconfigure $outer 2 -weight 1 grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) grid columnconfigure $outer {0 2 4} -weight 1 grid columnconfigure $outer 0 -minsize $minsize(fonts) -- cgit v0.12 From 89f6d4e6f23c746d09db1ca9864d570304491055 Mon Sep 17 00:00:00 2001 From: max Date: Mon, 18 Oct 2021 16:08:38 +0000 Subject: Fix indentation --- library/fontchooser.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index e735ae4..fb6c6d3 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -247,7 +247,7 @@ proc ::tk::fontchooser::Create {} { grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news grid $WE x $WS - - x ^ -in $outer -sticky news -pady {15 30} grid configure $bbox -sticky n - grid rowconfigure $outer 2 -weight 1 + grid rowconfigure $outer 2 -weight 1 grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) grid columnconfigure $outer {0 2 4} -weight 1 grid columnconfigure $outer 0 -minsize $minsize(fonts) -- cgit v0.12 From ec3e39ca0ca59f48c28e32651d7a5a09707ab7ae Mon Sep 17 00:00:00 2001 From: griffin Date: Tue, 19 Oct 2021 15:35:28 +0000 Subject: Remove duplicate append of zip archive to wish. --- unix/Makefile.in | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 89298fc..b4cca52 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -641,7 +641,7 @@ ${LIB_FILE}: ${STUB_LIB_FILE} @LIB_RSRC_FILE@ ${OBJS} ${TK_ZIP_FILE} @MAKE_LIB@ @if test "${ZIPFS_BUILD}" = "1" ; then \ if test "x$(MACHER)" = "x" ; then \ - cat ${TK_ZIP_FILE} >> ${LIB_FILE}; \ + cat ${TK_ZIP_FILE} >> ${LIB_FILE}; \ else $(MACHER) append ${LIB_FILE} ${TK_ZIP_FILE} /tmp/macher_output; \ mv /tmp/macher_output ${LIB_FILE}; chmod u+x ${LIB_FILE}; \ fi; \ @@ -682,9 +682,8 @@ ${WISH_EXE}: $(TK_STUB_LIB_FILE) $(WISH_OBJS) $(TK_LIB_FILE) @APP_RSRC_FILE@ ${CC} ${CFLAGS} ${LDFLAGS} $(WISH_OBJS) @TK_BUILD_LIB_SPEC@ \ $(WISH_LIBS) $(CC_SEARCH_FLAGS) -o ${WISH_EXE} @if test "${ZIPFS_BUILD}" = "2" ; then \ - cat ${TK_ZIP_FILE} >> ${WISH_EXE}; \ if test "x$(MACHER)" = "x" ; then \ - cat ${TK_ZIP_FILE} >> ${WISH_EXE}; \ + cat ${TK_ZIP_FILE} >> ${WISH_EXE}; \ else $(MACHER) append ${WISH_EXE} ${TK_ZIP_FILE} /tmp/macher_output; \ mv /tmp/macher_output ${LIB_FILE}; chmod u+x ${LIB_FILE}; \ fi; \ -- cgit v0.12 From 77257c0f79171da4fd01a11664615679bf3ea959 Mon Sep 17 00:00:00 2001 From: culler Date: Wed, 27 Oct 2021 15:01:09 +0000 Subject: The standalone file dialog needs the same fix as the sheet --- macosx/tkMacOSXDialog.c | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 08998bc..717c17d 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -350,9 +350,9 @@ static NSInteger showOpenSavePanel( FilePanelCallbackInfo *callbackInfo) { NSInteger modalReturnCode; + int osVersion = [NSApp macOSVersion]; if (parent && ![parent attachedSheet]) { - int osVersion = [NSApp macOSVersion]; [panel beginSheetModalForWindow:parent completionHandler:^(NSModalResponse returnCode) { [NSApp tkFilePanelDidEnd:panel @@ -385,20 +385,15 @@ static NSInteger showOpenSavePanel( * at all on macOS 10.14 and earlier. */ - if ([NSApp macOSVersion] > 101400) { - [panel beginWithCompletionHandler:^(NSModalResponse returnCode) { - [NSApp tkFilePanelDidEnd:panel - returnCode:returnCode - contextInfo:callbackInfo ]; - }]; + if ( osVersion > 101400 && osVersion < 120000) { modalReturnCode = [panel runModal]; } else { - modalReturnCode = [panel runModal]; - [NSApp tkFilePanelDidEnd:panel - returnCode:modalReturnCode - contextInfo:callbackInfo ]; - [panel close]; + modalReturnCode = [NSApp runModalForWindow:panel]; } + [NSApp tkFilePanelDidEnd:panel + returnCode:modalReturnCode + contextInfo:callbackInfo ]; + [panel close]; } return callbackInfo->cmdObj ? modalOther : modalReturnCode; } -- cgit v0.12 From bc47200f0cf1837c15042210beffdb5f7912301e Mon Sep 17 00:00:00 2001 From: culler Date: Wed, 27 Oct 2021 18:17:21 +0000 Subject: Some cleanup without resolving other (minor) 12.0 bugs --- macosx/tkMacOSXDialog.c | 43 +++++++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 717c17d..2ba35e0 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -362,7 +362,7 @@ static NSInteger showOpenSavePanel( /* * The sheet has been prepared, so now we have to run it as a modal - * window. Using [NSApp runModalForWindow:] on macOS 10.15 or later + * window. Using [NSApp runModalForWindow:] on macOS 10.15 or 11.0 * generates warnings on stderr. But using [NSOpenPanel runModal] or * [NSSavePanel runModal] on 10.14 or earler does not cause the * completion handler to run when the panel is closed. Apple apparently @@ -370,7 +370,12 @@ static NSInteger showOpenSavePanel( * macOS 12.0. The warnings do not appear in that OS, and using * runModal produces an error dialog that says "The open file operation * failed to connect to the open and save panel service." along with an - * assertion error. + * assertion error. Unfortunately, 10.12 introduced other bugs. When + * displaying the panel as a sheet it is first shown as a separate + * window for an instant and then attached to the parent as a sheet. + * Also, the filename input field is not focused when the dialog opens, + * either as a sheet or a separate window. No workaround is currently + * known for these. */ if ( osVersion > 101400 && osVersion < 120000) { @@ -393,7 +398,6 @@ static NSInteger showOpenSavePanel( [NSApp tkFilePanelDidEnd:panel returnCode:modalReturnCode contextInfo:callbackInfo ]; - [panel close]; } return callbackInfo->cmdObj ? modalOther : modalReturnCode; } @@ -688,10 +692,11 @@ Tk_GetOpenFileObjCmd( NSString *directory = nil, *filename = nil; NSString *message = nil, *title = nil; NSWindow *parent; - openpanel = [NSOpenPanel openPanel]; NSInteger modalReturnCode = modalError; BOOL parentIsKey = NO; + openpanel = [NSOpenPanel openPanel]; + for (i = 1; i < objc; i += 2) { if (Tcl_GetIndexFromObjStruct(interp, objv[i], openOptionStrings, sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { @@ -754,7 +759,6 @@ Tk_GetOpenFileObjCmd( } } if (title) { - [openpanel setTitle:title]; /* * From OSX 10.11, the title string is silently ignored in the open @@ -771,6 +775,8 @@ Tk_GetOpenFileObjCmd( } else { message = title; } + } else { + [openpanel setTitle:title]; } } @@ -961,10 +967,10 @@ Tk_GetSaveFileObjCmd( NSString *directory = nil, *filename = nil, *defaultType = nil; NSString *message = nil, *title = nil; NSWindow *parent; - savepanel = [NSSavePanel savePanel]; NSInteger modalReturnCode = modalError; BOOL parentIsKey = NO; + savepanel = [NSSavePanel savePanel]; for (i = 1; i < objc; i += 2) { if (Tcl_GetIndexFromObjStruct(interp, objv[i], saveOptionStrings, sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { @@ -1037,25 +1043,26 @@ Tk_GetSaveFileObjCmd( } if (title) { - [savepanel setTitle:title]; /* * From OSX 10.11, the title string is silently ignored, if the save * panel is a sheet. Prepend the title to the message in this case. - * NOTE: should be conditional on OSX version, but -mmacosx-version-min - * does not revert this behaviour. */ - if (haveParentOption) { - if (message) { - NSString *fullmessage = - [[NSString alloc] initWithFormat:@"%@\n%@",title,message]; - [message release]; - [title release]; - message = fullmessage; - } else { - message = title; + if ([NSApp macOSVersion] > 101000) { + if (haveParentOption) { + if (message) { + NSString *fullmessage = + [[NSString alloc] initWithFormat:@"%@\n%@",title,message]; + [message release]; + [title release]; + message = fullmessage; + } else { + message = title; + } } + } else { + [savepanel setTitle:title]; } } -- cgit v0.12 From e8b212de5ca61695a8ce7172649b90d9eb80defa Mon Sep 17 00:00:00 2001 From: culler Date: Wed, 27 Oct 2021 22:09:06 +0000 Subject: The real fix, at least for Big Sur and Monterey. --- macosx/tkMacOSXDialog.c | 61 ++++++++++++++++--------------------------------- 1 file changed, 20 insertions(+), 41 deletions(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 2ba35e0..09adaad 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -353,52 +353,28 @@ static NSInteger showOpenSavePanel( int osVersion = [NSApp macOSVersion]; if (parent && ![parent attachedSheet]) { - [panel beginSheetModalForWindow:parent - completionHandler:^(NSModalResponse returnCode) { - [NSApp tkFilePanelDidEnd:panel - returnCode:returnCode - contextInfo:callbackInfo ]; - }]; /* - * The sheet has been prepared, so now we have to run it as a modal - * window. Using [NSApp runModalForWindow:] on macOS 10.15 or 11.0 - * generates warnings on stderr. But using [NSOpenPanel runModal] or - * [NSSavePanel runModal] on 10.14 or earler does not cause the - * completion handler to run when the panel is closed. Apple apparently - * decided to go back to using runModalForWindow with the release of - * macOS 12.0. The warnings do not appear in that OS, and using - * runModal produces an error dialog that says "The open file operation - * failed to connect to the open and save panel service." along with an - * assertion error. Unfortunately, 10.12 introduced other bugs. When - * displaying the panel as a sheet it is first shown as a separate - * window for an instant and then attached to the parent as a sheet. - * Also, the filename input field is not focused when the dialog opens, - * either as a sheet or a separate window. No workaround is currently - * known for these. + * On most version of macOS the completion handler does not get + * run at all. So we ignore it. */ + + [parent beginSheet: panel completionHandler:nil]; - if ( osVersion > 101400 && osVersion < 120000) { - modalReturnCode = [panel runModal]; - } else { - modalReturnCode = [NSApp runModalForWindow:panel]; - } + } + /* + * On macOS 10.15 and higher, calling runModalForWindow generates + * warnings on stderr. + */ + + if ( osVersion > 101400) { + modalReturnCode = [panel runModal]; } else { - - /* - * For the standalone file dialog, completion handlers do not work - * at all on macOS 10.14 and earlier. - */ - - if ( osVersion > 101400 && osVersion < 120000) { - modalReturnCode = [panel runModal]; - } else { - modalReturnCode = [NSApp runModalForWindow:panel]; - } - [NSApp tkFilePanelDidEnd:panel - returnCode:modalReturnCode - contextInfo:callbackInfo ]; + modalReturnCode = [NSApp runModalForWindow:panel]; } + [NSApp tkFilePanelDidEnd:panel + returnCode:modalReturnCode + contextInfo:callbackInfo ]; return callbackInfo->cmdObj ? modalOther : modalReturnCode; } @@ -970,7 +946,10 @@ Tk_GetSaveFileObjCmd( NSInteger modalReturnCode = modalError; BOOL parentIsKey = NO; - savepanel = [NSSavePanel savePanel]; + if (savepanel == nil) { + savepanel = [NSSavePanel savePanel]; + [savepanel setDelegate:NSApp]; + } for (i = 1; i < objc; i += 2) { if (Tcl_GetIndexFromObjStruct(interp, objv[i], saveOptionStrings, sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { -- cgit v0.12 From b073b90aa63190350a96903dcac16bbc701c4204 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Wed, 27 Oct 2021 22:54:37 +0000 Subject: Catalina is a special case. --- macosx/tkMacOSXDialog.c | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 09adaad..afb57fb 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -355,11 +355,20 @@ static NSInteger showOpenSavePanel( if (parent && ![parent attachedSheet]) { /* - * On most version of macOS the completion handler does not get - * run at all. So we ignore it. + * A completion handler is not needed except on macOS 10.15, where we + * have to start the sheet differently. */ - - [parent beginSheet: panel completionHandler:nil]; + + if (osVersion >= 101500 && osVersion < 110000 ) { + [panel beginSheetModalForWindow:parent + completionHandler:^(NSModalResponse returnCode) { + [NSApp tkFilePanelDidEnd:panel + returnCode:returnCode + contextInfo:callbackInfo ]; + }]; + } else { + [parent beginSheet: panel completionHandler:nil]; + } } /* @@ -372,9 +381,12 @@ static NSInteger showOpenSavePanel( } else { modalReturnCode = [NSApp runModalForWindow:panel]; } - [NSApp tkFilePanelDidEnd:panel - returnCode:modalReturnCode - contextInfo:callbackInfo ]; + + if (osVersion < 101500 || osVersion >= 110000 ) { + [NSApp tkFilePanelDidEnd:panel + returnCode:modalReturnCode + contextInfo:callbackInfo ]; + } return callbackInfo->cmdObj ? modalOther : modalReturnCode; } -- cgit v0.12 From 554073edbdc9a4d3ac707404b7b78f76eb5e46ba Mon Sep 17 00:00:00 2001 From: culler Date: Thu, 28 Oct 2021 13:33:03 +0000 Subject: One more round - thanks to Ned Deily for testing with IDLE. --- macosx/tkMacOSXDialog.c | 77 ++++++++++++++++++++++--------------------------- 1 file changed, 35 insertions(+), 42 deletions(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index afb57fb..b6f4503 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -350,39 +350,38 @@ static NSInteger showOpenSavePanel( FilePanelCallbackInfo *callbackInfo) { NSInteger modalReturnCode; - int osVersion = [NSApp macOSVersion]; + int OSVersion = [NSApp macOSVersion]; - if (parent && ![parent attachedSheet]) { - - /* - * A completion handler is not needed except on macOS 10.15, where we - * have to start the sheet differently. - */ + /* + * Use a sheet if -parent is specified (unless there is already a sheet). + */ - if (osVersion >= 101500 && osVersion < 110000 ) { + if (parent && ![parent attachedSheet]) { + if (OSVersion < 101500) { [panel beginSheetModalForWindow:parent completionHandler:^(NSModalResponse returnCode) { [NSApp tkFilePanelDidEnd:panel returnCode:returnCode contextInfo:callbackInfo ]; }]; + modalReturnCode = [NSApp runModalForWindow:panel]; + } else if (OSVersion < 110000) { + [panel beginSheetModalForWindow:parent + completionHandler:^(NSModalResponse returnCode) { + [NSApp tkFilePanelDidEnd:panel + returnCode:returnCode + contextInfo:callbackInfo ]; + }]; + modalReturnCode = [panel runModal]; } else { [parent beginSheet: panel completionHandler:nil]; + modalReturnCode = [panel runModal]; + [NSApp tkFilePanelDidEnd:panel + returnCode:modalReturnCode + contextInfo:callbackInfo ]; } - - } - /* - * On macOS 10.15 and higher, calling runModalForWindow generates - * warnings on stderr. - */ - - if ( osVersion > 101400) { - modalReturnCode = [panel runModal]; } else { - modalReturnCode = [NSApp runModalForWindow:panel]; - } - - if (osVersion < 101500 || osVersion >= 110000 ) { + modalReturnCode = [panel runModal]; [NSApp tkFilePanelDidEnd:panel returnCode:modalReturnCode contextInfo:callbackInfo ]; @@ -680,11 +679,10 @@ Tk_GetOpenFileObjCmd( NSString *directory = nil, *filename = nil; NSString *message = nil, *title = nil; NSWindow *parent; + openpanel = [NSOpenPanel openPanel]; NSInteger modalReturnCode = modalError; BOOL parentIsKey = NO; - openpanel = [NSOpenPanel openPanel]; - for (i = 1; i < objc; i += 2) { if (Tcl_GetIndexFromObjStruct(interp, objv[i], openOptionStrings, sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { @@ -747,6 +745,7 @@ Tk_GetOpenFileObjCmd( } } if (title) { + [openpanel setTitle:title]; /* * From OSX 10.11, the title string is silently ignored in the open @@ -763,8 +762,6 @@ Tk_GetOpenFileObjCmd( } else { message = title; } - } else { - [openpanel setTitle:title]; } } @@ -955,13 +952,10 @@ Tk_GetSaveFileObjCmd( NSString *directory = nil, *filename = nil, *defaultType = nil; NSString *message = nil, *title = nil; NSWindow *parent; + savepanel = [NSSavePanel savePanel]; NSInteger modalReturnCode = modalError; BOOL parentIsKey = NO; - if (savepanel == nil) { - savepanel = [NSSavePanel savePanel]; - [savepanel setDelegate:NSApp]; - } for (i = 1; i < objc; i += 2) { if (Tcl_GetIndexFromObjStruct(interp, objv[i], saveOptionStrings, sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { @@ -1034,26 +1028,25 @@ Tk_GetSaveFileObjCmd( } if (title) { + [savepanel setTitle:title]; /* * From OSX 10.11, the title string is silently ignored, if the save * panel is a sheet. Prepend the title to the message in this case. + * NOTE: should be conditional on OSX version, but -mmacosx-version-min + * does not revert this behaviour. */ - if ([NSApp macOSVersion] > 101000) { - if (haveParentOption) { - if (message) { - NSString *fullmessage = - [[NSString alloc] initWithFormat:@"%@\n%@",title,message]; - [message release]; - [title release]; - message = fullmessage; - } else { - message = title; - } + if (haveParentOption) { + if (message) { + NSString *fullmessage = + [[NSString alloc] initWithFormat:@"%@\n%@",title,message]; + [message release]; + [title release]; + message = fullmessage; + } else { + message = title; } - } else { - [savepanel setTitle:title]; } } -- cgit v0.12