From 68f17ab967c493970c0fd1277ecf5abe9dd8e9a6 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 12 Jan 2006 13:38:21 +0000 Subject: TIP#260 implementation --- ChangeLog | 8 ++++++++ doc/canvas.n | 11 ++++++++++- generic/tkCanvText.c | 9 ++++++++- tests/canvText.test | 11 ++++++----- 4 files changed, 32 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4f45575..75813aa 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2006-01-12 Donal K. Fellows + + TIP #260 IMPLEMENTATION + + * generic/tkCanvText.c (TextItem, CreateText, DisplayCanvText): + * doc/canvas.n: Code, docs and tests to implement an -underline + * tests/canvText.test: option for canvases' text items. + 2006-01-11 Peter Spjuth * generic/tkGrid.c: Removed a lingering error message from diff --git a/doc/canvas.n b/doc/canvas.n index 60f09a5..14d7b99 100644 --- a/doc/canvas.n +++ b/doc/canvas.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: canvas.n,v 1.20 2005/05/12 22:51:03 dgp Exp $ +'\" RCS: @(#) $Id: canvas.n,v 1.21 2006/01/12 13:38:22 dkf Exp $ '\" .so man.macros .TH canvas n 8.3 Tk "Tk Built-In Commands" @@ -1673,6 +1673,15 @@ Newline characters cause line breaks. The characters in the item may also be changed with the \fBinsert\fR and \fBdelete\fR widget commands. This option defaults to an empty string. +.VS 8.5 +.TP +\fB\-underline \fI\fR +Specifies the integer index of a character within the text to be +underlined. 0 corresponds to the first character of the text +displayed, 1 to the next character, and so on. \-1 means that no +underline should be drawn (if the whole text item is to be underlined, +the appropriate font should be used instead). +.VE 8.5 .TP \fB\-width \fIlineLength\fR Specifies a maximum line length for the text, in any of the forms diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 2cfa782..9a8782e 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvText.c,v 1.20 2005/11/17 10:57:35 dkf Exp $ + * RCS: @(#) $Id: tkCanvText.c,v 1.21 2006/01/12 13:38:22 dkf Exp $ */ #include @@ -56,6 +56,8 @@ typedef struct TextItem { char *text; /* Text for item (malloc-ed). */ int width; /* Width of lines for word-wrap, pixels. Zero * means no word-wrap. */ + int underline; /* Index of character to put underline beneath + * or -1 for no underlining. */ /* * Fields whose values are derived from the current values of the @@ -124,6 +126,8 @@ static Tk_ConfigSpec configSpecs[] = { NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_STRING, "-text", NULL, NULL, "", Tk_Offset(TextItem, text), 0}, + {TK_CONFIG_INT, "-underline", NULL, NULL, + "-1", Tk_Offset(TextItem, underline), 0}, {TK_CONFIG_PIXELS, "-width", NULL, NULL, "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} @@ -257,6 +261,7 @@ CreateText( textPtr->disabledStipple = None; textPtr->text = NULL; textPtr->width = 0; + textPtr->underline = -1; textPtr->numChars = 0; textPtr->numBytes = 0; @@ -866,6 +871,8 @@ DisplayCanvText( Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout, drawableX, drawableY, 0, -1); } + Tk_UnderlineTextLayout(display, drawable, textPtr->gc, textPtr->textLayout, + drawableX, drawableY, textPtr->underline); if (stipple != None) { XSetTSOrigin(display, textPtr->gc, 0, 0); diff --git a/tests/canvText.test b/tests/canvText.test index d8482b9..1650f62 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: canvText.test,v 1.15 2004/08/09 23:45:57 mdejong Exp $ +# RCS: @(#) $Id: canvText.test,v 1.16 2006/01/12 13:38:22 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -33,6 +33,7 @@ foreach test { {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}} {-tags {test a b c} {test a b c} {} {}} {-text xyz xyz {} {}} + {-underline 0 0 xyz {expected integer but got "xyz"}} {-width 6 6 xyz {bad screen distance "xyz"}} } { lassign $test name goodValue goodResult badValue badResult @@ -401,7 +402,7 @@ test canvText-9.15 {TextInsert procedure: cursor doesn't move} { .c dchars test 7 9 .c index test insert } {5} - + test canvText-10.1 {TextToPoint procedure} { .c coords test 0 0 .c itemconfig test -text 0 -anchor center @@ -430,7 +431,7 @@ test canvText-13.1 {TranslateText procedure} { .c move all 10 10 .c coords test } {110.0 110.0} - + .c itemconfig test -text "abcdefghijklmno" -anchor nw .c select from test 5 .c select to test 8 @@ -479,7 +480,7 @@ test canvText-17.1 {TextToPostscript procedure} { .c delete all .c config -height 300 -highlightthickness 0 -bd 0 update - .c create text 100 100 -tags test + .c create text 100 100 -tags test .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax] .c itemconfig test -anchor n -fill black set x [.c postscript] @@ -560,7 +561,7 @@ test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { + ([font measure {Arial 28 bold} "Y"] / 2)}] set y1 [expr {18 + ($metrics(-linespace) / 2)}] set y2 [expr {160 + ($metrics(-linespace) / 2)}] - + lappend results [$c index tbox1 @$x,$y1] lappend results [$c index tbox2 @$x,$y2] -- cgit v0.12