summaryrefslogtreecommitdiffstats
path: root/doc/return.n
diff options
context:
space:
mode:
authorpoenitz <poenitz>2000-09-07 14:27:45 (GMT)
committerpoenitz <poenitz>2000-09-07 14:27:45 (GMT)
commit39d44b87548e38d667e0b1917f2fb2ee8d82958d (patch)
treef68040024b28950e64e8fe7aeaa92a7c84c31a7e /doc/return.n
parent68a252b7d9b1335f2236481163d17395a08c3327 (diff)
downloadtcl-39d44b87548e38d667e0b1917f2fb2ee8d82958d.zip
tcl-39d44b87548e38d667e0b1917f2fb2ee8d82958d.tar.gz
tcl-39d44b87548e38d667e0b1917f2fb2ee8d82958d.tar.bz2
New or changed "SEE ALSO" section.
Diffstat (limited to 'doc/return.n')
-rw-r--r--doc/return.n5
1 files changed, 4 insertions, 1 deletions
diff --git a/doc/return.n b/doc/return.n
index d3a3635..2ea381d 100644
--- a/doc/return.n
+++ b/doc/return.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: return.n,v 1.2 1998/09/14 18:39:54 stanton Exp $
+'\" RCS: @(#) $Id: return.n,v 1.3 2000/09/07 14:27:51 poenitz Exp $
'\"
.so man.macros
.TH return n 7.0 Tcl "Tcl Built-In Commands"
@@ -85,5 +85,8 @@ a value for the \fBerrorCode\fR variable.
If the option is not specified then \fBerrorCode\fR will
default to \fBNONE\fR.
+.SH "SEE ALSO"
+break(n), continue(n), error(n), proc(n)
+
.SH KEYWORDS
break, continue, error, procedure, return
it v0.12 From 450aa9743dee157400ca5b3227922914f1c434a0 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 19 Nov 2015 21:59:11 +0000 Subject: Tcl_Preserve should be first I guess --- generic/tkTextDisp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 8f72be0..a8a8f85 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -2946,8 +2946,9 @@ AsyncUpdateLineMetrics( */ if (textPtr->afterSyncCmd != NULL) { - int code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); + int code; Tcl_Preserve((ClientData)textPtr->interp); + code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) { Tcl_AddErrorInfo(textPtr->interp, "\n (text yupdate)"); -- cgit v0.12 From a2432ecdb54d15171a3f5f403048743e09305ea5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 19 Nov 2015 22:02:27 +0000 Subject: Rename "yupdate" to "sync" and fix various test-cases --- generic/tkText.c | 50 +++++++++++++++++++++++++------------------------- generic/tkText.h | 2 +- generic/tkTextDisp.c | 24 ++++++++++++------------ tests/text.test | 42 +++++++++++++++++++++--------------------- tests/textDisp.test | 20 ++++++++++---------- 5 files changed, 69 insertions(+), 69 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 15c6e73..9047911 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -689,16 +689,16 @@ TextWidgetObjCmd( static const char *optionStrings[] = { "bbox", "cget", "compare", "configure", "count", "debug", "delete", "dlineinfo", "dump", "edit", "get", "image", "index", "insert", - "mark", "peer", "pendingyupdate", "replace", "scan", "search", - "see", "tag", "window", "xview", "yupdate", "yview", NULL + "mark", "peer", "pendingsync", "replace", "scan", "search", + "see", "sync", "tag", "window", "xview", "yview", NULL }; enum options { TEXT_BBOX, TEXT_CGET, TEXT_COMPARE, TEXT_CONFIGURE, TEXT_COUNT, TEXT_DEBUG, TEXT_DELETE, TEXT_DLINEINFO, TEXT_DUMP, TEXT_EDIT, TEXT_GET, TEXT_IMAGE, TEXT_INDEX, TEXT_INSERT, TEXT_MARK, - TEXT_PEER, TEXT_PENDINGYUPDATE, TEXT_REPLACE, TEXT_SCAN, - TEXT_SEARCH, TEXT_SEE, TEXT_TAG, TEXT_WINDOW, TEXT_XVIEW, - TEXT_YUPDATE, TEXT_YVIEW + TEXT_PEER, TEXT_PENDINGSYNC, TEXT_REPLACE, TEXT_SCAN, + TEXT_SEARCH, TEXT_SEE, TEXT_SYNC, TEXT_TAG, TEXT_WINDOW, + TEXT_XVIEW, TEXT_YVIEW }; if (objc < 2) { @@ -1373,7 +1373,7 @@ TextWidgetObjCmd( case TEXT_PEER: result = TextPeerCmd(textPtr, interp, objc, objv); break; - case TEXT_PENDINGYUPDATE: { + case TEXT_PENDINGSYNC: { int number; if (objc != 2) { @@ -1381,7 +1381,7 @@ TextWidgetObjCmd( result = TCL_ERROR; goto done; } - number = TkTextPendingyupdate(textPtr); + number = TkTextPendingsync(textPtr); Tcl_SetObjResult(interp, Tcl_NewIntObj(number)); break; } @@ -1507,26 +1507,26 @@ TextWidgetObjCmd( case TEXT_XVIEW: result = TkTextXviewCmd(textPtr, interp, objc, objv); break; - case TEXT_YUPDATE: { + case TEXT_SYNC: { if (objc == 4) { - Tcl_Obj *cmd = objv[3]; - const char *option = Tcl_GetString(objv[2]); - if (strncmp(option, "-command", objv[2]->length)) { - Tcl_AppendResult(interp, "wrong option \"", option, "\": should be \"-command\"", NULL); - result = TCL_ERROR; - goto done; - } - Tcl_IncrRefCount(cmd); - if (TkTextPendingyupdate(textPtr)) { - if (textPtr->afterSyncCmd) { - Tcl_DecrRefCount(textPtr->afterSyncCmd); - } - textPtr->afterSyncCmd = cmd; - } else { - result = Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); - Tcl_DecrRefCount(cmd); + Tcl_Obj *cmd = objv[3]; + const char *option = Tcl_GetString(objv[2]); + if (strncmp(option, "-command", objv[2]->length)) { + Tcl_AppendResult(interp, "wrong option \"", option, "\": should be \"-command\"", NULL); + result = TCL_ERROR; + goto done; + } + Tcl_IncrRefCount(cmd); + if (TkTextPendingsync(textPtr)) { + if (textPtr->afterSyncCmd) { + Tcl_DecrRefCount(textPtr->afterSyncCmd); } - break; + textPtr->afterSyncCmd = cmd; + } else { + result = Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(cmd); + } + break; } else if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, "?-command command?"); result = TCL_ERROR; diff --git a/generic/tkText.h b/generic/tkText.h index 2aa8d59..1c4be68 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -1125,7 +1125,7 @@ MODULE_SCOPE int TkTextMarkNameToIndex(TkText *textPtr, MODULE_SCOPE void TkTextMarkSegToIndex(TkText *textPtr, TkTextSegment *markPtr, TkTextIndex *indexPtr); MODULE_SCOPE void TkTextEventuallyRepick(TkText *textPtr); -MODULE_SCOPE int TkTextPendingyupdate(TkText *textPtr); +MODULE_SCOPE int TkTextPendingsync(TkText *textPtr); MODULE_SCOPE void TkTextPickCurrent(TkText *textPtr, XEvent *eventPtr); MODULE_SCOPE void TkTextPixelIndex(TkText *textPtr, int x, int y, TkTextIndex *indexPtr, int *nearest); diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index a8a8f85..3cee288 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -590,7 +590,7 @@ static int TextGetScrollInfoObj(Tcl_Interp *interp, Tcl_Obj *CONST objv[], double *dblPtr, int *intPtr); static void AsyncUpdateLineMetrics(ClientData clientData); -static void GenerateTextLineHeightsInvalidEvent(TkText *textPtr); +static void GenerateWidgetViewSyncEvent(TkText *textPtr); static void AsyncUpdateYScrollbar(ClientData clientData); static int IsStartOfNotMergedLine(TkText *textPtr, CONST TkTextIndex *indexPtr); @@ -2930,7 +2930,7 @@ AsyncUpdateLineMetrics( LOG("tk_textInvalidateLine", buffer); } - GenerateTextLineHeightsInvalidEvent(textPtr); + GenerateWidgetViewSyncEvent(textPtr); /* * If we're not in the middle of a long-line calculation (metricEpoch==-1) @@ -2942,7 +2942,7 @@ AsyncUpdateLineMetrics( /* * We have looped over all lines, so we're done. We must release our * refCount on the widget (the timer token was already set to NULL - * above). If there is a registered command, run that first. + * above). If there is a registered aftersync command, run that first. */ if (textPtr->afterSyncCmd != NULL) { @@ -2951,7 +2951,7 @@ AsyncUpdateLineMetrics( code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) { - Tcl_AddErrorInfo(textPtr->interp, "\n (text yupdate)"); + Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); Tcl_BackgroundError(textPtr->interp); } Tcl_Release((ClientData)textPtr->interp); @@ -2978,12 +2978,12 @@ AsyncUpdateLineMetrics( /* *---------------------------------------------------------------------- * - * GenerateTextLineHeightsInvalidEvent -- + * GenerateWidgetViewSyncEvent -- * - * Send the <> event related to the text widget + * Send the <> event related to the text widget * line metrics asynchronous update. * This is equivalent to: - * event generate $textWidget <> -detail $N + * event generate $textWidget <> -detail $N * where $N is the number of lines for which the height is outdated. * * Results: @@ -2996,7 +2996,7 @@ AsyncUpdateLineMetrics( */ static void -GenerateTextLineHeightsInvalidEvent( +GenerateWidgetViewSyncEvent( TkText *textPtr) /* Information about text widget. */ { union {XEvent general; XVirtualEvent virtual;} event; @@ -3007,8 +3007,8 @@ GenerateTextLineHeightsInvalidEvent( event.general.xany.send_event = False; event.general.xany.window = Tk_WindowId(textPtr->tkwin); event.general.xany.display = Tk_Display(textPtr->tkwin); - event.virtual.name = Tk_GetUid("TextLineHeightsInvalid"); - event.virtual.user_data = Tcl_NewIntObj(TkTextPendingyupdate(textPtr)); + event.virtual.name = Tk_GetUid("WidgetViewSync"); + event.virtual.user_data = Tcl_NewIntObj(TkTextPendingsync(textPtr)); Tk_HandleEvent(&event.general); } @@ -6089,7 +6089,7 @@ TkTextYviewCmd( /* *-------------------------------------------------------------- * - * TkTextPendingyupdate -- + * TkTextPendingsync -- * * This function computes how many lines are not up-to-date regarding * asynchronous height calculations. @@ -6105,7 +6105,7 @@ TkTextYviewCmd( */ int -TkTextPendingyupdate( +TkTextPendingsync( TkText *textPtr) /* Information about text widget. */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; diff --git a/tests/text.test b/tests/text.test index 7e754e2..3532546 100644 --- a/tests/text.test +++ b/tests/text.test @@ -153,7 +153,7 @@ test text-3.1 {TextWidgetCmd procedure, basics} { } {1 {wrong # args: should be ".t option ?arg arg ...?"}} test text-3.2 {TextWidgetCmd procedure} { list [catch {.t gorp 1.0 z 1.2} msg] $msg -} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingyupdate, replace, scan, search, see, tag, window, xview, yupdate, or yview}} +} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview}} test text-4.1 {TextWidgetCmd procedure, "bbox" option} { list [catch {.t bbox} msg] $msg @@ -221,7 +221,7 @@ test text-6.13 {TextWidgetCmd procedure, "compare" option} { } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} test text-6.14 {TextWidgetCmd procedure, "compare" option} { list [catch {.t co 1.0 z 1.2} msg] $msg -} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingyupdate, replace, scan, search, see, tag, window, xview, yupdate, or yview}} +} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview}} # "configure" option is already covered above @@ -230,7 +230,7 @@ test text-7.1 {TextWidgetCmd procedure, "debug" option} { } {1 {wrong # args: should be ".t debug boolean"}} test text-7.2 {TextWidgetCmd procedure, "debug" option} { list [catch {.t de 0 1} msg] $msg -} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingyupdate, replace, scan, search, see, tag, window, xview, yupdate, or yview}} +} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview}} test text-7.3 {TextWidgetCmd procedure, "debug" option} { .t debug true .t deb @@ -901,7 +901,7 @@ test text-10.2 {TextWidgetCmd procedure, "index" option} { } {1 {wrong # args: should be ".t index index"}} test text-10.3 {TextWidgetCmd procedure, "index" option} { list [catch {.t in a b} msg] $msg -} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingyupdate, replace, scan, search, see, tag, window, xview, yupdate, or yview}} +} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview}} test text-10.4 {TextWidgetCmd procedure, "index" option} { list [catch {.t index @xyz} msg] $msg } {1 {bad text index "@xyz"}} @@ -960,12 +960,12 @@ test text-11.10 {TextWidgetCmd procedure, "insert" option} { list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly] } {{First second} {1.0 1.5} {1.5 1.12}} -test text-11a.1 {TextWidgetCmd procedure, "yupdate" option} { +test text-11a.1 {TextWidgetCmd procedure, "sync" option} { destroy .yt text .yt - list [catch {.yt yupdate mytext} msg] $msg -} {1 {wrong # args: should be ".yt yupdate"}} -test text-11a.2 {TextWidgetCmd procedure, "yupdate" option} { + list [catch {.yt sync mytext} msg] $msg +} {1 {wrong # args: should be ".yt sync ?-command command?"}} +test text-11a.2 {TextWidgetCmd procedure, "sync" option} { destroy .top.yt .top toplevel .top pack [text .top.yt] @@ -976,7 +976,7 @@ test text-11a.2 {TextWidgetCmd procedure, "yupdate" option} { .top.yt insert 1.0 $content # wait for end of line metrics calculation to get correct $fraction1 # as a reference - .top.yt yupdate + .top.yt sync .top.yt yview moveto 1 set fraction1 [lindex [.top.yt yview] 0] set res [expr {$fraction1 > 0}] @@ -989,17 +989,17 @@ test text-11a.2 {TextWidgetCmd procedure, "yupdate" option} { # second case: wait for completion of line metrics calculation .top.yt delete 1.0 end .top.yt insert 1.0 $content - .top.yt yupdate + .top.yt sync .top.yt yview moveto $fraction1 set fraction2 [lindex [.top.yt yview] 0] lappend res [expr {$fraction1 == $fraction2}] } {1 0 1} -test text-11a.11 {TextWidgetCmd procedure, "pendingyupdate" option} { +test text-11a.11 {TextWidgetCmd procedure, "pendingsync" option} { destroy .yt text .yt - list [catch {.yt pendingyupdate mytext} msg] $msg -} {1 {wrong # args: should be ".yt pendingyupdate"}} -test text-11a.12 {TextWidgetCmd procedure, "pendingyupdate" option} { + list [catch {.yt pendingsync mytext} msg] $msg +} {1 {wrong # args: should be ".yt pendingsync"}} +test text-11a.12 {TextWidgetCmd procedure, "pendingsync" option} { destroy .top.yt .top toplevel .top pack [text .top.yt] @@ -1011,21 +1011,21 @@ test text-11a.12 {TextWidgetCmd procedure, "pendingyupdate" option} { update # wait for end of line metrics calculation to get correct $fraction1 # as a reference - while {[.top.yt pendingyupdate]} {update} + while {[.top.yt pendingsync]} {update} .top.yt yview moveto 1 set fraction1 [lindex [.top.yt yview] 0] set res [expr {$fraction1 > 0}] .top.yt delete 1.0 end .top.yt insert 1.0 $content # ensure the test is relevant - lappend res [expr {[.top.yt pendingyupdate] > 0}] + lappend res [expr {[.top.yt pendingsync] > 0}] # asynchronously wait for completion of line metrics calculation - while {[.top.yt pendingyupdate]} {update} + while {[.top.yt pendingsync]} {update} .top.yt yview moveto $fraction1 set fraction2 [lindex [.top.yt yview] 0] lappend res [expr {$fraction1 == $fraction2}] } {1 1 1} -test text-11a.21 {"<>" event} { +test text-11a.21 {"<>" event} { destroy .top.yt .top toplevel .top pack [text .top.yt] @@ -1035,10 +1035,10 @@ test text-11a.21 {"<>" event} { } .top.yt insert 1.0 $content update - bind .top.yt <> { if {%d == 0} {set yud(%W) 1} } + bind .top.yt <> { if {%d == 0} {set yud(%W) 1} } # wait for end of line metrics calculation to get correct $fraction1 # as a reference - if {[.top.yt pendingyupdate]} {vwait yud(.top.yt)} + if {[.top.yt pendingsync]} {vwait yud(.top.yt)} .top.yt yview moveto 1 set fraction1 [lindex [.top.yt yview] 0] set res [expr {$fraction1 > 0}] @@ -1047,7 +1047,7 @@ test text-11a.21 {"<>" event} { # synchronously wait for completion of line metrics calculation # and ensure the test is relevant set waited 0 - if {[.top.yt pendingyupdate]} {set waited 1 ; vwait yud(.top.yt)} + if {[.top.yt pendingsync]} {set waited 1 ; vwait yud(.top.yt)} lappend res $waited .top.yt yview moveto $fraction1 set fraction2 [lindex [.top.yt yview] 0] diff --git a/tests/textDisp.test b/tests/textDisp.test index 133fcf5..80bdb9d 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -4175,9 +4175,9 @@ test textDisp-34.1 {Line heights recalculation problem: bug 2677890} -setup { set ge [winfo geometry .] scan $ge "%dx%d+%d+%d" width height left top update - .t1 yupdate + .t1 sync set negative 0 - bind .t1 <> { if {%d < 0} {set negative 1} } + bind .t1 <> { if {%d < 0} {set negative 1} } # Without the fix for bug 2677890, changing the width of the toplevel # will launch recomputation of the line heights, but will produce negative # number of still remaining outdated lines, which is obviously wrong. @@ -4185,33 +4185,33 @@ test textDisp-34.1 {Line heights recalculation problem: bug 2677890} -setup { # i.e. to check that the fix for this bug really is still in. wm geometry . "[expr {$width * 2}]x$height+$left+$top" update - .t1 yupdate + .t1 sync set negative } -cleanup { destroy .t1 } -result {0} -test textDisp-34.2 {text yupdate syntax} -body { +test textDisp-34.2 {text sync syntax} -body { } -body { pack [text .t1] -expand 1 -fill both - .t1 yupdate foo + .t1 sync foo } -cleanup { destroy .t1 -} -returnCodes 1 -result {wrong # args: should be ".t1 yupdate ?-command command?"} +} -returnCodes 1 -result {wrong # args: should be ".t1 sync ?-command command?"} -test textDisp-34.3 {text yupdate syntax} -body { +test textDisp-34.3 {text sync syntax} -body { } -body { pack [text .t1] -expand 1 -fill both - .t1 yupdate -comx foo + .t1 sync -comx foo } -cleanup { destroy .t1 } -returnCodes 1 -result {wrong option "-comx": should be "-command"} -test textDisp-34.4 {text yupdate syntax} -body { +test textDisp-34.4 {text sync syntax} -body { } -body { set ::x 0 pack [text .t1] -expand 1 -fill both - .t1 yupdate -comm [list set ::x 1] + .t1 sync -comm [list set ::x 1] set ::x } -cleanup { destroy .t1 -- cgit v0.12 From 1238f724da65d098cb652af93972b4d0ac6e8f72 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 21 Nov 2015 08:43:25 +0000 Subject: Adjusted when <> fires. Also %d now only has boolean value. Implementation in sync with TIP #438 rev. 1.10 --- generic/tkTextDisp.c | 24 +++++++++++++++++------- tests/text.test | 2 +- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 3cee288..d8a17a9 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -590,7 +590,7 @@ static int TextGetScrollInfoObj(Tcl_Interp *interp, Tcl_Obj *CONST objv[], double *dblPtr, int *intPtr); static void AsyncUpdateLineMetrics(ClientData clientData); -static void GenerateWidgetViewSyncEvent(TkText *textPtr); +static void GenerateWidgetViewSyncEvent(TkText *textPtr, Bool InSync); static void AsyncUpdateYScrollbar(ClientData clientData); static int IsStartOfNotMergedLine(TkText *textPtr, CONST TkTextIndex *indexPtr); @@ -2930,8 +2930,6 @@ AsyncUpdateLineMetrics( LOG("tk_textInvalidateLine", buffer); } - GenerateWidgetViewSyncEvent(textPtr); - /* * If we're not in the middle of a long-line calculation (metricEpoch==-1) * and we've reached the last line, then we're done. @@ -2959,6 +2957,14 @@ AsyncUpdateLineMetrics( textPtr->afterSyncCmd = 0; } + /* + * Fire the <> event since the widget view is in sync + * with its internal data (actually it will be after the next trip + * through the event loop, because the widget redraws at idle-time). + */ + + GenerateWidgetViewSyncEvent(textPtr, 1); + textPtr->refCount--; if (textPtr->refCount == 0) { ckfree((char *) textPtr); @@ -2983,8 +2989,9 @@ AsyncUpdateLineMetrics( * Send the <> event related to the text widget * line metrics asynchronous update. * This is equivalent to: - * event generate $textWidget <> -detail $N - * where $N is the number of lines for which the height is outdated. + * event generate $textWidget <> -detail $s + * where $s is the sync status: true (when the widget view is in + * sync with its internal data) or false (when it is not). * * Results: * None @@ -2997,7 +3004,8 @@ AsyncUpdateLineMetrics( static void GenerateWidgetViewSyncEvent( - TkText *textPtr) /* Information about text widget. */ + TkText *textPtr, /* Information about text widget. */ + Bool InSync) /* True if in sync, false otherwise */ { union {XEvent general; XVirtualEvent virtual;} event; @@ -3008,7 +3016,7 @@ GenerateWidgetViewSyncEvent( event.general.xany.window = Tk_WindowId(textPtr->tkwin); event.general.xany.display = Tk_Display(textPtr->tkwin); event.virtual.name = Tk_GetUid("WidgetViewSync"); - event.virtual.user_data = Tcl_NewIntObj(TkTextPendingsync(textPtr)); + event.virtual.user_data = Tcl_NewBooleanObj(InSync); Tk_HandleEvent(&event.general); } @@ -3391,6 +3399,7 @@ TextInvalidateLineMetrics( textPtr->refCount++; dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1, AsyncUpdateLineMetrics, (ClientData) textPtr); + GenerateWidgetViewSyncEvent(textPtr, 0); } } @@ -5095,6 +5104,7 @@ TkTextRelayoutWindow( textPtr->refCount++; dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1, AsyncUpdateLineMetrics, (ClientData) textPtr); + GenerateWidgetViewSyncEvent(textPtr, 0); } } } diff --git a/tests/text.test b/tests/text.test index 3532546..3ba85b7 100644 --- a/tests/text.test +++ b/tests/text.test @@ -1035,7 +1035,7 @@ test text-11a.21 {"<>" event} { } .top.yt insert 1.0 $content update - bind .top.yt <> { if {%d == 0} {set yud(%W) 1} } + bind .top.yt <> { if {%d} {set yud(%W) 1} } # wait for end of line metrics calculation to get correct $fraction1 # as a reference if {[.top.yt pendingsync]} {vwait yud(.top.yt)} -- cgit v0.12 From 6da3f989a4249675d97ecad8989d070f87966068 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 21 Nov 2015 09:08:52 +0000 Subject: Improved the tests a bit --- tests/text.test | 55 +++++++++++++++++++++++++++++++++++++++++++---------- tests/textDisp.test | 26 ------------------------- 2 files changed, 45 insertions(+), 36 deletions(-) diff --git a/tests/text.test b/tests/text.test index 3ba85b7..563f61b 100644 --- a/tests/text.test +++ b/tests/text.test @@ -960,13 +960,25 @@ test text-11.10 {TextWidgetCmd procedure, "insert" option} { list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly] } {{First second} {1.0 1.5} {1.5 1.12}} -test text-11a.1 {TextWidgetCmd procedure, "sync" option} { +test text-11a.1 {TextWidgetCmd procedure, "sync" option} -setup { destroy .yt +} -body { text .yt list [catch {.yt sync mytext} msg] $msg -} {1 {wrong # args: should be ".yt sync ?-command command?"}} -test text-11a.2 {TextWidgetCmd procedure, "sync" option} { +} -cleanup { + destroy .yt +} -result {1 {wrong # args: should be ".yt sync ?-command command?"}} +test text-11a.2 {TextWidgetCmd procedure, "sync" option with -command} -setup { + destroy .yt +} -body { + text .yt + list [catch {.yt sync -comx foo} msg] $msg +} -cleanup { + destroy .yt +} -result {1 {wrong option "-comx": should be "-command"}} +test text-11a.3 {TextWidgetCmd procedure, "sync" option} -setup { destroy .top.yt .top +} -body { toplevel .top pack [text .top.yt] set content {} @@ -993,14 +1005,31 @@ test text-11a.2 {TextWidgetCmd procedure, "sync" option} { .top.yt yview moveto $fraction1 set fraction2 [lindex [.top.yt yview] 0] lappend res [expr {$fraction1 == $fraction2}] -} {1 0 1} -test text-11a.11 {TextWidgetCmd procedure, "pendingsync" option} { +} -cleanup { + destroy .top.yt .top +} -result {1 0 1} +test text-11a.4 {TextWidgetCmd procedure, "sync" option with -command} -setup { + destroy .yt +} -body { + set ::x 0 + pack [text .yt] -expand 1 -fill both + .yt sync -command [list set ::x 1] + set ::x +} -cleanup { + destroy .yt +} -result {1} + +test text-11a.11 {TextWidgetCmd procedure, "pendingsync" option} -setup { destroy .yt +} -body { text .yt list [catch {.yt pendingsync mytext} msg] $msg -} {1 {wrong # args: should be ".yt pendingsync"}} -test text-11a.12 {TextWidgetCmd procedure, "pendingsync" option} { +} -cleanup { + destroy .yt +} -result {1 {wrong # args: should be ".yt pendingsync"}} +test text-11a.12 {TextWidgetCmd procedure, "pendingsync" option} -setup { destroy .top.yt .top +} -body { toplevel .top pack [text .top.yt] set content {} @@ -1024,9 +1053,13 @@ test text-11a.12 {TextWidgetCmd procedure, "pendingsync" option} { .top.yt yview moveto $fraction1 set fraction2 [lindex [.top.yt yview] 0] lappend res [expr {$fraction1 == $fraction2}] -} {1 1 1} -test text-11a.21 {"<>" event} { +} -cleanup { + destroy .top.yt .top +} -result {1 1 1} + +test text-11a.21 {"<>" event} -setup { destroy .top.yt .top +} -body { toplevel .top pack [text .top.yt] set content {} @@ -1052,7 +1085,9 @@ test text-11a.21 {"<>" event} { .top.yt yview moveto $fraction1 set fraction2 [lindex [.top.yt yview] 0] lappend res [expr {$fraction1 == $fraction2}] -} {1 1 1} +} -cleanup { + destroy .top.yt .top +} -result {1 1 1} # edit, mark, scan, search, see, tag, window, xview and yview actions are tested elsewhere. diff --git a/tests/textDisp.test b/tests/textDisp.test index 80bdb9d..c8264e6 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -4191,32 +4191,6 @@ test textDisp-34.1 {Line heights recalculation problem: bug 2677890} -setup { destroy .t1 } -result {0} -test textDisp-34.2 {text sync syntax} -body { -} -body { - pack [text .t1] -expand 1 -fill both - .t1 sync foo -} -cleanup { - destroy .t1 -} -returnCodes 1 -result {wrong # args: should be ".t1 sync ?-command command?"} - -test textDisp-34.3 {text sync syntax} -body { -} -body { - pack [text .t1] -expand 1 -fill both - .t1 sync -comx foo -} -cleanup { - destroy .t1 -} -returnCodes 1 -result {wrong option "-comx": should be "-command"} - -test textDisp-34.4 {text sync syntax} -body { -} -body { - set ::x 0 - pack [text .t1] -expand 1 -fill both - .t1 sync -comm [list set ::x 1] - set ::x -} -cleanup { - destroy .t1 -} -result {1} - deleteWindows option clear -- cgit v0.12 From b8c501de57829ea58d14a2f24841dec61241230a Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 21 Nov 2015 12:47:31 +0000 Subject: Respect alphabetical order --- generic/tkText.c | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 9047911..62de1af 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -1498,15 +1498,6 @@ TextWidgetObjCmd( case TEXT_SEE: result = TkTextSeeCmd(textPtr, interp, objc, objv); break; - case TEXT_TAG: - result = TkTextTagCmd(textPtr, interp, objc, objv); - break; - case TEXT_WINDOW: - result = TkTextWindowCmd(textPtr, interp, objc, objv); - break; - case TEXT_XVIEW: - result = TkTextXviewCmd(textPtr, interp, objc, objv); - break; case TEXT_SYNC: { if (objc == 4) { Tcl_Obj *cmd = objv[3]; @@ -1540,6 +1531,15 @@ TextWidgetObjCmd( TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr), -1); break; } + case TEXT_TAG: + result = TkTextTagCmd(textPtr, interp, objc, objv); + break; + case TEXT_WINDOW: + result = TkTextWindowCmd(textPtr, interp, objc, objv); + break; + case TEXT_XVIEW: + result = TkTextXviewCmd(textPtr, interp, objc, objv); + break; case TEXT_YVIEW: result = TkTextYviewCmd(textPtr, interp, objc, objv); break; -- cgit v0.12 From 258c36047d8f5dfd175a0b2cbaab37c1d0406cec Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 22 Nov 2015 20:11:32 +0000 Subject: Use the new sync command instead of the 'count -update' workaround --- tests/text.test | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/tests/text.test b/tests/text.test index 563f61b..dc44293 100644 --- a/tests/text.test +++ b/tests/text.test @@ -745,10 +745,7 @@ test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup { .t tag configure hidden -elide true .t tag add hidden 5.7 11.0 update - # next line to be fully sure that asynchronous line heights calculation is - # up-to-date otherwise this test may fail (depending on the computer - # performance), especially when the . toplevel has small height - .t count -update -ypixels 1.0 end + .t sync set y1 [lindex [.t yview] 1] .t count -displaylines 5.0 11.0 set y2 [lindex [.t yview] 1] -- cgit v0.12 From 492a37c09443c512e4054acff1bd206ae5d4d501 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 28 Nov 2015 19:45:01 +0000 Subject: [.text pendingsync] returns a boolean --- generic/tkText.c | 6 ++---- generic/tkText.h | 2 +- generic/tkTextDisp.c | 13 +++++++------ tests/text.test | 2 +- 4 files changed, 11 insertions(+), 12 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 62de1af..09e656f 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -1374,15 +1374,13 @@ TextWidgetObjCmd( result = TextPeerCmd(textPtr, interp, objc, objv); break; case TEXT_PENDINGSYNC: { - int number; - if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); result = TCL_ERROR; goto done; } - number = TkTextPendingsync(textPtr); - Tcl_SetObjResult(interp, Tcl_NewIntObj(number)); + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(TkTextPendingsync(textPtr))); break; } case TEXT_REPLACE: { diff --git a/generic/tkText.h b/generic/tkText.h index 1c4be68..49ee479 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -1125,7 +1125,7 @@ MODULE_SCOPE int TkTextMarkNameToIndex(TkText *textPtr, MODULE_SCOPE void TkTextMarkSegToIndex(TkText *textPtr, TkTextSegment *markPtr, TkTextIndex *indexPtr); MODULE_SCOPE void TkTextEventuallyRepick(TkText *textPtr); -MODULE_SCOPE int TkTextPendingsync(TkText *textPtr); +MODULE_SCOPE Bool TkTextPendingsync(TkText *textPtr); MODULE_SCOPE void TkTextPickCurrent(TkText *textPtr, XEvent *eventPtr); MODULE_SCOPE void TkTextPixelIndex(TkText *textPtr, int x, int y, TkTextIndex *indexPtr, int *nearest); diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index d8a17a9..d214fa7 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -6101,12 +6101,11 @@ TkTextYviewCmd( * * TkTextPendingsync -- * - * This function computes how many lines are not up-to-date regarding - * asynchronous height calculations. + * This function checks if any line heights are not up-to-date. * * Results: - * Returns a positive integer corresponding to the number of lines for - * which the height is outdated. + * Returns a boolean true if it is the case, or false if all line + * heights are up-to-date. * * Side effects: * None. @@ -6114,13 +6113,15 @@ TkTextYviewCmd( *-------------------------------------------------------------- */ -int +Bool TkTextPendingsync( TkText *textPtr) /* Information about text widget. */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; - return (dInfoPtr->lastMetricUpdateLine - dInfoPtr->currentMetricUpdateLine); + return ( + (dInfoPtr->lastMetricUpdateLine - dInfoPtr->currentMetricUpdateLine) ? + 1 : 0); } /* diff --git a/tests/text.test b/tests/text.test index dc44293..89dd12c 100644 --- a/tests/text.test +++ b/tests/text.test @@ -1044,7 +1044,7 @@ test text-11a.12 {TextWidgetCmd procedure, "pendingsync" option} -setup { .top.yt delete 1.0 end .top.yt insert 1.0 $content # ensure the test is relevant - lappend res [expr {[.top.yt pendingsync] > 0}] + lappend res [.top.yt pendingsync] # asynchronously wait for completion of line metrics calculation while {[.top.yt pendingsync]} {update} .top.yt yview moveto $fraction1 -- cgit v0.12 From c7c6352112248f90539ef01a9d921745572b5d6b Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 28 Nov 2015 21:38:19 +0000 Subject: Text widget documentation updated according to TIP #438 --- doc/text.n | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 92 insertions(+), 1 deletion(-) diff --git a/doc/text.n b/doc/text.n index d2f0c82..f7cb143 100644 --- a/doc/text.n +++ b/doc/text.n @@ -1060,6 +1060,82 @@ affected. See below for the \fIpathName \fBpeer\fR widget command that controls the creation of peer widgets. .VE 8.5 +.SH "ASYNCHRONOUS UPDATE OF LINE HEIGHTS" +.PP +In order to maintain a responsive user-experience, the text widget calculates +lines metrics (line heights in pixels) asynchronously. Because of this, some +commands of the text widget may return wrong results if the asynchronous +calculations are not finished at the time of calling. This applies to +\fIpathName \fBcount -ypixels\fR and \fIpathName \fByview\fR. +.PP +Again for performance reasons, it would not be appropriate to let these +commands always wait for the end of the update calculation each time they are +called. In most use cases of these commands a more or less inaccurate result +does not really matter compared to execution speed. +.PP +In case accurate result is needed (and if the text widget is managed by a +geometry manager), one can resort to \fIpathName \fBsync\fR and \fIpathName +\fBpendingsync\fR to control the synchronization of the view of text widgets. +.PP +The \fB<>\fR virtual event fires when the line heights of the +text widget becomes obsolete (due to some editing command or configuration +change), and again when the internal data of the text widget are back in sync +with the widget view. The detail field (%d substitution) is either true (when +the widget is in sync) or false (when it is not). +.PP +\fIpathName \fBsync\fR, \fIpathName \fBpendingsync\fR and +\fB<>\fR apply to each text widget independently of its peers. +.PP +Examples of use: +.CS +## Example 1: +# runtime, immediately complete line metrics at any cost (GUI unresponsive) +$w sync +$w yview moveto $fraction + +## Example 2: +# runtime, synchronously wait for up-to-date line metrics (GUI responsive) +$w sync -command [list $w yview moveto $fraction] + +## Example 3: +# init +set yud($w) 0 +proc updateaction w { +\&set ::yud($w) 1 +\&# any other update action here... +} +# runtime, synchronously wait for up-to-date line metrics (GUI responsive) +$w sync -command [list updateaction $w] +vwait yud($w) +$w yview moveto $fraction + +## Example 4: +# init +set todo($w) {} +proc updateaction w { +\&foreach cmd $::todo($w) {uplevel #0 $cmd} +\&set todo($w) {} +} +# runtime +lappend todo($w) [list $w yview moveto $fraction] +$w sync -command [list updateaction $w] + +## Example 5: +# init +set todo($w) {} +bind $w <> { +\&if {%d} { +\&\&foreach cmd $todo(%W) {eval $cmd} +\&\&set todo(%W) {} +\&} +} +# runtime +if {![$w pendingsync]} { +\&$w yview moveto $fraction +} else { +\&lappend todo($w) [list $w yview moveto $fraction] +} +.CE .SH "WIDGET COMMAND" .PP The \fBtext\fR command creates a new Tcl command whose @@ -1132,7 +1208,9 @@ if the text widget is managed by a geometry manager), then all subsequent options ensure that any possible out of date information is recalculated. This currently only has any effect for the \fI\-ypixels\fR count (which, if \fB\-update\fR is not given, will use the text widget's current cached value -for each line). The count options are interpreted as follows: +for each line). This \fB\-update\fR option is obsoleted by \fIpathName +\fBsync\fR, \fIpathName \fBpendingsync\fR and \fB<>\fR. The +count options are interpreted as follows: .RS .IP \fB\-chars\fR count all characters, whether elided or not. Do not count @@ -1508,6 +1586,9 @@ Returns a list of peers of this widget (this does not include the widget itself). The order within this list is undefined. .RE .TP +\fIpathName \fBpendingsync\fR +Returns 1 if the line heights calculations are not up-to-date, 0 otherwise. +.TP \fIpathName \fBreplace\fR \fIindex1 index2 chars\fR ?\fItagList chars tagList ...\fR? Replaces the range of characters between \fIindex1\fR and \fIindex2\fR with the given characters and tags. See the section on \fIpathName @@ -1701,6 +1782,16 @@ edge of the window. If \fIindex\fR is far out of view, then the command centers \fIindex\fR in the window. .TP +\fIpathName \fBsync\fR ?\fB-command \fIcommand\fR? +Immediately brings the line metrics up-to-date by forcing computation of any +outdated line heights. The command returns immediately if there is no such +outdated line heights, otherwise it returns only at the end of the computation. +The command returns an empty string. If \fB-command \fIcommand\fR is specified, +schedule \fIcommand\fR to be executed exactly once as soon as all line +calculations are up-to-date. If there are no pending line metrics calculations, +\fIcommand\fR is executed immediately. \fIpathName \fBsync -command +\fIcommand\fR returns the return value of \fIcommand\fR. +.TP \fIpathName \fBtag \fIoption \fR?\fIarg arg ...\fR? This command is used to manipulate tags. The exact behavior of the command depends on the \fIoption\fR argument that follows the -- cgit v0.12 From 8fd7d7784f01c76fd4cb02b9a66cc435194a8bc4 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 28 Nov 2015 22:18:58 +0000 Subject: Fixed indentation --- generic/tkText.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 09e656f..a2b7dde 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -1510,19 +1510,19 @@ TextWidgetObjCmd( if (textPtr->afterSyncCmd) { Tcl_DecrRefCount(textPtr->afterSyncCmd); } - textPtr->afterSyncCmd = cmd; + textPtr->afterSyncCmd = cmd; } else { - result = Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); - Tcl_DecrRefCount(cmd); + result = Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(cmd); } - break; + break; } else if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, "?-command command?"); - result = TCL_ERROR; - goto done; + Tcl_WrongNumArgs(interp, 2, objv, "?-command command?"); + result = TCL_ERROR; + goto done; } if (textPtr->afterSyncCmd) { - Tcl_DecrRefCount(textPtr->afterSyncCmd); + Tcl_DecrRefCount(textPtr->afterSyncCmd); } textPtr->afterSyncCmd = NULL; TkTextUpdateLineMetrics(textPtr, 1, -- cgit v0.12 From bba041fbdedf7358083ff0f2cc618a4990696bd0 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 28 Nov 2015 22:35:18 +0000 Subject: Clearer separation between what [.text sync] and [.text sync -command] exactly perform --- doc/text.n | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/doc/text.n b/doc/text.n index f7cb143..1966882 100644 --- a/doc/text.n +++ b/doc/text.n @@ -1783,14 +1783,21 @@ If \fIindex\fR is far out of view, then the command centers \fIindex\fR in the window. .TP \fIpathName \fBsync\fR ?\fB-command \fIcommand\fR? +Control the synchronization of the view of text widget. +.RS +.TP +\fIpathName \fBsync\fR Immediately brings the line metrics up-to-date by forcing computation of any outdated line heights. The command returns immediately if there is no such outdated line heights, otherwise it returns only at the end of the computation. -The command returns an empty string. If \fB-command \fIcommand\fR is specified, -schedule \fIcommand\fR to be executed exactly once as soon as all line -calculations are up-to-date. If there are no pending line metrics calculations, -\fIcommand\fR is executed immediately. \fIpathName \fBsync -command -\fIcommand\fR returns the return value of \fIcommand\fR. +The command returns an empty string. +.TP +\fIpathName \fBsync -command \fIcommand\fR +Schedule \fIcommand\fR to be executed exactly once as soon as all line heights +are up-to-date. If there are no pending line metrics calculations, +\fIcommand\fR is executed immediately and the command returns the return value +of \fIcommand\fR. Otherwise the command returns an empty string. +.RE .TP \fIpathName \fBtag \fIoption \fR?\fIarg arg ...\fR? This command is used to manipulate tags. The exact behavior of the -- cgit v0.12 From ff45ebd61fc2390dcfe72e451ddc579fe1bca4bc Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 13 Dec 2015 20:58:26 +0000 Subject: Better (and more correct) description of what [.text sync -command $command] does --- doc/text.n | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/text.n b/doc/text.n index 1966882..c55b4cf 100644 --- a/doc/text.n +++ b/doc/text.n @@ -1794,9 +1794,9 @@ The command returns an empty string. .TP \fIpathName \fBsync -command \fIcommand\fR Schedule \fIcommand\fR to be executed exactly once as soon as all line heights -are up-to-date. If there are no pending line metrics calculations, -\fIcommand\fR is executed immediately and the command returns the return value -of \fIcommand\fR. Otherwise the command returns an empty string. +are up-to-date. If there are no pending line metrics calculations, the +scheduling is immediate. The command returns the empty string. \fBbgerror\fR is +called on \fIcommand\fR failure. .RE .TP \fIpathName \fBtag \fIoption \fR?\fIarg arg ...\fR? -- cgit v0.12 From 816ab6c14bd318a6918e1cb3cd97e1de92419e1a Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 19 Dec 2015 21:48:11 +0000 Subject: Tests reordered. Two issues currently: 1. text-11a.22 currently hangs but should pass once [.text sync -command $cmd] will be correctly implemented. 2. text-11a.41 fails (unsure why) --- tests/text.test | 118 ++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 80 insertions(+), 38 deletions(-) diff --git a/tests/text.test b/tests/text.test index 89dd12c..cdc14c0 100644 --- a/tests/text.test +++ b/tests/text.test @@ -957,23 +957,52 @@ test text-11.10 {TextWidgetCmd procedure, "insert" option} { list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly] } {{First second} {1.0 1.5} {1.5 1.12}} -test text-11a.1 {TextWidgetCmd procedure, "sync" option} -setup { +test text-11a.1 {TextWidgetCmd procedure, "pendingsync" option} -setup { destroy .yt } -body { text .yt - list [catch {.yt sync mytext} msg] $msg + list [catch {.yt pendingsync mytext} msg] $msg } -cleanup { destroy .yt -} -result {1 {wrong # args: should be ".yt sync ?-command command?"}} -test text-11a.2 {TextWidgetCmd procedure, "sync" option with -command} -setup { +} -result {1 {wrong # args: should be ".yt pendingsync"}} +test text-11a.2 {TextWidgetCmd procedure, "pendingsync" option} -setup { + destroy .top.yt .top +} -body { + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 300} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + # wait for end of line metrics calculation to get correct $fraction1 + # as a reference + while {[.top.yt pendingsync]} {update} + .top.yt yview moveto 1 + set fraction1 [lindex [.top.yt yview] 0] + set res [expr {$fraction1 > 0}] + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + # ensure the test is relevant + lappend res [.top.yt pendingsync] + # asynchronously wait for completion of line metrics calculation + while {[.top.yt pendingsync]} {update} + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] +} -cleanup { + destroy .top.yt .top +} -result {1 1 1} + +test text-11a.11 {TextWidgetCmd procedure, "sync" option} -setup { destroy .yt } -body { text .yt - list [catch {.yt sync -comx foo} msg] $msg + list [catch {.yt sync mytext} msg] $msg } -cleanup { destroy .yt -} -result {1 {wrong option "-comx": should be "-command"}} -test text-11a.3 {TextWidgetCmd procedure, "sync" option} -setup { +} -result {1 {wrong # args: should be ".yt sync ?-command command?"}} +test text-11a.12 {TextWidgetCmd procedure, "sync" option} -setup { destroy .top.yt .top } -body { toplevel .top @@ -1005,56 +1034,44 @@ test text-11a.3 {TextWidgetCmd procedure, "sync" option} -setup { } -cleanup { destroy .top.yt .top } -result {1 0 1} -test text-11a.4 {TextWidgetCmd procedure, "sync" option with -command} -setup { - destroy .yt -} -body { - set ::x 0 - pack [text .yt] -expand 1 -fill both - .yt sync -command [list set ::x 1] - set ::x -} -cleanup { - destroy .yt -} -result {1} -test text-11a.11 {TextWidgetCmd procedure, "pendingsync" option} -setup { +test text-11a.21 {TextWidgetCmd procedure, "sync" option with -command} -setup { destroy .yt } -body { text .yt - list [catch {.yt pendingsync mytext} msg] $msg + list [catch {.yt sync -comx foo} msg] $msg } -cleanup { destroy .yt -} -result {1 {wrong # args: should be ".yt pendingsync"}} -test text-11a.12 {TextWidgetCmd procedure, "pendingsync" option} -setup { +} -result {1 {wrong option "-comx": should be "-command"}} +test text-11a.22 {TextWidgetCmd procedure, "sync" option with -command} -setup { destroy .top.yt .top } -body { + set res {} + set ::x 0 toplevel .top pack [text .top.yt] set content {} - for {set i 1} {$i < 300} {incr i} { + for {set i 1} {$i < 30} {incr i} { append content [string repeat "$i " 15] \n } .top.yt insert 1.0 $content - update - # wait for end of line metrics calculation to get correct $fraction1 - # as a reference - while {[.top.yt pendingsync]} {update} - .top.yt yview moveto 1 - set fraction1 [lindex [.top.yt yview] 0] - set res [expr {$fraction1 > 0}] - .top.yt delete 1.0 end - .top.yt insert 1.0 $content - # ensure the test is relevant + # first case: line metrics calculation still running when launching 'sync -command' lappend res [.top.yt pendingsync] - # asynchronously wait for completion of line metrics calculation + .top.yt sync -command [list set ::x 1] + lappend res $::x + # now finish line metrics calculations while {[.top.yt pendingsync]} {update} - .top.yt yview moveto $fraction1 - set fraction2 [lindex [.top.yt yview] 0] - lappend res [expr {$fraction1 == $fraction2}] + lappend res [.top.yt pendingsync] $::x + # second case: line metrics calculation completed when launching 'sync -command' + .top.yt sync -command [list set ::x 2] + lappend res $::x + vwait ::x + lappend res $::x } -cleanup { destroy .top.yt .top -} -result {1 1 1} +} -result {1 0 0 1 1 2} -test text-11a.21 {"<>" event} -setup { +test text-11a.31 {"<>" event} -setup { destroy .top.yt .top } -body { toplevel .top @@ -1086,6 +1103,31 @@ test text-11a.21 {"<>" event} -setup { destroy .top.yt .top } -result {1 1 1} +test text-11a.41 {"sync" "pendingsync" and <>} -setup { + destroy .top.yt .top +} -body { + set res {} + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 300} {incr i} { + append content [string repeat "$i " 50] \n + } + bind .top.yt <> {lappend res Sync:%d} + .top.yt insert 1.0 $content + update + # ensure the test is relevant + lappend res [.top.yt pendingsync] + # - there is no more any pending sync after running 'sync' + # - <> fires when sync returns if there was pending syncs + .top.yt sync + lappend res [.top.yt pendingsync] + update + set res +} -cleanup { + destroy .top.yt .top +} -result {Sync:0 1 0 Sync:1} + # edit, mark, scan, search, see, tag, window, xview and yview actions are tested elsewhere. test text-12.1 {ConfigureText procedure} { -- cgit v0.12 From 801439653efba1124e5dc705bdcd018062719562 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 20 Dec 2015 22:09:14 +0000 Subject: There could be false negatives with [.text pendingsync] when line metrics calculation is in the middle of a long line. --- generic/tkTextDisp.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 108cc4a..ba584ac 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -6144,8 +6144,9 @@ TkTextPendingsync( TextDInfo *dInfoPtr = textPtr->dInfoPtr; return ( - (dInfoPtr->lastMetricUpdateLine - dInfoPtr->currentMetricUpdateLine) ? - 1 : 0); + ((dInfoPtr->metricEpoch == -1) && + (dInfoPtr->lastMetricUpdateLine == dInfoPtr->currentMetricUpdateLine)) ? + 0 : 1); } /* -- cgit v0.12 From f3e4c6787e4309d230f3d102105b2ebedf2d12ca Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 20 Dec 2015 22:16:36 +0000 Subject: Test text-11a.41 now correctly written passes. --- tests/text.test | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/text.test b/tests/text.test index cdc14c0..2487df7 100644 --- a/tests/text.test +++ b/tests/text.test @@ -1115,18 +1115,18 @@ test text-11a.41 {"sync" "pendingsync" and <>} -setup { } bind .top.yt <> {lappend res Sync:%d} .top.yt insert 1.0 $content - update + vwait res ; # event dealt with by the event loop, with %d==0 i.e. we're out of sync # ensure the test is relevant - lappend res [.top.yt pendingsync] - # - there is no more any pending sync after running 'sync' + lappend res "Pending:[.top.yt pendingsync]" # - <> fires when sync returns if there was pending syncs + # - there is no more any pending sync after running 'sync' .top.yt sync - lappend res [.top.yt pendingsync] - update + vwait res ; # event dealt with by the event loop, with %d==1 i.e. we're in sync again + lappend res "Pending:[.top.yt pendingsync]" set res } -cleanup { destroy .top.yt .top -} -result {Sync:0 1 0 Sync:1} +} -result {Sync:0 Pending:1 Sync:1 Pending:0} # edit, mark, scan, search, see, tag, window, xview and yview actions are tested elsewhere. -- cgit v0.12 From 7fba872bef36903476be033836a8394fd742a1c0 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 26 Dec 2015 20:52:21 +0000 Subject: [.text sync -command $cmd] schedules execution of $cmd by the event loop at idle time --- generic/tkText.c | 51 +++++++++++++++++++++++++++++++++++++++++++++++++-- generic/tkText.h | 3 ++- generic/tkTextDisp.c | 22 +++++++++++----------- 3 files changed, 62 insertions(+), 14 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index a2b7dde..0cb8431 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -397,6 +397,7 @@ static int TextSearchIndexInLine(const SearchSpec *searchSpecPtr, static int TextPeerCmd(TkText *textPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static TkUndoProc TextUndoRedoCallback; +static void RunAfterSyncCmd(ClientData clientData); /* * Declarations of the three search procs required by the multi-line search @@ -1512,8 +1513,8 @@ TextWidgetObjCmd( } textPtr->afterSyncCmd = cmd; } else { - result = Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); - Tcl_DecrRefCount(cmd); + textPtr->afterSyncCmd = cmd; + Tcl_DoWhenIdle(RunAfterSyncCmd, (ClientData) textPtr); } break; } else if (objc != 2) { @@ -6747,6 +6748,52 @@ TkpTesttextCmd( } /* + *---------------------------------------------------------------------- + * + * RunAfterSyncCmd -- + * + * This function is called by the event loop and excutes the command + * scheduled by [.text sync -command $cmd]. + * + * Results: + * None. + * + * Side effects: + * Anything may happen, depending on $cmd contents. + * + *---------------------------------------------------------------------- + */ + +static void +RunAfterSyncCmd( + ClientData clientData) /* Information about text widget. */ +{ + register TkText *textPtr = (TkText *) clientData; + int code; + + if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { + /* + * The widget has been deleted. Don't do anything. + */ + + if (--textPtr->refCount == 0) { + ckfree((char *) textPtr); + } + return; + } + + Tcl_Preserve((ClientData) textPtr->interp); + code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); + if (code == TCL_ERROR) { + Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); + Tcl_BackgroundError(textPtr->interp); + } + Tcl_Release((ClientData) textPtr->interp); + Tcl_DecrRefCount(textPtr->afterSyncCmd); + textPtr->afterSyncCmd = NULL; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkText.h b/generic/tkText.h index 49ee479..ea8ce07 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -782,7 +782,8 @@ typedef struct TkText { * statements. */ int autoSeparators; /* Non-zero means the separators will be * inserted automatically. */ - Tcl_Obj *afterSyncCmd; /* Command to be executed when lines are up to date */ + Tcl_Obj *afterSyncCmd; /* Command to be executed when lines are up to + * date */ } TkText; /* diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index ba584ac..39311a6 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -2958,18 +2958,18 @@ AsyncUpdateLineMetrics( * above). If there is a registered aftersync command, run that first. */ - if (textPtr->afterSyncCmd != NULL) { - int code; - Tcl_Preserve((ClientData)textPtr->interp); - code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); - if (code != TCL_OK && code != TCL_CONTINUE - && code != TCL_BREAK) { - Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); - Tcl_BackgroundError(textPtr->interp); + if (textPtr->afterSyncCmd) { + int code; + Tcl_Preserve((ClientData) textPtr->interp); + code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, + TCL_EVAL_GLOBAL); + if (code == TCL_ERROR) { + Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); + Tcl_BackgroundError(textPtr->interp); } - Tcl_Release((ClientData)textPtr->interp); - Tcl_DecrRefCount(textPtr->afterSyncCmd); - textPtr->afterSyncCmd = 0; + Tcl_Release((ClientData) textPtr->interp); + Tcl_DecrRefCount(textPtr->afterSyncCmd); + textPtr->afterSyncCmd = NULL; } /* -- cgit v0.12 From 915557944f9230377dfa08852f0f51d1c6e9dadf Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 4 Jan 2016 17:34:53 +0000 Subject: Fixed bug [1510538] - Wrong initial scrollbar width --- win/tkWinScrlbr.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c index 46aad58..fc9685d 100644 --- a/win/tkWinScrlbr.c +++ b/win/tkWinScrlbr.c @@ -218,10 +218,10 @@ CreateProc( if (scrollPtr->info.vertical) { style = WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS - | SBS_VERT | SBS_RIGHTALIGN; + | SBS_VERT; } else { style = WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS - | SBS_HORZ | SBS_BOTTOMALIGN; + | SBS_HORZ; } scrollPtr->hwnd = CreateWindow("SCROLLBAR", NULL, style, -- cgit v0.12 From 24e81e277b14fd83eab9b110fbb9ea459baef7d2 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 5 Jan 2016 15:32:27 +0000 Subject: Fixed bug [1305128] - Scrollbar doesn't receive event --- generic/tkScrollbar.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c index 3fff58d..ba42c20 100644 --- a/generic/tkScrollbar.c +++ b/generic/tkScrollbar.c @@ -627,6 +627,8 @@ TkScrollbarEventProc( TkScrollbarEventuallyRedraw(scrollPtr); } } + } else if (eventPtr->type == MapNotify) { + TkScrollbarEventuallyRedraw(scrollPtr); } } -- cgit v0.12 From d429b10b89cba5a8dd80ca4eb3874dea424e5fb7 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 5 Jan 2016 16:12:39 +0000 Subject: Typo fixed in comment --- generic/tkText.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tkText.c b/generic/tkText.c index 0cb8431..c12c9a5 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -6752,7 +6752,7 @@ TkpTesttextCmd( * * RunAfterSyncCmd -- * - * This function is called by the event loop and excutes the command + * This function is called by the event loop and executes the command * scheduled by [.text sync -command $cmd]. * * Results: -- cgit v0.12 From e4067df1777998f73378f3a6e18f372a985bad0c Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 5 Jan 2016 16:25:50 +0000 Subject: Moved RunAfterSyncCmd procedure --- generic/tkText.c | 94 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 47 insertions(+), 47 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index c12c9a5..3389733 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -388,6 +388,7 @@ static Tcl_Obj * TextGetText(const TkText *textPtr, const TkTextIndex *index2, int visibleOnly); static void GenerateModifiedEvent(TkText *textPtr); static void UpdateDirtyFlag(TkSharedText *sharedPtr); +static void RunAfterSyncCmd(ClientData clientData); static void TextPushUndoAction(TkText *textPtr, Tcl_Obj *undoString, int insert, const TkTextIndex *index1Ptr, @@ -397,7 +398,6 @@ static int TextSearchIndexInLine(const SearchSpec *searchSpecPtr, static int TextPeerCmd(TkText *textPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static TkUndoProc TextUndoRedoCallback; -static void RunAfterSyncCmd(ClientData clientData); /* * Declarations of the three search procs required by the multi-line search @@ -5377,6 +5377,52 @@ UpdateDirtyFlag( /* *---------------------------------------------------------------------- * + * RunAfterSyncCmd -- + * + * This function is called by the event loop and executes the command + * scheduled by [.text sync -command $cmd]. + * + * Results: + * None. + * + * Side effects: + * Anything may happen, depending on $cmd contents. + * + *---------------------------------------------------------------------- + */ + +static void +RunAfterSyncCmd( + ClientData clientData) /* Information about text widget. */ +{ + register TkText *textPtr = (TkText *) clientData; + int code; + + if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { + /* + * The widget has been deleted. Don't do anything. + */ + + if (--textPtr->refCount == 0) { + ckfree((char *) textPtr); + } + return; + } + + Tcl_Preserve((ClientData) textPtr->interp); + code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); + if (code == TCL_ERROR) { + Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); + Tcl_BackgroundError(textPtr->interp); + } + Tcl_Release((ClientData) textPtr->interp); + Tcl_DecrRefCount(textPtr->afterSyncCmd); + textPtr->afterSyncCmd = NULL; +} + +/* + *---------------------------------------------------------------------- + * * SearchPerform -- * * Overall control of search process. Is given a pattern, a starting @@ -6748,52 +6794,6 @@ TkpTesttextCmd( } /* - *---------------------------------------------------------------------- - * - * RunAfterSyncCmd -- - * - * This function is called by the event loop and executes the command - * scheduled by [.text sync -command $cmd]. - * - * Results: - * None. - * - * Side effects: - * Anything may happen, depending on $cmd contents. - * - *---------------------------------------------------------------------- - */ - -static void -RunAfterSyncCmd( - ClientData clientData) /* Information about text widget. */ -{ - register TkText *textPtr = (TkText *) clientData; - int code; - - if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { - /* - * The widget has been deleted. Don't do anything. - */ - - if (--textPtr->refCount == 0) { - ckfree((char *) textPtr); - } - return; - } - - Tcl_Preserve((ClientData) textPtr->interp); - code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); - if (code == TCL_ERROR) { - Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); - Tcl_BackgroundError(textPtr->interp); - } - Tcl_Release((ClientData) textPtr->interp); - Tcl_DecrRefCount(textPtr->afterSyncCmd); - textPtr->afterSyncCmd = NULL; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 -- cgit v0.12 From 2e67237b8b1fa6815d9e318f28d2f50674bafde6 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 5 Jan 2016 16:48:20 +0000 Subject: Polished documentation a bit --- doc/text.n | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/text.n b/doc/text.n index c55b4cf..536a3a5 100644 --- a/doc/text.n +++ b/doc/text.n @@ -1089,12 +1089,13 @@ the widget is in sync) or false (when it is not). Examples of use: .CS ## Example 1: -# runtime, immediately complete line metrics at any cost (GUI unresponsive) +# immediately complete line metrics at any cost (GUI unresponsive) $w sync $w yview moveto $fraction ## Example 2: -# runtime, synchronously wait for up-to-date line metrics (GUI responsive) +# synchronously wait for up-to-date line metrics (GUI responsive) +# before executing the scheduled command, but don't block execution flow $w sync -command [list $w yview moveto $fraction] ## Example 3: @@ -1783,7 +1784,7 @@ If \fIindex\fR is far out of view, then the command centers \fIindex\fR in the window. .TP \fIpathName \fBsync\fR ?\fB-command \fIcommand\fR? -Control the synchronization of the view of text widget. +Controls the synchronization of the view of the text widget. .RS .TP \fIpathName \fBsync\fR @@ -1793,10 +1794,10 @@ outdated line heights, otherwise it returns only at the end of the computation. The command returns an empty string. .TP \fIpathName \fBsync -command \fIcommand\fR -Schedule \fIcommand\fR to be executed exactly once as soon as all line heights -are up-to-date. If there are no pending line metrics calculations, the -scheduling is immediate. The command returns the empty string. \fBbgerror\fR is -called on \fIcommand\fR failure. +Schedules \fIcommand\fR to be executed (by the event loop) exactly once as soon +as all line heights are up-to-date. If there are no pending line metrics +calculations, the scheduling is immediate. The command returns the empty +string. \fBbgerror\fR is called on \fIcommand\fR failure. .RE .TP \fIpathName \fBtag \fIoption \fR?\fIarg arg ...\fR? -- cgit v0.12 From 5faa9a11695c74d40ca830ee4dcd68cfc9011e89 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 5 Jan 2016 17:00:48 +0000 Subject: Harmonized use of NULL for textPtr->afterSyncCmd --- generic/tkText.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 3389733..8dbe13e 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2015,9 +2015,9 @@ DestroyText( textPtr->tkwin = NULL; textPtr->refCount--; Tcl_DeleteCommandFromToken(textPtr->interp, textPtr->widgetCmd); - if (textPtr->afterSyncCmd != 0){ + if (textPtr->afterSyncCmd){ Tcl_DecrRefCount(textPtr->afterSyncCmd); - textPtr->afterSyncCmd = 0; + textPtr->afterSyncCmd = NULL; } if (textPtr->refCount == 0) { ckfree((char *) textPtr); -- cgit v0.12 From 975963bc1eb5cfb0c4b01b258dbe9a08269217dc Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 6 Jan 2016 13:22:06 +0000 Subject: Fixed bug [3e3e25f483] - winbutton-1.[12] fails on Win7 --- tests/winButton.test | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/winButton.test b/tests/winButton.test index 5bf6867..5e3dcfb 100644 --- a/tests/winButton.test +++ b/tests/winButton.test @@ -29,7 +29,9 @@ radiobutton .r -text Radiobutton pack .l .b .c .r update -test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win} { +test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win nonPortable} { + # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen + # the smallest size (i.e. 8) is not available for "MS Sans Serif" font deleteWindows image create test image1 image1 changed 0 0 0 0 60 40 @@ -46,7 +48,9 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {68 48 70 50 90 52 90 52} -test winbutton-1.2 {TkpComputeButtonGeometry procedure} win { +test winbutton-1.2 {TkpComputeButtonGeometry procedure} {win nonPortable} { + # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen + # the smallest size (i.e. 8) is not available for "MS Sans Serif" font deleteWindows label .b1 -bitmap question -bd 3 -padx 0 -pady 2 button .b2 -bitmap question -bd 3 -padx 0 -pady 2 -- cgit v0.12 From 46dd965d3c6d8b9617e6f4edb792a79b08730423 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 6 Jan 2016 15:59:47 +0000 Subject: Fixed bug [1927212] - MouseWheel unbound for non-aqua scrollbars --- library/scrlbar.tcl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 4b25325..7cec556 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -141,6 +141,10 @@ if {[tk windowingsystem] eq "aqua"} { bind Scrollbar { tk::ScrollByUnits %W h [expr {-10 * (%D)}] } +} else { + bind Scrollbar { + tk::ScrollByUnits %W v [expr {- (%D/120)}] + } } # tk::ScrollButtonDown -- # This procedure is invoked when a button is pressed in a scrollbar. -- cgit v0.12 From 8e521a94152cd4546be53ea626f09f96f1f102d4 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 7 Jan 2016 14:49:18 +0000 Subject: Added non-regression test for [1927212] --- tests/scrollbar.test | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 5d4334f..10aa7d6 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -632,6 +632,21 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] +test scrollbar-10.1 { event on scrollbar} -constraints win -setup { + destroy .t .s +} -body { + pack [text .t -yscrollcommand {.s set}] -side left + for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} + pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left + update + focus -force .s + event generate .s -delta -120 + after 200 {set eventprocessed 1} ; vwait eventprocessed + .t index @0,0 +} -cleanup { + destroy .t .s +} -result {2.0} + catch {destroy .s} catch {destroy .t} -- cgit v0.12 From 43554959e209cc2aaf81dbbb6909cf9d77cf57f4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Jan 2016 14:39:48 +0000 Subject: Backout previous commit: it causes many event-related test-failures in Tk test suite --- library/scrlbar.tcl | 4 ---- tests/scrollbar.test | 15 --------------- 2 files changed, 19 deletions(-) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 2a70b97..e17442f 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -157,10 +157,6 @@ switch [tk windowingsystem] { bind Scrollbar {tk::ScrollByUnits %W h -5} bind Scrollbar {tk::ScrollByUnits %W h 5} } -} else { - bind Scrollbar { - tk::ScrollByUnits %W v [expr {- (%D/120)}] - } } # tk::ScrollButtonDown -- # This procedure is invoked when a button is pressed in a scrollbar. diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 8f92c93..c6a5a90 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -632,21 +632,6 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] -test scrollbar-10.1 { event on scrollbar} -constraints win -setup { - destroy .t .s -} -body { - pack [text .t -yscrollcommand {.s set}] -side left - for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} - pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left - update - focus -force .s - event generate .s -delta -120 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {2.0} - catch {destroy .s} catch {destroy .t} -- cgit v0.12 From 3b7649bdc1d6357c2c3145879d0720493e784622 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Jan 2016 15:40:47 +0000 Subject: ..... horizontal scrollbar too --- library/scrlbar.tcl | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 7b1c3af..b1658ac 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -153,7 +153,10 @@ switch [tk windowingsystem] { } "x11" { bind Scrollbar { - tk::ScrollByUnits %W v [expr {- (%D/120)}] + tk::ScrollByUnits %W v [expr {- (%D /120 )}] + } + bind Scrollbar { + tk::ScrollByUnits %W h [expr {- (%D /120 )}] } bind Scrollbar <4> {tk::ScrollByUnits %W v -5} bind Scrollbar <5> {tk::ScrollByUnits %W v 5} -- cgit v0.12 From a74bdffd9369f2ed76ba90a5497e5a4f7b2475cd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Jan 2016 22:10:59 +0000 Subject: Make test-case and binding equal for win32 and x11. Test-case doesn't pass yet --- library/scrlbar.tcl | 4 ++-- tests/scrollbar.test | 17 ++++++++++++++++- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index b1658ac..b7be014 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -153,10 +153,10 @@ switch [tk windowingsystem] { } "x11" { bind Scrollbar { - tk::ScrollByUnits %W v [expr {- (%D /120 )}] + tk::ScrollByUnits %W v [expr {- (%D /120 ) * 4}] } bind Scrollbar { - tk::ScrollByUnits %W h [expr {- (%D /120 )}] + tk::ScrollByUnits %W h [expr {- (%D /120 ) * 4}] } bind Scrollbar <4> {tk::ScrollByUnits %W v -5} bind Scrollbar <5> {tk::ScrollByUnits %W v 5} diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 8f92c93..6717deb 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -632,7 +632,7 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] -test scrollbar-10.1 { event on scrollbar} -constraints win -setup { +test scrollbar-10.1 { event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left @@ -647,6 +647,21 @@ test scrollbar-10.1 { event on scrollbar} -constraints win -setup { destroy .t .s } -result {2.0} +test scrollbar-10.2 { event on scrollbar} -setup { + destroy .t .s +} -body { + pack [text .t -xscrollcommand {.s set}] -side top + for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} + pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top + update + focus -force .s + event generate .s -delta -120 + after 200 {set eventprocessed 1} ; vwait eventprocessed + .t index @0,0 +} -cleanup { + destroy .t .s +} -result {2.0} + catch {destroy .s} catch {destroy .t} -- cgit v0.12 From c0690b39259579097efedce36dffdc37d3626be2 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 8 Jan 2016 22:46:35 +0000 Subject: Bug [2049429] - Documented TK_OPTION_DONT_SET_DEFAULT --- doc/SetOptions.3 | 50 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 20 deletions(-) diff --git a/doc/SetOptions.3 b/doc/SetOptions.3 index 028467a..f12a00f 100644 --- a/doc/SetOptions.3 +++ b/doc/SetOptions.3 @@ -129,19 +129,21 @@ option table is no longer needed \fBTk_DeleteOptionTable\fR should be called to free all of its resources. All of the option tables for a Tcl interpreter are freed automatically if the interpreter is deleted. .PP -\fBTk_InitOptions\fR is invoked when a new widget is created to set -the default values for all of the widget's configuration options. -\fBTk_InitOptions\fR is passed a token for an option table (\fIoptionTable\fR) -and a pointer to a widget record (\fIrecordPtr\fR), which is the C -structure that holds information about this widget. \fBTk_InitOptions\fR -uses the information in the option table to -choose an appropriate default for each option, then it stores the default -value directly into the widget record, overwriting any information that -was already present in the widget record. \fBTk_InitOptions\fR normally -returns \fBTCL_OK\fR. If an error occurred while setting the default values -(e.g., because a default value was erroneous) then \fBTCL_ERROR\fR is returned -and an error message is left in \fIinterp\fR's result if \fIinterp\fR -is not NULL. +\fBTk_InitOptions\fR is invoked when a new widget is created to set the +default values for all of the widget's configuration options that do not +have \fBTK_OPTION_DONT_SET_DEFAULT\fR set in their \fIflags\fR field. +\fBTk_InitOptions\fR is passed a token for an option table +(\fIoptionTable\fR) and a pointer to a widget record (\fIrecordPtr\fR), +which is the C structure that holds information about this widget. +\fBTk_InitOptions\fR uses the information in the option table to choose an +appropriate default for each option, except those having +\fBTK_OPTION_DONT_SET_DEFAULT\fR set, then it stores the default value +directly into the widget record, overwriting any information that was +already present in the widget record. \fBTk_InitOptions\fR normally +returns \fBTCL_OK\fR. If an error occurred while setting the default +values (e.g., because a default value was erroneous) then \fBTCL_ERROR\fR +is returned and an error message is left in \fIinterp\fR's result if +\fIinterp\fR is not NULL. .PP \fBTk_SetOptions\fR is invoked to modify configuration options based on information specified in a Tcl command. The command might be one that @@ -306,19 +308,27 @@ given by \fIinternalOffset\fR. For example, if the option's type is value is not stored in that form. At least one of the offsets must be greater than or equal to zero. .PP -The \fIflags\fR field consists of one or more bits ORed together. At -present only a single flag is supported: \fBTK_OPTION_NULL_OK\fR. If -this bit is set for an option then an empty string will be accepted as -the value for the option and the resulting internal form will be a -NULL pointer, a zero value, or \fBNone\fR, depending on the type of -the option. If the flag is not set then empty strings will result -in errors. +The \fIflags\fR field consists of one or more bits ORed together. The +following flags are supported: +.TP +\fBTK_OPTION_NULL_OK\fR +If this bit is set for an option then an empty string will be accepted as +the value for the option and the resulting internal form will be a NULL +pointer, a zero value, or \fBNone\fR, depending on the type of the option. +If the flag is not set then empty strings will result in errors. \fBTK_OPTION_NULL_OK\fR is typically used to allow a feature to be turned off entirely, e.g. set a cursor value to \fBNone\fR so that a window simply inherits its parent's cursor. Not all option types support the \fBTK_OPTION_NULL_OK\fR flag; for those that do, there is an explicit indication of that fact in the descriptions below. +.TP +\fBTK_OPTION_DONT_SET_DEFAULT\fR +If this bit is set for an option then no default value will be set in +\fBTk_InitOptions\fR for this option. Neither the option database, nor any +system default value, nor \fIoptionTable\fR are used to give a default +value to this option. Instead it is assumed that the caller has already +supplied a default value in the widget code. .PP The \fItype\fR field of each Tk_OptionSpec structure determines how to parse the value of that configuration option. The -- cgit v0.12 From f1ad837bb6dfcf955f3b560dc34892e9031dd7bd Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 8 Jan 2016 23:22:29 +0000 Subject: Use TK_OPTION_NULL_OK instead of TK_CONFIG_NULL_OK --- generic/tkEntry.c | 12 ++++++------ generic/tkListbox.c | 2 +- generic/tkText.c | 2 +- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 338652b..8c8cd90 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -133,7 +133,7 @@ static const Tk_OptionSpec entryOptSpec[] = { 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr), - TK_CONFIG_NULL_OK, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0}, + TK_OPTION_NULL_OK, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0}, {TK_OPTION_STRING, "-show", "show", "Show", DEF_ENTRY_SHOW, -1, Tk_Offset(Entry, showChar), TK_OPTION_NULL_OK, 0, 0}, @@ -279,23 +279,23 @@ static const Tk_OptionSpec sbOptSpec[] = { 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr), - TK_CONFIG_NULL_OK, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0}, + TK_OPTION_NULL_OK, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state), 0, (ClientData) stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus), - TK_CONFIG_NULL_OK, 0, 0}, + TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", DEF_ENTRY_TEXT_VARIABLE, -1, Tk_Offset(Entry, textVarName), - TK_CONFIG_NULL_OK, 0, 0}, + TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_DOUBLE, "-to", "to", "To", DEF_SPINBOX_TO, -1, Tk_Offset(Spinbox, toValue), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate", DEF_ENTRY_VALIDATE, -1, Tk_Offset(Entry, validate), 0, (ClientData) validateStrings, 0}, {TK_OPTION_STRING, "-validatecommand", "validateCommand","ValidateCommand", - NULL, -1, Tk_Offset(Entry, validateCmd), TK_CONFIG_NULL_OK, 0, 0}, + NULL, -1, Tk_Offset(Entry, validateCmd), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-values", "values", "Values", DEF_SPINBOX_VALUES, -1, Tk_Offset(Spinbox, valueStr), TK_OPTION_NULL_OK, 0, 0}, @@ -307,7 +307,7 @@ static const Tk_OptionSpec sbOptSpec[] = { DEF_SPINBOX_WRAP, -1, Tk_Offset(Spinbox, wrap), 0, 0, 0}, {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", DEF_ENTRY_SCROLL_COMMAND, -1, Tk_Offset(Entry, scrollCmd), - TK_CONFIG_NULL_OK, 0, 0}, + TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0} }; diff --git a/generic/tkListbox.c b/generic/tkListbox.c index ff72596..537bbfc 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -278,7 +278,7 @@ static const Tk_OptionSpec optionSpecs[] = { Tk_Offset(Listbox, selBorderWidth), 0, 0, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", DEF_LISTBOX_SELECT_FG_COLOR, -1, Tk_Offset(Listbox, selFgColorPtr), - TK_CONFIG_NULL_OK, (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0}, + TK_OPTION_NULL_OK, (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0}, {TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode", DEF_LISTBOX_SELECT_MODE, -1, Tk_Offset(Listbox, selectMode), TK_OPTION_NULL_OK, 0, 0}, diff --git a/generic/tkText.c b/generic/tkText.c index 6e982b0..5694700 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -197,7 +197,7 @@ static const Tk_OptionSpec optionSpecs[] = { TK_OPTION_NULL_OK, (ClientData) DEF_TEXT_SELECT_BD_MONO, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", DEF_TEXT_SELECT_FG_COLOR, -1, Tk_Offset(TkText, selFgColorPtr), - TK_CONFIG_NULL_OK, (ClientData) DEF_TEXT_SELECT_FG_MONO, 0}, + TK_OPTION_NULL_OK, (ClientData) DEF_TEXT_SELECT_FG_MONO, 0}, {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid", DEF_TEXT_SET_GRID, -1, Tk_Offset(TkText, setGrid), 0, 0, 0}, {TK_OPTION_PIXELS, "-spacing1", "spacing1", "Spacing", -- cgit v0.12 From cf5e1ec939d60bdf2c3440acc22e33dcadfb5dc0 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 8 Jan 2016 23:35:37 +0000 Subject: Removed unused flags argument in Configure function since Tk_ConfigureWidget is no longer used there since last century --- generic/tkEntry.c | 13 ++++++------- generic/tkListbox.c | 9 ++++----- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 8c8cd90..9f43f90 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -390,7 +390,7 @@ static const char *selElementNames[] = { */ static int ConfigureEntry(Tcl_Interp *interp, Entry *entryPtr, - int objc, Tcl_Obj *const objv[], int flags); + int objc, Tcl_Obj *const objv[]); static int DeleteChars(Entry *entryPtr, int index, int count); static void DestroyEntry(char *memPtr); static void DisplayEntry(ClientData clientData); @@ -553,7 +553,7 @@ Tk_EntryObjCmd( if ((Tk_InitOptions(interp, (char *) entryPtr, optionTable, tkwin) != TCL_OK) || - (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK)) { + (ConfigureEntry(interp, entryPtr, objc-2, objv+2) != TCL_OK)) { Tk_DestroyWindow(entryPtr->tkwin); return TCL_ERROR; } @@ -658,7 +658,7 @@ EntryWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); } } else { - result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0); + result = ConfigureEntry(interp, entryPtr, objc-2, objv+2); } break; @@ -1086,8 +1086,7 @@ ConfigureEntry( Entry *entryPtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in argv. */ - Tcl_Obj *const objv[], /* Argument objects. */ - int flags) /* Flags to pass to Tk_ConfigureWidget. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_SavedOptions savedOptions; Tk_3DBorder border; @@ -3637,7 +3636,7 @@ Tk_SpinboxObjCmd( Tk_DestroyWindow(entryPtr->tkwin); return TCL_ERROR; } - if (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK) { + if (ConfigureEntry(interp, entryPtr, objc-2, objv+2) != TCL_OK) { goto error; } @@ -3747,7 +3746,7 @@ SpinboxWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); } } else { - result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0); + result = ConfigureEntry(interp, entryPtr, objc-2, objv+2); } break; diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 537bbfc..86fb671 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -379,7 +379,7 @@ enum indices { static void ChangeListboxOffset(Listbox *listPtr, int offset); static void ChangeListboxView(Listbox *listPtr, int index); static int ConfigureListbox(Tcl_Interp *interp, Listbox *listPtr, - int objc, Tcl_Obj *const objv[], int flags); + int objc, Tcl_Obj *const objv[]); static int ConfigureListboxItem(Tcl_Interp *interp, Listbox *listPtr, ItemAttr *attrs, int objc, Tcl_Obj *const objv[], int index); @@ -564,7 +564,7 @@ Tk_ListboxObjCmd( return TCL_ERROR; } - if (ConfigureListbox(interp, listPtr, objc-2, objv+2, 0) != TCL_OK) { + if (ConfigureListbox(interp, listPtr, objc-2, objv+2) != TCL_OK) { Tk_DestroyWindow(listPtr->tkwin); return TCL_ERROR; } @@ -700,7 +700,7 @@ ListboxWidgetObjCmd( result = TCL_OK; } } else { - result = ConfigureListbox(interp, listPtr, objc-2, objv+2, 0); + result = ConfigureListbox(interp, listPtr, objc-2, objv+2); } break; } @@ -1544,8 +1544,7 @@ ConfigureListbox( register Listbox *listPtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in argv. */ - Tcl_Obj *const objv[], /* Arguments. */ - int flags) /* Flags to pass to Tk_ConfigureWidget. */ + Tcl_Obj *const objv[]) /* Arguments. */ { Tk_SavedOptions savedOptions; Tcl_Obj *oldListObj = NULL; -- cgit v0.12 From ac43dfdc269f9ea9dc7448bc815aba5f28a96efc Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 9 Jan 2016 00:03:22 +0000 Subject: Test cases scrollbar-10.[12] pass --- tests/scrollbar.test | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 6717deb..85ee8b9 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -632,7 +632,7 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] -test scrollbar-10.1 { event on scrollbar} -setup { +test scrollbar-10.1 { event on scrollbar} -constraints {win unix} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left @@ -645,12 +645,12 @@ test scrollbar-10.1 { event on scrollbar} -setup { .t index @0,0 } -cleanup { destroy .t .s -} -result {2.0} +} -result {5.0} -test scrollbar-10.2 { event on scrollbar} -setup { +test scrollbar-10.2 { event on scrollbar} -constraints {win unix} -setup { destroy .t .s } -body { - pack [text .t -xscrollcommand {.s set}] -side top + pack [text .t -xscrollcommand {.s set} -wrap none] -side top for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update @@ -660,7 +660,7 @@ test scrollbar-10.2 { event on scrollbar} -setup { .t index @0,0 } -cleanup { destroy .t .s -} -result {2.0} +} -result {1.4} catch {destroy .s} catch {destroy .t} -- cgit v0.12 From 631b7815fb57704361344f53cad675ffdbbd6d13 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 9 Jan 2016 00:06:49 +0000 Subject: Fixed test constraints --- tests/scrollbar.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 85ee8b9..3b16821 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -632,7 +632,7 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] -test scrollbar-10.1 { event on scrollbar} -constraints {win unix} -setup { +test scrollbar-10.1 { event on scrollbar} -constraints {win|unix} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left @@ -647,7 +647,7 @@ test scrollbar-10.1 { event on scrollbar} -constraints {win unix} -s destroy .t .s } -result {5.0} -test scrollbar-10.2 { event on scrollbar} -constraints {win unix} -setup { +test scrollbar-10.2 { event on scrollbar} -constraints {win|unix} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top -- cgit v0.12 From 3e525786724c39e02e20eda8c5684ce7c0ec7e00 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 9 Jan 2016 02:58:47 +0000 Subject: Additional fixes for memory leaks, window flickering on OS X 10.11; thanks to Marc Culler for patch --- macosx/tkMacOSXInit.c | 4 +--- macosx/tkMacOSXWindowEvent.c | 10 ++++++---- macosx/tkMacOSXWm.c | 2 ++ 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c index 997d306..b965a38 100644 --- a/macosx/tkMacOSXInit.c +++ b/macosx/tkMacOSXInit.c @@ -105,10 +105,9 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt - (void) _setup: (Tcl_Interp *) interp { _eventInterp = interp; - _mainPool = nil; + _mainPool = [NSAutoreleasePool new]; [NSApp setPoolProtected:NO]; _defaultMainMenu = nil; - NSAutoreleasePool *pool = [NSAutoreleasePool new]; [self _setupMenus]; [self setDelegate:self]; #ifdef TK_MAC_DEBUG_NOTIFICATIONS @@ -117,7 +116,6 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt #endif [self _setupWindowNotifications]; [self _setupApplicationNotifications]; - [pool drain]; } - (NSString *) tkFrameworkImagePath: (NSString *) image diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index 95ebb25..461a94c 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -165,6 +165,10 @@ extern BOOL opaqueTag; if (winPtr) { TkGenWMDestroyEvent((Tk_Window) winPtr); + if (_windowWithMouse == w) { + _windowWithMouse = nil; + [w release]; + } } /* @@ -858,12 +862,9 @@ ConfigureRestrictProc( /* * Try to prevent flickers and flashes. - * - * This stops the flickers on OSX 10.11. But flashes still occur when - * the width of the window is 16, 32, 48, 64, 80, 96, 112, 256, 512, - * 768, ... :^( */ [w disableFlushWindow]; + NSDisableScreenUpdates(); /* Disable Tk drawing until the window has been completely configured.*/ TkMacOSXSetDrawingEnabled(winPtr, 0); @@ -887,6 +888,7 @@ ConfigureRestrictProc( while (Tk_DoOneEvent(TK_ALL_EVENTS|TK_DONT_WAIT)) {} [w enableFlushWindow]; [w flushWindowIfNeeded]; + NSEnableScreenUpdates(); [NSApp setPoolProtected:NO]; } } diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 308ee11..3ea2f51 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -902,6 +902,8 @@ TkWmDeadWindow( [front makeKeyAndOrderFront:NSApp]; } } + [NSApp _resetAutoreleasePool]; + #if DEBUG_ZOMBIES > 0 fprintf(stderr, "================= Pool dump ===================\n"); [NSAutoreleasePool showPools]; -- cgit v0.12 -- cgit v0.12 From 2987950f24f7b2fda46de8d528a3693ccf7943b9 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 9 Jan 2016 08:29:15 +0000 Subject: -spacing[123] use TK_OPTION_NULL_OK instead of TK_OPTION_DONT_SET_DEFAULT --- generic/tkText.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 5694700..f884239 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -202,13 +202,13 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_TEXT_SET_GRID, -1, Tk_Offset(TkText, setGrid), 0, 0, 0}, {TK_OPTION_PIXELS, "-spacing1", "spacing1", "Spacing", DEF_TEXT_SPACING1, -1, Tk_Offset(TkText, spacing1), - TK_OPTION_DONT_SET_DEFAULT, 0 , TK_TEXT_LINE_GEOMETRY }, + TK_OPTION_NULL_OK, 0 , TK_TEXT_LINE_GEOMETRY }, {TK_OPTION_PIXELS, "-spacing2", "spacing2", "Spacing", DEF_TEXT_SPACING2, -1, Tk_Offset(TkText, spacing2), - TK_OPTION_DONT_SET_DEFAULT, 0 , TK_TEXT_LINE_GEOMETRY }, + TK_OPTION_NULL_OK, 0 , TK_TEXT_LINE_GEOMETRY }, {TK_OPTION_PIXELS, "-spacing3", "spacing3", "Spacing", DEF_TEXT_SPACING3, -1, Tk_Offset(TkText, spacing3), - TK_OPTION_DONT_SET_DEFAULT, 0 , TK_TEXT_LINE_GEOMETRY }, + TK_OPTION_NULL_OK, 0 , TK_TEXT_LINE_GEOMETRY }, {TK_OPTION_CUSTOM, "-startline", NULL, NULL, NULL, -1, Tk_Offset(TkText, start), TK_OPTION_NULL_OK, (ClientData) &lineOption, TK_TEXT_LINE_RANGE}, -- cgit v0.12 From c2aba2ca12911e5c707679168da5a09f0f779977 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 11 Jan 2016 00:24:47 +0000 Subject: Fix for 63c3542c06, messageboxes in Tk-Cocoa; thanks to Marc Culler for patch --- macosx/tkMacOSXDialog.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index a3510f8..3523bc4 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -1016,7 +1016,8 @@ Tk_MessageBoxObjCmd( NSArray *buttons; NSAlert *alert = [NSAlert new]; NSInteger modalReturnCode = 1; - + BOOL parentIsKey = NO; + iconIndex = ICON_INFO; typeIndex = TYPE_OK; for (i = 1; i < objc; i += 2) { @@ -1142,6 +1143,7 @@ Tk_MessageBoxObjCmd( callbackInfo->typeIndex = typeIndex; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { + parentIsKey = [parent isKeyWindow]; #if MAC_OS_X_VERSION_MIN_REQUIRED > 1090 [alert beginSheetModalForWindow:parent completionHandler:^(NSModalResponse returnCode) @@ -1164,6 +1166,9 @@ Tk_MessageBoxObjCmd( result = (modalReturnCode >= NSAlertFirstButtonReturn) ? TCL_OK : TCL_ERROR; end: [alert release]; + if (parentIsKey) { + [parent makeKeyWindow]; + } return result; } -- cgit v0.12 From ad1f3c6bd527110188baf7a518480c669cb92306 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Mon, 11 Jan 2016 00:44:22 +0000 Subject: Additional tweaks for dialog --- macosx/tkMacOSXDialog.c | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 3523bc4..257f16d 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -398,6 +398,7 @@ Tk_GetOpenFileObjCmd( NSMutableArray *fileTypes = nil; NSOpenPanel *panel = [NSOpenPanel openPanel]; NSInteger modalReturnCode = modalError; + BOOL parentIsKey = NO; TkInitFileFilters(&fl); for (i = 1; i < objc; i += 2) { @@ -513,6 +514,7 @@ Tk_GetOpenFileObjCmd( callbackInfo->multiple = multiple; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { + parentIsKey = [parent isKeyWindow]; #if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 [panel beginSheetForDirectory:directory file:filename @@ -544,6 +546,9 @@ Tk_GetOpenFileObjCmd( contextInfo:callbackInfo]; } result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR; + if (parentIsKey) { + [parent makeKeyWindow]; + } if (typeVariablePtr && result == TCL_OK) { /* * The -typevariable option is not really supported. @@ -596,6 +601,7 @@ Tk_GetSaveFileObjCmd( NSMutableArray *fileTypes = nil; NSSavePanel *panel = [NSSavePanel savePanel]; NSInteger modalReturnCode = modalError; + BOOL parentIsKey = NO; TkInitFileFilters(&fl); for (i = 1; i < objc; i += 2) { @@ -712,6 +718,7 @@ Tk_GetSaveFileObjCmd( callbackInfo->multiple = 0; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { + parentIsKey = [parent isKeyWindow]; #if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 [panel beginSheetForDirectory:directory file:filename @@ -740,7 +747,9 @@ Tk_GetSaveFileObjCmd( contextInfo:callbackInfo]; } result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR; - + if (parentIsKey) { + [parent makeKeyWindow]; + } end: TkFreeFileFilters(&fl); return result; @@ -783,6 +792,7 @@ Tk_ChooseDirectoryObjCmd( NSWindow *parent; NSOpenPanel *panel = [NSOpenPanel openPanel]; NSInteger modalReturnCode = modalError; + BOOL parentIsKey = NO; for (i = 1; i < objc; i += 2) { if (Tcl_GetIndexFromObjStruct(interp, objv[i], chooseOptionStrings, @@ -850,6 +860,7 @@ Tk_ChooseDirectoryObjCmd( callbackInfo->multiple = 0; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { + parentIsKey = [parent isKeyWindow]; #if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 [panel beginSheetForDirectory:directory file:filename @@ -877,7 +888,9 @@ Tk_ChooseDirectoryObjCmd( contextInfo:callbackInfo]; } result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR; - + if (parentIsKey) { + [parent makeKeyWindow]; + } end: return result; } -- cgit v0.12 -- cgit v0.12 From 5147bd27c61d07d5acfdd82046fccfdbb1aa38df Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 11 Jan 2016 14:32:00 +0000 Subject: Improved patch formatting. No functional change --- generic/tkListbox.c | 70 ++++++++++++++++++++++++++++++------------------ macosx/tkMacOSXDefault.h | 2 +- unix/tkUnixDefault.h | 2 +- win/tkWinDefault.h | 2 +- 4 files changed, 47 insertions(+), 29 deletions(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index f16218b..2929882 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -165,8 +165,9 @@ typedef struct { Pixmap gray; /* Pixmap for displaying disabled text. */ int flags; /* Various flag bits: see below for * definitions. */ - Tk_Justify justify; /* Justification */ - int oldMaxOffset; /* Used in scrolling for right/center justification */ + Tk_Justify justify; /* Justification. */ + int oldMaxOffset; /* Used in scrolling for right/center + * justification. */ } Listbox; /* @@ -277,6 +278,8 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness", DEF_LISTBOX_HIGHLIGHT_WIDTH, -1, Tk_Offset(Listbox, highlightWidth), 0, 0, 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_LISTBOX_JUSTIFY, -1, Tk_Offset(Listbox, justify), 0, 0, 0}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", DEF_LISTBOX_RELIEF, -1, Tk_Offset(Listbox, relief), 0, 0, 0}, {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground", @@ -310,8 +313,6 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_STRING, "-listvariable", "listVariable", "Variable", DEF_LISTBOX_LIST_VARIABLE, -1, Tk_Offset(Listbox, listVarName), TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", - DEF_LISTBOX_JUSTIFY, -1, Tk_Offset(Listbox, justify), 0, 0, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0} }; @@ -440,7 +441,7 @@ static char * ListboxListVarProc(ClientData clientData, const char *name2, int flags); static void MigrateHashEntries(Tcl_HashTable *table, int first, int last, int offset); -static int GetMaxOffset(Listbox *listPtr); +static int GetMaxOffset(Listbox *listPtr); /* * The structure below defines button class behavior by means of procedures @@ -1125,7 +1126,7 @@ ListboxBboxSubCmd( Tk_GetFontMetrics(listPtr->tkfont, &fm); pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen); - x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; + x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; y = ((index - listPtr->topIndex)*listPtr->lineHeight) + listPtr->inset + listPtr->selBorderWidth; results[0] = Tcl_NewIntObj(x); @@ -2071,23 +2072,27 @@ DisplayListbox( /* * Draw the actual text of this item. */ - Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement); - stringRep = Tcl_GetStringFromObj(curElement, &stringLen); - Tk_ComputeTextLayout(listPtr->tkfont, - stringRep, stringLen, 0, - listPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height); + + Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement); + stringRep = Tcl_GetStringFromObj(curElement, &stringLen); + Tk_ComputeTextLayout(listPtr->tkfont, stringRep, stringLen, 0, + listPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height); Tk_GetFontMetrics(listPtr->tkfont, &fm); y += fm.ascent + listPtr->selBorderWidth; - if (listPtr->justify == TK_JUSTIFY_LEFT) { - x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; - } else if (listPtr->justify == TK_JUSTIFY_RIGHT) { - x = width - totalLength - listPtr->inset - listPtr->selBorderWidth - listPtr->xOffset + GetMaxOffset(listPtr) - 1; - } else { - x = (width + GetMaxOffset(listPtr))/2 - totalLength/2 - listPtr->xOffset; - } - Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont, + if (listPtr->justify == TK_JUSTIFY_LEFT) { + x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; + } else if (listPtr->justify == TK_JUSTIFY_RIGHT) { + x = width - totalLength - listPtr->inset - + listPtr->selBorderWidth - listPtr->xOffset + + GetMaxOffset(listPtr) - 1; + } else { + x = (width + GetMaxOffset(listPtr))/2 - totalLength/2 - + listPtr->xOffset; + } + + Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont, stringRep, stringLen, x, y); /* @@ -2641,7 +2646,12 @@ ListboxEventProc( ChangeListboxView(listPtr, listPtr->topIndex); if (listPtr->justify == TK_JUSTIFY_RIGHT) { maxOffset = GetMaxOffset(listPtr); - if (maxOffset != listPtr->oldMaxOffset && listPtr->oldMaxOffset > 0) { // window has shrunk + if (maxOffset != listPtr->oldMaxOffset && listPtr->oldMaxOffset > 0) { + + /* + * Window has shrunk. + */ + if (maxOffset > listPtr->oldMaxOffset) { tmpOffset = maxOffset - listPtr->oldMaxOffset; } else { @@ -2661,7 +2671,12 @@ ListboxEventProc( listPtr->oldMaxOffset = maxOffset; } else if (listPtr->justify == TK_JUSTIFY_CENTER) { maxOffset = GetMaxOffset(listPtr); - if (maxOffset != listPtr->oldMaxOffset && listPtr->oldMaxOffset > 0) { // window has shrunk + if (maxOffset != listPtr->oldMaxOffset && listPtr->oldMaxOffset > 0) { + + /* + * Window has shrunk. + */ + tmpOffset2 = maxOffset / 2; if (maxOffset > listPtr->oldMaxOffset) { tmpOffset = maxOffset/2 - listPtr->oldMaxOffset/2; @@ -3661,21 +3676,24 @@ MigrateHashEntries( * * GetMaxOffset -- * - * Passing in a listbox pointer, returns the maximum offset for the box + * Passing in a listbox pointer, returns the maximum offset for the box. * * Results: - * Listbox's maxOffset + * Listbox's maxOffset. * * Side effects: - * None + * None. * *---------------------------------------------------------------------- */ -static int GetMaxOffset(register Listbox *listPtr) +static int GetMaxOffset( + register Listbox *listPtr) { int maxOffset; - maxOffset = listPtr->maxWidth - (Tk_Width(listPtr->tkwin) - 2*listPtr->inset - 2*listPtr->selBorderWidth) + listPtr->xScrollUnit - 1; + maxOffset = listPtr->maxWidth - + (Tk_Width(listPtr->tkwin) - 2*listPtr->inset - + 2*listPtr->selBorderWidth) + listPtr->xScrollUnit - 1; if (maxOffset < 0) { maxOffset = 0; } diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index dc73188..65762b7 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -259,10 +259,10 @@ #define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG #define DEF_LISTBOX_HIGHLIGHT BLACK #define DEF_LISTBOX_HIGHLIGHT_WIDTH "0" +#define DEF_LISTBOX_JUSTIFY "left" #define DEF_LISTBOX_RELIEF "solid" #define DEF_LISTBOX_SCROLL_COMMAND "" #define DEF_LISTBOX_LIST_VARIABLE "" -#define DEF_LISTBOX_JUSTIFY "left" #define DEF_LISTBOX_SELECT_COLOR SELECT_BG #define DEF_LISTBOX_SELECT_MONO BLACK #define DEF_LISTBOX_SELECT_BD "0" diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index ac7bc4d..2c3854d 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -221,10 +221,10 @@ #define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG #define DEF_LISTBOX_HIGHLIGHT BLACK #define DEF_LISTBOX_HIGHLIGHT_WIDTH "1" +#define DEF_LISTBOX_JUSTIFY "left" #define DEF_LISTBOX_RELIEF "sunken" #define DEF_LISTBOX_SCROLL_COMMAND "" #define DEF_LISTBOX_LIST_VARIABLE "" -#define DEF_LISTBOX_JUSTIFY "left" #define DEF_LISTBOX_SELECT_COLOR SELECT_BG #define DEF_LISTBOX_SELECT_MONO BLACK #define DEF_LISTBOX_SELECT_BD "0" diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index 29fe4ee..f389075 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -224,10 +224,10 @@ #define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG #define DEF_LISTBOX_HIGHLIGHT HIGHLIGHT #define DEF_LISTBOX_HIGHLIGHT_WIDTH "1" +#define DEF_LISTBOX_JUSTIFY "left" #define DEF_LISTBOX_RELIEF "sunken" #define DEF_LISTBOX_SCROLL_COMMAND "" #define DEF_LISTBOX_LIST_VARIABLE "" -#define DEF_LISTBOX_JUSTIFY "left" #define DEF_LISTBOX_SELECT_COLOR SELECT_BG #define DEF_LISTBOX_SELECT_MONO BLACK #define DEF_LISTBOX_SELECT_BD "0" -- cgit v0.12 From 5de259d30a538e9ede43cea981bdf0002bb0601d Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 11 Jan 2016 16:23:55 +0000 Subject: Polished listbox justification demo --- library/demos/states.tcl | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/library/demos/states.tcl b/library/demos/states.tcl index 41ce0bf..aeb3d5b 100644 --- a/library/demos/states.tcl +++ b/library/demos/states.tcl @@ -19,14 +19,16 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing the 50 states is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by scanning. To scan, press button 2 in the widget and drag up or down." pack $w.msg -side top +labelframe $w.justif -text Justification foreach c {Left Center Right} { set lower [string tolower $c] - radiobutton $w.$lower -text $c -variable just \ - -relief flat -value $lower -anchor w \ - -command "$w.frame.list configure -justify \$just" \ - -tristatevalue "multi" - pack $w.$lower -side left -pady 2 -fill x + radiobutton $w.justif.$lower -text $c -variable just \ + -relief flat -value $lower -anchor w \ + -command "$w.frame.list configure -justify \$just" \ + -tristatevalue "multi" + pack $w.justif.$lower -side left -pady 2 -fill x } +pack $w.justif ## See Code / Dismiss buttons set btns [addSeeDismiss $w.buttons $w] -- cgit v0.12 From 2ab896442a6992390a79803686b3aa3abe266cc6 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 11 Jan 2016 18:00:11 +0000 Subject: Added some tests --- tests/listbox.test | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/listbox.test b/tests/listbox.test index 0519e93..effaad8 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -203,6 +203,21 @@ test listbox-1.31 {configuration options} -body { } -cleanup { .l configure -highlightthickness [lindex [.l configure -highlightthickness] 3] } -result {0 0} +test listbox-1.32.1 {configuration options} -setup { + set res {} +} -body { + .l configure -justify left + set res [list [lindex [.l configure -justify] 4] [.l cget -justify]] + .l configure -justify center + lappend res [lindex [.l configure -justify] 4] [.l cget -justify] + .l configure -justify right + lappend res [lindex [.l configure -justify] 4] [.l cget -justify] +} -cleanup { + .l configure -justify [lindex [.l configure -justify] 3] +} -result {left left center center right right} +test listbox-1.32.2 {configuration options} -body { + .l configure -justify bogus +} -returnCodes error -result {bad justification "bogus": must be left, right, or center} test listbox-1.33 {configuration options} -body { .l configure -relief groove list [lindex [.l configure -relief] 4] [.l cget -relief] -- cgit v0.12 From c84948f660d87bfecd5cf830a4986d95f00c1e4a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Jan 2016 09:46:26 +0000 Subject: Bring back DEF_TEXT_SPACING[123], since "0" is not exactly equal to NULL (just to be 100% sure there will not be a behavioral change) --- generic/tkText.c | 12 ++++++------ generic/tkTextTag.c | 4 ++-- macosx/tkMacOSXDefault.h | 3 +++ macosx/tkMacOSXDialog.c | 4 ++-- unix/tkUnixDefault.h | 3 +++ win/tkWinDefault.h | 3 +++ 6 files changed, 19 insertions(+), 10 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index eb9658e..a713e7e 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -215,14 +215,14 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid", DEF_TEXT_SET_GRID, -1, Tk_Offset(TkText, setGrid), 0, 0, 0}, {TK_OPTION_PIXELS, "-spacing1", "spacing1", "Spacing", - NULL, -1, Tk_Offset(TkText, spacing1), - TK_OPTION_NULL_OK, 0 , TK_TEXT_LINE_GEOMETRY }, + DEF_TEXT_SPACING1, -1, Tk_Offset(TkText, spacing1), + 0, 0 , TK_TEXT_LINE_GEOMETRY }, {TK_OPTION_PIXELS, "-spacing2", "spacing2", "Spacing", - NULL, -1, Tk_Offset(TkText, spacing2), - TK_OPTION_NULL_OK, 0 , TK_TEXT_LINE_GEOMETRY }, + DEF_TEXT_SPACING2, -1, Tk_Offset(TkText, spacing2), + 0, 0 , TK_TEXT_LINE_GEOMETRY }, {TK_OPTION_PIXELS, "-spacing3", "spacing3", "Spacing", - NULL, -1, Tk_Offset(TkText, spacing3), - TK_OPTION_NULL_OK, 0 , TK_TEXT_LINE_GEOMETRY }, + DEF_TEXT_SPACING3, -1, Tk_Offset(TkText, spacing3), + 0, 0 , TK_TEXT_LINE_GEOMETRY }, {TK_OPTION_CUSTOM, "-startline", NULL, NULL, NULL, -1, Tk_Offset(TkText, start), TK_OPTION_NULL_OK, &lineOption, TK_TEXT_LINE_RANGE}, diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index a433905..3363d25 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -45,10 +45,10 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, -1, Tk_Offset(TkTextTag, bgStipple), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_PIXELS, "-borderwidth", NULL, NULL, NULL, Tk_Offset(TkTextTag, borderWidthPtr), Tk_Offset(TkTextTag, borderWidth), - TK_OPTION_DONT_SET_DEFAULT|TK_OPTION_NULL_OK, 0, 0}, + TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0}, {TK_OPTION_STRING, "-elide", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, elideString), - TK_OPTION_DONT_SET_DEFAULT|TK_OPTION_NULL_OK, 0, 0}, + TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0}, {TK_OPTION_BITMAP, "-fgstipple", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, fgStipple), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_FONT, "-font", NULL, NULL, diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index b24c540..528ea10 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -536,6 +536,9 @@ #define DEF_TEXT_SELECT_FG_MONO WHITE #define DEF_TEXT_SELECT_RELIEF "flat" #define DEF_TEXT_SET_GRID "0" +#define DEF_TEXT_SPACING1 "0" +#define DEF_TEXT_SPACING2 "0" +#define DEF_TEXT_SPACING3 "0" #define DEF_TEXT_STATE "normal" #define DEF_TEXT_TABS "" #define DEF_TEXT_TABSTYLE "tabular" diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 8e49f65..f6edb6d 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -514,7 +514,7 @@ Tk_GetOpenFileObjCmd( callbackInfo->multiple = multiple; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { - parentIsKey = [parent isKeyWindow]; + parentIsKey = [parent isKeyWindow]; #if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 [panel beginSheetForDirectory:directory file:filename @@ -860,7 +860,7 @@ Tk_ChooseDirectoryObjCmd( callbackInfo->multiple = 0; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { - parentIsKey = [parent isKeyWindow]; + parentIsKey = [parent isKeyWindow]; #if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 [panel beginSheetForDirectory:directory file:filename diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index 62e3fec..d214aa5 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -494,6 +494,9 @@ #define DEF_TEXT_SELECT_FG_MONO WHITE #define DEF_TEXT_SELECT_RELIEF "raised" #define DEF_TEXT_SET_GRID "0" +#define DEF_TEXT_SPACING1 "0" +#define DEF_TEXT_SPACING2 "0" +#define DEF_TEXT_SPACING3 "0" #define DEF_TEXT_STATE "normal" #define DEF_TEXT_TABS "" #define DEF_TEXT_TABSTYLE "tabular" diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index 3a8ce9b..c52cc4d 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -497,6 +497,9 @@ #define DEF_TEXT_SELECT_FG_MONO WHITE #define DEF_TEXT_SELECT_RELIEF "flat" #define DEF_TEXT_SET_GRID "0" +#define DEF_TEXT_SPACING1 "0" +#define DEF_TEXT_SPACING2 "0" +#define DEF_TEXT_SPACING3 "0" #define DEF_TEXT_STATE "normal" #define DEF_TEXT_TABS "" #define DEF_TEXT_TABSTYLE "tabular" -- cgit v0.12 From 9b0a5374a4e77d86b7a0e94ff46dceb6a413d246 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 12 Jan 2016 15:08:41 +0000 Subject: Added more tests --- tests/listbox.test | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 74 insertions(+) diff --git a/tests/listbox.test b/tests/listbox.test index effaad8..57cd974 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -456,6 +456,80 @@ test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} mkPartial list [.partial.l bbox 3] [.partial.l bbox 4] } -result {{5 56 24 14} {5 73 23 14}} +test listbox-3.18a {ListboxWidgetCmd procedure, "bbox" option, justified} -constraints { + fonts +} -setup { + destroy .top.l .top + unset -nocomplain res +} -body { + toplevel .top + listbox .top.l -justify left + .top.l insert end Item1 LongerItem2 MuchLongerItem3 + pack .top.l + update + lappend res [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2] + .top.l configure -justify center + lappend res [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2] + .top.l configure -justify right + lappend res [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2] +} -cleanup { + destroy .top.l .top + unset -nocomplain res +} -result { + # + # Results to be defined when I get my hands on a platform featuring tcltest::testConstraints fonts == 1 + {TBD} {TBD} {TBD} {TBD} {TBD} {TBD} +} +test listbox-3.18b {ListboxWidgetCmd procedure, "bbox" option, justified, non-default borderwidth} -setup { + destroy .top.l .top + unset -nocomplain lres res +} -body { + toplevel .top + listbox .top.l -justify left -borderwidth 17 -highlightthickness 19 -selectborderwidth 22 + .top.l insert end Item1 LongerItem2 MuchLongerItem3 + .top.l selection set 1 + pack .top.l + update + lappend lres [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2] + .top.l configure -justify center + lappend lres [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2] + .top.l configure -justify right + lappend lres [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2] + set res 1 + for {set i 0} {$i < [llength $lres]} {incr i 4} { + set res [expr {$res * [expr {[lindex $lres $i] >= 0}] }] + } + set res +} -cleanup { + destroy .top.l .top + unset -nocomplain lres res +} -result {1} +test listbox-3.18c {ListboxWidgetCmd procedure, "bbox" option, justified, selecting does not change offset} -setup { + destroy .top.l .top + unset -nocomplain bb1 bb2 +} -body { + toplevel .top + listbox .top.l -justify center + .top.l insert end Item1 Item2 Item3 + pack .top.l + update + set bb1 [.top.l bbox 1] + .top.l selection set 1 + update + set bb2 [.top.l bbox 1] + expr { + [lindex $bb1 0] == [lindex $bb2 0] && + [lindex $bb1 1] == [lindex $bb2 1] && + [lindex $bb1 2] == [lindex $bb2 2] && + [lindex $bb1 3] == [lindex $bb2 3] + } + # Note: the result of this test is relevant only if test listbox-3.18a + # succeeds first, otherwise the fact the present test listbox-3.18c + # passes does not mean it is OK +} -cleanup { + destroy .top.l .top + unset -nocomplain bb1 bb2 +} -result {1} test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} -body { .l cget } -returnCodes error -result {wrong # args: should be ".l cget option"} -- cgit v0.12 From 9976bb4ea9febe4dbdb963f7b5d81e4c71a21ba0 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 13 Jan 2016 07:16:53 +0000 Subject: Typo fixed --- generic/tkListbox.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 2929882..7295677 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -90,7 +90,7 @@ typedef struct { * display. */ int topIndex; /* Index of top-most element visible in * window. */ - int fullLines; /* Number of lines that fit are completely + int fullLines; /* Number of lines that are completely * visible in window. There may be one * additional line at the bottom that is * partially visible. */ -- cgit v0.12 From cbe1741d686fd3de6be07ad51e091360d967b1ef Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 13 Jan 2016 07:49:55 +0000 Subject: More typos fixed --- generic/tkListbox.c | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 7295677..50f1717 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -97,7 +97,7 @@ typedef struct { int partialLine; /* 0 means that the window holds exactly * fullLines lines. 1 means that there is one * additional line that is partially - * visble. */ + * visible. */ int setGrid; /* Non-zero means pass gridding information to * window manager. */ @@ -131,7 +131,7 @@ typedef struct { int active; /* Index of "active" element (the one that has * been selected by keyboard traversal). -1 * means none. */ - int activeStyle; /* style in which to draw the active element. + int activeStyle; /* Style in which to draw the active element. * One of: underline, none, dotbox */ /* @@ -200,7 +200,7 @@ typedef struct { * be updated. * GOT_FOCUS: Non-zero means this widget currently has the * input focus. - * MAXWIDTH_IS_STALE: Stored maxWidth may be out-of-date + * MAXWIDTH_IS_STALE: Stored maxWidth may be out-of-date. * LISTBOX_DELETED: This listbox has been effectively destroyed. */ @@ -318,7 +318,7 @@ static const Tk_OptionSpec optionSpecs[] = { /* * The itemAttrOptionSpecs table defines the valid configuration options for - * listbox items + * listbox items. */ static const Tk_OptionSpec itemAttrOptionSpecs[] = { @@ -345,7 +345,7 @@ static const Tk_OptionSpec itemAttrOptionSpecs[] = { }; /* - * The following tables define the listbox widget commands (and sub- commands) + * The following tables define the listbox widget commands (and sub-commands) * and map the indexes into the string tables into enumerated types used to * dispatch the listbox widget command. */ @@ -628,7 +628,7 @@ ListboxWidgetObjCmd( /* * Parse the command by looking up the second argument in the list of - * valid subcommand names + * valid subcommand names. */ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, @@ -2033,7 +2033,7 @@ DisplayListbox( } else { /* * If there is an item attributes record for this item, draw - * the background box and set the foreground color accordingly + * the background box and set the foreground color accordingly. */ if (entry != NULL) { @@ -2489,7 +2489,7 @@ ListboxDeleteSubCmd( /* * Check width of the element. We only have to check if widthChanged * has not already been set to 1, because we only need one maxWidth - * element to disappear for us to have to recompute the width + * element to disappear for us to have to recompute the width. */ if (widthChanged == 0) { @@ -2824,7 +2824,11 @@ GetListboxIndex( stringRep = Tcl_GetString(indexObj); if (stringRep[0] == '@') { - /* @x,y index */ + + /* + * @x,y index + */ + int y; const char *start; char *end; @@ -3554,7 +3558,7 @@ ListboxListVarProc( /* * If the list length has decreased, then we should clean up selection and - * attributes information for elements past the end of the new list + * attributes information for elements past the end of the new list. */ oldLength = listPtr->nElements; -- cgit v0.12 From 48ae923fc9c18de0e45d927b819cc756b6833aba Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 16 Jan 2016 14:00:15 +0000 Subject: Addressed question 1 (see artifact [9d48a9c212] of ticket [3f456a5bb9]) --- generic/tkListbox.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 490f795..bea98ee 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -114,7 +114,8 @@ typedef struct { int xOffset; /* The left edge of each string in the listbox * is offset to the left by this many pixels * (0 means no offset, positive means there is - * an offset). */ + * an offset). This is x scrolling information + * is not linked to justification. */ /* * Information about what's selected or active, if any. -- cgit v0.12 From cc44a614a3a33b8007a980a64270832c67c629f2 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 16 Jan 2016 14:03:32 +0000 Subject: Addressed question 2 (see artifact [9d48a9c212] of ticket [3f456a5bb9]). This code arranges for the correct xview when creating the listbox with non-default justification. It is correctly placed in Tk_ListboxObjCmd. When changing justification later, i.e. in ConfigureListbox, there is no reason to change the xview, it would not be desired that the listbox xview jumps when configuring -justify. --- generic/tkListbox.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index bea98ee..56e2c2f 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -581,6 +581,10 @@ Tk_ListboxObjCmd( return TCL_ERROR; } + /* + * Adjust startup x view according to the justify option. + */ + if (listPtr->justify == TK_JUSTIFY_RIGHT) { listPtr->xOffset = GetMaxOffset(listPtr); } else if (listPtr->justify == TK_JUSTIFY_CENTER) { -- cgit v0.12 From d48a10cb3142cfbefd0314439d877da5eb03b926 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 16 Jan 2016 14:16:00 +0000 Subject: Addressed issue A and question 6 (see artifact [9d48a9c212] of ticket [3f456a5bb9]). Issue A is fixed. Test case: package req Tk listbox .l .l insert end M M M M M M M M M pack .l .l conf -just center ; # or right .l conf -highlightthickness 40 .l selection set 4 Regarding question 6, Tk_TextWidth is a bit lower level function in the API, which must be slightly beneficial regarding performance. Tk_TextWidth is therefore preferred. --- generic/tkListbox.c | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 56e2c2f..a57650b 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -1857,7 +1857,7 @@ DisplayListbox( * or right edge of the listbox is * off-screen. */ Pixmap pixmap; - int totalLength, height; + int textWidth; listPtr->flags &= ~REDRAW_PENDING; if (listPtr->flags & LISTBOX_DELETED) { @@ -2079,21 +2079,19 @@ DisplayListbox( Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement); stringRep = Tcl_GetStringFromObj(curElement, &stringLen); - Tk_ComputeTextLayout(listPtr->tkfont, stringRep, stringLen, 0, - listPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height); + textWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen); Tk_GetFontMetrics(listPtr->tkfont, &fm); y += fm.ascent + listPtr->selBorderWidth; if (listPtr->justify == TK_JUSTIFY_LEFT) { - x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; + x = (listPtr->inset + listPtr->selBorderWidth) - listPtr->xOffset; } else if (listPtr->justify == TK_JUSTIFY_RIGHT) { - x = width - totalLength - listPtr->inset - - listPtr->selBorderWidth - listPtr->xOffset + - GetMaxOffset(listPtr) - 1; + x = Tk_Width(tkwin) - (listPtr->inset + listPtr->selBorderWidth) + - textWidth - listPtr->xOffset + GetMaxOffset(listPtr); } else { - x = (width + GetMaxOffset(listPtr))/2 - totalLength/2 - - listPtr->xOffset; + x = (Tk_Width(tkwin) - textWidth)/2 + - listPtr->xOffset + GetMaxOffset(listPtr)/2; } Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont, -- cgit v0.12 From dfecb499abf1df3c0605d0058f454d8230221dd8 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 16 Jan 2016 14:20:40 +0000 Subject: Addressed issue B (see artifact [9d48a9c212] of ticket [3f456a5bb9]) --- generic/tkListbox.c | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index a57650b..4f20d44 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -1096,6 +1096,7 @@ ListboxBboxSubCmd( Listbox *listPtr, /* Information about the listbox */ int index) /* Index of the element to get bbox info on */ { + register Tk_Window tkwin = listPtr->tkwin; int lastVisibleIndex; /* @@ -1131,7 +1132,15 @@ ListboxBboxSubCmd( Tk_GetFontMetrics(listPtr->tkfont, &fm); pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen); - x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; + if (listPtr->justify == TK_JUSTIFY_LEFT) { + x = (listPtr->inset + listPtr->selBorderWidth) - listPtr->xOffset; + } else if (listPtr->justify == TK_JUSTIFY_RIGHT) { + x = Tk_Width(tkwin) - (listPtr->inset + listPtr->selBorderWidth) + - pixelWidth - listPtr->xOffset + GetMaxOffset(listPtr); + } else { + x = (Tk_Width(tkwin) - pixelWidth)/2 + - listPtr->xOffset + GetMaxOffset(listPtr)/2; + } y = ((index - listPtr->topIndex)*listPtr->lineHeight) + listPtr->inset + listPtr->selBorderWidth; results[0] = Tcl_NewIntObj(x); -- cgit v0.12 From c1d11ea280efc1d70e599d7237cf84235c715064 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 16 Jan 2016 15:21:29 +0000 Subject: Fixed bug [639558ac83] - Lots of listbox tests fail on Linux --- tests/listbox.test | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/listbox.test b/tests/listbox.test index f50267e..9ca0411 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -57,6 +57,7 @@ proc mkPartial {{w .partial}} { # like border width have predictable values. option add *Listbox.borderWidth 2 +option add *Listbox.selectBorderWidth 1 option add *Listbox.highlightThickness 2 option add *Listbox.font {Helvetica -12 bold} -- cgit v0.12 From e43c3c8be1a8b46419c5b4b8308a1dff03a803fc Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 16 Jan 2016 15:43:00 +0000 Subject: Decided about test results for listbox-3.18a --- tests/listbox.test | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/listbox.test b/tests/listbox.test index fdad4c0..b62946d 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -476,11 +476,11 @@ test listbox-3.18a {ListboxWidgetCmd procedure, "bbox" option, justified} -const } -cleanup { destroy .top.l .top unset -nocomplain res -} -result { - # - # Results to be defined when I get my hands on a platform featuring tcltest::testConstraints fonts == 1 - {TBD} {TBD} {TBD} {TBD} {TBD} {TBD} -} +} -result [list \ + {5 5 34 14} {5 22 74 14} {5 39 106 14} \ + {58 5 34 14} {38 22 74 14} {22 39 106 14} \ + {111 5 34 14} {71 22 74 14} {39 39 106 14} \ +] test listbox-3.18b {ListboxWidgetCmd procedure, "bbox" option, justified, non-default borderwidth} -setup { destroy .top.l .top unset -nocomplain lres res -- cgit v0.12 From 24a1905f5c41cebbad36b04ef8c1f9327fe5a109 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 16 Jan 2016 15:45:54 +0000 Subject: Removed test listbox-3.18c since it is irrelevant (the rendering of the selected items is made in a code that depends on existence of a selection but this is untestable by bboxing since bbox is independent from the presence of a selection in the listbox) --- tests/listbox.test | 26 -------------------------- 1 file changed, 26 deletions(-) diff --git a/tests/listbox.test b/tests/listbox.test index b62946d..812d1c2 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -505,32 +505,6 @@ test listbox-3.18b {ListboxWidgetCmd procedure, "bbox" option, justified, non-de destroy .top.l .top unset -nocomplain lres res } -result {1} -test listbox-3.18c {ListboxWidgetCmd procedure, "bbox" option, justified, selecting does not change offset} -setup { - destroy .top.l .top - unset -nocomplain bb1 bb2 -} -body { - toplevel .top - listbox .top.l -justify center - .top.l insert end Item1 Item2 Item3 - pack .top.l - update - set bb1 [.top.l bbox 1] - .top.l selection set 1 - update - set bb2 [.top.l bbox 1] - expr { - [lindex $bb1 0] == [lindex $bb2 0] && - [lindex $bb1 1] == [lindex $bb2 1] && - [lindex $bb1 2] == [lindex $bb2 2] && - [lindex $bb1 3] == [lindex $bb2 3] - } - # Note: the result of this test is relevant only if test listbox-3.18a - # succeeds first, otherwise the fact the present test listbox-3.18c - # passes does not mean it is OK -} -cleanup { - destroy .top.l .top - unset -nocomplain bb1 bb2 -} -result {1} test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} -body { .l cget } -returnCodes error -result {wrong # args: should be ".l cget option"} -- cgit v0.12 From 61a97384456cdf43006536d3436fa51ee3e9acff Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 17 Jan 2016 20:40:01 +0000 Subject: Addressed questions 3 and 5 (see artifact [9d48a9c212] of ticket [3f456a5bb9]). It is not desirable to make the listbox xview jump on resizing. --- generic/tkListbox.c | 61 ----------------------------------------------------- 1 file changed, 61 deletions(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 4f20d44..9ff9d23 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -167,8 +167,6 @@ typedef struct { int flags; /* Various flag bits: see below for * definitions. */ Tk_Justify justify; /* Justification. */ - int oldMaxOffset; /* Used in scrolling for right/center - * justification. */ } Listbox; /* @@ -554,7 +552,6 @@ Tk_ListboxObjCmd( listPtr->state = STATE_NORMAL; listPtr->gray = None; listPtr->justify = TK_JUSTIFY_LEFT; - listPtr->oldMaxOffset = 0; /* * Keep a hold of the associated tkwin until we destroy the listbox, @@ -2623,7 +2620,6 @@ ListboxEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - int tmpOffset, tmpOffset2, maxOffset; Listbox *listPtr = clientData; if (eventPtr->type == Expose) { @@ -2655,63 +2651,6 @@ ListboxEventProc( } listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR; ChangeListboxView(listPtr, listPtr->topIndex); - if (listPtr->justify == TK_JUSTIFY_RIGHT) { - maxOffset = GetMaxOffset(listPtr); - if (maxOffset != listPtr->oldMaxOffset && listPtr->oldMaxOffset > 0) { - - /* - * Window has shrunk. - */ - - if (maxOffset > listPtr->oldMaxOffset) { - tmpOffset = maxOffset - listPtr->oldMaxOffset; - } else { - tmpOffset = listPtr->oldMaxOffset - maxOffset; - } - tmpOffset -= tmpOffset % listPtr->xScrollUnit; - if ((tmpOffset + listPtr->xOffset) > maxOffset) { - tmpOffset = maxOffset - listPtr->xOffset; - } - if (tmpOffset < 0) { - tmpOffset = 0; - } - listPtr->xOffset += tmpOffset; - } else { - listPtr->xOffset = maxOffset; - } - listPtr->oldMaxOffset = maxOffset; - } else if (listPtr->justify == TK_JUSTIFY_CENTER) { - maxOffset = GetMaxOffset(listPtr); - if (maxOffset != listPtr->oldMaxOffset && listPtr->oldMaxOffset > 0) { - - /* - * Window has shrunk. - */ - - tmpOffset2 = maxOffset / 2; - if (maxOffset > listPtr->oldMaxOffset) { - tmpOffset = maxOffset/2 - listPtr->oldMaxOffset/2; - } else { - tmpOffset = listPtr->oldMaxOffset/2 - maxOffset/2; - } - tmpOffset -= tmpOffset % listPtr->xScrollUnit; - if ((tmpOffset + listPtr->xOffset) > maxOffset) { - tmpOffset = maxOffset - listPtr->xOffset; - } - if (tmpOffset < 0) { - tmpOffset = 0; - } - if (listPtr->xOffset < tmpOffset2) { - listPtr->xOffset += tmpOffset; - } else { - listPtr->xOffset -= tmpOffset; - } - } else { - listPtr->xOffset = maxOffset/2; - listPtr->xOffset -= listPtr->xOffset % listPtr->xScrollUnit; - } - listPtr->oldMaxOffset = maxOffset; - } ChangeListboxOffset(listPtr, listPtr->xOffset); /* -- cgit v0.12 From f753eecfed15ad634f2a6b98c56a6cd1f0194beb Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 17 Jan 2016 21:09:52 +0000 Subject: Addressed question 4 (see artifact [9d48a9c212] of ticket [3f456a5bb9]). --- generic/tkListbox.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 9ff9d23..e29c637 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -3630,7 +3630,8 @@ MigrateHashEntries( * * GetMaxOffset -- * - * Passing in a listbox pointer, returns the maximum offset for the box. + * Passing in a listbox pointer, returns the maximum offset for the box, + * i.e. the maximum possible horizontal scrolling value (in pixels). * * Results: * Listbox's maxOffset. @@ -3649,6 +3650,11 @@ static int GetMaxOffset( (Tk_Width(listPtr->tkwin) - 2*listPtr->inset - 2*listPtr->selBorderWidth) + listPtr->xScrollUnit - 1; if (maxOffset < 0) { + + /* + * Listbox is larger in width than its largest width item. + */ + maxOffset = 0; } maxOffset -= maxOffset % listPtr->xScrollUnit; -- cgit v0.12 From 53047ac807d37682c72abeb9a92fff3e41779108 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 18 Jan 2016 09:47:10 +0000 Subject: Fixed bug with the listbox justify patch: with large borders, when moving the horizontal scrollbar fully to the right the edge of the border could not be seen, one needed to push once on the right arrow of the scrollbar to see it. Test case: package require Tk destroy .top toplevel .top listbox .top.l -justify right -borderwidth 17 -highlightthickness 19 -selectborderwidth 22 scrollbar .top.hs -command ".top.l xview" -orient horizontal .top.l configure -xscrollcommand ".top.hs set" set huge [concat "START -" [string repeat "Huge Item... " 20] "- END"] .top.l insert end $huge pack .top.l -expand 1 -fill both pack .top.hs -expand 1 -fill x --- generic/tkListbox.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index e29c637..ee6941e 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -3657,7 +3657,6 @@ static int GetMaxOffset( maxOffset = 0; } - maxOffset -= maxOffset % listPtr->xScrollUnit; return maxOffset; } -- cgit v0.12 From 85c13e1d28d4bac711f3b92737b501207e261280 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 18 Jan 2016 10:08:58 +0000 Subject: Use GetMaxOffset when possible to reduce code duplication. The change in ListboxScanTo is not exactly equivalent but I believe the previous version was a bug. --- generic/tkListbox.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index ee6941e..795ec0f 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -2887,9 +2887,7 @@ ChangeListboxOffset( */ offset += listPtr->xScrollUnit / 2; - maxOffset = listPtr->maxWidth - (Tk_Width(listPtr->tkwin) - - 2*listPtr->inset - 2*listPtr->selBorderWidth) - + listPtr->xScrollUnit - 1; + maxOffset = GetMaxOffset(listPtr); if (offset > maxOffset) { offset = maxOffset; } @@ -2930,9 +2928,7 @@ ListboxScanTo( int newTopIndex, newOffset, maxIndex, maxOffset; maxIndex = listPtr->nElements - listPtr->fullLines; - maxOffset = listPtr->maxWidth + (listPtr->xScrollUnit - 1) - - (Tk_Width(listPtr->tkwin) - 2*listPtr->inset - - 2*listPtr->selBorderWidth - listPtr->xScrollUnit); + maxOffset = GetMaxOffset(listPtr); /* * Compute new top line for screen by amplifying the difference between -- cgit v0.12 From 94fd95f35c60eceaa87f6e666785e6a6d3fb5630 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 18 Jan 2016 10:19:24 +0000 Subject: Documented what listbox-3.18b intends to test. --- tests/listbox.test | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/listbox.test b/tests/listbox.test index 812d1c2..76a4349 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -485,6 +485,10 @@ test listbox-3.18b {ListboxWidgetCmd procedure, "bbox" option, justified, non-de destroy .top.l .top unset -nocomplain lres res } -body { + # This test checks whether all "x" values from bbox for different size + # items with different justification settings are all positive or zero + # This checks a bit the calculation of this x value with non-default + # borders widths of the listbox toplevel .top listbox .top.l -justify left -borderwidth 17 -highlightthickness 19 -selectborderwidth 22 .top.l insert end Item1 LongerItem2 MuchLongerItem3 -- cgit v0.12 From 60426c4ec3415ab57206d57f49f672f407b94a86 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 18 Jan 2016 18:17:30 +0000 Subject: Removed attempt of adjustment of the startup xview according to the -justify option. Anyway this does not work. --- generic/tkListbox.c | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 795ec0f..04dab6f 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -578,17 +578,6 @@ Tk_ListboxObjCmd( return TCL_ERROR; } - /* - * Adjust startup x view according to the justify option. - */ - - if (listPtr->justify == TK_JUSTIFY_RIGHT) { - listPtr->xOffset = GetMaxOffset(listPtr); - } else if (listPtr->justify == TK_JUSTIFY_CENTER) { - listPtr->xOffset = GetMaxOffset(listPtr) / 2; - listPtr->xOffset -= listPtr->xOffset % listPtr->xScrollUnit; - } - Tcl_SetObjResult(interp, TkNewWindowObj(listPtr->tkwin)); return TCL_OK; } -- cgit v0.12 From 65f1c08a6b543a6c25ad704beb200541fc7f6a94 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 18 Jan 2016 18:43:27 +0000 Subject: Reverted [5f396dacdc]. --- generic/tkListbox.c | 1 + tests/listbox.test | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+) diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 04dab6f..c7effdd 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -3642,6 +3642,7 @@ static int GetMaxOffset( maxOffset = 0; } + maxOffset -= maxOffset % listPtr->xScrollUnit; return maxOffset; } diff --git a/tests/listbox.test b/tests/listbox.test index 76a4349..40041de 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -509,6 +509,28 @@ test listbox-3.18b {ListboxWidgetCmd procedure, "bbox" option, justified, non-de destroy .top.l .top unset -nocomplain lres res } -result {1} +test listbox-3.18c {ListboxWidgetCmd procedure, "bbox" option, justified, with x scrolling} -setup { + destroy .top.l .top.hs .top + +} -body { +package req Tk +destroy .top.l .top.hs .top + toplevel .top + listbox .top.l -justify right -borderwidth 7 -highlightthickness 10 -selectborderwidth 20 + scrollbar .top.hs -command ".top.l xview" -orient horizontal + .top.l configure -xscrollcommand ".top.hs set" + set huge [concat "START -" [string repeat "Huge Item... " 20] "- END"] + .top.l insert end VeryVeryLongItem1 AnEvenMuchVeryVeryLongerItem2 $huge ShortItem3 + pack .top.l -expand 1 -fill both + pack .top.hs -expand 1 -fill x + update + + finish write this test case + +} -cleanup { + destroy .top.l .top.hs .top + +} -result {} test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} -body { .l cget } -returnCodes error -result {wrong # args: should be ".l cget option"} -- cgit v0.12 From eed41e54aa350fab52153895c9052ed38517e9fa Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 18 Jan 2016 18:45:27 +0000 Subject: Removed unfinished test case committed by error in the previous commit. --- tests/listbox.test | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/tests/listbox.test b/tests/listbox.test index 40041de..76a4349 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -509,28 +509,6 @@ test listbox-3.18b {ListboxWidgetCmd procedure, "bbox" option, justified, non-de destroy .top.l .top unset -nocomplain lres res } -result {1} -test listbox-3.18c {ListboxWidgetCmd procedure, "bbox" option, justified, with x scrolling} -setup { - destroy .top.l .top.hs .top - -} -body { -package req Tk -destroy .top.l .top.hs .top - toplevel .top - listbox .top.l -justify right -borderwidth 7 -highlightthickness 10 -selectborderwidth 20 - scrollbar .top.hs -command ".top.l xview" -orient horizontal - .top.l configure -xscrollcommand ".top.hs set" - set huge [concat "START -" [string repeat "Huge Item... " 20] "- END"] - .top.l insert end VeryVeryLongItem1 AnEvenMuchVeryVeryLongerItem2 $huge ShortItem3 - pack .top.l -expand 1 -fill both - pack .top.hs -expand 1 -fill x - update - - finish write this test case - -} -cleanup { - destroy .top.l .top.hs .top - -} -result {} test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} -body { .l cget } -returnCodes error -result {wrong # args: should be ".l cget option"} -- cgit v0.12 From 05fb4fb354a81a939be50ee1eea487e58cd6e5b6 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 20 Jan 2016 22:03:33 +0000 Subject: Fixed bug [9e606527af] - && instead of & used in generic/tkOption.c --- generic/tkOption.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tkOption.c b/generic/tkOption.c index d758b6f..680c9db 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -560,7 +560,7 @@ Tk_GetOption( count -= levelPtr[-1].bases[currentStack]; } - if (currentStack && CLASS) { + if (currentStack & CLASS) { nodeId = winClassId; } else { nodeId = winNameId; -- cgit v0.12 From b93bf38ccbdc6c1ad92004de062574738c6a3569 Mon Sep 17 00:00:00 2001 From: jenglish Date: Mon, 25 Jan 2016 20:48:08 +0000 Subject: NotebookAddCommand: fix off-by-one error counting objc/objv when readding an already-managed window with arguments. Bug reported on tcl-core by Sam Bromley (22 Jan 2016) --- generic/ttk/ttkNotebook.c | 2 +- tests/ttk/notebook.test | 21 +++++++++++++++++++++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c index 16a8bfe..81a8b64 100644 --- a/generic/ttk/ttkNotebook.c +++ b/generic/ttk/ttkNotebook.c @@ -901,7 +901,7 @@ static int NotebookAddCommand( if (tab->state == TAB_STATE_HIDDEN) { tab->state = TAB_STATE_NORMAL; } - if (ConfigureTab(interp, nb, tab, slaveWindow, objc-4,objv+4) != TCL_OK) { + if (ConfigureTab(interp, nb, tab, slaveWindow, objc-3,objv+3) != TCL_OK) { return TCL_ERROR; } diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test index cdce020..3a2a6ff 100644 --- a/tests/ttk/notebook.test +++ b/tests/ttk/notebook.test @@ -468,6 +468,27 @@ test notebook-1817596-3 "insert/configure" -body { } -result [list [list .nb.l2 .nb.l0 .nb.l1] L2 L0 L1] -cleanup { destroy .nb } +test notebook-readd-1 "add same widget twice" -body { + pack [ttk::notebook .nb] + .nb add [ttk::button .nb.b1] -text "Button" + .nb add .nb.b1 + .nb tabs +} -result [list .nb.b1] -cleanup { destroy .nb } + +test notebook-readd-2 "add same widget twice, with options" -body { + pack [ttk::notebook .nb] + .nb add [ttk::button .nb.b1] -text "Tab label" + .nb add .nb.b1 -text "Changed tab label" + .nb tabs +} -result [list .nb.b1] -cleanup { destroy .nb } + +test notebook-readd-3 "insert same widget twice, with options" -body { + pack [ttk::notebook .nb] + .nb insert end [ttk::button .nb.b1] -text "Tab label" + .nb insert end .nb.b1 -text "Changed tab label" + .nb tabs +} -result [list .nb.b1] -cleanup { destroy .nb } + # See #1343984 test notebook-1343984-1 "don't autoselect on destroy - setup" -body { -- cgit v0.12 From b2bb8f7366e971a698d64610c5d30fa31f414ca1 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 28 Jan 2016 17:40:10 +0000 Subject: Bump to 8.6.5 --- README | 2 +- generic/tk.h | 4 ++-- library/tk.tcl | 2 +- unix/configure | 14 +++++++------- unix/configure.in | 2 +- win/configure | 2 +- win/configure.in | 2 +- 7 files changed, 14 insertions(+), 14 deletions(-) diff --git a/README b/README index 1470c04..aa5d0f6 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tk - This is the Tk 8.6.4 source distribution. + This is the Tk 8.6.5 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tk from the URL above. diff --git a/generic/tk.h b/generic/tk.h index 4a655a4..75d82ba 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -75,10 +75,10 @@ extern "C" { #define TK_MAJOR_VERSION 8 #define TK_MINOR_VERSION 6 #define TK_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TK_RELEASE_SERIAL 4 +#define TK_RELEASE_SERIAL 5 #define TK_VERSION "8.6" -#define TK_PATCH_LEVEL "8.6.4" +#define TK_PATCH_LEVEL "8.6.5" /* * A special definition used to allow this header file to be included from diff --git a/library/tk.tcl b/library/tk.tcl index 946ab7e..38162d1 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -13,7 +13,7 @@ # Insist on running with compatible version of Tcl package require Tcl 8.6 # Verify that we have Tk binary and script components from the same release -package require -exact Tk 8.6.4 +package require -exact Tk 8.6.5 # Create a ::tk namespace namespace eval ::tk { diff --git a/unix/configure b/unix/configure index 8f9a4ac..3958a6b 100755 --- a/unix/configure +++ b/unix/configure @@ -1338,7 +1338,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".4" +TK_PATCH_LEVEL=".5" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -9598,7 +9598,7 @@ ac_x_header_dirs=' /usr/openwin/share/include' if test "$ac_x_includes" = no; then - # Guess where to find include files, by looking for Xlib.h. + # Guess where to find include files, by looking for Intrinsic.h. # First, try using that file with no special directory specified. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -9606,7 +9606,7 @@ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include +#include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 @@ -9633,7 +9633,7 @@ else sed 's/^/| /' conftest.$ac_ext >&5 for ac_dir in $ac_x_header_dirs; do - if test -r "$ac_dir/X11/Xlib.h"; then + if test -r "$ac_dir/X11/Intrinsic.h"; then ac_x_includes=$ac_dir break fi @@ -9647,18 +9647,18 @@ if test "$ac_x_libraries" = no; then # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS=$LIBS - LIBS="-lX11 $LIBS" + LIBS="-lXt $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include +#include int main () { -XrmInitialize () +XtMalloc (0) ; return 0; } diff --git a/unix/configure.in b/unix/configure.in index 5a18d46..cb412af 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".4" +TK_PATCH_LEVEL=".5" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" diff --git a/win/configure b/win/configure index 18efa23..cbac248 100755 --- a/win/configure +++ b/win/configure @@ -1312,7 +1312,7 @@ SHELL=/bin/sh TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".4" +TK_PATCH_LEVEL=".5" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ diff --git a/win/configure.in b/win/configure.in index 709b97f..0ff9304 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".4" +TK_PATCH_LEVEL=".5" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ -- cgit v0.12 From c3777ebd3a31648fc5427b9536d2e304e9cbcf77 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 29 Jan 2016 07:11:54 +0000 Subject: Fixed test entry-6.12: merge from 8.5 didn't see that $fixed does not exist in trunk version of entry.test. Thanks to emiliano for the report. --- tests/entry.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/entry.test b/tests/entry.test index 9c30b00..4f09450 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -1074,7 +1074,7 @@ test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} -setup { } -body { .e scan a } -cleanup { - destroy .e + destroy .efixed } -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e @@ -1896,12 +1896,12 @@ test entry-6.12 {EntryComputeGeometry procedure} -constraints { fonts } -setup { catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 20 + entry .e -font {Courier -12} -bd 2 -relief raised -width 20 pack .e } -body { .e insert end "012\t456\t" update - list [.e index @81] [.e index @82] [.e index @116] [.e index @117] + list [.e index @80] [.e index @81] [.e index @115] [.e index @116] } -cleanup { destroy .e } -result {6 7 7 8} -- cgit v0.12 From b5e22a7b7e4fd964d34f9d16aa7802fe7322636c Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sun, 31 Jan 2016 00:53:25 +0000 Subject: Fix build errors on i386 for Cocoa; thanks to Marc Culler for patch --- macosx/tkMacOSXButton.c | 4 ++-- macosx/tkMacOSXInit.c | 2 -- macosx/tkMacOSXPrivate.h | 4 ++++ macosx/ttkMacOSXTheme.c | 2 +- 4 files changed, 7 insertions(+), 5 deletions(-) diff --git a/macosx/tkMacOSXButton.c b/macosx/tkMacOSXButton.c index 59d394e..ebbcf09 100644 --- a/macosx/tkMacOSXButton.c +++ b/macosx/tkMacOSXButton.c @@ -289,10 +289,10 @@ TkpComputeButtonGeometry( if ( butPtr->indicatorOn ) { switch (butPtr->type) { case TYPE_RADIO_BUTTON: - GetThemeMetric(kThemeMetricRadioButtonWidth, &butPtr->indicatorDiameter); + GetThemeMetric(kThemeMetricRadioButtonWidth, (SInt32 *)&butPtr->indicatorDiameter); break; case TYPE_CHECK_BUTTON: - GetThemeMetric(kThemeMetricCheckBoxWidth, &butPtr->indicatorDiameter); + GetThemeMetric(kThemeMetricCheckBoxWidth, (SInt32 *)&butPtr->indicatorDiameter); break; default: break; diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c index b965a38..33a60f2 100644 --- a/macosx/tkMacOSXInit.c +++ b/macosx/tkMacOSXInit.c @@ -57,9 +57,7 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt @end @implementation TKApplication -#ifndef __clang__ @synthesize poolProtected = _poolProtected; -#endif @end @implementation TKApplication(TKInit) diff --git a/macosx/tkMacOSXPrivate.h b/macosx/tkMacOSXPrivate.h index 2a411f6..65d60ce 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -276,6 +276,10 @@ VISIBILITY_HIDDEN NSArray *_defaultHelpMenuItems; NSWindow *_windowWithMouse; NSAutoreleasePool *_mainPool; +#ifdef __i386__ + /* The Objective C runtime used on i386 requires this. */ + BOOL _poolProtected; +#endif } @property BOOL poolProtected; @end diff --git a/macosx/ttkMacOSXTheme.c b/macosx/ttkMacOSXTheme.c index 4753a40..f9611c5 100644 --- a/macosx/ttkMacOSXTheme.c +++ b/macosx/ttkMacOSXTheme.c @@ -298,7 +298,7 @@ static void TabElementSize( void *clientData, void *elementRecord, Tk_Window tkwin, int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr) { - *heightPtr = GetThemeMetric(kThemeMetricLargeTabHeight, heightPtr); + GetThemeMetric(kThemeMetricLargeTabHeight, (SInt32 *)heightPtr); *paddingPtr = Ttk_MakePadding(0, 0, 0, 2); } -- cgit v0.12 From a5b54a7f07e68d3223a0b945b7e7e0da345633ed Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 2 Feb 2016 22:16:08 +0000 Subject: Re-implement tkoption readfile using Tcl_ReadChars --- generic/tkOption.c | 40 ++++++++-------------------------------- tests/option.file3 | 2 +- 2 files changed, 9 insertions(+), 33 deletions(-) diff --git a/generic/tkOption.c b/generic/tkOption.c index 680c9db..24e7fb3 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -1080,10 +1080,10 @@ ReadOptionFile( * TK_MAX_PRIO. */ { const char *realName; - char *buffer; + Tcl_Obj *buffer; int result, bufferSize; Tcl_Channel chan; - Tcl_DString newName, optString; + Tcl_DString newName; /* * Prevent file system access in a safe interpreter. @@ -1108,24 +1108,10 @@ ReadOptionFile( return TCL_ERROR; } - /* - * Compute size of file by seeking to the end of the file. This will - * overallocate if we are performing CRLF translation. - */ - - bufferSize = (int) Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_END); - Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_SET); - - if (bufferSize < 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error seeking to end of file \"%s\": %s", - fileName, Tcl_PosixError(interp))); - Tcl_Close(NULL, chan); - return TCL_ERROR; - } - - buffer = ckalloc(bufferSize + 1); - bufferSize = Tcl_Read(chan, buffer, bufferSize); + buffer = Tcl_NewObj(); + Tcl_IncrRefCount(buffer); + Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8"); + bufferSize = Tcl_ReadChars(chan, buffer, -1, 0); if (bufferSize < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error reading file \"%s\": %s", @@ -1134,18 +1120,8 @@ ReadOptionFile( return TCL_ERROR; } Tcl_Close(NULL, chan); - buffer[bufferSize] = 0; - if ((bufferSize>2) && !memcmp(buffer, "\357\273\277", 3)) { - /* File starts with UTF-8 BOM */ - result = AddFromString(interp, tkwin, buffer+3, priority); - } else { - Tcl_DStringInit(&optString); - Tcl_ExternalToUtfDString(NULL, buffer, bufferSize, &optString); - result = AddFromString(interp, tkwin, Tcl_DStringValue(&optString), - priority); - Tcl_DStringFree(&optString); - } - ckfree(buffer); + result = AddFromString(interp, tkwin, Tcl_GetString(buffer), priority); + Tcl_DecrRefCount(buffer); return result; } diff --git a/tests/option.file3 b/tests/option.file3 index 87f41ae..146cfd9 100755 --- a/tests/option.file3 +++ b/tests/option.file3 @@ -1,4 +1,4 @@ -! This file is a sample option (resource) database used to test +! This file is a sample option (resource) database used to test ! Tk's option-handling capabilities. ! Comment line \ -- cgit v0.12 From e1d015ea1d6d8301149fa627ec1abf6b487d99c3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 3 Feb 2016 09:14:37 +0000 Subject: Added documentation, please review! --- doc/option.n | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/option.n b/doc/option.n index 8699c0d..8f29d3a 100644 --- a/doc/option.n +++ b/doc/option.n @@ -59,6 +59,11 @@ options specified in that file to the option database. If \fIpriority\fR is specified, it indicates the priority level at which to enter the options; \fIpriority\fR defaults to \fBinteractive\fR. .PP +The file is read through a channel which is in "utf-8" encoding, +invalid byte sequences are automatically converted to valid +ones. This means that encodings like ISO 8859-1 or cp1282 with +high probablility will work as well, but this is not guaranteed. +.PP The \fIpriority\fR arguments to the \fBoption\fR command are normally specified symbolically using one of the following values: .TP -- cgit v0.12 From 3b67157554ddf66b9d0fafeda1944869ed881b13 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 3 Feb 2016 09:20:12 +0000 Subject: Document that [encoding system] has no effect on option readfile --- doc/option.n | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/doc/option.n b/doc/option.n index 8f29d3a..2763d64 100644 --- a/doc/option.n +++ b/doc/option.n @@ -60,9 +60,10 @@ is specified, it indicates the priority level at which to enter the options; \fIpriority\fR defaults to \fBinteractive\fR. .PP The file is read through a channel which is in "utf-8" encoding, -invalid byte sequences are automatically converted to valid -ones. This means that encodings like ISO 8859-1 or cp1282 with -high probablility will work as well, but this is not guaranteed. +invalid byte sequences are automatically converted to valid ones. +This means that encodings like ISO 8859-1 or cp1252 with high +probability will work as well, but this cannot be guaranteed. +This cannot be changed, setting the [encoding system] has no effect. .PP The \fIpriority\fR arguments to the \fBoption\fR command are normally specified symbolically using one of the following values: -- cgit v0.12 From 4b766d1f24378289437bc45e7405f68a48053915 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 5 Feb 2016 19:30:32 +0000 Subject: Fix crashing test case, textDisp-8.13 --- generic/tkTextDisp.c | 5 +++++ tests/textDisp.test | 9 +++++++++ 2 files changed, 14 insertions(+) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 18b373f..f2e760b 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -4765,6 +4765,11 @@ TextChanged( } } + while ((lastPtr != NULL) + && (lastPtr->index.linePtr == index2Ptr->linePtr)) { + lastPtr = lastPtr->nextPtr; + } + /* * Delete all the DLines from firstPtr up to but not including lastPtr. */ diff --git a/tests/textDisp.test b/tests/textDisp.test index caba769..f5fbd3d 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -1192,6 +1192,15 @@ test textDisp-8.12 {TkTextChanged, moving the insert cursor redraws only past an # cursor is in since this display line was just unlinked in (a). } {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {2.0 3.0}} +test textDisp-8.13 {TkTextChanged, [06c1433906]} { + .t delete 1.0 end + .t insert 1.0 \nLine1\nLine2\n + update + .t insert 3.0 "" + .t delete 1.0 2.0 + update idletasks +} {} + test textDisp-9.1 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end -- cgit v0.12 From e5ea273dc4f32113d02d0ede8742e214ad6ea37b Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 7 Feb 2016 13:29:51 +0000 Subject: Hopefully a better fix for [06c1433906] - Text widget crash --- generic/tkTextDisp.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 10f6414..fe69f28 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -4683,6 +4683,9 @@ TextChanged( */ lastPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &rounded); + if ((lastPtr != NULL) && (TkTextIndexCmp(&lastPtr->index, &rounded) < 0)) { + lastPtr = lastPtr->nextPtr; + } /* * At least one display line is supposed to change. This makes the @@ -4699,11 +4702,6 @@ TextChanged( } } - while ((lastPtr != NULL) - && (lastPtr->index.linePtr == index2Ptr->linePtr)) { - lastPtr = lastPtr->nextPtr; - } - /* * Delete all the DLines from firstPtr up to but not including lastPtr. */ -- cgit v0.12 From 0253e18f4273fb5354b29beca73e4835ec02058f Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 7 Feb 2016 13:34:02 +0000 Subject: Cherrypicked the new test textDisp-8.13 from core-8-5-branch. This test (and all the other tests) pass. --- tests/textDisp.test | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/textDisp.test b/tests/textDisp.test index ac3aee0..532caf4 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -1191,6 +1191,14 @@ test textDisp-8.12 {TkTextChanged, moving the insert cursor redraws only past an # because during (b) findDLine cannot return the display line the # cursor is in since this display line was just unlinked in (a). } {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {2.0 3.0}} +test textDisp-8.13 {TkTextChanged, used to crash, see [06c1433906]} { + .t delete 1.0 end + .t insert 1.0 \nLine1\nLine2\n + update + .t insert 3.0 "" + .t delete 1.0 2.0 + update idletasks +} {} test textDisp-9.1 {TkTextRedrawTag} { .t configure -wrap char -- cgit v0.12 From ecb4e238565152c913a65d2eb5d8ad782793b474 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 7 Feb 2016 19:21:04 +0000 Subject: while is better than if because it deals with wrapped lines then. --- generic/tkTextDisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index fe69f28..91642f9 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -4683,7 +4683,7 @@ TextChanged( */ lastPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &rounded); - if ((lastPtr != NULL) && (TkTextIndexCmp(&lastPtr->index, &rounded) < 0)) { + while ((lastPtr != NULL) && (TkTextIndexCmp(&lastPtr->index, &rounded) < 0)) { lastPtr = lastPtr->nextPtr; } -- cgit v0.12 From 6fcac7ae49122cfb95054e673f24cd82835d4116 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 8 Feb 2016 19:42:54 +0000 Subject: Reverted [311ef109] and [1847c858] because they are no longer needed to fix bug [2f78c7c5ea]. The corresponding test textDisp-9.14 still passes. --- generic/tkTextDisp.c | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 91642f9..c5ad36b 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -4806,16 +4806,9 @@ TextRedrawTag( /* * Round up the starting position if it's before the first line visible on - * the screen (we only care about what's on the screen). Beware that the - * display info structure might need update, for instance if we arrived - * here from an 'after idle' script removing tags in a range whose - * display lines (and dInfo) were partially invalidated by a previous - * delete operation in the text widget. + * the screen (we only care about what's on the screen). */ - if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { - UpdateDisplayInfo(textPtr); - } dlPtr = dInfoPtr->dLinePtr; if (dlPtr == NULL) { return; -- cgit v0.12 From 47fa51915781b8ceb0ad65f72b06b6d4814dbde7 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 8 Feb 2016 20:13:20 +0000 Subject: More comments in FindDLine, with slightly optimized code to achieve the same functionality. --- generic/tkTextDisp.c | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index c5ad36b..d45ac73 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -6618,17 +6618,25 @@ FindDLine( /* * We're past the last display line, either because the desired * index lies past the visible text, or because the desired index - * is on the last display line showing the last logical line. + * is on the last display line. */ indexPtr2 = dlPtrPrev->index; TkTextIndexForwBytes(textPtr, &indexPtr2, dlPtrPrev->byteCount, &indexPtr2); if (TkTextIndexCmp(&indexPtr2,indexPtr) > 0) { + /* + * The desired index is on the last display line. + * --> return this display line. + */ dlPtr = dlPtrPrev; - break; } else { - return NULL; + /* + * The desired index is past the visible text. There is no + * display line displaying something at the desired index + * --> return NULL. + */ } + break; } if (TkTextIndexCmp(&dlPtr->index,indexPtr) > 0) { dlPtr = dlPtrPrev; -- cgit v0.12 From afd2fa759f72c2936c5fcec0449acbaaaa93f989 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 8 Feb 2016 20:15:40 +0000 Subject: Renumbered lines to avoid wrong interpretation of the test. --- tests/textDisp.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/textDisp.test b/tests/textDisp.test index 532caf4..6aa3721 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -1193,7 +1193,7 @@ test textDisp-8.12 {TkTextChanged, moving the insert cursor redraws only past an } {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {2.0 3.0}} test textDisp-8.13 {TkTextChanged, used to crash, see [06c1433906]} { .t delete 1.0 end - .t insert 1.0 \nLine1\nLine2\n + .t insert 1.0 \nLine2\nLine3\n update .t insert 3.0 "" .t delete 1.0 2.0 -- cgit v0.12 From d00d37bf4da1bd2c0ac1548af910aea41a4e1289 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 8 Feb 2016 21:13:57 +0000 Subject: Made FindDLine fully match its header description. --- generic/tkTextDisp.c | 33 ++++++++++++++++++++++++++++++--- tests/textDisp.test | 11 +---------- 2 files changed, 31 insertions(+), 13 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index d45ac73..4d41134 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -6590,6 +6590,7 @@ FindDLine( CONST TkTextIndex *indexPtr)/* Index of desired character. */ { DLine *dlPtrPrev; + TkTextIndex indexPtr2; if (dlPtr == NULL) { return NULL; @@ -6614,7 +6615,6 @@ FindDLine( dlPtrPrev = dlPtr; dlPtr = dlPtr->nextPtr; if (dlPtr == NULL) { - TkTextIndex indexPtr2; /* * We're past the last display line, either because the desired * index lies past the visible text, or because the desired index @@ -6632,14 +6632,41 @@ FindDLine( } else { /* * The desired index is past the visible text. There is no - * display line displaying something at the desired index + * display line displaying something at the desired index. * --> return NULL. */ } break; } if (TkTextIndexCmp(&dlPtr->index,indexPtr) > 0) { - dlPtr = dlPtrPrev; + /* + * If we're here then we would normally expect that: + * dlPtrPrev->index <= indexPtr < dlPtr->index + * i.e. we have found the searched display line being dlPtr. + * However it is possible that some DLines were unlinked + * previously, leading to a situation where going through + * the list of display lines skips display lines that did + * exist just a moment ago. + */ + indexPtr2 = dlPtrPrev->index; + TkTextIndexForwBytes(textPtr, &indexPtr2, dlPtrPrev->byteCount, + &indexPtr2); + if (TkTextIndexCmp(&indexPtr2,indexPtr) > 0) { + /* + * Confirmed: + * dlPtrPrev->index <= indexPtr < dlPtr->index + * --> return dlPtrPrev. + */ + dlPtr = dlPtrPrev; + } else { + /* + * The last (rightmost) index shown by dlPtrPrev is still + * before the desired index. This may be because there was + * previously a display line between dlPtrPrev and dlPtr + * and this display line has been unlinked. + * --> return dlPtr. + */ + } break; } } diff --git a/tests/textDisp.test b/tests/textDisp.test index 6aa3721..885c940 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -1181,16 +1181,7 @@ test textDisp-8.12 {TkTextChanged, moving the insert cursor redraws only past an .t mark set insert 3.8 ; # within the same line update lappend res $tk_textRedraw - # This last one is tricky: correct result really is {2.0 3.0} when - # calling .t mark set insert, two calls to TkTextChanged are done: - # (a) to redraw the line of the past position of the cursor - # (b) to redraw the line of the new position of the cursor - # During (a) the display line showing the cursor gets unlinked, - # which leads TkTextChanged in (b) to schedule a redraw starting - # one line _before_ the line containing the insert cursor. This is - # because during (b) findDLine cannot return the display line the - # cursor is in since this display line was just unlinked in (a). -} {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {2.0 3.0}} +} {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {3.0 4.0}} test textDisp-8.13 {TkTextChanged, used to crash, see [06c1433906]} { .t delete 1.0 end .t insert 1.0 \nLine2\nLine3\n -- cgit v0.12 From 961c4a400fecbd654b8b744a5de3f006ceb22d58 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 8 Feb 2016 21:39:52 +0000 Subject: With the real fix in FindDLine ([717e12ee]) there is no need anymore of the emergency patch [c3c09f82]. --- generic/tkTextDisp.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 4d41134..44d451a 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -4683,9 +4683,6 @@ TextChanged( */ lastPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &rounded); - while ((lastPtr != NULL) && (TkTextIndexCmp(&lastPtr->index, &rounded) < 0)) { - lastPtr = lastPtr->nextPtr; - } /* * At least one display line is supposed to change. This makes the -- cgit v0.12 From 4cf679d27cf1beb50d5806e6173a8071821aff95 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 8 Feb 2016 21:45:03 +0000 Subject: Corrected indentation + added an explanatory comment. --- generic/tkTextDisp.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 07623c4..960f11a 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -5243,7 +5243,10 @@ TkTextSetYView( dInfoPtr->newTopPixelOffset = 0; goto scheduleUpdate; - } + } + /* + * The line is already on screen, with no need to scroll. + */ return; } } -- cgit v0.12 From 199e45b764bee51a9aacbced3e5ac9828b731d3f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Feb 2016 09:23:17 +0000 Subject: Fix [62a5ba7474]: tk 'make install' fails on Mac OS 10.11 --- macosx/GNUmakefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile index 02240ed..24e1f77 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -116,7 +116,7 @@ TCL_FRAMEWORK_DIR := ${TCL_BUILD_DIR}/.. MAKE_VARS := else TCL_DIR := ${TCL_FRAMEWORK_DIR}/Tcl.framework -TCL_EXE := ${TCLSH_DIR}/tclsh${TCL_VERSION} +TCL_EXE := ${TCLSH_DIR}/bin/tclsh${TCL_VERSION} MAKE_VARS := TCL_EXE export DYLD_FRAMEWORK_PATH := ${TCL_FRAMEWORK_DIR} endif -- cgit v0.12 From 8f151700b10bf8811876305e284738707d4ad237 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Feb 2016 09:48:23 +0000 Subject: Slightly more logical fix for [62a5ba7474]: tk 'make install' fails on Mac OS 10.11, which doesn't change the meaning of TCLSH_DIR --- macosx/GNUmakefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile index 24e1f77..d0bab1a 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -35,7 +35,7 @@ MANDIR ?= ${PREFIX}/man TCL_BUILD_DIR ?= ${BUILD_DIR}/tcl/${BUILD_STYLE} # location of installed tcl, only used if tcl in TCL_BUILD_DIR can't be found TCL_FRAMEWORK_DIR ?= /Library/Frameworks -TCLSH_DIR ?= ${PREFIX} +TCLSH_DIR ?= ${PREFIX}/bin # set to non-empty value to install manpages in addition to html help: INSTALL_MANPAGES ?= @@ -116,7 +116,7 @@ TCL_FRAMEWORK_DIR := ${TCL_BUILD_DIR}/.. MAKE_VARS := else TCL_DIR := ${TCL_FRAMEWORK_DIR}/Tcl.framework -TCL_EXE := ${TCLSH_DIR}/bin/tclsh${TCL_VERSION} +TCL_EXE := ${TCLSH_DIR}/tclsh${TCL_VERSION} MAKE_VARS := TCL_EXE export DYLD_FRAMEWORK_PATH := ${TCL_FRAMEWORK_DIR} endif -- cgit v0.12 From 9e0da9a8a02dceebf16ed424cdef34ebcb6f3b5c Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 9 Feb 2016 18:44:42 +0000 Subject: Repair broken test. --- tests/entry.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/entry.test b/tests/entry.test index 4f09450..d27ffb5 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -1074,7 +1074,7 @@ test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} -setup { } -body { .e scan a } -cleanup { - destroy .efixed + destroy .e } -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e -- cgit v0.12 From b258e6b408ef99ed31fdde484f21548851eca156 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:23:23 +0000 Subject: -selectbackground tag configuration option: implementation --- generic/tkText.c | 7 ++++++- generic/tkText.h | 2 ++ generic/tkTextDisp.c | 13 +++++++++++++ generic/tkTextTag.c | 10 +++++++++- 4 files changed, 30 insertions(+), 2 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 3079417..1b420d6 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2253,7 +2253,11 @@ ConfigureText( * replaced in the widget record. */ - textPtr->selTagPtr->border = textPtr->selBorder; + if (textPtr->selTagPtr->selBorder == NULL) { + textPtr->selTagPtr->border = textPtr->selBorder; + } else { + textPtr->selTagPtr->selBorder = textPtr->selBorder; + } if (textPtr->selTagPtr->borderWidthPtr != textPtr->selBorderWidthPtr) { textPtr->selTagPtr->borderWidthPtr = textPtr->selBorderWidthPtr; textPtr->selTagPtr->borderWidth = textPtr->selBorderWidth; @@ -2277,6 +2281,7 @@ ConfigureText( textPtr->selTagPtr->affectsDisplayGeometry = 1; } if ((textPtr->selTagPtr->border != NULL) + || (textPtr->selTagPtr->selBorder != NULL) || (textPtr->selTagPtr->reliefString != NULL) || (textPtr->selTagPtr->bgStipple != None) || (textPtr->selTagPtr->fgColor != NULL) diff --git a/generic/tkText.h b/generic/tkText.h index fc92644..5cd009f 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -362,6 +362,8 @@ typedef struct TkTextTag { * means option not specified. */ int rMargin; /* Right margin for text, in pixels. Only * valid if rMarginString is non-NULL. */ + Tk_3DBorder selBorder; /* Used for drawing background for selected text. + * NULL means no value specified here. */ char *spacing1String; /* -spacing1 option string (malloc-ed). NULL * means option not specified. */ int spacing1; /* Extra spacing above first display line for diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 7969091..1bd5905 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -748,6 +748,7 @@ GetStyle( TextStyle *stylePtr; Tcl_HashEntry *hPtr; int numTags, isNew, i; + int isSelected; XGCValues gcValues; unsigned long mask; /* @@ -786,6 +787,14 @@ GetStyle( styleValues.tabStyle = textPtr->tabStyle; styleValues.wrapMode = textPtr->wrapMode; styleValues.elide = 0; + isSelected = 0; + + for (i = 0 ; i < numTags; i++) { + if (textPtr->selTagPtr == tagPtrs[i]) { + isSelected = 1; + break; + } + } for (i = 0 ; i < numTags; i++) { Tk_3DBorder border; @@ -811,6 +820,10 @@ GetStyle( border = textPtr->inactiveSelBorder; } + if ((tagPtr->selBorder != NULL) && (isSelected)) { + border = tagPtr->selBorder; + } + if ((border != NULL) && (tagPtr->priority > borderPrio)) { styleValues.border = border; borderPrio = tagPtr->priority; diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index 3363d25..a857cf9 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -70,6 +70,8 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, -1, Tk_Offset(TkTextTag, reliefString), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-rmargin", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, rMarginString), TK_OPTION_NULL_OK, 0,0}, + {TK_OPTION_BORDER, "-selectbackground", NULL, NULL, + NULL, -1, Tk_Offset(TkTextTag, selBorder), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-spacing1", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, spacing1String), TK_OPTION_NULL_OK,0,0}, {TK_OPTION_STRING, "-spacing2", NULL, NULL, @@ -484,7 +486,11 @@ TkTextTagCmd( */ if (tagPtr == textPtr->selTagPtr) { - textPtr->selBorder = tagPtr->border; + if (tagPtr->selBorder == NULL) { + textPtr->selBorder = tagPtr->border; + } else { + textPtr->selBorder = tagPtr->selBorder; + } textPtr->selBorderWidth = tagPtr->borderWidth; textPtr->selBorderWidthPtr = tagPtr->borderWidthPtr; textPtr->selFgColorPtr = tagPtr->fgColor; @@ -509,6 +515,7 @@ TkTextTagCmd( tagPtr->affectsDisplayGeometry = 1; } if ((tagPtr->border != NULL) + || (tagPtr->selBorder != NULL) || (tagPtr->reliefString != NULL) || (tagPtr->bgStipple != None) || (tagPtr->fgColor != NULL) @@ -1017,6 +1024,7 @@ TkTextCreateTag( tagPtr->overstrike = 0; tagPtr->rMarginString = NULL; tagPtr->rMargin = 0; + tagPtr->selBorder = NULL; tagPtr->spacing1String = NULL; tagPtr->spacing1 = 0; tagPtr->spacing2String = NULL; -- cgit v0.12 From b3b68ebfe18ad11c210bc80ec440c49d7b6dad8d Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:24:38 +0000 Subject: -selectbackground tag configuration option: documentation --- doc/text.n | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/text.n b/doc/text.n index ac7803c..41d6a6f 100644 --- a/doc/text.n +++ b/doc/text.n @@ -517,6 +517,13 @@ option is only used when wrapping is enabled. If a text line wraps, the right margin for each line on the display is determined by the first non-elided character of that display line. .TP +\fB\-selectbackground \fIcolor\fR +\fIcolor\fR specifies the background color to use when displaying selected +items. It may have any of the forms accepted by \fBTk_GetColor\fR. If +\fIcolor\fR has not been specified, or if it is specified as an empty +string, then the color specified by the fB\-background\fR tag option is +used. +.TP \fB\-spacing1 \fIpixels\fR . \fIPixels\fR specifies how much additional space should be left above each -- cgit v0.12 From f47ea89bb9b84548e135f0a72a033b20f0fe9f2a Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:27:11 +0000 Subject: -selectbackground tag configuration option: tests --- tests/textTag.test | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/tests/textTag.test b/tests/textTag.test index fed073a..a7935da 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -228,6 +228,17 @@ test textTag-1.25 {configuration options} -constraints { } -cleanup { .t tag configure x -rmargin [lindex [.t tag configure x -rmargin] 3] } -returnCodes error -result {bad screen distance "bad"} +test textTag-1.25a {tag configuration options} -body { + .t tag configure x -selectbackground #012345 + .t tag cget x -selectbackground +} -cleanup { + .t tag configure x -selectbackground [lindex [.t tag configure x -selectbackground] 3] +} -result {#012345} +test textTag-1.25b {configuration options} -body { + .t tag configure x -selectbackground non-existent +} -cleanup { + .t tag configure x -selectbackground [lindex [.t tag configure x -selectbackground] 3] +} -returnCodes error -result {unknown color name "non-existent"} test textTag-1.26 {tag configuration options} -constraints { haveCourier12 } -body { @@ -713,7 +724,29 @@ test textTag-5.22 {TkTextTagCmd - "configure" option} -constraints { .t tag configure sel -borderwidth {} .t cget -selectborderwidth } -result {} - +test textTag-5.23 {TkTextTagCmd - "configure" option} -body { + set x {} + # when [.t tag cget sel -selectbackground] == "", mirroring happens between + # the text widget option -selectbackground + # and the tag option -background + .t tag configure sel -selectbackground {} + .t configure -selectbackground black + .t tag configure sel -background yellow + lappend x [.t cget -selectbackground] + .t tag configure sel -background orange + .t configure -selectbackground blue + lappend x [.t tag cget sel -background] + # when [.t tag cget sel -selectbackground] != "", mirroring happens between + # the text widget option -selectbackground + # and the tag option -selectbackground + .t tag configure sel -selectbackground green + .t configure -selectbackground red + lappend x [.t tag cget sel -selectbackground] + .t configure -selectbackground black + .t tag configure sel -selectbackground white + lappend x [.t cget -selectbackground] + return $x +} -result {yellow blue red white} test textTag-6.1 {TkTextTagCmd - "delete" option} -constraints { haveCourier12 -- cgit v0.12 From 0e661eb452692fff53250ae95abde079888f3a27 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:29:22 +0000 Subject: -selectforeground tag configuration option: implementation --- generic/tkText.c | 7 ++++++- generic/tkText.h | 2 ++ generic/tkTextDisp.c | 10 ++++++++-- generic/tkTextTag.c | 10 +++++++++- 4 files changed, 25 insertions(+), 4 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 1b420d6..464d4d9 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2262,7 +2262,11 @@ ConfigureText( textPtr->selTagPtr->borderWidthPtr = textPtr->selBorderWidthPtr; textPtr->selTagPtr->borderWidth = textPtr->selBorderWidth; } - textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr; + if (textPtr->selTagPtr->selFgColor == NULL) { + textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr; + } else { + textPtr->selTagPtr->selFgColor = textPtr->selFgColorPtr; + } textPtr->selTagPtr->affectsDisplay = 0; textPtr->selTagPtr->affectsDisplayGeometry = 0; if ((textPtr->selTagPtr->elideString != NULL) @@ -2285,6 +2289,7 @@ ConfigureText( || (textPtr->selTagPtr->reliefString != NULL) || (textPtr->selTagPtr->bgStipple != None) || (textPtr->selTagPtr->fgColor != NULL) + || (textPtr->selTagPtr->selFgColor != NULL) || (textPtr->selTagPtr->fgStipple != None) || (textPtr->selTagPtr->overstrikeString != NULL) || (textPtr->selTagPtr->underlineString != NULL)) { diff --git a/generic/tkText.h b/generic/tkText.h index 5cd009f..3056ab8 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -364,6 +364,8 @@ typedef struct TkTextTag { * valid if rMarginString is non-NULL. */ Tk_3DBorder selBorder; /* Used for drawing background for selected text. * NULL means no value specified here. */ + XColor *selFgColor; /* Foreground color for selected text. NULL means + * no value specified here. */ char *spacing1String; /* -spacing1 option string (malloc-ed). NULL * means option not specified. */ int spacing1; /* Extra spacing above first display line for diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 1bd5905..e8f8d79 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -798,9 +798,11 @@ GetStyle( for (i = 0 ; i < numTags; i++) { Tk_3DBorder border; + XColor *fgColor; tagPtr = tagPtrs[i]; border = tagPtr->border; + fgColor = tagPtr->fgColor; /* * If this is the selection tag, and inactiveSelBorder is NULL (the @@ -824,6 +826,10 @@ GetStyle( border = tagPtr->selBorder; } + if ((tagPtr->selFgColor != None) && (isSelected)) { + fgColor = tagPtr->selFgColor; + } + if ((border != NULL) && (tagPtr->priority > borderPrio)) { styleValues.border = border; borderPrio = tagPtr->priority; @@ -847,8 +853,8 @@ GetStyle( styleValues.bgStipple = tagPtr->bgStipple; bgStipplePrio = tagPtr->priority; } - if ((tagPtr->fgColor != None) && (tagPtr->priority > fgPrio)) { - styleValues.fgColor = tagPtr->fgColor; + if ((fgColor != None) && (tagPtr->priority > fgPrio)) { + styleValues.fgColor = fgColor; fgPrio = tagPtr->priority; } if ((tagPtr->tkfont != None) && (tagPtr->priority > fontPrio)) { diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index a857cf9..97356ed 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -72,6 +72,8 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, -1, Tk_Offset(TkTextTag, rMarginString), TK_OPTION_NULL_OK, 0,0}, {TK_OPTION_BORDER, "-selectbackground", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, selBorder), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_COLOR, "-selectforeground", NULL, NULL, + NULL, -1, Tk_Offset(TkTextTag, selFgColor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-spacing1", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, spacing1String), TK_OPTION_NULL_OK,0,0}, {TK_OPTION_STRING, "-spacing2", NULL, NULL, @@ -493,7 +495,11 @@ TkTextTagCmd( } textPtr->selBorderWidth = tagPtr->borderWidth; textPtr->selBorderWidthPtr = tagPtr->borderWidthPtr; - textPtr->selFgColorPtr = tagPtr->fgColor; + if (tagPtr->selFgColor == NULL) { + textPtr->selFgColorPtr = tagPtr->fgColor; + } else { + textPtr->selFgColorPtr = tagPtr->selFgColor; + } } tagPtr->affectsDisplay = 0; @@ -519,6 +525,7 @@ TkTextTagCmd( || (tagPtr->reliefString != NULL) || (tagPtr->bgStipple != None) || (tagPtr->fgColor != NULL) + || (tagPtr->selFgColor != NULL) || (tagPtr->fgStipple != None) || (tagPtr->overstrikeString != NULL) || (tagPtr->underlineString != NULL)) { @@ -1025,6 +1032,7 @@ TkTextCreateTag( tagPtr->rMarginString = NULL; tagPtr->rMargin = 0; tagPtr->selBorder = NULL; + tagPtr->selFgColor = NULL; tagPtr->spacing1String = NULL; tagPtr->spacing1 = 0; tagPtr->spacing2String = NULL; -- cgit v0.12 From 8ffa9516ef4ea4b1d2bded2bc05999322889a15a Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:29:50 +0000 Subject: -selectforeground tag configuration option: documentation --- doc/text.n | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/text.n b/doc/text.n index 41d6a6f..61808ce 100644 --- a/doc/text.n +++ b/doc/text.n @@ -524,6 +524,13 @@ items. It may have any of the forms accepted by \fBTk_GetColor\fR. If string, then the color specified by the fB\-background\fR tag option is used. .TP +\fB\-selectforeground \fIcolor\fR +\fIcolor\fR specifies the foreground color to use when displaying selected +items. It may have any of the forms accepted by \fBTk_GetColor\fR. If +\fIcolor\fR has not been specified, or if it is specified as an empty +string, then the color specified by the fB\-foreground\fR tag option is +used. +.TP \fB\-spacing1 \fIpixels\fR . \fIPixels\fR specifies how much additional space should be left above each -- cgit v0.12 From 91073e4b5a77eb86aadddb05d9666a89f9b81907 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:30:11 +0000 Subject: -selectforeground tag configuration option: tests --- tests/textTag.test | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/tests/textTag.test b/tests/textTag.test index a7935da..8b5ac74 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -239,6 +239,17 @@ test textTag-1.25b {configuration options} -body { } -cleanup { .t tag configure x -selectbackground [lindex [.t tag configure x -selectbackground] 3] } -returnCodes error -result {unknown color name "non-existent"} +test textTag-1.25c {tag configuration options} -body { + .t tag configure x -selectforeground #012345 + .t tag cget x -selectforeground +} -cleanup { + .t tag configure x -selectforeground [lindex [.t tag configure x -selectforeground] 3] +} -result {#012345} +test textTag-1.25d {configuration options} -body { + .t tag configure x -selectforeground non-existent +} -cleanup { + .t tag configure x -selectforeground [lindex [.t tag configure x -selectforeground] 3] +} -returnCodes error -result {unknown color name "non-existent"} test textTag-1.26 {tag configuration options} -constraints { haveCourier12 } -body { @@ -747,6 +758,29 @@ test textTag-5.23 {TkTextTagCmd - "configure" option} -body { lappend x [.t cget -selectbackground] return $x } -result {yellow blue red white} +test textTag-5.24 {TkTextTagCmd - "configure" option} -body { + set x {} + # when [.t tag cget sel -selectforeground] == "", mirroring happens between + # the text widget option -selectforeground + # and the tag option -foreground + .t tag configure sel -selectforeground {} + .t configure -selectforeground black + .t tag configure sel -foreground yellow + lappend x [.t cget -selectforeground] + .t tag configure sel -foreground orange + .t configure -selectforeground blue + lappend x [.t tag cget sel -foreground] + # when [.t tag cget sel -selectforeground] != "", mirroring happens between + # the text widget option -selectforeground + # and the tag option -selectforeground + .t tag configure sel -selectforeground green + .t configure -selectforeground red + lappend x [.t tag cget sel -selectforeground] + .t configure -selectforeground black + .t tag configure sel -selectforeground white + lappend x [.t cget -selectforeground] + return $x +} -result {yellow blue red white} test textTag-6.1 {TkTextTagCmd - "delete" option} -constraints { haveCourier12 -- cgit v0.12 From 5d588d31457d24ca04b54f6f1c92647e6a3d2b50 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:32:10 +0000 Subject: -selectbgstipple tag configuration option: implementation --- generic/tkText.c | 1 + generic/tkText.h | 2 ++ generic/tkTextDisp.c | 10 ++++++++-- generic/tkTextTag.c | 4 ++++ 4 files changed, 15 insertions(+), 2 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 464d4d9..7a2a6d5 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2288,6 +2288,7 @@ ConfigureText( || (textPtr->selTagPtr->selBorder != NULL) || (textPtr->selTagPtr->reliefString != NULL) || (textPtr->selTagPtr->bgStipple != None) + || (textPtr->selTagPtr->selBgStipple != None) || (textPtr->selTagPtr->fgColor != NULL) || (textPtr->selTagPtr->selFgColor != NULL) || (textPtr->selTagPtr->fgStipple != None) diff --git a/generic/tkText.h b/generic/tkText.h index 3056ab8..c8a71b3 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -364,6 +364,8 @@ typedef struct TkTextTag { * valid if rMarginString is non-NULL. */ Tk_3DBorder selBorder; /* Used for drawing background for selected text. * NULL means no value specified here. */ + Pixmap selBgStipple; /* Stipple bitmap for background of selected text. + * None means no value specified here. */ XColor *selFgColor; /* Foreground color for selected text. NULL means * no value specified here. */ char *spacing1String; /* -spacing1 option string (malloc-ed). NULL diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index e8f8d79..0ccd3c2 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -798,10 +798,12 @@ GetStyle( for (i = 0 ; i < numTags; i++) { Tk_3DBorder border; + Pixmap bgStipple; XColor *fgColor; tagPtr = tagPtrs[i]; border = tagPtr->border; + bgStipple = tagPtr->bgStipple; fgColor = tagPtr->fgColor; /* @@ -826,6 +828,10 @@ GetStyle( border = tagPtr->selBorder; } + if ((tagPtr->selBgStipple != None) && (isSelected)) { + bgStipple = tagPtr->selBgStipple; + } + if ((tagPtr->selFgColor != None) && (isSelected)) { fgColor = tagPtr->selFgColor; } @@ -848,9 +854,9 @@ GetStyle( styleValues.relief = tagPtr->relief; reliefPrio = tagPtr->priority; } - if ((tagPtr->bgStipple != None) + if ((bgStipple != None) && (tagPtr->priority > bgStipplePrio)) { - styleValues.bgStipple = tagPtr->bgStipple; + styleValues.bgStipple = bgStipple; bgStipplePrio = tagPtr->priority; } if ((fgColor != None) && (tagPtr->priority > fgPrio)) { diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index 97356ed..86a6e77 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -72,6 +72,8 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, -1, Tk_Offset(TkTextTag, rMarginString), TK_OPTION_NULL_OK, 0,0}, {TK_OPTION_BORDER, "-selectbackground", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, selBorder), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BITMAP, "-selectbgstipple", NULL, NULL, + NULL, -1, Tk_Offset(TkTextTag, selBgStipple), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_COLOR, "-selectforeground", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, selFgColor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-spacing1", NULL, NULL, @@ -524,6 +526,7 @@ TkTextTagCmd( || (tagPtr->selBorder != NULL) || (tagPtr->reliefString != NULL) || (tagPtr->bgStipple != None) + || (tagPtr->selBgStipple != None) || (tagPtr->fgColor != NULL) || (tagPtr->selFgColor != NULL) || (tagPtr->fgStipple != None) @@ -1032,6 +1035,7 @@ TkTextCreateTag( tagPtr->rMarginString = NULL; tagPtr->rMargin = 0; tagPtr->selBorder = NULL; + tagPtr->selBgStipple = None; tagPtr->selFgColor = NULL; tagPtr->spacing1String = NULL; tagPtr->spacing1 = 0; -- cgit v0.12 From 28fda9f36ca5e2e5cb00e56da38cd13e8391f44d Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:32:41 +0000 Subject: -selectbgstipple tag configuration option: documentation --- doc/text.n | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/text.n b/doc/text.n index 61808ce..a8f25c9 100644 --- a/doc/text.n +++ b/doc/text.n @@ -524,6 +524,14 @@ items. It may have any of the forms accepted by \fBTk_GetColor\fR. If string, then the color specified by the fB\-background\fR tag option is used. .TP +\fB\-selectbgstipple \fIbitmap\fR +. +\fIBitmap\fR specifies a bitmap that is used as a stipple pattern for the +selected background. It may have any of the forms accepted by +\fBTk_GetBitmap\fR. If \fIbitmap\fR has not been specified, or if it is +specified as an empty string, then the \fIbitmap\fR specified by +'''-bgstipple''' will be used for the background. +.TP \fB\-selectforeground \fIcolor\fR \fIcolor\fR specifies the foreground color to use when displaying selected items. It may have any of the forms accepted by \fBTk_GetColor\fR. If -- cgit v0.12 From fe236b4cfe544d14e84df23e27d07f7efba752d5 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:33:07 +0000 Subject: -selectbgstipple tag configuration option: tests --- tests/textTag.test | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/tests/textTag.test b/tests/textTag.test index 8b5ac74..63081f3 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -240,12 +240,23 @@ test textTag-1.25b {configuration options} -body { .t tag configure x -selectbackground [lindex [.t tag configure x -selectbackground] 3] } -returnCodes error -result {unknown color name "non-existent"} test textTag-1.25c {tag configuration options} -body { + .t tag configure x -selectbgstipple gray50 + .t tag cget x -selectbgstipple +} -cleanup { + .t tag configure x -selectbgstipple [lindex [.t tag configure x -selectbgstipple] 3] +} -result {gray50} +test textTag-1.25d {configuration options} -body { + .t tag configure x -selectbgstipple badStipple +} -cleanup { + .t tag configure x -selectbgstipple [lindex [.t tag configure x -selectbgstipple] 3] +} -returnCodes error -result {bitmap "badStipple" not defined} +test textTag-1.25e {tag configuration options} -body { .t tag configure x -selectforeground #012345 .t tag cget x -selectforeground } -cleanup { .t tag configure x -selectforeground [lindex [.t tag configure x -selectforeground] 3] } -result {#012345} -test textTag-1.25d {configuration options} -body { +test textTag-1.25f {configuration options} -body { .t tag configure x -selectforeground non-existent } -cleanup { .t tag configure x -selectforeground [lindex [.t tag configure x -selectforeground] 3] -- cgit v0.12 From da061a037670e4bc29f960a349403aac50cd915c Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:36:19 +0000 Subject: -selectfgstipple tag configuration option: implementation --- generic/tkText.c | 1 + generic/tkText.h | 3 +++ generic/tkTextDisp.c | 10 ++++++++-- generic/tkTextTag.c | 4 ++++ 4 files changed, 16 insertions(+), 2 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 7a2a6d5..ccc9691 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2292,6 +2292,7 @@ ConfigureText( || (textPtr->selTagPtr->fgColor != NULL) || (textPtr->selTagPtr->selFgColor != NULL) || (textPtr->selTagPtr->fgStipple != None) + || (textPtr->selTagPtr->selFgStipple != None) || (textPtr->selTagPtr->overstrikeString != NULL) || (textPtr->selTagPtr->underlineString != NULL)) { textPtr->selTagPtr->affectsDisplay = 1; diff --git a/generic/tkText.h b/generic/tkText.h index c8a71b3..1a7d986 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -368,6 +368,9 @@ typedef struct TkTextTag { * None means no value specified here. */ XColor *selFgColor; /* Foreground color for selected text. NULL means * no value specified here. */ + Pixmap selFgStipple; /* Stipple bitmap for text and other + * foreground stuff when selected. None means + * no value specified here.*/ char *spacing1String; /* -spacing1 option string (malloc-ed). NULL * means option not specified. */ int spacing1; /* Extra spacing above first display line for diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 0ccd3c2..d0c1483 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -800,11 +800,13 @@ GetStyle( Tk_3DBorder border; Pixmap bgStipple; XColor *fgColor; + Pixmap fgStipple; tagPtr = tagPtrs[i]; border = tagPtr->border; bgStipple = tagPtr->bgStipple; fgColor = tagPtr->fgColor; + fgStipple = tagPtr->fgStipple; /* * If this is the selection tag, and inactiveSelBorder is NULL (the @@ -836,6 +838,10 @@ GetStyle( fgColor = tagPtr->selFgColor; } + if ((tagPtr->selFgStipple != None) && (isSelected)) { + bgStipple = tagPtr->selFgStipple; + } + if ((border != NULL) && (tagPtr->priority > borderPrio)) { styleValues.border = border; borderPrio = tagPtr->priority; @@ -867,9 +873,9 @@ GetStyle( styleValues.tkfont = tagPtr->tkfont; fontPrio = tagPtr->priority; } - if ((tagPtr->fgStipple != None) + if ((fgStipple != None) && (tagPtr->priority > fgStipplePrio)) { - styleValues.fgStipple = tagPtr->fgStipple; + styleValues.fgStipple = fgStipple; fgStipplePrio = tagPtr->priority; } if ((tagPtr->justifyString != NULL) diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index 86a6e77..bb512e4 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -74,6 +74,8 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, -1, Tk_Offset(TkTextTag, selBorder), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_BITMAP, "-selectbgstipple", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, selBgStipple), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BITMAP, "-selectfgstipple", NULL, NULL, + NULL, -1, Tk_Offset(TkTextTag, selFgStipple), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_COLOR, "-selectforeground", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, selFgColor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-spacing1", NULL, NULL, @@ -530,6 +532,7 @@ TkTextTagCmd( || (tagPtr->fgColor != NULL) || (tagPtr->selFgColor != NULL) || (tagPtr->fgStipple != None) + || (tagPtr->selFgStipple != None) || (tagPtr->overstrikeString != NULL) || (tagPtr->underlineString != NULL)) { tagPtr->affectsDisplay = 1; @@ -1037,6 +1040,7 @@ TkTextCreateTag( tagPtr->selBorder = NULL; tagPtr->selBgStipple = None; tagPtr->selFgColor = NULL; + tagPtr->selFgStipple = None; tagPtr->spacing1String = NULL; tagPtr->spacing1 = 0; tagPtr->spacing2String = NULL; -- cgit v0.12 From 196fc0f4ea980dfeed790a1c2f5e4cae7077c0b4 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:36:41 +0000 Subject: -selectfgstipple tag configuration option: documentation (+ polished doc of the previously developed new tag options) --- doc/text.n | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/doc/text.n b/doc/text.n index a8f25c9..0216e5c 100644 --- a/doc/text.n +++ b/doc/text.n @@ -518,10 +518,10 @@ margin for each line on the display is determined by the first non-elided character of that display line. .TP \fB\-selectbackground \fIcolor\fR -\fIcolor\fR specifies the background color to use when displaying selected +\fIColor\fR specifies the background color to use when displaying selected items. It may have any of the forms accepted by \fBTk_GetColor\fR. If \fIcolor\fR has not been specified, or if it is specified as an empty -string, then the color specified by the fB\-background\fR tag option is +string, then the color specified by the \fB\-background\fR tag option is used. .TP \fB\-selectbgstipple \fIbitmap\fR @@ -529,14 +529,22 @@ used. \fIBitmap\fR specifies a bitmap that is used as a stipple pattern for the selected background. It may have any of the forms accepted by \fBTk_GetBitmap\fR. If \fIbitmap\fR has not been specified, or if it is -specified as an empty string, then the \fIbitmap\fR specified by -'''-bgstipple''' will be used for the background. +specified as an empty string, then the bitmap specified by +\fB\-bgstipple\fR will be used for the background. +.TP +\fB\-selectfgstipple \fIbitmap\fR +. +\fIBitmap\fR specifies a bitmap that is used as a stipple pattern when drawing +selected text and other foreground information such as underlines. It may have any of +the forms accepted by \fBTk_GetBitmap\fR. If \fIbitmap\fR has not been +specified, or if it is specified as an empty string, then the bitmap specified by +\fB\-fgstipple\fR will be used. .TP \fB\-selectforeground \fIcolor\fR -\fIcolor\fR specifies the foreground color to use when displaying selected +\fIColor\fR specifies the foreground color to use when displaying selected items. It may have any of the forms accepted by \fBTk_GetColor\fR. If \fIcolor\fR has not been specified, or if it is specified as an empty -string, then the color specified by the fB\-foreground\fR tag option is +string, then the color specified by the \fB\-foreground\fR tag option is used. .TP \fB\-spacing1 \fIpixels\fR -- cgit v0.12 From e108f0116e3154bacd641f8f85529512a2b9046f Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:37:33 +0000 Subject: -selectfgstipple tag configuration option: tests --- tests/textTag.test | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/tests/textTag.test b/tests/textTag.test index 63081f3..ede86fd 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -251,12 +251,23 @@ test textTag-1.25d {configuration options} -body { .t tag configure x -selectbgstipple [lindex [.t tag configure x -selectbgstipple] 3] } -returnCodes error -result {bitmap "badStipple" not defined} test textTag-1.25e {tag configuration options} -body { + .t tag configure x -selectfgstipple gray50 + .t tag cget x -selectfgstipple +} -cleanup { + .t tag configure x -selectfgstipple [lindex [.t tag configure x -selectfgstipple] 3] +} -result {gray50} +test textTag-1.25f {configuration options} -body { + .t tag configure x -selectfgstipple badStipple +} -cleanup { + .t tag configure x -selectfgstipple [lindex [.t tag configure x -selectfgstipple] 3] +} -returnCodes error -result {bitmap "badStipple" not defined} +test textTag-1.25g {tag configuration options} -body { .t tag configure x -selectforeground #012345 .t tag cget x -selectforeground } -cleanup { .t tag configure x -selectforeground [lindex [.t tag configure x -selectforeground] 3] } -result {#012345} -test textTag-1.25f {configuration options} -body { +test textTag-1.25h {configuration options} -body { .t tag configure x -selectforeground non-existent } -cleanup { .t tag configure x -selectforeground [lindex [.t tag configure x -selectforeground] 3] -- cgit v0.12 From 62609c21da13af24e1df10132bdb5effc1d3ea7a Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:40:51 +0000 Subject: -underlinefg tag configuration option: implementation --- generic/tkText.c | 3 ++- generic/tkText.h | 4 +++- generic/tkTextDisp.c | 19 +++++++++++++++++-- generic/tkTextTag.c | 6 +++++- 4 files changed, 27 insertions(+), 5 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index ccc9691..7010601 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2294,7 +2294,8 @@ ConfigureText( || (textPtr->selTagPtr->fgStipple != None) || (textPtr->selTagPtr->selFgStipple != None) || (textPtr->selTagPtr->overstrikeString != NULL) - || (textPtr->selTagPtr->underlineString != NULL)) { + || (textPtr->selTagPtr->underlineString != NULL) + || (textPtr->selTagPtr->underlineColor != NULL)) { textPtr->selTagPtr->affectsDisplay = 1; } TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr, 1); diff --git a/generic/tkText.h b/generic/tkText.h index 1a7d986..815841c 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -398,7 +398,9 @@ typedef struct TkTextTag { int underline; /* Non-zero means draw underline underneath * text. Only valid if underlineString is * non-NULL. */ - TkWrapMode wrapMode; /* How to handle wrap-around for this tag. + XColor *underlineColor; /* Color for the underline. NULL means same + * color as foreground. */ + TkWrapMode wrapMode; /* How to hsandle wrap-around for this tag. * Must be TEXT_WRAPMODE_CHAR, * TEXT_WRAPMODE_NONE, TEXT_WRAPMODE_WORD, or * TEXT_WRAPMODE_NULL to use wrapmode for diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index d0c1483..f246818 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -149,6 +149,8 @@ typedef struct StyleValues { int tabStyle; /* One of TABULAR or WORDPROCESSOR. */ int underline; /* Non-zero means draw underline underneath * text. */ + XColor *underlineColor; /* Foreground color for underline underneath + * text. */ int elide; /* Zero means draw text, otherwise not. */ TkWrapMode wrapMode; /* How to handle wrap-around for this tag. * One of TEXT_WRAPMODE_CHAR, @@ -166,6 +168,7 @@ typedef struct TextStyle { * referenced in Chunks. */ GC bgGC; /* Graphics context for background. None means * use widget background. */ + GC ulGC; /* Graphics context for underline. */ GC fgGC; /* Graphics context for foreground. */ StyleValues *sValuePtr; /* Raw information from which GCs were * derived. */ @@ -778,6 +781,7 @@ GetStyle( memset(&styleValues, 0, sizeof(StyleValues)); styleValues.relief = TK_RELIEF_FLAT; styleValues.fgColor = textPtr->fgColor; + styleValues.underlineColor = textPtr->fgColor; styleValues.tkfont = textPtr->tkfont; styleValues.justify = TK_JUSTIFY_LEFT; styleValues.spacing1 = textPtr->spacing1; @@ -937,6 +941,11 @@ GetStyle( && (tagPtr->priority > underlinePrio)) { styleValues.underline = tagPtr->underline; underlinePrio = tagPtr->priority; + if (tagPtr->underlineColor != None) { + styleValues.underlineColor = tagPtr->underlineColor; + } else if (fgColor != None) { + styleValues.underlineColor = fgColor; + } } if ((tagPtr->elideString != NULL) && (tagPtr->priority > elidePrio)) { @@ -993,6 +1002,9 @@ GetStyle( mask |= GCStipple|GCFillStyle; } stylePtr->fgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues); + mask = GCForeground; + gcValues.foreground = styleValues.underlineColor->pixel; + stylePtr->ulGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues); stylePtr->sValuePtr = (StyleValues *) Tcl_GetHashKey(&textPtr->dInfoPtr->styleTable, hPtr); stylePtr->hPtr = hPtr; @@ -1033,6 +1045,9 @@ FreeStyle( if (stylePtr->fgGC != None) { Tk_FreeGC(textPtr->display, stylePtr->fgGC); } + if (stylePtr->ulGC != None) { + Tk_FreeGC(textPtr->display, stylePtr->ulGC); + } Tcl_DeleteHashEntry(stylePtr->hPtr); ckfree(stylePtr); } @@ -7876,7 +7891,7 @@ CharDisplayProc( y + baseline - sValuePtr->offset); if (sValuePtr->underline) { - TkUnderlineCharsInContext(display, dst, stylePtr->fgGC, + TkUnderlineCharsInContext(display, dst, stylePtr->ulGC, sValuePtr->tkfont, string, numBytes, ciPtr->baseChunkPtr->x + xDisplacement, y + baseline - sValuePtr->offset, @@ -7903,7 +7918,7 @@ CharDisplayProc( Tk_DrawChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, string, numBytes, offsetX, y + baseline - sValuePtr->offset); if (sValuePtr->underline) { - Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, + Tk_UnderlineChars(display, dst, stylePtr->ulGC, sValuePtr->tkfont, string, offsetX, y + baseline - sValuePtr->offset, 0, numBytes); diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index bb512e4..ed0ef98 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -92,6 +92,8 @@ static const Tk_OptionSpec tagOptionSpecs[] = { {TK_OPTION_STRING, "-underline", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, underlineString), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_COLOR, "-underlinefg", NULL, NULL, + NULL, -1, Tk_Offset(TkTextTag, underlineColor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-wrap", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, wrapMode), TK_OPTION_NULL_OK, wrapStrings, 0}, @@ -534,7 +536,8 @@ TkTextTagCmd( || (tagPtr->fgStipple != None) || (tagPtr->selFgStipple != None) || (tagPtr->overstrikeString != NULL) - || (tagPtr->underlineString != NULL)) { + || (tagPtr->underlineString != NULL) + || (tagPtr->underlineColor != NULL)) { tagPtr->affectsDisplay = 1; } if (!newTag) { @@ -1052,6 +1055,7 @@ TkTextCreateTag( tagPtr->tabStyle = TK_TEXT_TABSTYLE_NONE; tagPtr->underlineString = NULL; tagPtr->underline = 0; + tagPtr->underlineColor = NULL; tagPtr->elideString = NULL; tagPtr->elide = 0; tagPtr->wrapMode = TEXT_WRAPMODE_NULL; -- cgit v0.12 From ecdc7dbb08227389f593c55a3b769a4e1ec9c8aa Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:41:37 +0000 Subject: -underlinefg tag configuration option: documentation --- doc/text.n | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/text.n b/doc/text.n index 0216e5c..e88728c 100644 --- a/doc/text.n +++ b/doc/text.n @@ -589,6 +589,14 @@ unspecified for the tag (the default). \fIBoolean\fR specifies whether or not to draw an underline underneath characters. It may have any of the forms accepted by \fBTcl_GetBoolean\fR. .TP +.TP +\fB\-underlinefg \fIcolor\fR +. +\fIColor\fR specifies the color to use when displaying the underline. It may +have any of the forms accepted by \fBTk_GetColor\fR. If \fIcolor\fR has not +been specified, or if it is specified as an empty string, then the color +specified by the \fB\-foreground\fR tag option is used. +.TP \fB\-wrap \fImode\fR . \fIMode\fR specifies how to handle lines that are wider than the text's -- cgit v0.12 From 797f245ca2d4aafd6a0f7ad853cccd32a7942171 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:42:17 +0000 Subject: -underlinefg tag configuration option: tests --- tests/textTag.test | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tests/textTag.test b/tests/textTag.test index ede86fd..ae71a48 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -347,6 +347,17 @@ test textTag-1.35 {configuration options} -constraints { } -cleanup { .t tag configure x -underline [lindex [.t tag configure x -underline] 3] } -returnCodes error -result {expected boolean value but got "stupid"} +test textTag-1.36 {tag configuration options} -body { + .t tag configure x -underlinefg red + .t tag cget x -underlinefg +} -cleanup { + .t tag configure x -underlinefg [lindex [.t tag configure x -underlinefg] 3] +} -result {red} +test textTag-1.37 {configuration options} -body { + .t tag configure x -underlinefg stupid +} -cleanup { + .t tag configure x -underlinefg [lindex [.t tag configure x -underlinefg] 3] +} -returnCodes error -result {unknown color name "stupid"} test textTag-2.1 {TkTextTagCmd - "add" option} -constraints { @@ -603,6 +614,13 @@ test textTag-5.4 {TkTextTagCmd - "configure" option} -constraints { } -cleanup { .t tag delete x } -result {-underline {} {} {} yes} +test textTag-5.4a {TkTextTagCmd - "configure" option} -body { + .t tag delete x + .t tag configure x -underlinefg lightgreen + .t tag configure x -underlinefg +} -cleanup { + .t tag delete x +} -result {-underlinefg {} {} {} lightgreen} test textTag-5.5 {TkTextTagCmd - "configure" option} -constraints { haveCourier12 } -body { -- cgit v0.12 From 7c5f4b62829c4efa7ee754d566c45a0be0ace440 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:44:23 +0000 Subject: -overstrikefg tag configuration option: implementation --- generic/tkText.c | 1 + generic/tkText.h | 2 ++ generic/tkTextDisp.c | 20 +++++++++++++++++--- generic/tkTextTag.c | 8 +++++++- 4 files changed, 27 insertions(+), 4 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 7010601..19dce65 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2294,6 +2294,7 @@ ConfigureText( || (textPtr->selTagPtr->fgStipple != None) || (textPtr->selTagPtr->selFgStipple != None) || (textPtr->selTagPtr->overstrikeString != NULL) + || (textPtr->selTagPtr->overstrikeColor != NULL) || (textPtr->selTagPtr->underlineString != NULL) || (textPtr->selTagPtr->underlineColor != NULL)) { textPtr->selTagPtr->affectsDisplay = 1; diff --git a/generic/tkText.h b/generic/tkText.h index 815841c..242785a 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -358,6 +358,8 @@ typedef struct TkTextTag { int overstrike; /* Non-zero means draw horizontal line through * middle of text. Only valid if * overstrikeString is non-NULL. */ + XColor *overstrikeColor; /* Color for the overstrike. NULL means same + * color as foreground. */ char *rMarginString; /* -rmargin option string (malloc-ed). NULL * means option not specified. */ int rMargin; /* Right margin for text, in pixels. Only diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index f246818..b74c6db 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -140,6 +140,8 @@ typedef struct StyleValues { * baseline of line. */ int overstrike; /* Non-zero means draw overstrike through * text. */ + XColor *overstrikeColor; /* Foreground color for overstrike through + * text. */ int rMargin; /* Right margin, in pixels. */ int spacing1; /* Spacing above first dline in text line. */ int spacing2; /* Spacing between lines of dline. */ @@ -168,8 +170,9 @@ typedef struct TextStyle { * referenced in Chunks. */ GC bgGC; /* Graphics context for background. None means * use widget background. */ - GC ulGC; /* Graphics context for underline. */ GC fgGC; /* Graphics context for foreground. */ + GC ulGC; /* Graphics context for underline. */ + GC ovGC; /* Graphics context for overstrike. */ StyleValues *sValuePtr; /* Raw information from which GCs were * derived. */ Tcl_HashEntry *hPtr; /* Pointer to entry in styleTable. Used to @@ -782,6 +785,7 @@ GetStyle( styleValues.relief = TK_RELIEF_FLAT; styleValues.fgColor = textPtr->fgColor; styleValues.underlineColor = textPtr->fgColor; + styleValues.overstrikeColor = textPtr->fgColor; styleValues.tkfont = textPtr->tkfont; styleValues.justify = TK_JUSTIFY_LEFT; styleValues.spacing1 = textPtr->spacing1; @@ -906,6 +910,11 @@ GetStyle( && (tagPtr->priority > overstrikePrio)) { styleValues.overstrike = tagPtr->overstrike; overstrikePrio = tagPtr->priority; + if (tagPtr->overstrikeColor != None) { + styleValues.overstrikeColor = tagPtr->overstrikeColor; + } else if (fgColor != None) { + styleValues.overstrikeColor = fgColor; + } } if ((tagPtr->rMarginString != NULL) && (tagPtr->priority > rMarginPrio)) { @@ -1005,6 +1014,8 @@ GetStyle( mask = GCForeground; gcValues.foreground = styleValues.underlineColor->pixel; stylePtr->ulGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues); + gcValues.foreground = styleValues.overstrikeColor->pixel; + stylePtr->ovGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues); stylePtr->sValuePtr = (StyleValues *) Tcl_GetHashKey(&textPtr->dInfoPtr->styleTable, hPtr); stylePtr->hPtr = hPtr; @@ -1048,6 +1059,9 @@ FreeStyle( if (stylePtr->ulGC != None) { Tk_FreeGC(textPtr->display, stylePtr->ulGC); } + if (stylePtr->ovGC != None) { + Tk_FreeGC(textPtr->display, stylePtr->ovGC); + } Tcl_DeleteHashEntry(stylePtr->hPtr); ckfree(stylePtr); } @@ -7901,7 +7915,7 @@ CharDisplayProc( Tk_FontMetrics fm; Tk_GetFontMetrics(sValuePtr->tkfont, &fm); - TkUnderlineCharsInContext(display, dst, stylePtr->fgGC, + TkUnderlineCharsInContext(display, dst, stylePtr->ovGC, sValuePtr->tkfont, string, numBytes, ciPtr->baseChunkPtr->x + xDisplacement, y + baseline - sValuePtr->offset @@ -7928,7 +7942,7 @@ CharDisplayProc( Tk_FontMetrics fm; Tk_GetFontMetrics(sValuePtr->tkfont, &fm); - Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, + Tk_UnderlineChars(display, dst, stylePtr->ovGC, sValuePtr->tkfont, string, offsetX, y + baseline - sValuePtr->offset - fm.descent - (fm.ascent * 3) / 10, diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index ed0ef98..e268352 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -66,6 +66,9 @@ static const Tk_OptionSpec tagOptionSpecs[] = { {TK_OPTION_STRING, "-overstrike", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, overstrikeString), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_COLOR, "-overstrikefg", NULL, NULL, + NULL, -1, Tk_Offset(TkTextTag, overstrikeColor), + TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-relief", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, reliefString), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-rmargin", NULL, NULL, @@ -93,7 +96,8 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, -1, Tk_Offset(TkTextTag, underlineString), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_COLOR, "-underlinefg", NULL, NULL, - NULL, -1, Tk_Offset(TkTextTag, underlineColor), TK_OPTION_NULL_OK, 0, 0}, + NULL, -1, Tk_Offset(TkTextTag, underlineColor), + TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-wrap", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, wrapMode), TK_OPTION_NULL_OK, wrapStrings, 0}, @@ -536,6 +540,7 @@ TkTextTagCmd( || (tagPtr->fgStipple != None) || (tagPtr->selFgStipple != None) || (tagPtr->overstrikeString != NULL) + || (tagPtr->overstrikeColor != NULL) || (tagPtr->underlineString != NULL) || (tagPtr->underlineColor != NULL)) { tagPtr->affectsDisplay = 1; @@ -1038,6 +1043,7 @@ TkTextCreateTag( tagPtr->offset = 0; tagPtr->overstrikeString = NULL; tagPtr->overstrike = 0; + tagPtr->overstrikeColor = NULL; tagPtr->rMarginString = NULL; tagPtr->rMargin = 0; tagPtr->selBorder = NULL; -- cgit v0.12 From 935d5f2814f55a18088b4ce4a3cfc6cb76fa86df Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:44:48 +0000 Subject: -overstrikefg tag configuration option: documentation --- doc/text.n | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/doc/text.n b/doc/text.n index e88728c..fd18a59 100644 --- a/doc/text.n +++ b/doc/text.n @@ -500,6 +500,13 @@ Specifies whether or not to draw a horizontal rule through the middle of characters. \fIBoolean\fR may have any of the forms accepted by \fBTcl_GetBoolean\fR. .TP +\fB\-overstrikefg \fIcolor\fR +. +\fIColor\fR specifies the color to use when displaying the overstrike. It may +have any of the forms accepted by \fBTk_GetColor\fR. If \fIcolor\fR has not +been specified, or if it is specified as an empty string, then the color +specified by the \fB\-foreground\fR tag option is used. +.TP \fB\-relief \fIrelief\fR . \fIRelief\fR specifies the relief style to use for drawing the border, in any @@ -589,7 +596,6 @@ unspecified for the tag (the default). \fIBoolean\fR specifies whether or not to draw an underline underneath characters. It may have any of the forms accepted by \fBTcl_GetBoolean\fR. .TP -.TP \fB\-underlinefg \fIcolor\fR . \fIColor\fR specifies the color to use when displaying the underline. It may -- cgit v0.12 From 74d865bb3e520e131dc6655986fe79141120c2e9 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Feb 2016 21:45:19 +0000 Subject: -overstrikefg tag configuration option: tests --- tests/textTag.test | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tests/textTag.test b/tests/textTag.test index ae71a48..c2feaa7 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -198,6 +198,17 @@ test textTag-1.21 {configuration options} -constraints { } -cleanup { .t tag configure x -overstrike [lindex [.t tag configure x -overstrike] 3] } -returnCodes error -result {expected boolean value but got "stupid"} +test textTag-1.21a {tag configuration options} -body { + .t tag configure x -overstrikefg red + .t tag cget x -overstrikefg +} -cleanup { + .t tag configure x -overstrikefg [lindex [.t tag configure x -overstrikefg] 3] +} -result {red} +test textTag-1.21b {configuration options} -body { + .t tag configure x -overstrikefg stupid +} -cleanup { + .t tag configure x -overstrikefg [lindex [.t tag configure x -overstrikefg] 3] +} -returnCodes error -result {unknown color name "stupid"} test textTag-1.22 {tag configuration options} -constraints { haveCourier12 } -body { @@ -630,6 +641,13 @@ test textTag-5.5 {TkTextTagCmd - "configure" option} -constraints { } -cleanup { .t tag delete x } -result {on} +test textTag-5.5a {TkTextTagCmd - "configure" option} -body { + .t tag delete x + .t tag configure x -overstrikefg lightgreen + .t tag configure x -overstrikefg +} -cleanup { + .t tag delete x +} -result {-overstrikefg {} {} {} lightgreen} test textTag-5.6 {TkTextTagCmd - "configure" option} -constraints { haveCourier12 } -body { -- cgit v0.12 From 30a85a7ace1cf7ea9de7828dfb84fde2af23148b Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 10 Feb 2016 22:51:45 +0000 Subject: -lmargincolor tag configuration option: implementation --- generic/tkText.c | 3 ++- generic/tkText.h | 3 +++ generic/tkTextDisp.c | 26 ++++++++++++++++++++++++++ generic/tkTextTag.c | 6 +++++- 4 files changed, 36 insertions(+), 2 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 19dce65..415e0bc 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2296,7 +2296,8 @@ ConfigureText( || (textPtr->selTagPtr->overstrikeString != NULL) || (textPtr->selTagPtr->overstrikeColor != NULL) || (textPtr->selTagPtr->underlineString != NULL) - || (textPtr->selTagPtr->underlineColor != NULL)) { + || (textPtr->selTagPtr->underlineColor != NULL) + || (textPtr->selTagPtr->lMarginColor != NULL)) { textPtr->selTagPtr->affectsDisplay = 1; } TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr, 1); diff --git a/generic/tkText.h b/generic/tkText.h index 242785a..22df370 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -347,6 +347,9 @@ typedef struct TkTextTag { int lMargin2; /* Left margin for second and later display * lines of each text line, in pixels. Only * valid if lMargin2String is non-NULL. */ + Tk_3DBorder lMarginColor; /* Used for drawing background in left margins. + * This is used for both lmargin1 and lmargin2. + * NULL means no value specified here. */ char *offsetString; /* -offset option string (malloc-ed). NULL * means option not specified. */ int offset; /* Vertical offset of text's baseline from diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index b74c6db..c0d6384 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -136,6 +136,7 @@ typedef struct StyleValues { * line of each text line. */ int lMargin2; /* Left margin, in pixels, for second and * later display lines of each text line. */ + Tk_3DBorder lMarginColor; /* Color of left margins (1 and 2). */ int offset; /* Offset in pixels of baseline, relative to * baseline of line. */ int overstrike; /* Non-zero means draw overstrike through @@ -240,6 +241,10 @@ typedef struct DLine { int spaceBelow; /* How much extra space was added to the * bottom of the line because of spacing * options. This is included in height. */ + Tk_3DBorder lMarginColor; /* Background color of the area corresponding + * to the left margin of the display line. */ + int lMarginWidth; /* Pixel width of the area corresponding to + * the left margin. */ int length; /* Total length of line, in pixels. */ TkTextDispChunk *chunkPtr; /* Pointer to first chunk in list of all of * those that are displayed on this line of @@ -765,6 +770,7 @@ GetStyle( int fgPrio, fontPrio, fgStipplePrio; int underlinePrio, elidePrio, justifyPrio, offsetPrio; int lMargin1Prio, lMargin2Prio, rMarginPrio; + int lMarginColorPrio; int spacing1Prio, spacing2Prio, spacing3Prio; int overstrikePrio, tabPrio, tabStylePrio, wrapPrio; @@ -779,6 +785,7 @@ GetStyle( fgPrio = fontPrio = fgStipplePrio = -1; underlinePrio = elidePrio = justifyPrio = offsetPrio = -1; lMargin1Prio = lMargin2Prio = rMarginPrio = -1; + lMarginColorPrio = -1; spacing1Prio = spacing2Prio = spacing3Prio = -1; overstrikePrio = tabPrio = tabStylePrio = wrapPrio = -1; memset(&styleValues, 0, sizeof(StyleValues)); @@ -901,6 +908,11 @@ GetStyle( styleValues.lMargin2 = tagPtr->lMargin2; lMargin2Prio = tagPtr->priority; } + if ((tagPtr->lMarginColor != NULL) + && (tagPtr->priority > lMarginColorPrio)) { + styleValues.lMarginColor = tagPtr->lMarginColor; + lMarginColorPrio = tagPtr->priority; + } if ((tagPtr->offsetString != NULL) && (tagPtr->priority > offsetPrio)) { styleValues.offset = tagPtr->offset; @@ -1173,6 +1185,8 @@ LayoutDLine( dlPtr->nextPtr = NULL; dlPtr->flags = NEW_LAYOUT | OLD_Y_INVALID; dlPtr->logicalLinesMerged = 0; + dlPtr->lMarginColor = NULL; + dlPtr->lMarginWidth = 0; /* * This is not necessarily totally correct, where we have merged logical @@ -1447,6 +1461,7 @@ LayoutDLine( x = chunkPtr->stylePtr->sValuePtr->lMargin2; } + dlPtr->lMarginWidth = x; if (wrapMode == TEXT_WRAPMODE_NONE) { maxX = -1; } else { @@ -1758,6 +1773,7 @@ LayoutDLine( } dlPtr->height += dlPtr->spaceAbove + dlPtr->spaceBelow; dlPtr->baseline += dlPtr->spaceAbove; + dlPtr->lMarginColor = sValuePtr->lMarginColor; /* * Recompute line length: may have changed because of justification. @@ -2444,6 +2460,16 @@ DisplayDLine( Tk_Width(textPtr->tkwin), dlPtr->height, 0, TK_RELIEF_FLAT); /* + * Second, draw the background color of the left margin. + */ + if (dlPtr->lMarginColor != NULL) { + int x = dlPtr->lMarginWidth + dInfoPtr->x - dInfoPtr->curXPixelOffset; + + Tk_Fill3DRectangle(textPtr->tkwin, pixmap, dlPtr->lMarginColor, 0, y, + (x>0?x:0), dlPtr->height, 0, TK_RELIEF_FLAT); + } + + /* * Next, draw background information for the whole line. */ diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index e268352..a3e55fc 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -61,6 +61,8 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, -1, Tk_Offset(TkTextTag, lMargin1String), TK_OPTION_NULL_OK,0,0}, {TK_OPTION_STRING, "-lmargin2", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, lMargin2String), TK_OPTION_NULL_OK,0,0}, + {TK_OPTION_BORDER, "-lmargincolor", NULL, NULL, + NULL, -1, Tk_Offset(TkTextTag, lMarginColor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-offset", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, offsetString), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-overstrike", NULL, NULL, @@ -542,7 +544,8 @@ TkTextTagCmd( || (tagPtr->overstrikeString != NULL) || (tagPtr->overstrikeColor != NULL) || (tagPtr->underlineString != NULL) - || (tagPtr->underlineColor != NULL)) { + || (tagPtr->underlineColor != NULL) + || (tagPtr->lMarginColor != NULL)) { tagPtr->affectsDisplay = 1; } if (!newTag) { @@ -1039,6 +1042,7 @@ TkTextCreateTag( tagPtr->lMargin1 = 0; tagPtr->lMargin2String = NULL; tagPtr->lMargin2 = 0; + tagPtr->lMarginColor = NULL; tagPtr->offsetString = NULL; tagPtr->offset = 0; tagPtr->overstrikeString = NULL; -- cgit v0.12 From 3c2928472dcfca0f3053ad349df8b64e98a6923c Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 10 Feb 2016 22:52:15 +0000 Subject: -lmargincolor tag configuration option: documentation --- doc/text.n | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/doc/text.n b/doc/text.n index fd18a59..1e6dbc2 100644 --- a/doc/text.n +++ b/doc/text.n @@ -486,6 +486,15 @@ much the line should be indented from the left edge of the window. option is only used when wrapping is enabled, and it only applies to the second and later display lines for a text line. .TP +\fB\-lmargincolor \fIcolor\fR +. +\fIColor\fR specifies the background color to use in regions that do not +contain characters because they are indented by \fB\-lmargin1\fR or +\fB\-lmargin2\fR. It may have any of the forms accepted by +\fBTk_GetColor\fR.If \fIcolor\fR has not been specified, or if it is +specified as an empty string, then the color specified by the +\fB-background\fR widget option is used. +.TP \fB\-offset \fIpixels\fR . \fIPixels\fR specifies an amount by which the text's baseline should be offset -- cgit v0.12 From 47cbb49b5a939e1af93b945c53daa3177d9aeef0 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 10 Feb 2016 22:52:33 +0000 Subject: -lmargincolor tag configuration option: tests --- tests/textTag.test | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/tests/textTag.test b/tests/textTag.test index c2feaa7..9e0cf38 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -168,6 +168,17 @@ test textTag-1.17 {configuration options} -constraints { } -cleanup { .t tag configure x -lmargin2 [lindex [.t tag configure x -lmargin2] 3] } -returnCodes error -result {bad screen distance "bad"} +test textTag-1.17a {tag configuration options} -body { + .t tag configure x -lmargincolor lightgreen + .t tag cget x -lmargincolor +} -cleanup { + .t tag configure x -lmargincolor [lindex [.t tag configure x -lmargincolor] 3] +} -result {lightgreen} +test textTag-1.17b {configuration options} -body { + .t tag configure x -lmargincolor non-existent +} -cleanup { + .t tag configure x -lmargincolor [lindex [.t tag configure x -lmargincolor] 3] +} -returnCodes error -result {unknown color name "non-existent"} test textTag-1.18 {tag configuration options} -constraints { haveCourier12 } -body { @@ -705,16 +716,15 @@ test textTag-5.12 {TkTextTagCmd - "configure" option} -constraints { } -cleanup { .t tag delete x } -returnCodes error -result {bad screen distance "1.0q"} -test textTag-5.13 {TkTextTagCmd - "configure" option} -constraints { - haveCourier12 -} -body { +test textTag-5.13 {TkTextTagCmd - "configure" option} -body { .t tag delete x - .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5 + .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5 \ + -lmargincolor darkblue list [.t tag configure x -lmargin1] [.t tag configure x -lmargin2] \ - [.t tag configure x -rmargin] + [.t tag configure x -rmargin] [.t tag configure x -lmargincolor] } -cleanup { .t tag delete x -} -result {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}} +} -result {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5} {-lmargincolor {} {} {} darkblue}} test textTag-5.14 {TkTextTagCmd - "configure" option} -constraints { haveCourier12 } -body { @@ -731,6 +741,12 @@ test textTag-5.15 {TkTextTagCmd - "configure" option} -constraints { } -cleanup { .t tag delete x } -returnCodes error -result {bad screen distance "gorp"} +test textTag-5.15a {TkTextTagCmd - "configure" option} -body { + .t tag delete x + .t tag configure x -lmargincolor rainbow +} -cleanup { + .t tag delete x +} -returnCodes error -result {unknown color name "rainbow"} test textTag-5.16 {TkTextTagCmd - "configure" option} -constraints { haveCourier12 } -body { -- cgit v0.12 From 3cea177e222e8c8b59cfcd693faa3581340d2c3d Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 10 Feb 2016 22:53:30 +0000 Subject: -rmargincolor tag configuration option: implementation --- generic/tkText.c | 3 ++- generic/tkText.h | 2 ++ generic/tkTextDisp.c | 29 +++++++++++++++++++++++++---- generic/tkTextTag.c | 6 +++++- 4 files changed, 34 insertions(+), 6 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 415e0bc..0de648a 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2297,7 +2297,8 @@ ConfigureText( || (textPtr->selTagPtr->overstrikeColor != NULL) || (textPtr->selTagPtr->underlineString != NULL) || (textPtr->selTagPtr->underlineColor != NULL) - || (textPtr->selTagPtr->lMarginColor != NULL)) { + || (textPtr->selTagPtr->lMarginColor != NULL) + || (textPtr->selTagPtr->rMarginColor != NULL)) { textPtr->selTagPtr->affectsDisplay = 1; } TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr, 1); diff --git a/generic/tkText.h b/generic/tkText.h index 22df370..8fab200 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -367,6 +367,8 @@ typedef struct TkTextTag { * means option not specified. */ int rMargin; /* Right margin for text, in pixels. Only * valid if rMarginString is non-NULL. */ + Tk_3DBorder rMarginColor; /* Used for drawing background in right margin. + * NULL means no value specified here. */ Tk_3DBorder selBorder; /* Used for drawing background for selected text. * NULL means no value specified here. */ Pixmap selBgStipple; /* Stipple bitmap for background of selected text. diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index c0d6384..c0dc017 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -144,6 +144,7 @@ typedef struct StyleValues { XColor *overstrikeColor; /* Foreground color for overstrike through * text. */ int rMargin; /* Right margin, in pixels. */ + Tk_3DBorder rMarginColor; /* Color of right margin. */ int spacing1; /* Spacing above first dline in text line. */ int spacing2; /* Spacing between lines of dline. */ int spacing3; /* Spacing below last dline in text line. */ @@ -245,6 +246,10 @@ typedef struct DLine { * to the left margin of the display line. */ int lMarginWidth; /* Pixel width of the area corresponding to * the left margin. */ + Tk_3DBorder rMarginColor; /* Background color of the area corresponding + * to the right margin of the display line. */ + int rMarginWidth; /* Pixel width of the area corresponding to + * the right margin. */ int length; /* Total length of line, in pixels. */ TkTextDispChunk *chunkPtr; /* Pointer to first chunk in list of all of * those that are displayed on this line of @@ -770,7 +775,7 @@ GetStyle( int fgPrio, fontPrio, fgStipplePrio; int underlinePrio, elidePrio, justifyPrio, offsetPrio; int lMargin1Prio, lMargin2Prio, rMarginPrio; - int lMarginColorPrio; + int lMarginColorPrio, rMarginColorPrio; int spacing1Prio, spacing2Prio, spacing3Prio; int overstrikePrio, tabPrio, tabStylePrio, wrapPrio; @@ -785,7 +790,7 @@ GetStyle( fgPrio = fontPrio = fgStipplePrio = -1; underlinePrio = elidePrio = justifyPrio = offsetPrio = -1; lMargin1Prio = lMargin2Prio = rMarginPrio = -1; - lMarginColorPrio = -1; + lMarginColorPrio = rMarginColorPrio = -1; spacing1Prio = spacing2Prio = spacing3Prio = -1; overstrikePrio = tabPrio = tabStylePrio = wrapPrio = -1; memset(&styleValues, 0, sizeof(StyleValues)); @@ -933,6 +938,11 @@ GetStyle( styleValues.rMargin = tagPtr->rMargin; rMarginPrio = tagPtr->priority; } + if ((tagPtr->rMarginColor != NULL) + && (tagPtr->priority > rMarginColorPrio)) { + styleValues.rMarginColor = tagPtr->rMarginColor; + rMarginColorPrio = tagPtr->priority; + } if ((tagPtr->spacing1String != NULL) && (tagPtr->priority > spacing1Prio)) { styleValues.spacing1 = tagPtr->spacing1; @@ -1187,6 +1197,8 @@ LayoutDLine( dlPtr->logicalLinesMerged = 0; dlPtr->lMarginColor = NULL; dlPtr->lMarginWidth = 0; + dlPtr->rMarginColor = NULL; + dlPtr->rMarginWidth = 0; /* * This is not necessarily totally correct, where we have merged logical @@ -1774,6 +1786,10 @@ LayoutDLine( dlPtr->height += dlPtr->spaceAbove + dlPtr->spaceBelow; dlPtr->baseline += dlPtr->spaceAbove; dlPtr->lMarginColor = sValuePtr->lMarginColor; + dlPtr->rMarginColor = sValuePtr->rMarginColor; + if (wrapMode != TEXT_WRAPMODE_NONE) { + dlPtr->rMarginWidth = rMargin; + } /* * Recompute line length: may have changed because of justification. @@ -2460,13 +2476,18 @@ DisplayDLine( Tk_Width(textPtr->tkwin), dlPtr->height, 0, TK_RELIEF_FLAT); /* - * Second, draw the background color of the left margin. + * Second, draw the background color of the left and right margins. */ if (dlPtr->lMarginColor != NULL) { int x = dlPtr->lMarginWidth + dInfoPtr->x - dInfoPtr->curXPixelOffset; Tk_Fill3DRectangle(textPtr->tkwin, pixmap, dlPtr->lMarginColor, 0, y, - (x>0?x:0), dlPtr->height, 0, TK_RELIEF_FLAT); + (x>0?x:0), dlPtr->height, 0, TK_RELIEF_FLAT); + } + if (dlPtr->rMarginColor != NULL) { + Tk_Fill3DRectangle(textPtr->tkwin, pixmap, dlPtr->rMarginColor, + dInfoPtr->maxX - dlPtr->rMarginWidth + dInfoPtr->curXPixelOffset, + y, dlPtr->rMarginWidth, dlPtr->height, 0, TK_RELIEF_FLAT); } /* diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index a3e55fc..49d6a50 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -75,6 +75,8 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, -1, Tk_Offset(TkTextTag, reliefString), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-rmargin", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, rMarginString), TK_OPTION_NULL_OK, 0,0}, + {TK_OPTION_BORDER, "-rmargincolor", NULL, NULL, + NULL, -1, Tk_Offset(TkTextTag, rMarginColor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_BORDER, "-selectbackground", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, selBorder), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_BITMAP, "-selectbgstipple", NULL, NULL, @@ -545,7 +547,8 @@ TkTextTagCmd( || (tagPtr->overstrikeColor != NULL) || (tagPtr->underlineString != NULL) || (tagPtr->underlineColor != NULL) - || (tagPtr->lMarginColor != NULL)) { + || (tagPtr->lMarginColor != NULL) + || (tagPtr->rMarginColor != NULL)) { tagPtr->affectsDisplay = 1; } if (!newTag) { @@ -1050,6 +1053,7 @@ TkTextCreateTag( tagPtr->overstrikeColor = NULL; tagPtr->rMarginString = NULL; tagPtr->rMargin = 0; + tagPtr->rMarginColor = NULL; tagPtr->selBorder = NULL; tagPtr->selBgStipple = None; tagPtr->selFgColor = NULL; -- cgit v0.12 From c841d963af542a097122211248620383ff6098c0 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 10 Feb 2016 22:53:51 +0000 Subject: -rmargincolor tag configuration option: documentation --- doc/text.n | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/text.n b/doc/text.n index 1e6dbc2..84ad710 100644 --- a/doc/text.n +++ b/doc/text.n @@ -533,6 +533,14 @@ option is only used when wrapping is enabled. If a text line wraps, the right margin for each line on the display is determined by the first non-elided character of that display line. .TP +\fB\-rmargincolor \fIcolor\fR +. +\fIColor\fR specifies the background color to use in regions that do not +contain characters because they are indented by \fB\-rmargin1\fR. It may +have any of the forms accepted by \fBTk_GetColor\fR.If \fIcolor\fR has not +been specified, or if it is specified as an empty string, then the color +specified by the \fB-background\fR widget option is used. +.TP \fB\-selectbackground \fIcolor\fR \fIColor\fR specifies the background color to use when displaying selected items. It may have any of the forms accepted by \fBTk_GetColor\fR. If -- cgit v0.12 From 6acf033f061f09ca43c0203318847b950110eb87 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 10 Feb 2016 22:54:09 +0000 Subject: -rmargincolor tag configuration option: tests --- tests/textTag.test | 41 +++++++++++++++++++++++++++++++---------- 1 file changed, 31 insertions(+), 10 deletions(-) diff --git a/tests/textTag.test b/tests/textTag.test index 9e0cf38..f8d7033 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -251,45 +251,56 @@ test textTag-1.25 {configuration options} -constraints { .t tag configure x -rmargin [lindex [.t tag configure x -rmargin] 3] } -returnCodes error -result {bad screen distance "bad"} test textTag-1.25a {tag configuration options} -body { + .t tag configure x -rmargincolor darkblue + .t tag cget x -rmargincolor +} -cleanup { + .t tag configure x -rmargincolor [lindex [.t tag configure x -rmargincolor] 3] +} -result {darkblue} +test textTag-1.25b {configuration options} -body { + .t tag configure x -rmargincolor non-existent +} -cleanup { + .t tag configure x -rmargincolor [lindex [.t tag configure x -rmargincolor] 3] +} -returnCodes error -result {unknown color name "non-existent"} +test textTag-1.25c {tag configuration options} -body { .t tag configure x -selectbackground #012345 .t tag cget x -selectbackground } -cleanup { .t tag configure x -selectbackground [lindex [.t tag configure x -selectbackground] 3] } -result {#012345} -test textTag-1.25b {configuration options} -body { +test textTag-1.25d {configuration options} -body { .t tag configure x -selectbackground non-existent } -cleanup { .t tag configure x -selectbackground [lindex [.t tag configure x -selectbackground] 3] } -returnCodes error -result {unknown color name "non-existent"} -test textTag-1.25c {tag configuration options} -body { +test textTag-1.25e {tag configuration options} -body { .t tag configure x -selectbgstipple gray50 .t tag cget x -selectbgstipple } -cleanup { .t tag configure x -selectbgstipple [lindex [.t tag configure x -selectbgstipple] 3] } -result {gray50} -test textTag-1.25d {configuration options} -body { +test textTag-1.25f {configuration options} -body { .t tag configure x -selectbgstipple badStipple } -cleanup { .t tag configure x -selectbgstipple [lindex [.t tag configure x -selectbgstipple] 3] } -returnCodes error -result {bitmap "badStipple" not defined} -test textTag-1.25e {tag configuration options} -body { +test textTag-1.25g {tag configuration options} -body { .t tag configure x -selectfgstipple gray50 .t tag cget x -selectfgstipple } -cleanup { .t tag configure x -selectfgstipple [lindex [.t tag configure x -selectfgstipple] 3] } -result {gray50} -test textTag-1.25f {configuration options} -body { +test textTag-1.25h {configuration options} -body { .t tag configure x -selectfgstipple badStipple } -cleanup { .t tag configure x -selectfgstipple [lindex [.t tag configure x -selectfgstipple] 3] } -returnCodes error -result {bitmap "badStipple" not defined} -test textTag-1.25g {tag configuration options} -body { +test textTag-1.25i {tag configuration options} -body { .t tag configure x -selectforeground #012345 .t tag cget x -selectforeground } -cleanup { .t tag configure x -selectforeground [lindex [.t tag configure x -selectforeground] 3] } -result {#012345} -test textTag-1.25h {configuration options} -body { +test textTag-1.25j {configuration options} -body { .t tag configure x -selectforeground non-existent } -cleanup { .t tag configure x -selectforeground [lindex [.t tag configure x -selectforeground] 3] @@ -719,12 +730,16 @@ test textTag-5.12 {TkTextTagCmd - "configure" option} -constraints { test textTag-5.13 {TkTextTagCmd - "configure" option} -body { .t tag delete x .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5 \ - -lmargincolor darkblue + -lmargincolor darkblue -rmargincolor lightgreen list [.t tag configure x -lmargin1] [.t tag configure x -lmargin2] \ - [.t tag configure x -rmargin] [.t tag configure x -lmargincolor] + [.t tag configure x -rmargin] [.t tag configure x -lmargincolor] \ + [.t tag configure x -rmargincolor] } -cleanup { .t tag delete x -} -result {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5} {-lmargincolor {} {} {} darkblue}} +} -result [list {-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} \ + {-rmargin {} {} {} 5} \ + {-lmargincolor {} {} {} darkblue} {-rmargincolor {} {} {} lightgreen} \ + ] test textTag-5.14 {TkTextTagCmd - "configure" option} -constraints { haveCourier12 } -body { @@ -755,6 +770,12 @@ test textTag-5.16 {TkTextTagCmd - "configure" option} -constraints { } -cleanup { .t tag delete x } -returnCodes error -result {bad screen distance "140.1.1"} +test textTag-5.16a {TkTextTagCmd - "configure" option} -body { + .t tag delete x + .t tag configure x -rmargincolor rainbow +} -cleanup { + .t tag delete x +} -returnCodes error -result {unknown color name "rainbow"} .t tag delete x test textTag-5.17 {TkTextTagCmd - "configure" option} -constraints { haveCourier12 -- cgit v0.12 From 0fe18b82571d24300bc235e6c37013742ee3b778 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 11 Feb 2016 10:41:03 +0000 Subject: Fixed typo in comment (introduced by error in [6a21622c7e]) --- generic/tkText.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tkText.h b/generic/tkText.h index 8fab200..f37e01a 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -407,7 +407,7 @@ typedef struct TkTextTag { * non-NULL. */ XColor *underlineColor; /* Color for the underline. NULL means same * color as foreground. */ - TkWrapMode wrapMode; /* How to hsandle wrap-around for this tag. + TkWrapMode wrapMode; /* How to handle wrap-around for this tag. * Must be TEXT_WRAPMODE_CHAR, * TEXT_WRAPMODE_NONE, TEXT_WRAPMODE_WORD, or * TEXT_WRAPMODE_NULL to use wrapmode for -- cgit v0.12 From 4dd26486a8997a2706c8c9369c4a17706c33e114 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 11 Feb 2016 13:09:34 +0000 Subject: Fix crash in TkFinalize() if Tk_Init() is never called. Suggested by Brian Griffin. --- generic/tkEvent.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/generic/tkEvent.c b/generic/tkEvent.c index bcc6d98..95aeda1 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -2039,6 +2039,12 @@ TkFinalize( { ExitHandler *exitPtr; +#if defined(_WIN32) && !defined(STATIC_BUILD) + if (!tclStubsPtr) { + return; + } +#endif + Tcl_DeleteExitHandler(TkFinalize, NULL); Tcl_MutexLock(&exitMutex); -- cgit v0.12 From 2d1dee7c0fdf51a57ac71ed493aa92e278a7720e Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 11 Feb 2016 13:17:51 +0000 Subject: -lmargincolor tag configuration option: implementation slightly optimized since Tk_Fill3DRectangle is robust with respect to negative widths --- generic/tkTextDisp.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index c0dc017..f871fc1 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -2479,10 +2479,9 @@ DisplayDLine( * Second, draw the background color of the left and right margins. */ if (dlPtr->lMarginColor != NULL) { - int x = dlPtr->lMarginWidth + dInfoPtr->x - dInfoPtr->curXPixelOffset; - Tk_Fill3DRectangle(textPtr->tkwin, pixmap, dlPtr->lMarginColor, 0, y, - (x>0?x:0), dlPtr->height, 0, TK_RELIEF_FLAT); + dlPtr->lMarginWidth + dInfoPtr->x - dInfoPtr->curXPixelOffset, + dlPtr->height, 0, TK_RELIEF_FLAT); } if (dlPtr->rMarginColor != NULL) { Tk_Fill3DRectangle(textPtr->tkwin, pixmap, dlPtr->rMarginColor, -- cgit v0.12 From 2c864a03e860d3d1b46385e52f6fb648b9f7edb2 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 11 Feb 2016 13:58:42 +0000 Subject: Repair visual test for bevels, inadvertently broken in [6a93101279] --- tests/bevel.tcl | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/bevel.tcl b/tests/bevel.tcl index 531def0..4af60f3 100644 --- a/tests/bevel.tcl +++ b/tests/bevel.tcl @@ -147,14 +147,12 @@ set ind [.t.t index end] xxxx} {} SSSSS sol100 {xxxx x} {} SSSSSSSSSSSSSSSSSS sol100 {x xxx} {} SSSSSSSSS sol100 xxxx {} -} .t.t insert end "\n\nA thinner border is continuous" .t.t insert end { xxxx} {} SSSSS sol12 {xxxx x} {} SSSSSSSSSSSSSSSSSS sol12 {x xxx} {} SSSSSSSSS sol12 xxxx {} -} .t.t tag add big $ind end -- cgit v0.12 From 365dd709b8625b7b08f347f0c0122612c454b618 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 11 Feb 2016 20:06:29 +0000 Subject: Fixed error in comment --- generic/tkTextDisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 7969091..1eea37d 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -1640,7 +1640,7 @@ LayoutDLine( * Make one more pass over the line to recompute various things like its * height, length, and total number of bytes. Also modify the x-locations * of chunks to reflect justification. If we're not wrapping, I'm not sure - * what is the best way to handle left and center justification: should + * what is the best way to handle right and center justification: should * the total length, for purposes of justification, be (a) the window * width, (b) the length of the longest line in the window, or (c) the * length of the longest line in the text? (c) isn't available, (b) seems -- cgit v0.12 From 2944e4c7eb5d6ddae6aaf1eac0262f396d2a4a95 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 19 Feb 2016 17:39:34 +0000 Subject: update changes --- changes | 99 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) diff --git a/changes b/changes index 81be9f1..bf3e62e 100644 --- a/changes +++ b/changes @@ -7167,3 +7167,102 @@ Tk Cocoa 2.0: App Store enabled (walzer,culler,desmera,owen,nyberg,reincke) *** POTENTIAL INCOMPATIBILITY *** --- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tk/ for details + +2015-03-10 (bug) Cocoa: premature image free crash (walzer) + +2015-03-15 (bug) Cocoa: wish launches in front. [focus -force] works (culler) + +2015-04-09 (bug)[e4ed00] [$text index "1.0 display wordstart"] crash (vogel) + +2015-04-09 (bug)[562118] Unicode support of "wordstart" modifier (vogel) + +2015-05-05 (bug)[06c3fc] PNG alpha error corrupted output file (gauthier,porter) + +2015-05-20 (bug)[dece63] various mem corruptions in images (mic42,porter) + +2015-05-24 (bug)[53f8fc] panedwindow geometry management (vogel) + +2015-05-26 (bug)[1641721] tk_getOpenFile symlink display doubled (nijtmans) + +2015-06-01 (bug)[d7bad5][2368195][3592454][1714535][1292219][3592454] + panedwindow fixes (vogel) + +2015-06-25 (bug)[805cff] Tk_ConfigureWidget() segfault (aspect,nijtmans) + +2015-07-13 (bug)[3f179a] Text widget crash with elided text (vogel) + +2015-07-16 (bug)[2886436] Stop [$text delete] acting before start index (vogel) + +2015-07-28 (bug)[1236306] TraverseToMenu error bound to toplevel destroy (vogel) + +2015-08-20 (bug)[00189c] MSVC 14: semi-static UCRT support (dower,nijtmans) + +2015-09-13 (bug)[cc0ba3] PNG read buffer overflow (maxjarek,porter) + +2015-09-29 (bug)[1501749] Crash embedded window delete bound to (vogel) + +2015-10-04 (license) Replace icons that lacked clear free license (cowals) + +2015-10-06 (bug)[46c83f] Win: tk_getOpenFile -initialdir (koend,nadkarni) + +2015-10-08 (new feature)[TIP 437] New panedwindow options (vogel) + +2015-10-09 (bug)[1669632] [text] autoseparator placement (nash,vogel) + +2015-10-09 (bug)[2262711] [text] RE search Unicode+elided (kaitzschu,vogel) + +2015-10-09 (bug)[1815161] [$text count -ypixels] needs management (vogel) + +2015-10-22 (bug)[1520118] Document spinbox validate expectations (vogel) + +2015-10-22 (bug)[1414025] $entry insertion cursor visibility (vogel) + +2015-10-26 (bug) PNG rendering on El Capitan (meier,walzer) + +2015-11-08 (bug)[2160206] menubutton panic (vogel) + +2015-11-08 (bug)[220854] Display trailing TAB in entry (vogel) + +2015-11-08 (bug)[542199] double click on lone char in entry (vogel) + +2015-11-08 (bug)[297442d] strict motif binding on (vogel) + +2015-11-08 (bug)[3601604] $listbox -takefocus (vogel) + +2015-11-09 (bug)[5ee8af] X, Win: 64-bit enable embedded windows (vogel) + +2015-11-29 (bug)[1997299] [text] tag borderwidth leak (vogel) + +2015-12-12 (bug)[1739605] [text see] misbehavior (danckaert) + +2015-12-13 (bug)[ff8a1e] Never-mapped [text] performance (danckaert) + +2015-12-19 (bug)[1700065] Report errors from -textvariable write trace (vogel) + +2015-12-19 (bug)[793909] -textvariable handle undefined namespace (vogel) + +2015-12-26 (bug)[2f78c7] crash with [text] and [tablelist] (vogel) + +2016-01-06 (bug)[1288433,3102228] <> misfires (vogel) + +2016-01-08 (bug)[1510538] initial scrollbar width (vogel,nijtmans) + +2016-01-08 (bug)[1305128] event not received by scrollbar (vogel,nijtmans) + +2016-01-09 (bug)[1927212] Mousewheel/scrollbar bindings (vogel) + +2016-01-11 (bug)[63c354] Cocoa message boxes (culler) + +2016-01-12 (bug)[2049429] get more $text options from database (vogel) + +2016-01-22 (TIP 441) New option [listbox ... -justify] (vogel) + +2016-01-25 (bug) OBOE in ttk::notebook options parsing (bromley,english) + +2016-02-08 (enhance) [option readile] expects utf-8 file (oehlmann,nijtmans) + +2016-02-08 (bug) crash in [$text delete] (griffin,vogel) + +Tk Cocoa 2.0: More drawing internals refinements (culler,walzer) + +--- Released 8.6.5, February 29, 2016 --- http://core.tcl.tk/tk/ for details -- cgit v0.12 From 4e1b2a38af5d33026af79d7bcb6320680bab198b Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 21 Feb 2016 20:53:44 +0000 Subject: Fixed typo in canvas man page --- doc/canvas.n | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/canvas.n b/doc/canvas.n index bc29cc3..38697cd 100644 --- a/doc/canvas.n +++ b/doc/canvas.n @@ -263,7 +263,7 @@ automatically decremented by one. A number less than 0 is treated as if it were zero, and a number greater than the length of the text item is treated as if it were equal to the length of the text item. For -polygons, numbers less than 0 or greater then the length +polygons, numbers less than 0 or greater than the length of the coordinate list will be adjusted by adding or subtracting the length until the result is between zero and the length, inclusive. @@ -405,7 +405,7 @@ behaves as if the \fIstart\fR argument had not been specified. . Selects all the items completely enclosed within the rectangular region given by \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR. -\fIX1\fR must be no greater then \fIx2\fR and \fIy1\fR must be +\fIX1\fR must be no greater than \fIx2\fR and \fIy1\fR must be no greater than \fIy2\fR. .TP \fBoverlapping\fR \fIx1\fR \fIy1\fR \fIx2\fR \fIy2\fR @@ -413,7 +413,7 @@ no greater than \fIy2\fR. Selects all the items that overlap or are enclosed within the rectangular region given by \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR. -\fIX1\fR must be no greater then \fIx2\fR and \fIy1\fR must be +\fIX1\fR must be no greater than \fIx2\fR and \fIy1\fR must be no greater than \fIy2\fR. .TP \fBwithtag \fItagOrId\fR -- cgit v0.12 From 3dfd0dd611bcd8d85edae8c326be10eb2ee5518a Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 22 Feb 2016 17:45:21 +0000 Subject: Added missing comments describing input parameters of some procs --- library/spinbox.tcl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 6a5f829..02584f4 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -336,6 +336,7 @@ proc ::tk::spinbox::ClosestGap {w x} { # Arguments: # w - The spinbox window in which the button was pressed. # x - The x-coordinate of the button press. +# y - The y-coordinate of the button press. proc ::tk::spinbox::ButtonDown {w x y} { variable ::tk::Priv @@ -388,6 +389,7 @@ proc ::tk::spinbox::ButtonDown {w x y} { # Arguments: # w - The spinbox window in which the button was pressed. # x - The x-coordinate of the button press. +# y - The y-coordinate of the button press. proc ::tk::spinbox::ButtonUp {w x y} { variable ::tk::Priv @@ -491,6 +493,8 @@ proc ::tk::spinbox::Paste {w x} { # # Arguments: # w - The spinbox window. +# x - The x-coordinate of the mouse. +# y - The y-coordinate of the mouse. proc ::tk::spinbox::Motion {w x y} { variable ::tk::Priv -- cgit v0.12 From 3a076fb453d7473cf3e8ab0beecb1aabc337c317 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 22 Feb 2016 17:47:02 +0000 Subject: Fixed bug [2981253] - spinbox button frozen in case of repeated depressions --- library/spinbox.tcl | 46 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 14 deletions(-) diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 02584f4..8c287bf 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -86,10 +86,12 @@ bind Spinbox { ::tk::spinbox::Motion %W %x %y } bind Spinbox { + ::tk::spinbox::ArrowPress %W %x %y set tk::Priv(selectMode) word ::tk::spinbox::MouseSelect %W %x sel.first } bind Spinbox { + ::tk::spinbox::ArrowPress %W %x %y set tk::Priv(selectMode) line ::tk::spinbox::MouseSelect %W %x 0 } @@ -328,6 +330,35 @@ proc ::tk::spinbox::ClosestGap {w x} { incr pos } +# ::tk::spinbox::ArrowPress -- +# This procedure is invoked to handle button-1 presses in buttonup +# or buttondown elements of spinbox widgets. +# +# Arguments: +# w - The spinbox window in which the button was pressed. +# x - The x-coordinate of the button press. +# y - The y-coordinate of the button press. + +proc ::tk::spinbox::ArrowPress {w x y} { + variable ::tk::Priv + + if {[$w cget -state] ne "disabled" && \ + [string match "button*" $Priv(element)]} { + $w selection element $Priv(element) + set Priv(repeated) 0 + set Priv(relief) [$w cget -$Priv(element)relief] + catch {after cancel $Priv(afterId)} + set delay [$w cget -repeatdelay] + if {$delay > 0} { + set Priv(afterId) [after $delay \ + [list ::tk::spinbox::Invoke $w $Priv(element)]] + } + if {[info exists Priv(outsideElement)]} { + unset Priv(outsideElement) + } + } +} + # ::tk::spinbox::ButtonDown -- # This procedure is invoked to handle button-1 presses in spinbox # widgets. It moves the insertion cursor, sets the selection anchor, @@ -351,20 +382,7 @@ proc ::tk::spinbox::ButtonDown {w x y} { switch -exact $Priv(element) { "buttonup" - "buttondown" { - if {"disabled" ne [$w cget -state]} { - $w selection element $Priv(element) - set Priv(repeated) 0 - set Priv(relief) [$w cget -$Priv(element)relief] - catch {after cancel $Priv(afterId)} - set delay [$w cget -repeatdelay] - if {$delay > 0} { - set Priv(afterId) [after $delay \ - [list ::tk::spinbox::Invoke $w $Priv(element)]] - } - if {[info exists Priv(outsideElement)]} { - unset Priv(outsideElement) - } - } + ::tk::spinbox::ArrowPress $w $x $y } "entry" { set Priv(selectMode) char -- cgit v0.12 From e34d5227c7b3b6adb662059adbb55ac026d5baf2 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 22 Feb 2016 21:46:32 +0000 Subject: Fixed bug [3137232] - spinbox error after destroying toplevel from widget --- library/spinbox.tcl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 02584f4..fecf7d6 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -299,6 +299,10 @@ bind Spinbox { proc ::tk::spinbox::Invoke {w elem} { variable ::tk::Priv + if {![winfo exists $w]} { + return + } + if {![info exists Priv(outsideElement)]} { $w invoke $elem incr Priv(repeated) -- cgit v0.12 From db0f75aaee952d79eac60d9f4e4179441c040d55 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 24 Feb 2016 17:19:36 +0000 Subject: Added tests cases for bug [2262543] - Scale widget unexpectedly fires command callback --- tests/scale.test | 108 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 108 insertions(+) diff --git a/tests/scale.test b/tests/scale.test index a8d08a8..8c14ed4 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -1396,6 +1396,114 @@ test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \ } \ -result {1.0 1.0 1.0 1.0} +test scale-20.1 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 1} -setup { + catch {destroy .s} + set res {} + set commandedVar -1 +} -body { + scale .s -from 1 -to 50 -command {set commandedVar} + pack .s + update ; # -command callback shall NOT fire + set res [list [.s get] $commandedVar] +} -cleanup { + destroy .s +} -result {1 -1} +test scale-20.2 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 2} -setup { + catch {destroy .s} + set res {} + set commandedVar -1 + set scaleVar 7 +} -body { + scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar} + pack .s + update ; # -command callback shall NOT fire + set res [list [.s get] $commandedVar] +} -cleanup { + destroy .s +} -result {7 -1} +test scale-20.3 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 3} -setup { + catch {destroy .s} + set res {} + set commandedVar -1 +} -body { + scale .s -from 1 -to 50 + .s set 10 + .s configure -command {set commandedVar} + pack .s + update ; # -command callback shall NOT fire + set res [list [.s get] $commandedVar] +} -cleanup { + destroy .s +} -result {10 -1} +test scale-20.4 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 4} -setup { + catch {destroy .s} + set res {} + set commandedVar -1 +} -body { + scale .s -from 1 -to 50 -command {set commandedVar} + .s set 10 + pack .s + update ; # -command callback shall fire + set res [list [.s get] $commandedVar] +} -cleanup { + destroy .s +} -result {10 10} +test scale-20.5 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 5} -setup { + catch {destroy .s} + set res {} + set commandedVar -1 +} -body { + scale .s -from 1 -to 50 + pack .s + .s set 10 + .s configure -command {set commandedVar} + update ; # -command callback shall NOT fire + set res [list [.s get] $commandedVar] +} -cleanup { + destroy .s +} -result {10 -1} +test scale-20.6 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 6} -setup { + catch {destroy .s} + set res {} + set commandedVar -1 +} -body { + scale .s -from 1 -to 50 + pack .s + .s configure -command {set commandedVar} + .s set 10 + update ; # -command callback shall fire + set res [list [.s get] $commandedVar] +} -cleanup { + destroy .s +} -result {10 10} +test scale-20.7 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 7} -setup { + catch {destroy .s} + set res {} + set commandedVar -1 +} -body { + scale .s -from 1 -to 50 -command {set commandedVar} + pack .s + .s set 10 + update ; # -command callback shall fire + set res [list [.s get] $commandedVar] +} -cleanup { + destroy .s +} -result {10 10} +test scale-20.8 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 8} -setup { + catch {destroy .s} + set res {} + set commandedVar -1 + set scaleVar 7 +} -body { + scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar} + pack .s + .s set 10 + update ; # -command callback shall fire + set res [list [.s get] $commandedVar] +} -cleanup { + destroy .s +} -result {10 10} + option clear # cleanup -- cgit v0.12 From 1b0adcf04a83a228748415aa2c01506890ea8941 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 24 Feb 2016 17:32:24 +0000 Subject: Fixed bug [2262543] - Scale widget unexpectedly fires command callback --- generic/tkScale.c | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/generic/tkScale.c b/generic/tkScale.c index cc7c294..cbc5202 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -303,6 +303,12 @@ Tk_ScaleObjCmd( return TCL_ERROR; } + /* + * The widget was just created, no command callback must be invoked. + */ + + scalePtr->flags &= ~INVOKE_COMMAND; + Tcl_SetObjResult(interp, TkNewWindowObj(scalePtr->tkwin)); return TCL_OK; } @@ -1268,7 +1274,14 @@ TkScaleSetValue( return; } scalePtr->value = value; - if (invokeCommand) { + + /* + * Schedule command callback invocation only if there is such a command + * already registered, otherwise the callback would trigger later when + * configuring the widget -command option even if the value did not change. + */ + + if ((invokeCommand) && (scalePtr->command != NULL)) { scalePtr->flags |= INVOKE_COMMAND; } TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER); -- cgit v0.12 From a3ee774779349213a90779a5b69d5ac5d8357099 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 24 Feb 2016 20:10:25 +0000 Subject: Fixed bug [e9112ef96e] - [wm forget] doesn't completely --- macosx/tkMacOSXWm.c | 5 +++++ unix/tkUnixWm.c | 5 +++++ win/tkWinWm.c | 6 ++++++ 3 files changed, 16 insertions(+) diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 3ea2f51..39990e6 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -1788,6 +1788,11 @@ WmForgetCmd( TkWmDeadWindow(winPtr); RemapWindows(winPtr, (MacDrawable *) winPtr->parentPtr->window); + /* + * Make sure wm no longer manages this window + */ + Tk_ManageGeometry(frameWin, NULL, NULL); + winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); /* diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 612270c..19ac86c 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -1826,6 +1826,11 @@ WmForgetCmd( ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); RemapWindows(winPtr, winPtr->parentPtr); + /* + * Make sure wm no longer manages this window + */ + Tk_ManageGeometry(frameWin, NULL, NULL); + /* * Flags (above) must be cleared before calling TkMapTopFrame (below). */ diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 768ee69..4e7618d 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -3673,6 +3673,12 @@ WmForgetCmd( winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); 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); + TkWmDeadWindow(winPtr); /* flags (above) must be cleared before calling */ /* TkMapTopFrame (below) */ -- cgit v0.12 From 2dd0105b9da82fc1d2f88de7ab2b51c2ee928bcd Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 24 Feb 2016 20:29:31 +0000 Subject: Added test case wm-forget-2 related to test the fix for bug [e9112ef96e] --- tests/wm.test | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/tests/wm.test b/tests/wm.test index 1aa0779..afcc2cd 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -2276,6 +2276,32 @@ test wm-forget-1.4 "pack into unmapped toplevel causes crash" -body { deleteWindows } -result {} +test wm-forget-2 {bug [e9112ef96e] - [wm forget] doesn't completely} -setup { + catch {destroy .l .f.b .f} + set res {} +} -body { + label .l -text "Top Dot" + frame .f + button .f.b -text Hello -command "puts Hello!" + pack .l -side top + pack .f.b + pack .f -side bottom + update + set res [winfo manager .f] + pack forget .f + update + lappend res [winfo manager .f] + wm manage .f + update + lappend res [winfo manager .f] + wm forget .f + update + lappend res [winfo manager .f] +} -cleanup { + destroy .l .f.b .f + unset res +} -result {pack {} wm {}} + # FIXME: # Test delivery of virtual