Tk Source Code

Check-in [f815da13]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:TIP #438 - [.text pendingyupdate] command added, with corresponding new tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-438
Files: files | file ages | folders
SHA1:f815da13099273382156d75d5757eb91a7557e85
User & Date: fvogel 2015-11-14 09:11:48
Context
2015-11-14
13:05
TIP #438 - <<TextLineHeightsInvalid>> event added, with corresponding new tests check-in: 83bb08d7 user: fvogel tags: tip-438
09:11
TIP #438 - [.text pendingyupdate] command added, with corresponding new tests check-in: f815da13 user: fvogel tags: tip-438
00:02
TIP #438 - [.text yupdate] command added, with corresponding new tests check-in: 85025549 user: fvogel tags: tip-438
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkText.c.

685
686
687
688
689
690
691
692
693
694
695
696
697
698

699
700
701
702
703
704
705
706
707
....
1368
1369
1370
1371
1372
1373
1374












1375
1376
1377
1378
1379
1380
1381
    register TkText *textPtr = (TkText *) clientData;
    int result = TCL_OK;
    int index;

    static const char *optionStrings[] = {
	"bbox", "cget", "compare", "configure", "count", "debug", "delete",
	"dlineinfo", "dump", "edit", "get", "image", "index", "insert",
	"mark", "peer", "replace", "scan", "search", "see", "tag", "window",
	"xview", "yupdate", "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_REPLACE, TEXT_SCAN, TEXT_SEARCH, TEXT_SEE,
	TEXT_TAG, TEXT_WINDOW, TEXT_XVIEW, TEXT_YUPDATE, TEXT_YVIEW
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }

................................................................................
    }
    case TEXT_MARK:
	result = TkTextMarkCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_PEER:
	result = TextPeerCmd(textPtr, interp, objc, objv);
	break;












    case TEXT_REPLACE: {
	const TkTextIndex *indexFromPtr, *indexToPtr;

	if (objc < 5) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "index1 index2 chars ?tagList chars tagList ...?");
	    result = TCL_ERROR;







|
|





>
|
|







 







>
>
>
>
>
>
>
>
>
>
>
>







685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
....
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
    register TkText *textPtr = (TkText *) clientData;
    int result = TCL_OK;
    int index;

    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
    };
    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
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }

................................................................................
    }
    case TEXT_MARK:
	result = TkTextMarkCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_PEER:
	result = TextPeerCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_PENDINGYUPDATE: {
        int number;

        if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            result = TCL_ERROR;
            goto done;
        }
        number = TkTextPendingyupdate(textPtr);
        Tcl_SetObjResult(interp, Tcl_NewIntObj(number));
        break;
    }
    case TEXT_REPLACE: {
	const TkTextIndex *indexFromPtr, *indexToPtr;

	if (objc < 5) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "index1 index2 chars ?tagList chars tagList ...?");
	    result = TCL_ERROR;

Changes to generic/tkText.h.

1120
1121
1122
1123
1124
1125
1126

1127
1128
1129
1130
1131
1132
1133
MODULE_SCOPE int	TkTextMarkCmd(TkText *textPtr, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TkTextMarkNameToIndex(TkText *textPtr,
			    const char *name, TkTextIndex *indexPtr);
MODULE_SCOPE void	TkTextMarkSegToIndex(TkText *textPtr,
			    TkTextSegment *markPtr, TkTextIndex *indexPtr);
MODULE_SCOPE void	TkTextEventuallyRepick(TkText *textPtr);

MODULE_SCOPE void	TkTextPickCurrent(TkText *textPtr, XEvent *eventPtr);
MODULE_SCOPE void	TkTextPixelIndex(TkText *textPtr, int x, int y,
			    TkTextIndex *indexPtr, int *nearest);
MODULE_SCOPE int	TkTextPrintIndex(const TkText *textPtr,
			    const TkTextIndex *indexPtr, char *string);
MODULE_SCOPE Tcl_Obj *	TkTextNewIndexObj(TkText *textPtr,
			    const TkTextIndex *indexPtr);







>







1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
MODULE_SCOPE int	TkTextMarkCmd(TkText *textPtr, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TkTextMarkNameToIndex(TkText *textPtr,
			    const char *name, TkTextIndex *indexPtr);
MODULE_SCOPE void	TkTextMarkSegToIndex(TkText *textPtr,
			    TkTextSegment *markPtr, TkTextIndex *indexPtr);
MODULE_SCOPE void	TkTextEventuallyRepick(TkText *textPtr);
MODULE_SCOPE int	TkTextPendingyupdate(TkText *textPtr);
MODULE_SCOPE void	TkTextPickCurrent(TkText *textPtr, XEvent *eventPtr);
MODULE_SCOPE void	TkTextPixelIndex(TkText *textPtr, int x, int y,
			    TkTextIndex *indexPtr, int *nearest);
MODULE_SCOPE int	TkTextPrintIndex(const TkText *textPtr,
			    const TkTextIndex *indexPtr, char *string);
MODULE_SCOPE Tcl_Obj *	TkTextNewIndexObj(TkText *textPtr,
			    const TkTextIndex *indexPtr);

Changes to generic/tkTextDisp.c.

2916
2917
2918
2919
2920
2921
2922


2923
2924
2925
2926
2927
2928
2929
....
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
....
6026
6027
6028
6029
6030
6031
6032



























6033
6034
6035
6036
6037
6038
6039
     * Update the lines in blocks of about 24 recalculations, or 250+ lines
     * examined, so we pass in 256 for 'doThisMuch'.
     */

    lineNum = TkTextUpdateLineMetrics(textPtr, lineNum,
	    dInfoPtr->lastMetricUpdateLine, 256);



    if (tkTextDebug) {
	char buffer[2 * TCL_INTEGER_SPACE + 1];

	sprintf(buffer, "%d %d", lineNum, dInfoPtr->lastMetricUpdateLine);
	LOG("tk_textInvalidateLine", buffer);
    }

................................................................................

	textPtr->refCount--;
	if (textPtr->refCount == 0) {
	    ckfree((char *) textPtr);
	}
	return;
    }
    dInfoPtr->currentMetricUpdateLine = lineNum;

    /*
     * Re-arm the timer. We already have a refCount on the text widget so no
     * need to adjust that.
     */

    dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1,
................................................................................
	break;
    case TKTEXT_SCROLL_UNITS:
	YScrollByLines(textPtr, count);
	break;
    }
    return TCL_OK;
}



























 
/*
 *--------------------------------------------------------------
 *
 * TkTextScanCmd --
 *
 *	This function is invoked to process the "scan" option for the widget







>
>







 







<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
....
2944
2945
2946
2947
2948
2949
2950

2951
2952
2953
2954
2955
2956
2957
....
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
     * Update the lines in blocks of about 24 recalculations, or 250+ lines
     * examined, so we pass in 256 for 'doThisMuch'.
     */

    lineNum = TkTextUpdateLineMetrics(textPtr, lineNum,
	    dInfoPtr->lastMetricUpdateLine, 256);

    dInfoPtr->currentMetricUpdateLine = lineNum;

    if (tkTextDebug) {
	char buffer[2 * TCL_INTEGER_SPACE + 1];

	sprintf(buffer, "%d %d", lineNum, dInfoPtr->lastMetricUpdateLine);
	LOG("tk_textInvalidateLine", buffer);
    }

................................................................................

	textPtr->refCount--;
	if (textPtr->refCount == 0) {
	    ckfree((char *) textPtr);
	}
	return;
    }


    /*
     * Re-arm the timer. We already have a refCount on the text widget so no
     * need to adjust that.
     */

    dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1,
................................................................................
	break;
    case TKTEXT_SCROLL_UNITS:
	YScrollByLines(textPtr, count);
	break;
    }
    return TCL_OK;
}
 
/*
 *--------------------------------------------------------------
 *
 * TkTextPendingyupdate --
 *
 *	This function computes how many lines are not up-to-date regarding
 *	asynchronous height calculations.
 *
 * Results:
 *	Returns a positive integer corresponding to the number of lines for
 *	which the height is outdated.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
TkTextPendingyupdate(
    TkText *textPtr)		/* Information about text widget. */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;

    return (dInfoPtr->lastMetricUpdateLine - dInfoPtr->currentMetricUpdateLine);
}
 
/*
 *--------------------------------------------------------------
 *
 * TkTextScanCmd --
 *
 *	This function is invoked to process the "scan" option for the widget

Changes to tests/text.test.

149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
...
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
...
990
991
992
993
994
995
996































997
998
999
1000
1001
1002
1003
....
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
} {.t2 Text}

test text-3.1 {TextWidgetCmd procedure, basics} {
    list [catch {.t} msg] $msg
} {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, replace, scan, search, see, tag, window, xview, yupdate, or yview}}

test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
    list [catch {.t bbox} msg] $msg
} {1 {wrong # args: should be ".t bbox index"}}
test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
    list [catch {.t bbox a b} msg] $msg
} {1 {wrong # args: should be ".t bbox index"}}
................................................................................
    list [catch {.t compare 1.0 >> 1.2} msg] $msg
} {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
test text-6.13 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare 1.0 z 1.2} msg] $msg
} {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, replace, scan, search, see, tag, window, xview, yupdate, or yview}}

# "configure" option is already covered above

test text-7.1 {TextWidgetCmd procedure, "debug" option} {
    list [catch {.t debug 0 1} msg] $msg
} {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, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
test text-7.3 {TextWidgetCmd procedure, "debug" option} {
    .t debug true
    .t deb
} 1
test text-7.4 {TextWidgetCmd procedure, "debug" option} {
    .t debug false
    .t debug
................................................................................
    list [catch {.t index} msg] $msg
} {1 {wrong # args: should be ".t index index"}}
test text-10.2 {TextWidgetCmd procedure, "index" option} {
    list [catch {.t ind a b} msg] $msg
} {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, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
test text-10.4 {TextWidgetCmd procedure, "index" option} {
    list [catch {.t index @xyz} msg] $msg
} {1 {bad text index "@xyz"}}
test text-10.5 {TextWidgetCmd procedure, "index" option} {
    .t index 1.2
} 1.2

................................................................................
    .top.yt delete 1.0 end
    .top.yt insert 1.0 $content
    .top.yt yupdate
    .top.yt yview moveto $fraction1
    set fraction2 [lindex [.top.yt yview] 0]
    lappend res [expr {$fraction1 == $fraction2}]
} {1 0 1}
































# edit, mark, scan, search, see, tag, window, xview and yview actions are tested elsewhere.

test text-12.1 {ConfigureText procedure} {
    list [catch {.t2 configure -state foobar} msg] $msg
} {1 {bad state "foobar": must be disabled or normal}}
test text-12.2 {ConfigureText procedure} {
................................................................................
test text-31.1 {TextWidgetCmd procedure, "peer" option} {
    list [catch {.t peer foo 1} msg] $msg
} {1 {bad peer option "foo": must be create or names}}
test text-31.2 {TextWidgetCmd procedure, "peer" option} {
    list [catch {.t peer names foo} msg] $msg
} {1 {wrong # args: should be ".t peer names"}}
test text-31.3 {TextWidgetCmd procedure, "peer" option} {
    list [catch {.t p names} msg] $msg
} {0 {}}
test text-31.4 {TextWidgetCmd procedure, "peer" option} {
    .t peer names
} {}
test text-31.5 {TextWidgetCmd procedure, "peer" option} {
    list [catch {.t peer create foo} msg] $msg
} {1 {bad window path name "foo"}}







|







 







|








|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
...
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
...
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
....
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
} {.t2 Text}

test text-3.1 {TextWidgetCmd procedure, basics} {
    list [catch {.t} msg] $msg
} {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}}

test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
    list [catch {.t bbox} msg] $msg
} {1 {wrong # args: should be ".t bbox index"}}
test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
    list [catch {.t bbox a b} msg] $msg
} {1 {wrong # args: should be ".t bbox index"}}
................................................................................
    list [catch {.t compare 1.0 >> 1.2} msg] $msg
} {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
test text-6.13 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare 1.0 z 1.2} msg] $msg
} {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}}

# "configure" option is already covered above

test text-7.1 {TextWidgetCmd procedure, "debug" option} {
    list [catch {.t debug 0 1} msg] $msg
} {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}}
test text-7.3 {TextWidgetCmd procedure, "debug" option} {
    .t debug true
    .t deb
} 1
test text-7.4 {TextWidgetCmd procedure, "debug" option} {
    .t debug false
    .t debug
................................................................................
    list [catch {.t index} msg] $msg
} {1 {wrong # args: should be ".t index index"}}
test text-10.2 {TextWidgetCmd procedure, "index" option} {
    list [catch {.t ind a b} msg] $msg
} {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}}
test text-10.4 {TextWidgetCmd procedure, "index" option} {
    list [catch {.t index @xyz} msg] $msg
} {1 {bad text index "@xyz"}}
test text-10.5 {TextWidgetCmd procedure, "index" option} {
    .t index 1.2
} 1.2

................................................................................
    .top.yt delete 1.0 end
    .top.yt insert 1.0 $content
    .top.yt yupdate
    .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} {
    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} {
    destroy .top.yt .top
    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
    update
    # wait for end of line metrics calculation to get correct $fraction1
    # as a reference
    while {[.top.yt pendingyupdate]} {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}]
    # asynchronously wait for completion of line metrics calculation
    while {[.top.yt pendingyupdate]} {update}
    .top.yt yview moveto $fraction1
    set fraction2 [lindex [.top.yt yview] 0]
    lappend res [expr {$fraction1 == $fraction2}]
} {1 1 1}

# edit, mark, scan, search, see, tag, window, xview and yview actions are tested elsewhere.

test text-12.1 {ConfigureText procedure} {
    list [catch {.t2 configure -state foobar} msg] $msg
} {1 {bad state "foobar": must be disabled or normal}}
test text-12.2 {ConfigureText procedure} {
................................................................................
test text-31.1 {TextWidgetCmd procedure, "peer" option} {
    list [catch {.t peer foo 1} msg] $msg
} {1 {bad peer option "foo": must be create or names}}
test text-31.2 {TextWidgetCmd procedure, "peer" option} {
    list [catch {.t peer names foo} msg] $msg
} {1 {wrong # args: should be ".t peer names"}}
test text-31.3 {TextWidgetCmd procedure, "peer" option} {
    list [catch {.t pee names} msg] $msg
} {0 {}}
test text-31.4 {TextWidgetCmd procedure, "peer" option} {
    .t peer names
} {}
test text-31.5 {TextWidgetCmd procedure, "peer" option} {
    list [catch {.t peer create foo} msg] $msg
} {1 {bad window path name "foo"}}