TIP#260 implementation

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  <dkf@users.sf.net>
+
+	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  <peter.spjuth@space.se>
 
 	* 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 <stdio.h>
@@ -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]