diff options
| -rw-r--r-- | doc/spinbox.n | 582 | ||||
| -rw-r--r-- | generic/tkEntry.c | 1893 | ||||
| -rw-r--r-- | generic/tkInt.h | 5 | ||||
| -rw-r--r-- | generic/tkWindow.c | 3 | ||||
| -rw-r--r-- | library/entry.tcl | 6 | ||||
| -rw-r--r-- | library/spinbox.tcl | 746 | ||||
| -rw-r--r-- | library/tk.tcl | 3 | ||||
| -rw-r--r-- | tests/entry.test | 26 | ||||
| -rw-r--r-- | tests/spinbox.test | 1577 |
9 files changed, 4623 insertions, 218 deletions
diff --git a/doc/spinbox.n b/doc/spinbox.n new file mode 100644 index 0000000..5cf39e6 --- /dev/null +++ b/doc/spinbox.n @@ -0,0 +1,582 @@ +'\" +'\" Copyright (c) 2000 Jeffrey Hobbs. +'\" Copyright (c) 2000 Ajuba Solutions. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +'\" RCS: @(#) $Id: spinbox.n,v 1.1 2000/05/29 01:43:13 hobbs Exp $ +'\" +.so man.macros +.TH spinbox n 8.4 Tk "Tk Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +spinbox \- Create and manipulate spinbox widgets +.SH SYNOPSIS +\fBspinbox\fR \fIpathName \fR?\fIoptions\fR? +.SO +\-activebackground \-background \-borderwidth +\-cursor \-exportselection \-font +\-foreground \-highlightbackground \-highlightcolor +\-highlightthickness \-insertbackground \-insertborderwidth +\-insertontime \-insertwidth \-insertofftime +\-justify \-relief \-repeatdelay +\-repeatinterval \-selectbackground \-selectborderwidth +\-selectforeground \-takefocus \-textvariable +\-xscrollcommand +.SE +.SH "WIDGET-SPECIFIC OPTIONS" +.OP \-buttonbackground buttonBackground Background +The background color to be used for the spin buttons. +.OP \-buttoncursor buttonCursor Cursor +The cursor to be used when over the spin buttons. If this is empty +(the default), a default cursor will be used. +.OP \-buttondownrelief buttonDownRelief Relief +The relief to be used for the upper spin button. +.OP \-buttonuprelief buttonUpRelief Relief +The relief to be used for the lower spin button. +.OP \-command command Command +Specifies a Tcl command to invoke whenever a spinbutton is invoked. +The command recognizes several percent substitutions: \fB%W\fR for +the widget path, \fB%s\fR for the current value of the widget, and +\fB%d\fR for the direction of the button pressed (\fBup\fR or \fBdown\fR). +.OP \-disabledbackground disabledBackground DisabledBackground +Specifies the background color to use when the spinbox is disabled. If +this option is the empty string, the normal background color is used. +.OP \-disabledforeground disabledForeground DisabledForeground +Specifies the foreground color to use when the spinbox is disabled. If +this option is the empty string, the normal foreground color is used. +.OP \-format format Format +Specifies an alternate format to use when setting the string value +when using the \fB\-from\fR and \fB\-to\fR range. +This must be a format specifier of the form \fB%<pad>.<pad>f\fR, +as it will format a floating-point number. +.OP \-from from From +A floating-point value corresponding to the lowest value for a spinbox, to +be used in conjunction with \fB\-to\fR and \fB\-increment\fR. When all +are specified correctly, the spinbox will use these values to control its +contents. This value must be less than the \fB\-to\fR option. +If \fB\-values\fR is specified, it supercedes this option. +.OP "\-invalidcommand or \-invcmd" invalidCommand InvalidCommand +Specifies a script to eval when \fBvalidateCommand\fR returns 0. Setting +it to an empty string disables this feature (the default). The best use of +this option is to set it to \fIbell\fR. See \fBValidation\fR below for +more information. +.OP \-increment increment Increment +A floating-point value specifying the increment. When used with +\fB\-from\fR and \fB\-to\fR, the value in the widget will be adjusted by +\fB\-increment\fR when a spin button is pressed (up adds the value, +down subtracts the value). +.OP \-readonlybackground readonlyBackground ReadonlyBackground +Specifies the background color to use when the spinbox is readonly. If +this option is the empty string, the normal background color is used. +.OP \-state state State +Specifies one of three states for the spinbox: \fBnormal\fR, +\fBdisabled\fR, or \fBreadonly\fR. If the spinbox is readonly, then the +value may not be changed using widget commands and no insertion cursor +will be displayed, even if the input focus is in the widget; the +contents of the widget may still be selected. If the spinbox is +disabled, the value may not be changed, no insertion cursor will be +displayed, the contents will not be selectable, and the spinbox may +be displayed in a different color, depending on the values of the +\fB-disabledforeground\fR and \fB-disabledbackground\fR options. +.OP \-to to To +A floating-point value corresponding to the highest value for the spinbox, +to be used in conjunction with \fB\-from\fR and \fB\-increment\fR. When +all are specified correctly, the spinbox will use these values to control +its contents. This value must be greater than the \fB\-from\fR option. +If \fB\-values\fR is specified, it supercedes this option. +.OP \-validate validate Validate +Specifies the mode in which validation should operate: \fBnone\fR, +\fBfocus\fR, \fBfocusin\fR, \fBfocusout\fR, \fBkey\fR, or \fBall\fR. +It defaults to \fBnone\fR. When you want validation, you must explicitly +state which mode you wish to use. See \fBValidation\fR below for more. +.OP "\-validatecommand or \-vcmd" validateCommand ValidateCommand +Specifies a script to evaluate when you want to validate the input in the +widget. Setting it to an empty string disables this feature (the default). +Validation occurs according to the value of \fB\-validate\fR. +This command must return a valid Tcl boolean value. If it returns 0 (or +the valid Tcl boolean equivalent) then the value of the widget will not +change and the \fBinvalidCommand\fR will be evaluated if it is set. If it +returns 1, then value will be changed. +See \fBValidation\fR below for more information. +.OP \-values values Values +Must be a proper list value. If specified, the spinbox will use these +values as to control its contents, starting with the first value. This +option has precedence over the \fB\-from\fR and \fB\-to\fR range. +.OP \-width width Width +Specifies an integer value indicating the desired width of the spinbox window, +in average-size characters of the widget's font. +If the value is less than or equal to zero, the widget picks a +size just large enough to hold its current text. +.OP \-wrap wrap wrap +Must be a proper boolean value. If on, the spinbox will wrap around the +values of data in the widget. +.BE + +.SH DESCRIPTION +.PP +The \fBspinbox\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a spinbox widget. +Additional options, described above, may be specified on the +command line or in the option database +to configure aspects of the spinbox such as its colors, font, +and relief. The \fBspinbox\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A \fBspinbox\fR is an extended \fBentry\fR widget that allows he user +to move, or spin, through a fixed set of ascending or descending values +such as times or dates in addition to editing the value as in an +\fBentry\fR. When first created, a spinbox's string is empty. +A portion of the spinbox may be selected as described below. +If a spinbox is exporting its selection (see the \fBexportSelection\fR +option), then it will observe the standard protocols for handling the +selection; spinbox selections are available as type \fBSTRING\fR. +Spinboxes also observe the standard Tk rules for dealing with the +input focus. When a spinbox has the input focus it displays an +\fIinsertion cursor\fR to indicate where new characters will be +inserted. +.PP +Spinboxes are capable of displaying strings that are too long to +fit entirely within the widget's window. In this case, only a +portion of the string will be displayed; commands described below +may be used to change the view in the window. Spinboxes use +the standard \fBxScrollCommand\fR mechanism for interacting with +scrollbars (see the description of the \fBxScrollCommand\fR option +for details). They also support scanning, as described below. + +.SH VALIDATION +.PP +Validation works by setting the \fBvalidateCommand\fR +option to a script which will be evaluated according to the \fBvalidate\fR +option as follows: +.PP +.IP \fBnone\fR 10 +Default. This means no validation will occur. +.IP \fBfocus\fR 10 +\fBvalidateCommand\fR will be called when the spinbox receives or +loses focus. +.IP \fBfocusin\fR 10 +\fBvalidateCommand\fR will be called when the spinbox receives focus. +.IP \fBfocusout\fR 10 +\fBvalidateCommand\fR will be called when the spinbox loses focus. +.IP \fBkey\fR 10 +\fBvalidateCommand\fR will be called when the spinbox is edited. +.IP \fBall\fR 10 +\fBvalidateCommand\fR will be called for all above conditions. +.PP +It is posible to perform percent substitutions on the \fBvalidateCommand\fR +and \fBinvalidCommand\fR, just as you would in a \fBbind\fR script. The +following substitutions are recognized: +.PP +.IP \fB%d\fR 5 +Type of action: 1 for \fBinsert\fR, 0 for \fBdelete\fR, +or -1 for focus, forced or textvariable validation. +.IP \fB%i\fR 5 +Index of char string to be inserted/deleted, if any, otherwise -1. +.IP \fB%P\fR 5 +The value of the spinbox should edition occur. If you are configuring the +spinbox widget to have a new textvariable, this will be the value of that +textvariable. +.IP \fB%s\fR 5 +The current value of spinbox before edition. +.IP \fB%S\fR 5 +The text string being inserted/deleted, if any. +Otherwise it is an empty string. +.IP \fB%v\fR 5 +The type of validation currently set. +.IP \fB%V\fR 5 +The type of validation that triggered the callback +(key, focusin, focusout, forced). +.IP \fB%W\fR 5 +The name of the spinbox widget. +.PP +In general, the \fBtextVariable\fR and \fBvalidateCommand\fR can be +dangerous to mix. Any problems have been overcome so that using the +\fBvalidateCommand\fR will not interfere with the traditional behavior of +the spinbox widget. Using the \fBtextVariable\fR for read-only purposes will +never cause problems. The danger comes when you try set the +\fBtextVariable\fR to something that the \fBvalidateCommand\fR would not +accept, which causes \fBvalidate\fR to become \fInone\fR (the +\fBinvalidCommand\fR will not be triggered). The same happens +when an error occurs evaluating the \fBvalidateCommand\fR. +.PP +Primarily, an error will occur when the \fBvalidateCommand\fR or +\fBinvalidCommand\fR encounters an error in its script while evaluating or +\fBvalidateCommand\fR does not return a valid Tcl boolean value. The +\fBvalidate\fR option will also set itself to \fBnone\fR when you edit the +spinbox widget from within either the \fBvalidateCommand\fR or the +\fBinvalidCommand\fR. Such editions will override the one that was being +validated. If you wish to edit the value of the widget +during validation and still have the \fBvalidate\fR option set, you should +include the command +.CS + \fI%W config -validate %v\fR +.CE +in the \fBvalidateCommand\fR or \fBinvalidCommand\fR (whichever one you +were editing the spinbox widget from). It is also recommended to not set an +associated \fBtextVariable\fR during validation, as that can cause the +spinbox widget to become out of sync with the \fBtextVariable\fR. + +.SH "WIDGET COMMAND" +.PP +The \fBspinbox\fR command creates a new Tcl command whose +name is \fIpathName\fR. This command may be used to invoke various +operations on the widget. It has the following general form: +.CS +\fIpathName option \fR?\fIarg arg ...\fR? +.CE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. +.PP +Many of the widget commands for spinboxes take one or more indices as +arguments. An index specifies a particular character in the spinbox's +string, in any of the following ways: +.TP 12 +\fInumber\fR +Specifies the character as a numerical index, where 0 corresponds +to the first character in the string. +.TP 12 +\fBanchor\fR +Indicates the anchor point for the selection, which is set with the +\fBselect from\fR and \fBselect adjust\fR widget commands. +.TP 12 +\fBend\fR +Indicates the character just after the last one in the spinbox's string. +This is equivalent to specifying a numerical index equal to the length +of the spinbox's string. +.TP 12 +\fBinsert\fR +Indicates the character adjacent to and immediately following the +insertion cursor. +.TP 12 +\fBsel.first\fR +Indicates the first character in the selection. It is an error to +use this form if the selection isn't in the spinbox window. +.TP 12 +\fBsel.last\fR +Indicates the character just after the last one in the selection. +It is an error to use this form if the selection isn't in the +spinbox window. +.TP 12 +\fB@\fInumber\fR +In this form, \fInumber\fR is treated as an x-coordinate in the +spinbox's window; the character spanning that x-coordinate is used. +For example, ``\fB@0\fR'' indicates the left-most character in the +window. +.LP +Abbreviations may be used for any of the forms above, e.g. ``\fBe\fR'' +or ``\fBsel.f\fR''. In general, out-of-range indices are automatically +rounded to the nearest legal value. +.PP +The following commands are possible for spinbox widgets: +.TP +\fIpathName \fBbbox \fIindex\fR +Returns a list of four numbers describing the bounding box of the +character given by \fIindex\fR. +The first two elements of the list give the x and y coordinates of +the upper-left corner of the screen area covered by the character +(in pixels relative to the widget) and the last two elements give +the width and height of the character, in pixels. +The bounding box may refer to a region outside the visible area +of the window. +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBspinbox\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for +information on the format of this list). If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBspinbox\fR +command. +.TP +\fIpathName \fBdelete \fIfirst \fR?\fIlast\fR? +Delete one or more elements of the spinbox. +\fIFirst\fR is the index of the first character to delete, and +\fIlast\fR is the index of the character just after the last +one to delete. +If \fIlast\fR isn't specified it defaults to \fIfirst\fR+1, +i.e. a single character is deleted. +This command returns an empty string. +.TP +\fIpathName \fBget\fR +Returns the spinbox's string. +.TP +\fIpathName \fBicursor \fIindex\fR +Arrange for the insertion cursor to be displayed just before the character +given by \fIindex\fR. Returns an empty string. +.TP +\fIpathName \fBidentify\fI x y\fR +Returns the name of the window element corresponding to coordinates +\fIx\fR and \fIy\fR in the spinbox. Return value is one of: +\fBnone\fR, \fBspindown\fR, \fBspinup\fR, \fBentry\fR. +.TP +\fIpathName \fBindex\fI index\fR +Returns the numerical index corresponding to \fIindex\fR. +.TP +\fIpathName \fBinsert \fIindex string\fR +Insert the characters of \fIstring\fR just before the character +indicated by \fIindex\fR. Returns an empty string. +.TP +\fIpathName \fBinvoke\fI element\fR +Causes the specified element, either \fBspindown\fR or \fBspinup\fR, +to be invoked, triggering the action associated with it. +.TP +\fIpathName \fBscan\fR \fIoption args\fR +This command is used to implement scanning on spinboxes. It has +two forms, depending on \fIoption\fR: +.RS +.TP +\fIpathName \fBscan mark \fIx\fR +Records \fIx\fR and the current view in the spinbox window; used in +conjunction with later \fBscan dragto\fR commands. Typically this +command is associated with a mouse button press in the widget. It +returns an empty string. +.TP +\fIpathName \fBscan dragto \fIx\fR +This command computes the difference between its \fIx\fR argument +and the \fIx\fR argument to the last \fBscan mark\fR command for +the widget. It then adjusts the view left or right by 10 times the +difference in x-coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the spinbox at high speed through the window. The return +value is an empty string. +.RE +.TP +\fIpathName \fBselection \fIoption arg\fR +This command is used to adjust the selection within a spinbox. It +has several forms, depending on \fIoption\fR: +.RS +.TP +\fIpathName \fBselection adjust \fIindex\fR +Locate the end of the selection nearest to the character given by +\fIindex\fR, and adjust that end of the selection to be at \fIindex\fR +(i.e including but not going beyond \fIindex\fR). The other +end of the selection is made the anchor point for future +\fBselect to\fR commands. If the selection +isn't currently in the spinbox, then a new selection is created to +include the characters between \fIindex\fR and the most recent +selection anchor point, inclusive. +Returns an empty string. +.TP +\fIpathName \fBselection clear\fR +Clear the selection if it is currently in this widget. If the +selection isn't in this widget then the command has no effect. +Returns an empty string. +.TP +\fIpathName \fBselection element\fR ?\fIelement\fR? +Sets or gets the currently selected element. If a spinbutton element +is specified, it will be displayed depressed. +.TP +\fIpathName \fBselection from \fIindex\fR +Set the selection anchor point to just before the character +given by \fIindex\fR. Doesn't change the selection. +Returns an empty string. +.TP +\fIpathName \fBselection present\fR +Returns 1 if there is are characters selected in the spinbox, +0 if nothing is selected. +.TP +\fIpathName \fBselection range \fIstart\fR \fIend\fR +Sets the selection to include the characters starting with +the one indexed by \fIstart\fR and ending with the one just +before \fIend\fR. +If \fIend\fR refers to the same character as \fIstart\fR or an +earlier one, then the spinbox's selection is cleared. +.TP +\fIpathName \fBselection to \fIindex\fR +If \fIindex\fR is before the anchor point, set the selection +to the characters from \fIindex\fR up to but not including +the anchor point. +If \fIindex\fR is the same as the anchor point, do nothing. +If \fIindex\fR is after the anchor point, set the selection +to the characters from the anchor point up to but not including +\fIindex\fR. +The anchor point is determined by the most recent \fBselect from\fR +or \fBselect adjust\fR command in this widget. +If the selection isn't in this widget then a new selection is +created using the most recent anchor point specified for the widget. +Returns an empty string. +.RE +.TP +\fIpathName \fBset\fR ?\fIstring\fR? +If \fIstring\fR is specified, the spinbox will try and set it to this +value, otherwise it just returns the spinbox's string. +If validation is on, it will occur when setting the string. +.TP +\fIpathName \fBvalidate\fR +This command is used to force an evaluation of the \fBvalidateCommand\fR +independent of the conditions specified by the \fBvalidate\fR option. +This is done by temporarily setting the \fBvalidate\fR option to \fBall\fR. +It returns 0 or 1. +.TP +\fIpathName \fBxview \fIargs\fR +This command is used to query and change the horizontal position of the +text in the widget's window. It can take any of the following +forms: +.RS +.TP +\fIpathName \fBxview\fR +Returns a list containing two elements. +Each element is a real fraction between 0 and 1; together they describe +the horizontal span that is visible in the window. +For example, if the first element is .2 and the second element is .6, +20% of the spinbox's text is off-screen to the left, the middle 40% is visible +in the window, and 40% of the text is off-screen to the right. +These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR +option. +.TP +\fIpathName \fBxview\fR \fIindex\fR +Adjusts the view in the window so that the character given by \fIindex\fR +is displayed at the left edge of the window. +.TP +\fIpathName \fBxview moveto\fI fraction\fR +Adjusts the view in the window so that the character \fIfraction\fR of the +way through the text appears at the left edge of the window. +\fIFraction\fR must be a fraction between 0 and 1. +.TP +\fIpathName \fBxview scroll \fInumber what\fR +This command shifts the view in the window left or right according to +\fInumber\fR and \fIwhat\fR. +\fINumber\fR must be an integer. +\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation +of one of these. +If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by +\fInumber\fR average-width characters on the display; if it is +\fBpages\fR then the view adjusts by \fInumber\fR screenfuls. +If \fInumber\fR is negative then characters farther to the left +become visible; if it is positive then characters farther to the right +become visible. +.RE + +.SH "DEFAULT BINDINGS" +.PP +Tk automatically creates class bindings for spinboxes that give them +the following default behavior. +In the descriptions below, ``word'' refers to a contiguous group +of letters, digits, or ``_'' characters, or any single character +other than these. +.IP [1] +Clicking mouse button 1 positions the insertion cursor +just before the character underneath the mouse cursor, sets the +input focus to this widget, and clears any selection in the widget. +Dragging with mouse button 1 strokes out a selection between +the insertion cursor and the character under the mouse. +.IP [2] +Double-clicking with mouse button 1 selects the word under the mouse +and positions the insertion cursor at the beginning of the word. +Dragging after a double click will stroke out a selection consisting +of whole words. +.IP [3] +Triple-clicking with mouse button 1 selects all of the text in the +spinbox and positions the insertion cursor before the first character. +.IP [4] +The ends of the selection can be adjusted by dragging with mouse +button 1 while the Shift key is down; this will adjust the end +of the selection that was nearest to the mouse cursor when button +1 was pressed. +If the button is double-clicked before dragging then the selection +will be adjusted in units of whole words. +.IP [5] +Clicking mouse button 1 with the Control key down will position the +insertion cursor in the spinbox without affecting the selection. +.IP [6] +If any normal printing characters are typed in a spinbox, they are +inserted at the point of the insertion cursor. +.IP [7] +The view in the spinbox can be adjusted by dragging with mouse button 2. +If mouse button 2 is clicked without moving the mouse, the selection +is copied into the spinbox at the position of the mouse cursor. +.IP [8] +If the mouse is dragged out of the spinbox on the left or right sides +while button 1 is pressed, the spinbox will automatically scroll to +make more text visible (if there is more text off-screen on the side +where the mouse left the window). +.IP [9] +The Left and Right keys move the insertion cursor one character to the +left or right; they also clear any selection in the spinbox and set +the selection anchor. +If Left or Right is typed with the Shift key down, then the insertion +cursor moves and the selection is extended to include the new character. +Control-Left and Control-Right move the insertion cursor by words, and +Control-Shift-Left and Control-Shift-Right move the insertion cursor +by words and also extend the selection. +Control-b and Control-f behave the same as Left and Right, respectively. +Meta-b and Meta-f behave the same as Control-Left and Control-Right, +respectively. +.IP [10] +The Home key, or Control-a, will move the insertion cursor to the +beginning of the spinbox and clear any selection in the spinbox. +Shift-Home moves the insertion cursor to the beginning of the spinbox +and also extends the selection to that point. +.IP [11] +The End key, or Control-e, will move the insertion cursor to the +end of the spinbox and clear any selection in the spinbox. +Shift-End moves the cursor to the end and extends the selection +to that point. +.IP [12] +The Select key and Control-Space set the selection anchor to the position +of the insertion cursor. They don't affect the current selection. +Shift-Select and Control-Shift-Space adjust the selection to the +current position of the insertion cursor, selecting from the anchor +to the insertion cursor if there was not any selection previously. +.IP [13] +Control-/ selects all the text in the spinbox. +.IP [14] +Control-\e clears any selection in the spinbox. +.IP [15] +The F16 key (labelled Copy on many Sun workstations) or Meta-w +copies the selection in the widget to the clipboard, if there is a selection. +.IP [16] +The F20 key (labelled Cut on many Sun workstations) or Control-w +copies the selection in the widget to the clipboard and deletes +the selection. +If there is no selection in the widget then these keys have no effect. +.IP [17] +The F18 key (labelled Paste on many Sun workstations) or Control-y +inserts the contents of the clipboard at the position of the +insertion cursor. +.IP [18] +The Delete key deletes the selection, if there is one in the spinbox. +If there is no selection, it deletes the character to the right of +the insertion cursor. +.IP [19] +The BackSpace key and Control-h delete the selection, if there is one +in the spinbox. +If there is no selection, it deletes the character to the left of +the insertion cursor. +.IP [20] +Control-d deletes the character to the right of the insertion cursor. +.IP [21] +Meta-d deletes the word to the right of the insertion cursor. +.IP [22] +Control-k deletes all the characters to the right of the insertion +cursor. +.IP [23] +Control-t reverses the order of the two characters to the right of +the insertion cursor. +.PP +If the spinbox is disabled using the \fB\-state\fR option, then the spinbox's +view can still be adjusted and text in the spinbox can still be selected, +but no insertion cursor will be displayed and no text modifications will +take place. +.PP +The behavior of spinboxes can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH KEYWORDS +spinbox, entry, widget diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 2271c49..f9031b9 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -1,5 +1,5 @@ /* - * tkEntry.c -- + * Entry.c -- * * This module implements entry widgets for the Tk * toolkit. An entry displays a string and allows @@ -7,18 +7,23 @@ * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 2000 Ajuba Solutions. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkEntry.c,v 1.16 2000/05/17 22:23:25 ericm Exp $ + * RCS: @(#) $Id: tkEntry.c,v 1.17 2000/05/29 01:43:14 hobbs Exp $ */ #include "tkInt.h" #include "default.h" +enum EntryType { + TK_ENTRY, TK_SPINBOX +}; + /* - * A data structure of the following type is kept for each entry + * A data structure of the following type is kept for each Entry * widget managed by this file: */ @@ -34,7 +39,7 @@ typedef struct { Tcl_Command widgetCmd; /* Token for entry's widget command. */ Tk_OptionTable optionTable; /* Table that defines configuration options * available for this widget. */ - + enum EntryType type; /* Specialized type of Entry widget */ /* * Fields that are set by widget commands other than "configure". @@ -106,9 +111,6 @@ typedef struct { * characters. */ int selBorderWidth; /* Width of border around selection. */ XColor *selFgColorPtr; /* Foreground color for selected text. */ - char *showChar; /* Value of -show option. If non-NULL, first - * character is used for displaying all - * characters in entry. Malloc'ed. */ int state; /* Normal or disabled. Entry is read-only * when disabled. */ char *textVarName; /* Name of variable (malloc'ed) or NULL. @@ -122,23 +124,27 @@ typedef struct { char *scrollCmd; /* Command prefix for communicating with * scrollbar(s). Malloc'ed. NULL means * no command to issue. */ + char *showChar; /* Value of -show option. If non-NULL, first + * character is used for displaying all + * characters in entry. Malloc'ed. + * This is only used by the Entry widget. */ /* * Fields whose values are derived from the current values of the * configuration settings above. */ + char *displayString; /* String to use when displaying. This may + * be a pointer to string, or a pointer to + * malloced memory with the same character + * length as string but whose characters + * are all equal to showChar. */ int numBytes; /* Length of string in bytes. */ int numChars; /* Length of string in characters. Both * string and displayString have the same * character length, but may have different * byte lengths due to being made from * different UTF-8 characters. */ - char *displayString; /* String to use when displaying. This may - * be a pointer to string, or a pointer to - * malloced memory with the same character - * length as string but whose characters - * are all equal to showChar. */ int numDisplayBytes; /* Length of displayString in bytes. */ int inset; /* Number of pixels on the left and right * sides that are taken up by XPAD, borderWidth @@ -156,19 +162,78 @@ typedef struct { GC selTextGC; /* For drawing selected text. */ GC highlightGC; /* For drawing traversal highlight. */ int avgWidth; /* Width of average character. */ + int xWidth; /* Extra width to reserve for widget. + * Used by spinboxes for button space. */ int flags; /* Miscellaneous flags; see below for * definitions. */ - Tk_TSOffset tsoffset; + int validate; /* Non-zero means try to validate */ char *validateCmd; /* Command prefix to use when invoking * validate command. NULL means don't * invoke commands. Malloc'ed. */ - int validate; /* Non-zero means try to validate */ char *invalidCmd; /* Command called when a validation returns 0 * (successfully fails), defaults to {}. */ + } Entry; /* + * A data structure of the following type is kept for each spinbox + * widget managed by this file: + */ + +typedef struct { + Entry entry; /* A pointer to the generic entry structure. + * This must be the first element of the + * Spinbox. */ + + /* + * Spinbox specific configuration settings. + */ + + Tk_3DBorder activeBorder; /* Used for drawing border around active + * buttons. */ + Tk_3DBorder buttonBorder; /* Used for drawing border around buttons. */ + Tk_Cursor bCursor; /* cursor for buttons, or None. */ + int bdRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */ + int buRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */ + char *command; /* Command to invoke for spin buttons. + * NULL means no command to issue. */ + + /* + * Spinbox specific fields for use with configuration settings above. + */ + + int wrap; /* whether to wrap around when spinning */ + + int selElement; /* currently selected control */ + int curElement; /* currently mouseover control */ + + int repeatDelay; /* repeat delay */ + int repeatInterval; /* repeat interval */ + + double fromValue; /* Value corresponding to left/top of dial */ + double toValue; /* Value corresponding to right/bottom + * of dial */ + double increment; /* If > 0, all values are rounded to an + * even multiple of this value. */ + char *formatBuf; /* string into which to format value. + * Malloc'ed. */ + char *reqFormat; /* Sprintf conversion specifier used for the + * value that the users requests. Malloc'ed. */ + char *valueFormat; /* Sprintf conversion specifier used for + * the value. */ + char digitFormat[10]; /* Sprintf conversion specifier computed from + * digits and other information; used for + * the value. */ + + char *valueStr; /* Values List. Malloc'ed. */ + Tcl_Obj *listObj; /* Pointer to the list object being used */ + int eIndex; /* Holds the current index into elements */ + int nElements; /* Holds the current count of elements */ + +} Spinbox; + +/* * Assigned bits of "flags" fields of Entry structures, and what those * bits mean: * @@ -212,6 +277,12 @@ typedef struct { #define YPAD 1 /* + * A comparison function for double values. For Spinboxes. + */ +#define MIN_DBL_VAL 1E-9 +#define DOUBLES_EQ(d1, d2) (fabs((d1) - (d2)) < MIN_DBL_VAL) + +/* * The following enum is used to define a type for the -state option * of the Entry widget. These values are used as indices into the * string table below. @@ -238,16 +309,16 @@ enum validateType { /* * These extra enums are for use with EntryValidateChange */ - VALIDATE_FORCED, VALIDATE_DELETE, VALIDATE_INSERT + VALIDATE_FORCED, VALIDATE_DELETE, VALIDATE_INSERT, VALIDATE_BUTTON }; #define DEF_ENTRY_VALIDATE "none" #define DEF_ENTRY_INVALIDCMD "" /* - * Information used for argv parsing. + * Information used for Entry objv parsing. */ -static Tk_OptionSpec optionSpecs[] = { +static Tk_OptionSpec entryOptSpec[] = { {TK_OPTION_BORDER, "-background", "background", "Background", DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder), 0, (ClientData) DEF_ENTRY_BG_MONO, 0}, @@ -359,11 +430,166 @@ static Tk_OptionSpec optionSpecs[] = { }; /* - * Flags for GetEntryIndex procedure: + * Information used for Spinbox objv parsing. */ -#define ZERO_OK 1 -#define LAST_PLUS_ONE_OK 2 +#define DEF_SPINBOX_REPEAT_DELAY "400" +#define DEF_SPINBOX_REPEAT_INTERVAL "100" + +#define DEF_SPINBOX_CMD "" + +#define DEF_SPINBOX_FROM "0" +#define DEF_SPINBOX_TO "0" +#define DEF_SPINBOX_INCREMENT "1" +#define DEF_SPINBOX_FORMAT "" + +#define DEF_SPINBOX_VALUES "" +#define DEF_SPINBOX_WRAP "0" + +static Tk_OptionSpec sbOptSpec[] = { + {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Background", + DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(Spinbox, activeBorder), + 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0}, + {TK_OPTION_BORDER, "-background", "background", "Background", + DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder), + 0, (ClientData) DEF_ENTRY_BG_MONO, 0}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth), + 0, 0, 0}, + {TK_OPTION_BORDER, "-buttonbackground", "Button.background", "Background", + DEF_BUTTON_BG_COLOR, -1, Tk_Offset(Spinbox, buttonBorder), + 0, (ClientData) DEF_BUTTON_BG_MONO, 0}, + {TK_OPTION_CURSOR, "-buttoncursor", "Button.cursor", "Cursor", + DEF_BUTTON_CURSOR, -1, Tk_Offset(Spinbox, bCursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_RELIEF, "-buttondownrelief", "Button.relief", "Relief", + DEF_BUTTON_RELIEF, -1, Tk_Offset(Spinbox, bdRelief), + 0, 0, 0}, + {TK_OPTION_RELIEF, "-buttonuprelief", "Button.relief", "Relief", + DEF_BUTTON_RELIEF, -1, Tk_Offset(Spinbox, buRelief), + 0, 0, 0}, + {TK_OPTION_STRING, "-command", "command", "Command", + DEF_SPINBOX_CMD, -1, Tk_Offset(Spinbox, command), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BORDER, "-disabledbackground", "disabledBackground", + "DisabledBackground", DEF_ENTRY_DISABLED_BG_COLOR, -1, + Tk_Offset(Entry, disabledBorder), TK_OPTION_NULL_OK, + (ClientData) DEF_ENTRY_DISABLED_BG_MONO, 0}, + {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", + "DisabledForeground", DEF_ENTRY_DISABLED_FG, -1, + Tk_Offset(Entry, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection", + "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1, + Tk_Offset(Entry, exportSelection), 0, 0, 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + {TK_OPTION_FONT, "-font", "font", "Font", + DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0}, + {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", + DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0, + 0, 0}, + {TK_OPTION_STRING, "-format", "format", "Format", + DEF_SPINBOX_FORMAT, -1, Tk_Offset(Spinbox, reqFormat), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_DOUBLE, "-from", "from", "From", + DEF_SPINBOX_FROM, -1, Tk_Offset(Spinbox, fromValue), 0, 0, 0}, + {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG, + -1, Tk_Offset(Entry, highlightBgColorPtr), + 0, 0, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1, + Tk_Offset(Entry, highlightWidth), 0, 0, 0}, + {TK_OPTION_DOUBLE, "-increment", "increment", "Increment", + DEF_SPINBOX_INCREMENT, -1, Tk_Offset(Spinbox, increment), 0, 0, 0}, + {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground", + DEF_ENTRY_INSERT_BG, -1, Tk_Offset(Entry, insertBorder), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth", + "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1, + Tk_Offset(Entry, insertBorderWidth), 0, + (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0}, + {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime", + DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime), + 0, 0, 0}, + {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime", + DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", + DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth), + 0, 0, 0}, + {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand", + DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_SYNONYM, "-invcmd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-invalidcommand", 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief), + 0, 0, 0}, + {TK_OPTION_BORDER, "-readonlybackground", "readonlyBackground", + "ReadonlyBackground", DEF_ENTRY_READONLY_BG_COLOR, -1, + Tk_Offset(Entry, readonlyBorder), TK_OPTION_NULL_OK, + (ClientData) DEF_ENTRY_READONLY_BG_MONO, 0}, + {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay", + DEF_SPINBOX_REPEAT_DELAY, -1, Tk_Offset(Spinbox, repeatDelay), + 0, 0, 0}, + {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval", + DEF_SPINBOX_REPEAT_INTERVAL, -1, Tk_Offset(Spinbox, repeatInterval), + 0, 0, 0}, + {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground", + DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder), + 0, (ClientData) DEF_ENTRY_SELECT_MONO, 0}, + {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth", + "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1, + Tk_Offset(Entry, selBorderWidth), + 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0}, + {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr), + 0, (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_STRING, "-textvariable", "textVariable", "Variable", + DEF_ENTRY_TEXT_VARIABLE, -1, Tk_Offset(Entry, textVarName), + TK_CONFIG_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", + (char *) NULL, -1, Tk_Offset(Entry, validateCmd), + TK_CONFIG_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-values", "values", "Values", + DEF_SPINBOX_VALUES, -1, Tk_Offset(Spinbox, valueStr), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_SYNONYM, "-vcmd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-validatecommand", 0}, + {TK_OPTION_INT, "-width", "width", "Width", + DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0}, + {TK_OPTION_BOOLEAN, "-wrap", "wrap", "Wrap", + 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_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, 0, 0} +}; /* * The following tables define the entry widget commands (and sub- @@ -371,27 +597,74 @@ static Tk_OptionSpec optionSpecs[] = { * enumerated types used to dispatch the entry widget command. */ -static char *commandNames[] = { +static char *entryCmdNames[] = { "bbox", "cget", "configure", "delete", "get", "icursor", "index", "insert", "scan", "selection", "validate", "xview", (char *) NULL }; -enum command { +enum entryCmd { COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELETE, COMMAND_GET, COMMAND_ICURSOR, COMMAND_INDEX, COMMAND_INSERT, COMMAND_SCAN, COMMAND_SELECTION, COMMAND_VALIDATE, COMMAND_XVIEW }; -static char *selCommandNames[] = { +static char *selCmdNames[] = { "adjust", "clear", "from", "present", "range", "to", (char *) NULL }; -enum selcommand { +enum selCmd { SELECTION_ADJUST, SELECTION_CLEAR, SELECTION_FROM, SELECTION_PRESENT, SELECTION_RANGE, SELECTION_TO }; /* + * The following tables define the spinbox widget commands (and sub- + * commands) and map the indexes into the string tables into + * enumerated types used to dispatch the spinbox widget command. + */ + +static char *sbCmdNames[] = { + "bbox", "cget", "configure", "delete", "get", "icursor", "identify", + "index", "insert", "invoke", "scan", "selection", "set", + "validate", "xview", (char *) NULL +}; + +enum sbCmd { + SB_CMD_BBOX, SB_CMD_CGET, SB_CMD_CONFIGURE, SB_CMD_DELETE, + SB_CMD_GET, SB_CMD_ICURSOR, SB_CMD_IDENTIFY, SB_CMD_INDEX, + SB_CMD_INSERT, SB_CMD_INVOKE, SB_CMD_SCAN, SB_CMD_SELECTION, + SB_CMD_SET, SB_CMD_VALIDATE, SB_CMD_XVIEW +}; + +static char *sbSelCmdNames[] = { + "adjust", "clear", "element", "from", "present", "range", "to", + (char *) NULL +}; + +enum sbselCmd { + SB_SEL_ADJUST, SB_SEL_CLEAR, SB_SEL_ELEMENT, SB_SEL_FROM, + SB_SEL_PRESENT, SB_SEL_RANGE, SB_SEL_TO +}; + +/* + * Extra for selection of elements + */ + +static char *selElementNames[] = { + "none", "buttondown", "buttonup", (char *) NULL, "entry" +}; +enum selelement { + SEL_NONE, SEL_BUTTONDOWN, SEL_BUTTONUP, SEL_NULL, SEL_ENTRY +}; + +/* + * Flags for GetEntryIndex procedure: + */ + +#define ZERO_OK 1 +#define LAST_PLUS_ONE_OK 2 + +/* * Forward declarations for procedures defined later in this file: */ @@ -431,7 +704,8 @@ static int EntryValidateChange _ANSI_ARGS_((Entry *entryPtr, static void ExpandPercents _ANSI_ARGS_((Entry *entryPtr, char *before, char *change, char *new, int index, int type, Tcl_DString *dsPtr)); -static void EntryValueChanged _ANSI_ARGS_((Entry *entryPtr)); +static void EntryValueChanged _ANSI_ARGS_((Entry *entryPtr, + char *newValue)); static void EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr, double *firstPtr, double *lastPtr)); static int EntryWidgetObjCmd _ANSI_ARGS_((ClientData clientData, @@ -445,7 +719,20 @@ static void InsertChars _ANSI_ARGS_((Entry *entryPtr, int index, char *string)); /* - * The structure below defines entry class behavior by means of procedures + * These forward declarations are the spinbox specific ones: + */ + +static int SpinboxWidgetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int GetSpinboxElement _ANSI_ARGS_((Spinbox *sbPtr, + int x, int y)); +static int SpinboxInvoke _ANSI_ARGS_((Tcl_Interp *interp, + Spinbox *sbPtr, int element)); +static int ComputeFormat _ANSI_ARGS_((Spinbox *sbPtr)); + +/* + * The structure below defines widget class behavior by means of procedures * that can be invoked from generic window code. */ @@ -497,7 +784,7 @@ Tk_EntryObjCmd(clientData, interp, objc, objv) * invocations of the command. */ - optionTable = Tk_CreateOptionTable(interp, optionSpecs); + optionTable = Tk_CreateOptionTable(interp, entryOptSpec); name = Tcl_GetString(objv[0]); Tcl_GetCommandInfo(interp, name, &info); info.objClientData = (ClientData) optionTable; @@ -518,10 +805,13 @@ Tk_EntryObjCmd(clientData, interp, objc, objv) /* * Initialize the fields of the structure that won't be initialized * by ConfigureEntry, or that ConfigureEntry requires to be - * initialized already (e.g. resource pointers). + * initialized already (e.g. resource pointers). Only the non-NULL/0 + * data must be initialized as memset covers the rest. */ entryPtr = (Entry *) ckalloc(sizeof(Entry)); + memset((VOID *) entryPtr, 0, sizeof(Entry)); + entryPtr->tkwin = tkwin; entryPtr->display = Tk_Display(tkwin); entryPtr->interp = interp; @@ -529,62 +819,24 @@ Tk_EntryObjCmd(clientData, interp, objc, objv) Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd, (ClientData) entryPtr, EntryCmdDeletedProc); entryPtr->optionTable = optionTable; + entryPtr->type = TK_ENTRY; entryPtr->string = (char *) ckalloc(1); entryPtr->string[0] = '\0'; - entryPtr->insertPos = 0; entryPtr->selectFirst = -1; entryPtr->selectLast = -1; - entryPtr->selectAnchor = 0; - entryPtr->scanMarkX = 0; - entryPtr->scanMarkIndex = 0; - - entryPtr->normalBorder = NULL; - entryPtr->disabledBorder = NULL; - entryPtr->readonlyBorder = NULL; - entryPtr->borderWidth = 0; + entryPtr->cursor = None; entryPtr->exportSelection = 1; - entryPtr->tkfont = NULL; - entryPtr->fgColorPtr = NULL; - entryPtr->dfgColorPtr = NULL; - entryPtr->highlightBgColorPtr = NULL; - entryPtr->highlightColorPtr = NULL; - entryPtr->highlightWidth = 0; - entryPtr->insertBorder = NULL; - entryPtr->insertBorderWidth = 0; - entryPtr->insertOffTime = 0; - entryPtr->insertOnTime = 0; - entryPtr->insertWidth = 0; entryPtr->justify = TK_JUSTIFY_LEFT; entryPtr->relief = TK_RELIEF_FLAT; - entryPtr->selBorder = NULL; - entryPtr->selBorderWidth = 0; - entryPtr->selFgColorPtr = NULL; - entryPtr->showChar = NULL; entryPtr->state = STATE_NORMAL; - entryPtr->textVarName = NULL; - entryPtr->takeFocus = NULL; - entryPtr->prefWidth = 0; - entryPtr->scrollCmd = NULL; - entryPtr->numBytes = 0; - entryPtr->numChars = 0; entryPtr->displayString = entryPtr->string; - entryPtr->numDisplayBytes = 0; entryPtr->inset = XPAD; - entryPtr->textLayout = NULL; - entryPtr->layoutX = 0; - entryPtr->layoutY = 0; - entryPtr->leftX = 0; - entryPtr->leftIndex = 0; - entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL; entryPtr->textGC = None; entryPtr->selTextGC = None; entryPtr->highlightGC = None; entryPtr->avgWidth = 1; - entryPtr->flags = 0; - entryPtr->validateCmd = NULL; entryPtr->validate = VALIDATE_NONE; - entryPtr->invalidCmd = NULL; Tk_SetClass(entryPtr->tkwin, "Entry"); TkSetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr); @@ -645,13 +897,13 @@ EntryWidgetObjCmd(clientData, interp, objc, objv) * the list of valid command names. */ - result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, + result = Tcl_GetIndexFromObj(interp, objv[1], entryCmdNames, "option", 0, &cmdIndex); if (result != TCL_OK) { return result; } - switch (cmdIndex) { + switch ((enum entryCmd) cmdIndex) { case COMMAND_BBOX: { int index, x, y, width, height; char buf[TCL_INTEGER_SPACE * 4]; @@ -826,15 +1078,15 @@ EntryWidgetObjCmd(clientData, interp, objc, objv) /* * Parse the selection sub-command, using the command - * table "selCommandNames" defined above. + * table "selCmdNames" defined above. */ - result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames, + result = Tcl_GetIndexFromObj(interp, objv[2], selCmdNames, "selection option", 0, &selIndex); if (result != TCL_OK) { goto error; } - + /* * Disabled entries don't allow the selection to be modified. */ @@ -842,7 +1094,7 @@ EntryWidgetObjCmd(clientData, interp, objc, objv) if (entryPtr->state == STATE_DISABLED) { goto done; } - + switch(selIndex) { case SELECTION_ADJUST: { if (objc != 4) { @@ -1076,7 +1328,7 @@ DestroyEntry(memPtr) Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd); if (entryPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr); + Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr); } /* @@ -1101,6 +1353,17 @@ DestroyEntry(memPtr) if (entryPtr->displayString != entryPtr->string) { ckfree(entryPtr->displayString); } + if (entryPtr->type == TK_SPINBOX) { + Spinbox *sbPtr = (Spinbox *) entryPtr; + + if (sbPtr->listObj != NULL) { + Tcl_DecrRefCount(sbPtr->listObj); + sbPtr->listObj = NULL; + } + if (sbPtr->formatBuf) { + ckfree(sbPtr->formatBuf); + } + } Tk_FreeTextLayout(entryPtr->textLayout); Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable, entryPtr->tkwin); @@ -1139,10 +1402,17 @@ ConfigureEntry(interp, entryPtr, objc, objv, flags) int flags; /* Flags to pass to Tk_ConfigureWidget. */ { Tk_SavedOptions savedOptions; - Tcl_Obj *errorResult = NULL; Tk_3DBorder border; + Tcl_Obj *errorResult = NULL; + Spinbox *sbPtr = (Spinbox *) entryPtr; /* Only used when this widget + * is of type TK_SPINBOX */ + char *oldValues = NULL; /* lint initialization */ + char *oldFormat = NULL; /* lint initialization */ int error; - int oldExport; + int oldExport = 0; /* lint initialization */ + int valuesChanged = 0; /* lint initialization */ + double oldFrom = 0.0; /* lint initialization */ + double oldTo = 0.0; /* lint initialization */ /* * Eliminate any existing trace on a variable monitored by the entry. @@ -1154,7 +1424,17 @@ ConfigureEntry(interp, entryPtr, objc, objv, flags) EntryTextVarProc, (ClientData) entryPtr); } - oldExport = entryPtr->exportSelection; + /* + * Store old values that we need to effect certain behavior if + * they change value + */ + oldExport = entryPtr->exportSelection; + if (entryPtr->type == TK_SPINBOX) { + oldValues = sbPtr->valueStr; + oldFormat = sbPtr->reqFormat; + oldFrom = sbPtr->fromValue; + oldTo = sbPtr->toValue; + } for (error = 0; error <= 1; error++) { if (!error) { @@ -1182,11 +1462,11 @@ ConfigureEntry(interp, entryPtr, objc, objv, flags) * the geometry and setting the background from a 3-D border. */ - if (entryPtr->state == STATE_DISABLED && - entryPtr->disabledBorder != NULL) { + if ((entryPtr->state == STATE_DISABLED) && + (entryPtr->disabledBorder != NULL)) { border = entryPtr->disabledBorder; - } else if (entryPtr->state == STATE_READONLY && - entryPtr->readonlyBorder != NULL) { + } else if ((entryPtr->state == STATE_READONLY) && + (entryPtr->readonlyBorder != NULL)) { border = entryPtr->readonlyBorder; } else { border = entryPtr->normalBorder; @@ -1200,6 +1480,80 @@ ConfigureEntry(interp, entryPtr, objc, objv, flags) entryPtr->insertBorderWidth = entryPtr->insertWidth/2; } + if (entryPtr->type == TK_SPINBOX) { + if (sbPtr->fromValue > sbPtr->toValue) { + Tcl_SetResult(interp, + "-to value must be greater than -from value", + TCL_VOLATILE); + continue; + } + + if (sbPtr->reqFormat && (oldFormat != sbPtr->reqFormat)) { + /* + * Make sure that the given format is somewhat correct, and + * calculate the minimum space we'll need for the values as + * strings. + */ + int min, max; + size_t formatLen, formatSpace = TCL_DOUBLE_SPACE; + char fbuf[4], *fmt = sbPtr->reqFormat; + + formatLen = strlen(fmt); + if ((fmt[0] != '%') || (fmt[formatLen-1] != 'f')) { + badFormatOpt: + Tcl_AppendResult(interp, "bad spinbox format specifier \"", + sbPtr->reqFormat, "\"", (char *) NULL); + continue; + } + if ((sscanf(fmt, "%%%d.%d%[f]", &min, &max, fbuf) == 3) + && (max >= 0)) { + formatSpace = min + max + 1; + } else if (((sscanf(fmt, "%%.%d%[f]", &min, fbuf) == 2) + || (sscanf(fmt, "%%%d%[f]", &min, fbuf) == 2) + || (sscanf(fmt, "%%%d.%[f]", &min, fbuf) == 2)) + && (min >= 0)) { + formatSpace = min + 1; + } else { + goto badFormatOpt; + } + if (formatSpace < TCL_DOUBLE_SPACE) { + formatSpace = TCL_DOUBLE_SPACE; + } + sbPtr->formatBuf = ckrealloc(sbPtr->formatBuf, formatSpace); + /* + * We perturb the value of oldFrom to allow us to go into + * the branch below that will reformat the displayed value. + */ + oldFrom = sbPtr->fromValue - 1; + } + + /* + * See if we have to rearrange our listObj data + */ + if (oldValues != sbPtr->valueStr) { + if (sbPtr->listObj != NULL) { + Tcl_DecrRefCount(sbPtr->listObj); + } + sbPtr->listObj = NULL; + if (sbPtr->valueStr != NULL) { + Tcl_Obj *newObjPtr; + int nelems; + + newObjPtr = Tcl_NewStringObj(sbPtr->valueStr, -1); + if (Tcl_ListObjLength(interp, newObjPtr, &nelems) + != TCL_OK) { + valuesChanged = -1; + continue; + } + sbPtr->listObj = newObjPtr; + Tcl_IncrRefCount(sbPtr->listObj); + sbPtr->nElements = nelems; + sbPtr->eIndex = 0; + valuesChanged++; + } + } + } + /* * Restart the cursor timing sequence in case the on-time or * off-time just changed. Set validate temporarily to none, @@ -1243,6 +1597,46 @@ ConfigureEntry(interp, entryPtr, objc, objv, flags) Tk_FreeSavedOptions(&savedOptions); } + if (entryPtr->type == TK_SPINBOX) { + ComputeFormat(sbPtr); + + if (valuesChanged > 0) { + Tcl_Obj *objPtr; + + /* + * No check for error return, because there shouldn't be one + * given the check for valid list above + */ + Tcl_ListObjIndex(interp, sbPtr->listObj, 0, &objPtr); + EntryValueChanged(entryPtr, Tcl_GetString(objPtr)); + } else if ((sbPtr->valueStr == NULL) + && !DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue) + && (!DOUBLES_EQ(sbPtr->fromValue, oldFrom) + || !DOUBLES_EQ(sbPtr->toValue, oldTo))) { + /* + * If the valueStr is empty and -from && -to are specified, check + * to see if the current string is within the range. If not, + * it will be constrained to the nearest edge. If the current + * string isn't a double value, we set it to -from. + */ + int code; + double dvalue; + + code = Tcl_GetDouble(NULL, entryPtr->string, &dvalue); + if (code != TCL_OK) { + dvalue = sbPtr->fromValue; + } else { + if (dvalue > sbPtr->toValue) { + dvalue = sbPtr->toValue; + } else if (dvalue < sbPtr->fromValue) { + dvalue = sbPtr->fromValue; + } + } + sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue); + EntryValueChanged(entryPtr, sbPtr->formatBuf); + } + } + /* * If the entry is tied to the value of a variable, then set up * a trace on the variable's value, create the variable if it doesn't @@ -1254,7 +1648,7 @@ ConfigureEntry(interp, entryPtr, objc, objv, flags) value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY); if (value == NULL) { - EntryValueChanged(entryPtr); + EntryValueChanged(entryPtr, NULL); } else { EntrySetValue(entryPtr, value); } @@ -1298,23 +1692,32 @@ EntryWorldChanged(instanceData) XGCValues gcValues; GC gc = None; unsigned long mask; - Entry *entryPtr; Tk_3DBorder border; XColor *colorPtr; - - entryPtr = (Entry *) instanceData; + Entry *entryPtr = (Entry *) instanceData; entryPtr->avgWidth = Tk_TextWidth(entryPtr->tkfont, "0", 1); if (entryPtr->avgWidth == 0) { entryPtr->avgWidth = 1; } + if (entryPtr->type == TK_SPINBOX) { + /* + * Compute the button width for a spinbox + */ + + entryPtr->xWidth = entryPtr->avgWidth + 2 * (1+XPAD); + if (entryPtr->xWidth < 11) { + entryPtr->xWidth = 11; /* we want a min visible size */ + } + } + /* * Default background and foreground are from the normal state. * In a disabled state, both of those may be overridden; in the readonly * state, the background may be overridden. */ - + border = entryPtr->normalBorder; colorPtr = entryPtr->fgColorPtr; switch (entryPtr->state) { @@ -1332,7 +1735,7 @@ EntryWorldChanged(instanceData) } break; } - + Tk_SetBackgroundFromBorder(entryPtr->tkwin, border); gcValues.foreground = colorPtr->pixel; gcValues.font = Tk_FontId(entryPtr->tkfont); @@ -1386,12 +1789,11 @@ DisplayEntry(clientData) Entry *entryPtr = (Entry *) clientData; Tk_Window tkwin = entryPtr->tkwin; int baseY, selStartX, selEndX, cursorX; - int xBound; + int showSelection, xBound; Tk_FontMetrics fm; Pixmap pixmap; - int showSelection; Tk_3DBorder border; - + entryPtr->flags &= ~REDRAW_PENDING; if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { return; @@ -1423,7 +1825,7 @@ DisplayEntry(clientData) * one, plus vertical position of baseline of text. */ - xBound = Tk_Width(tkwin) - entryPtr->inset; + xBound = Tk_Width(tkwin) - entryPtr->inset - entryPtr->xWidth; baseY = (Tk_Height(tkwin) + fm.ascent - fm.descent) / 2; /* @@ -1443,11 +1845,11 @@ DisplayEntry(clientData) * insertion cursor background. */ - if (entryPtr->state == STATE_DISABLED && - entryPtr->disabledBorder != NULL) { + if ((entryPtr->state == STATE_DISABLED) && + (entryPtr->disabledBorder != NULL)) { border = entryPtr->disabledBorder; - } else if (entryPtr->state == STATE_READONLY && - entryPtr->readonlyBorder != NULL) { + } else if ((entryPtr->state == STATE_READONLY) && + (entryPtr->readonlyBorder != NULL)) { border = entryPtr->readonlyBorder; } else { border = entryPtr->normalBorder; @@ -1455,7 +1857,7 @@ DisplayEntry(clientData) Tk_Fill3DRectangle(tkwin, pixmap, border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); - if (showSelection && entryPtr->state != STATE_DISABLED + if (showSelection && (entryPtr->state != STATE_DISABLED) && (entryPtr->selectLast > entryPtr->leftIndex)) { if (entryPtr->selectFirst <= entryPtr->leftIndex) { selStartX = entryPtr->leftX; @@ -1516,7 +1918,7 @@ DisplayEntry(clientData) entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY, entryPtr->leftIndex, entryPtr->numChars); - if (showSelection && entryPtr->state != STATE_DISABLED + if (showSelection && (entryPtr->state != STATE_DISABLED) && (entryPtr->selTextGC != entryPtr->textGC) && (entryPtr->selectFirst < entryPtr->selectLast)) { int selFirst; @@ -1531,29 +1933,106 @@ DisplayEntry(clientData) selFirst, entryPtr->selectLast); } + if (entryPtr->type == TK_SPINBOX) { + int startx, height, inset, pad, tHeight, xWidth; + Spinbox *sbPtr = (Spinbox *) entryPtr; + + /* + * Draw the spin button controls. + */ + xWidth = entryPtr->xWidth; + pad = XPAD + 1; + inset = entryPtr->inset - XPAD; + startx = Tk_Width(tkwin) - (xWidth + inset); + height = (Tk_Height(tkwin) - 2*inset)/2; +#if 0 + Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder, + startx, inset, xWidth, height, 1, sbPtr->buRelief); + Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder, + startx, inset+height, xWidth, height, 1, sbPtr->bdRelief); +#else + Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder, + startx, inset, xWidth, height, 1, + (sbPtr->selElement == SEL_BUTTONUP) ? + TK_RELIEF_SUNKEN : TK_RELIEF_RAISED); + Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder, + startx, inset+height, xWidth, height, 1, + (sbPtr->selElement == SEL_BUTTONDOWN) ? + TK_RELIEF_SUNKEN : TK_RELIEF_RAISED); +#endif + + xWidth -= 2*pad; + /* + * Only draw the triangles if we have enough display space + */ + if ((xWidth > 1)) { + XPoint points[3]; + int starty, space, offset; + + space = height - 2*pad; + /* + * Ensure width of triangle is odd to guarantee a sharp tip + */ + if (!(xWidth % 2)) { + xWidth++; + } + tHeight = (xWidth + 1) / 2; + if (tHeight > space) { + tHeight = space; + } + space = (space - tHeight) / 2; + startx += pad; + starty = inset + height - pad - space; + offset = (sbPtr->selElement == SEL_BUTTONUP); + /* + * The points are slightly different for the up and down arrows + * because (for *.x), we need to account for a bug in the way + * XFillPolygon draws triangles, and we want to shift + * the arrows differently when allowing for depressed behavior. + */ + points[0].x = startx + offset; + points[0].y = starty + (offset ? 0 : -1); + points[1].x = startx + xWidth/2 + offset; + points[1].y = starty - tHeight + (offset ? 0 : -1); + points[2].x = startx + xWidth + offset; + points[2].y = points[0].y; + XFillPolygon(entryPtr->display, pixmap, entryPtr->textGC, + points, 3, Convex, CoordModeOrigin); + + starty = inset + height + pad + space; + offset = (sbPtr->selElement == SEL_BUTTONDOWN); + points[0].x = startx + 1 + offset; + points[0].y = starty + (offset ? 1 : 0); + points[1].x = startx + xWidth/2 + offset; + points[1].y = starty + tHeight + (offset ? 0 : -1); + points[2].x = startx - 1 + xWidth + offset; + points[2].y = points[0].y; + XFillPolygon(entryPtr->display, pixmap, entryPtr->textGC, + points, 3, Convex, CoordModeOrigin); + } + } + /* * Draw the border and focus highlight last, so they will overwrite * any text that extends past the viewable part of the window. */ + xBound = entryPtr->highlightWidth; if (entryPtr->relief != TK_RELIEF_FLAT) { - Tk_Draw3DRectangle(tkwin, pixmap, border, - entryPtr->highlightWidth, entryPtr->highlightWidth, - Tk_Width(tkwin) - 2 * entryPtr->highlightWidth, - Tk_Height(tkwin) - 2 * entryPtr->highlightWidth, + Tk_Draw3DRectangle(tkwin, pixmap, border, xBound, xBound, + Tk_Width(tkwin) - 2 * xBound, + Tk_Height(tkwin) - 2 * xBound, entryPtr->borderWidth, entryPtr->relief); } - if (entryPtr->highlightWidth != 0) { + if (xBound > 0) { GC fgGC, bgGC; bgGC = Tk_GCForColor(entryPtr->highlightBgColorPtr, pixmap); if (entryPtr->flags & GOT_FOCUS) { fgGC = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap); - TkpDrawHighlightBorder(tkwin, fgGC, bgGC, - entryPtr->highlightWidth, pixmap); + TkpDrawHighlightBorder(tkwin, fgGC, bgGC, xBound, pixmap); } else { - TkpDrawHighlightBorder(tkwin, bgGC, bgGC, - entryPtr->highlightWidth, pixmap); + TkpDrawHighlightBorder(tkwin, bgGC, bgGC, xBound, pixmap); } } @@ -1634,6 +2113,7 @@ EntryComputeGeometry(entryPtr) } *p = '\0'; } + Tk_FreeTextLayout(entryPtr->textLayout); entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont, entryPtr->displayString, entryPtr->numChars, 0, @@ -1648,16 +2128,18 @@ EntryComputeGeometry(entryPtr) * window unless the entire window is full. */ - overflow = totalLength - (Tk_Width(entryPtr->tkwin) - 2*entryPtr->inset); + overflow = totalLength - + (Tk_Width(entryPtr->tkwin) - 2*entryPtr->inset - entryPtr->xWidth); if (overflow <= 0) { entryPtr->leftIndex = 0; if (entryPtr->justify == TK_JUSTIFY_LEFT) { entryPtr->leftX = entryPtr->inset; } else if (entryPtr->justify == TK_JUSTIFY_RIGHT) { entryPtr->leftX = Tk_Width(entryPtr->tkwin) - entryPtr->inset - - totalLength; + - entryPtr->xWidth - totalLength; } else { - entryPtr->leftX = (Tk_Width(entryPtr->tkwin) - totalLength)/2; + entryPtr->leftX = (Tk_Width(entryPtr->tkwin) + - entryPtr->xWidth - totalLength)/2; } entryPtr->layoutX = entryPtr->leftX; } else { @@ -1694,6 +2176,12 @@ EntryComputeGeometry(entryPtr) width = totalLength + 2*entryPtr->inset; } } + + /* + * Add one extra length for the spin buttons + */ + width += entryPtr->xWidth; + Tk_GeometryRequest(entryPtr->tkwin, width, height); } @@ -1793,7 +2281,7 @@ InsertChars(entryPtr, index, value) if (entryPtr->insertPos >= index) { entryPtr->insertPos += charsAdded; } - EntryValueChanged(entryPtr); + EntryValueChanged(entryPtr, NULL); } /* @@ -1907,7 +2395,7 @@ DeleteChars(entryPtr, index, count) entryPtr->insertPos = index; } } - EntryValueChanged(entryPtr); + EntryValueChanged(entryPtr, NULL); } /* @@ -1930,10 +2418,14 @@ DeleteChars(entryPtr, index, count) */ static void -EntryValueChanged(entryPtr) +EntryValueChanged(entryPtr, newValue) Entry *entryPtr; /* Entry whose value just changed. */ + char *newValue; /* If this value is not NULL, we first + * force the value of the entry to this */ { - char *newValue; + if (newValue != NULL) { + EntrySetValue(entryPtr, newValue); + } if (entryPtr->textVarName == NULL) { newValue = NULL; @@ -2073,7 +2565,7 @@ EntrySetValue(entryPtr, value) * EntryEventProc -- * * This procedure is invoked by the Tk dispatcher for various - * events on entryes. + * events on entries. * * Results: * None. @@ -2091,26 +2583,54 @@ EntryEventProc(clientData, eventPtr) XEvent *eventPtr; /* Information about event. */ { Entry *entryPtr = (Entry *) clientData; - if (eventPtr->type == Expose) { - EventuallyRedraw(entryPtr); - entryPtr->flags |= BORDER_NEEDED; - } else if (eventPtr->type == DestroyNotify) { - DestroyEntry((char *) clientData); - } else if (eventPtr->type == ConfigureNotify) { - Tcl_Preserve((ClientData) entryPtr); - entryPtr->flags |= UPDATE_SCROLLBAR; - EntryComputeGeometry(entryPtr); - EventuallyRedraw(entryPtr); - Tcl_Release((ClientData) entryPtr); - } else if (eventPtr->type == FocusIn) { - if (eventPtr->xfocus.detail != NotifyInferior) { - EntryFocusProc(entryPtr, 1); - } - } else if (eventPtr->type == FocusOut) { - if (eventPtr->xfocus.detail != NotifyInferior) { - EntryFocusProc(entryPtr, 0); + + if ((entryPtr->type == TK_SPINBOX) && (eventPtr->type == MotionNotify)) { + Spinbox *sbPtr = (Spinbox *) clientData; + int elem; + + elem = GetSpinboxElement(sbPtr, eventPtr->xmotion.x, + eventPtr->xmotion.y); + if (elem != sbPtr->curElement) { + Tk_Cursor cursor; + + sbPtr->curElement = elem; + if (elem == SEL_ENTRY) { + cursor = entryPtr->cursor; + } else if ((elem == SEL_BUTTONDOWN) || (elem == SEL_BUTTONUP)) { + cursor = sbPtr->bCursor; + } else { + cursor = None; + } + if (cursor != None) { + Tk_DefineCursor(entryPtr->tkwin, cursor); + } else { + Tk_UndefineCursor(entryPtr->tkwin); + } } } + + switch (eventPtr->type) { + case Expose: + EventuallyRedraw(entryPtr); + entryPtr->flags |= BORDER_NEEDED; + break; + case DestroyNotify: + DestroyEntry((char *) clientData); + break; + case ConfigureNotify: + Tcl_Preserve((ClientData) entryPtr); + entryPtr->flags |= UPDATE_SCROLLBAR; + EntryComputeGeometry(entryPtr); + EventuallyRedraw(entryPtr); + Tcl_Release((ClientData) entryPtr); + break; + case FocusIn: + case FocusOut: + if (eventPtr->xfocus.detail != NotifyInferior) { + EntryFocusProc(entryPtr, (eventPtr->type == FocusIn)); + } + break; + } } /* @@ -2195,8 +2715,9 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) */ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); - Tcl_AppendResult(interp, "bad entry index \"", string, - "\"", (char *) NULL); + Tcl_AppendResult(interp, "bad ", + (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox", + " index \"", string, "\"", (char *) NULL); return TCL_ERROR; } } else if (string[0] == 'e') { @@ -2213,7 +2734,9 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) } } else if (string[0] == 's') { if (entryPtr->selectFirst < 0) { - Tcl_SetResult(interp, "selection isn't in entry", TCL_STATIC); + Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); + Tcl_AppendResult(interp, "selection isn't in widget ", + Tk_PathName(entryPtr->tkwin), (char *) NULL); return TCL_ERROR; } if (length < 5) { @@ -2227,7 +2750,7 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) goto badIndex; } } else if (string[0] == '@') { - int x, roundUp; + int x, roundUp, maxWidth; if (Tcl_GetInt(interp, string + 1, &x) != TCL_OK) { goto badIndex; @@ -2236,8 +2759,10 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) x = entryPtr->inset; } roundUp = 0; - if (x >= (Tk_Width(entryPtr->tkwin) - entryPtr->inset)) { - x = Tk_Width(entryPtr->tkwin) - entryPtr->inset - 1; + maxWidth = Tk_Width(entryPtr->tkwin) - entryPtr->inset + - entryPtr->xWidth - 1; + if (x > maxWidth) { + x = maxWidth; roundUp = 1; } *indexPtr = Tk_PointToChar(entryPtr->textLayout, @@ -2554,7 +3079,7 @@ EntryVisibleRange(entryPtr, firstPtr, lastPtr) } else { charsInWindow = Tk_PointToChar(entryPtr->textLayout, Tk_Width(entryPtr->tkwin) - entryPtr->inset - - entryPtr->layoutX - 1, 0); + - entryPtr->xWidth - entryPtr->layoutX - 1, 0); if (charsInWindow < entryPtr->numChars) { charsInWindow++; } @@ -2609,7 +3134,9 @@ EntryUpdateScrollbar(entryPtr) code = Tcl_VarEval(interp, entryPtr->scrollCmd, args, (char *) NULL); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, - "\n (horizontal scrolling command executed by entry)"); + "\n (horizontal scrolling command executed by "); + Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin)); + Tcl_AddErrorInfo(interp, ")"); Tcl_BackgroundError(interp); } Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); @@ -2648,11 +3175,11 @@ EntryBlinkProc(clientData) if (entryPtr->flags & CURSOR_ON) { entryPtr->flags &= ~CURSOR_ON; entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - entryPtr->insertOffTime, EntryBlinkProc, (ClientData) entryPtr); + entryPtr->insertOffTime, EntryBlinkProc, (ClientData) entryPtr); } else { entryPtr->flags |= CURSOR_ON; entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - entryPtr->insertOnTime, EntryBlinkProc, (ClientData) entryPtr); + entryPtr->insertOnTime, EntryBlinkProc, (ClientData) entryPtr); } EventuallyRedraw(entryPtr); } @@ -2800,13 +3327,21 @@ EntryValidate(entryPtr, cmd) code = Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); + /* + * We accept TCL_OK and TCL_RETURN as valid return codes from the + * command callback. + */ if (code != TCL_OK && code != TCL_RETURN) { - Tcl_AddErrorInfo(interp, - "\n\t(in validation command executed by entry)"); + Tcl_AddErrorInfo(interp, "\n\t(in validation command executed by "); + Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin)); + Tcl_AddErrorInfo(interp, ")"); Tcl_BackgroundError(interp); return TCL_ERROR; } + /* + * The command callback should return an acceptable Tcl boolean. + */ if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp), &bool) != TCL_OK) { Tcl_AddErrorInfo(interp, @@ -3004,68 +3539,1034 @@ ExpandPercents(entryPtr, before, change, new, index, type, dsPtr) } else { ch = '%'; } - switch (ch) { - case 'd': /* Type of call that caused validation */ - switch (type) { - case VALIDATE_INSERT: - number = 1; - break; - case VALIDATE_DELETE: - number = 0; - break; - default: - number = -1; - break; - } - sprintf(numStorage, "%d", number); - string = numStorage; + if (type == VALIDATE_BUTTON) { + /* + * -command %-substitution + */ + switch (ch) { + case 's': /* Current string value of spinbox */ + string = entryPtr->string; + break; + case 'd': /* direction, up or down */ + string = change; + break; + case 'W': /* widget name */ + string = Tk_PathName(entryPtr->tkwin); + break; + default: + length = Tcl_UniCharToUtf(ch, numStorage); + numStorage[length] = '\0'; + string = numStorage; + break; + } + } else { + /* + * -validatecommand / -invalidcommand %-substitution + */ + switch (ch) { + case 'd': /* Type of call that caused validation */ + switch (type) { + case VALIDATE_INSERT: + number = 1; + break; + case VALIDATE_DELETE: + number = 0; + break; + default: + number = -1; + break; + } + sprintf(numStorage, "%d", number); + string = numStorage; + break; + case 'i': /* index of insert/delete */ + sprintf(numStorage, "%d", index); + string = numStorage; + break; + case 'P': /* 'Peeked' new value of the string */ + string = new; + break; + case 's': /* Current string value of spinbox */ + string = entryPtr->string; + break; + case 'S': /* string to be inserted/deleted, if any */ + string = change; + break; + case 'v': /* type of validation currently set */ + string = validateStrings[entryPtr->validate]; + break; + case 'V': /* type of validation in effect */ + switch (type) { + case VALIDATE_INSERT: + case VALIDATE_DELETE: + string = validateStrings[VALIDATE_KEY]; + break; + case VALIDATE_FORCED: + string = "forced"; + break; + default: + string = validateStrings[type]; + break; + } + break; + case 'W': /* widget name */ + string = Tk_PathName(entryPtr->tkwin); + break; + default: + length = Tcl_UniCharToUtf(ch, numStorage); + numStorage[length] = '\0'; + string = numStorage; + break; + } + } + + spaceNeeded = Tcl_ScanCountedElement(string, -1, &cvtFlags); + length = Tcl_DStringLength(dsPtr); + Tcl_DStringSetLength(dsPtr, length + spaceNeeded); + spaceNeeded = Tcl_ConvertCountedElement(string, -1, + Tcl_DStringValue(dsPtr) + length, + cvtFlags | TCL_DONT_USE_BRACES); + Tcl_DStringSetLength(dsPtr, length + spaceNeeded); + } +} + +/* + *-------------------------------------------------------------- + * + * Tk_SpinboxObjCmd -- + * + * This procedure is invoked to process the "spinbox" Tcl + * command. See the user documentation for details on what + * it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Tk_SpinboxObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to option table. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register Entry *entryPtr; + register Spinbox *sbPtr; + Tk_OptionTable optionTable; + Tk_Window tkwin; + + optionTable = (Tk_OptionTable) clientData; + if (optionTable == NULL) { + Tcl_CmdInfo info; + char *name; + + /* + * We haven't created the option table for this widget class + * yet. Do it now and save the table as the clientData for + * the command, so we'll have access to it in future + * invocations of the command. + */ + + optionTable = Tk_CreateOptionTable(interp, sbOptSpec); + name = Tcl_GetString(objv[0]); + Tcl_GetCommandInfo(interp, name, &info); + info.objClientData = (ClientData) optionTable; + Tcl_SetCommandInfo(interp, name, &info); + } + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + return TCL_ERROR; + } + + tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), + Tcl_GetString(objv[1]), (char *) NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + + /* + * Initialize the fields of the structure that won't be initialized + * by ConfigureEntry, or that ConfigureEntry requires to be + * initialized already (e.g. resource pointers). Only the non-NULL/0 + * data must be initialized as memset covers the rest. + */ + + sbPtr = (Spinbox *) ckalloc(sizeof(Spinbox)); + entryPtr = (Entry *) sbPtr; + memset((VOID *) sbPtr, 0, sizeof(Spinbox)); + + entryPtr->tkwin = tkwin; + entryPtr->display = Tk_Display(tkwin); + entryPtr->interp = interp; + entryPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(entryPtr->tkwin), SpinboxWidgetObjCmd, + (ClientData) sbPtr, EntryCmdDeletedProc); + entryPtr->optionTable = optionTable; + entryPtr->type = TK_SPINBOX; + entryPtr->string = (char *) ckalloc(1); + entryPtr->string[0] = '\0'; + entryPtr->selectFirst = -1; + entryPtr->selectLast = -1; + + entryPtr->cursor = None; + entryPtr->exportSelection = 1; + entryPtr->justify = TK_JUSTIFY_LEFT; + entryPtr->relief = TK_RELIEF_FLAT; + entryPtr->state = STATE_NORMAL; + entryPtr->displayString = entryPtr->string; + entryPtr->inset = XPAD; + entryPtr->textGC = None; + entryPtr->selTextGC = None; + entryPtr->highlightGC = None; + entryPtr->avgWidth = 1; + entryPtr->validate = VALIDATE_NONE; + + sbPtr->selElement = SEL_NONE; + sbPtr->curElement = SEL_NONE; + sbPtr->bCursor = None; + sbPtr->repeatDelay = 400; + sbPtr->repeatInterval = 100; + sbPtr->fromValue = 0.0; + sbPtr->toValue = 100.0; + sbPtr->increment = 1.0; + sbPtr->formatBuf = (char *) ckalloc(TCL_DOUBLE_SPACE); + sbPtr->bdRelief = TK_RELIEF_FLAT; + sbPtr->buRelief = TK_RELIEF_FLAT; + + Tk_SetClass(entryPtr->tkwin, "Spinbox"); + TkSetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr); + Tk_CreateEventHandler(entryPtr->tkwin, + PointerMotionMask|ExposureMask|StructureNotifyMask|FocusChangeMask, + EntryEventProc, (ClientData) entryPtr); + Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING, + EntryFetchSelection, (ClientData) entryPtr, XA_STRING); + + if (Tk_InitOptions(interp, (char *) sbPtr, optionTable, tkwin) + != TCL_OK) { + Tk_DestroyWindow(entryPtr->tkwin); + return TCL_ERROR; + } + if (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK) { + goto error; + } + + Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC); + return TCL_OK; + + error: + Tk_DestroyWindow(entryPtr->tkwin); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * SpinboxWidgetObjCmd -- + * + * This procedure is invoked to process the Tcl command + * that corresponds to a widget managed by this module. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +static int +SpinboxWidgetObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Information about spinbox widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + Entry *entryPtr = (Entry *) clientData; + Spinbox *sbPtr = (Spinbox *) clientData; + int cmdIndex, selIndex, result; + Tcl_Obj *objPtr; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + return TCL_ERROR; + } + Tcl_Preserve((ClientData) entryPtr); + + /* + * Parse the widget command by looking up the second token in + * the list of valid command names. + */ + + result = Tcl_GetIndexFromObj(interp, objv[1], sbCmdNames, + "option", 0, &cmdIndex); + if (result != TCL_OK) { + return result; + } + + switch ((enum sbCmd) cmdIndex) { + case SB_CMD_BBOX: { + int index, x, y, width, height; + char buf[TCL_INTEGER_SPACE * 4]; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &index) != TCL_OK) { + goto error; + } + if ((index == entryPtr->numChars) && (index > 0)) { + index--; + } + Tk_CharBbox(entryPtr->textLayout, index, &x, &y, + &width, &height); + sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX, + y + entryPtr->layoutY, width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); break; - case 'i': /* index of insert/delete */ - sprintf(numStorage, "%d", index); - string = numStorage; + } + + case SB_CMD_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option"); + goto error; + } + + objPtr = Tk_GetOptionValue(interp, (char *) entryPtr, + entryPtr->optionTable, objv[2], entryPtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); + } break; - case 'P': /* 'Peeked' new value of the string */ - string = new; + } + + case SB_CMD_CONFIGURE: { + if (objc <= 3) { + objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr, + entryPtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + entryPtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); + } + } else { + result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0); + } break; - case 's': /* Current string value of entry */ - string = entryPtr->string; + } + + case SB_CMD_DELETE: { + int first, last; + + if ((objc < 3) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &first) != TCL_OK) { + goto error; + } + if (objc == 3) { + last = first + 1; + } else { + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]), + &last) != TCL_OK) { + goto error; + } + } + if ((last >= first) && (entryPtr->state == STATE_NORMAL)) { + DeleteChars(entryPtr, first, last - first); + } break; - case 'S': /* string to be inserted/deleted, if any */ - string = change; + } + + case SB_CMD_GET: { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL); + goto error; + } + Tcl_SetResult(interp, entryPtr->string, TCL_STATIC); + break; + } + + case SB_CMD_ICURSOR: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "pos"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &entryPtr->insertPos) != TCL_OK) { + goto error; + } + EventuallyRedraw(entryPtr); break; - case 'v': /* type of validation currently set */ - string = validateStrings[entryPtr->validate]; + } + + case SB_CMD_IDENTIFY: { + int x, y, elem; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "x y"); + goto error; + } + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) || + (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { + goto error; + } + elem = GetSpinboxElement(sbPtr, x, y); + if (elem != SEL_NONE) { + Tcl_SetResult(interp, selElementNames[elem], TCL_VOLATILE); + } break; - case 'V': /* type of validation in effect */ - switch (type) { - case VALIDATE_INSERT: - case VALIDATE_DELETE: - string = validateStrings[VALIDATE_KEY]; - break; - case VALIDATE_FORCED: - string = "forced"; - break; - default: - string = validateStrings[type]; - break; + } + + case SB_CMD_INDEX: { + int index; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "string"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &index) != TCL_OK) { + goto error; } + Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); break; - case 'W': /* widget name */ - string = Tk_PathName(entryPtr->tkwin); + } + + case SB_CMD_INSERT: { + int index; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "index text"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &index) != TCL_OK) { + goto error; + } + if (entryPtr->state == STATE_NORMAL) { + InsertChars(entryPtr, index, Tcl_GetString(objv[3])); + } break; - default: - length = Tcl_UniCharToUtf(ch, numStorage); - numStorage[length] = '\0'; - string = numStorage; + } + + case SB_CMD_INVOKE: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "elemName"); + goto error; + } + result = Tcl_GetIndexFromObj(interp, objv[2], + selElementNames, "element", 0, &cmdIndex); + if (result != TCL_OK) { + goto error; + } + if (entryPtr->state != STATE_DISABLED) { + if (SpinboxInvoke(interp, sbPtr, cmdIndex) != TCL_OK) { + goto error; + } + } break; } - spaceNeeded = Tcl_ScanCountedElement(string, -1, &cvtFlags); - length = Tcl_DStringLength(dsPtr); - Tcl_DStringSetLength(dsPtr, length + spaceNeeded); - spaceNeeded = Tcl_ConvertCountedElement(string, -1, - Tcl_DStringValue(dsPtr) + length, - cvtFlags | TCL_DONT_USE_BRACES); - Tcl_DStringSetLength(dsPtr, length + spaceNeeded); + case SB_CMD_SCAN: { + int x; + char *minorCmd; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x"); + goto error; + } + if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) { + goto error; + } + + minorCmd = Tcl_GetString(objv[2]); + if (minorCmd[0] == 'm' + && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) { + entryPtr->scanMarkX = x; + entryPtr->scanMarkIndex = entryPtr->leftIndex; + } else if ((minorCmd[0] == 'd') + && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { + EntryScanTo(entryPtr, x); + } else { + Tcl_AppendResult(interp, "bad scan option \"", + Tcl_GetString(objv[2]), "\": must be mark or dragto", + (char *) NULL); + goto error; + } + break; + } + + case SB_CMD_SELECTION: { + int index, index2; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option ?index?"); + goto error; + } + + /* + * Parse the selection sub-command, using the command + * table "sbSelCmdNames" defined above. + */ + + result = Tcl_GetIndexFromObj(interp, objv[2], sbSelCmdNames, + "selection option", 0, &selIndex); + if (result != TCL_OK) { + goto error; + } + + /* + * Disabled entries don't allow the selection to be modified. + */ + + if (entryPtr->state == STATE_DISABLED) { + goto done; + } + + switch(selIndex) { + case SB_SEL_ADJUST: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[3]), &index) != TCL_OK) { + goto error; + } + if (entryPtr->selectFirst >= 0) { + int half1, half2; + + half1 = (entryPtr->selectFirst + + entryPtr->selectLast)/2; + half2 = (entryPtr->selectFirst + + entryPtr->selectLast + 1)/2; + if (index < half1) { + entryPtr->selectAnchor = entryPtr->selectLast; + } else if (index > half2) { + entryPtr->selectAnchor = entryPtr->selectFirst; + } else { + /* + * We're at about the halfway point in the + * selection; just keep the existing anchor. + */ + } + } + EntrySelectTo(entryPtr, index); + break; + } + + case SB_SEL_CLEAR: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL); + goto error; + } + if (entryPtr->selectFirst >= 0) { + entryPtr->selectFirst = -1; + entryPtr->selectLast = -1; + EventuallyRedraw(entryPtr); + } + goto done; + } + + case SB_SEL_FROM: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[3]), &index) != TCL_OK) { + goto error; + } + entryPtr->selectAnchor = index; + break; + } + + case SB_SEL_PRESENT: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL); + goto error; + } + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + goto done; + } + + case SB_SEL_RANGE: { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 3, objv, "start end"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[3]), &index) != TCL_OK) { + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[4]),& index2) != TCL_OK) { + goto error; + } + if (index >= index2) { + entryPtr->selectFirst = -1; + entryPtr->selectLast = -1; + } else { + entryPtr->selectFirst = index; + entryPtr->selectLast = index2; + } + if (!(entryPtr->flags & GOT_SELECTION) + && (entryPtr->exportSelection)) { + Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, + EntryLostSelection, (ClientData) entryPtr); + entryPtr->flags |= GOT_SELECTION; + } + EventuallyRedraw(entryPtr); + break; + } + + case SB_SEL_TO: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[3]), &index) != TCL_OK) { + goto error; + } + EntrySelectTo(entryPtr, index); + break; + } + + case SB_SEL_ELEMENT: { + if ((objc < 3) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 3, objv, "?elemName?"); + goto error; + } + if (objc == 3) { + Tcl_SetResult(interp, + selElementNames[sbPtr->selElement], + TCL_VOLATILE); + } else { + int lastElement = sbPtr->selElement; + + result = Tcl_GetIndexFromObj(interp, objv[3], + selElementNames, "selection element", 0, + &(sbPtr->selElement)); + if (result != TCL_OK) { + goto error; + } + if (lastElement != sbPtr->selElement) { + EventuallyRedraw(entryPtr); + } + } + break; + } + } + break; + } + + case SB_CMD_SET: { + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?string?"); + goto error; + } + if (objc == 3) { + EntryValueChanged(entryPtr, Tcl_GetString(objv[2])); + } + Tcl_SetResult(interp, entryPtr->string, TCL_STATIC); + break; + } + + case SB_CMD_VALIDATE: { + int code; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL); + goto error; + } + selIndex = entryPtr->validate; + entryPtr->validate = VALIDATE_ALL; + code = EntryValidateChange(entryPtr, (char *) NULL, + entryPtr->string, -1, VALIDATE_FORCED); + if (entryPtr->validate != VALIDATE_NONE) { + entryPtr->validate = selIndex; + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK))); + break; + } + + case SB_CMD_XVIEW: { + int index; + + if (objc == 2) { + double first, last; + char buf[TCL_DOUBLE_SPACE * 2]; + + EntryVisibleRange(entryPtr, &first, &last); + sprintf(buf, "%g %g", first, last); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + goto done; + } else if (objc == 3) { + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &index) != TCL_OK) { + goto error; + } + } else { + double fraction; + int count; + + index = entryPtr->leftIndex; + switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, + &count)) { + case TK_SCROLL_ERROR: { + goto error; + } + case TK_SCROLL_MOVETO: { + index = (int) ((fraction * entryPtr->numChars) + 0.5); + break; + } + case TK_SCROLL_PAGES: { + int charsPerPage; + + charsPerPage = ((Tk_Width(entryPtr->tkwin) + - 2 * entryPtr->inset - entryPtr->xWidth) + / entryPtr->avgWidth) - 2; + if (charsPerPage < 1) { + charsPerPage = 1; + } + index += count * charsPerPage; + break; + } + case TK_SCROLL_UNITS: { + index += count; + break; + } + } + } + if (index >= entryPtr->numChars) { + index = entryPtr->numChars - 1; + } + if (index < 0) { + index = 0; + } + entryPtr->leftIndex = index; + entryPtr->flags |= UPDATE_SCROLLBAR; + EntryComputeGeometry(entryPtr); + EventuallyRedraw(entryPtr); + break; + } + } + + done: + Tcl_Release((ClientData) entryPtr); + return result; + + error: + Tcl_Release((ClientData) entryPtr); + return TCL_ERROR; +} + +/* + *--------------------------------------------------------------------------- + * + * GetSpinboxElement -- + * + * Return the element associated with an x,y coord. + * + * Results: + * Element type as enum selelement. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static int +GetSpinboxElement(sbPtr, x, y) + Spinbox *sbPtr; /* Spinbox for which the index is being + * specified. */ + int x; /* x coord */ + int y; /* y coord */ +{ + Entry *entryPtr = (Entry *) sbPtr; + + if ((x < 0) || (y < 0) || (y > Tk_Height(entryPtr->tkwin)) + || (x > Tk_Width(entryPtr->tkwin))) { + return SEL_NONE; + } + + if (x > (Tk_Width(entryPtr->tkwin) - entryPtr->inset - entryPtr->xWidth)) { + if (y > (Tk_Height(entryPtr->tkwin) / 2)) { + return SEL_BUTTONDOWN; + } else { + return SEL_BUTTONUP; + } + } else { + return SEL_ENTRY; } + return SEL_ENTRY; +} + +/* + *-------------------------------------------------------------- + * + * SpinboxInvoke -- + * + * This procedure is invoked when the invoke method for the + * widget is called. + * + * Results: + * TCL_OK. + * + * Side effects: + * An background error condition may arise when invoking the + * callback. The widget value may change. + * + *-------------------------------------------------------------- + */ + +static int +SpinboxInvoke(interp, sbPtr, element) + register Tcl_Interp *interp; /* Current interpreter. */ + register Spinbox *sbPtr; /* Spinbox to invoke. */ + int element; /* element to invoke, either the "up" + * or "down" button. */ +{ + Entry *entryPtr = (Entry *) sbPtr; + char *type; + int code, up; + Tcl_DString script; + + switch (element) { + case SEL_BUTTONUP: + type = "up"; + up = 1; + break; + case SEL_BUTTONDOWN: + type = "down"; + up = 0; + break; + default: + return TCL_OK; + } + + if (fabs(sbPtr->increment) > MIN_DBL_VAL) { + if (sbPtr->listObj != NULL) { + Tcl_Obj *objPtr; + + Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr); + if (strcmp(Tcl_GetString(objPtr), entryPtr->string)) { + /* + * Somehow the string changed from what we expected, + * so let's do a search on the list to see if the current + * value is there. If not, move to the first element of + * the list. + */ + int i, listc, elemLen, length = entryPtr->numChars; + char *bytes; + Tcl_Obj **listv; + + Tcl_ListObjGetElements(interp, sbPtr->listObj, &listc, &listv); + for (i = 0; i < listc; i++) { + bytes = Tcl_GetStringFromObj(listv[i], &elemLen); + if ((length == elemLen) && + (memcmp(bytes, entryPtr->string, + (size_t) length) == 0)) { + sbPtr->eIndex = i; + break; + } + } + } + if (up) { + if (++sbPtr->eIndex >= sbPtr->nElements) { + if (sbPtr->wrap) { + sbPtr->eIndex = 0; + } else { + sbPtr->eIndex = sbPtr->nElements-1; + } + } + } else { + if (--sbPtr->eIndex < 0) { + if (sbPtr->wrap) { + sbPtr->eIndex = sbPtr->nElements-1; + } else { + sbPtr->eIndex = 0; + } + } + } + Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr); + EntryValueChanged(entryPtr, Tcl_GetString(objPtr)); + } else if (!DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)) { + double dvalue; + + if (Tcl_GetDouble(NULL, entryPtr->string, &dvalue) != TCL_OK) { + /* + * If the string is empty, or isn't a valid double value, + * just use the -from value + */ + dvalue = sbPtr->fromValue; + } else { + if (up) { + dvalue += sbPtr->increment; + if (dvalue > sbPtr->toValue) { + if (sbPtr->wrap) { + dvalue = sbPtr->fromValue; + } else { + dvalue = sbPtr->toValue; + } + } else if (dvalue < sbPtr->fromValue) { + /* + * It's possible that when pressing up, we are + * still less than the fromValue, because the + * user may have manipulated the value by hand. + */ + dvalue = sbPtr->fromValue; + } + } else { + dvalue -= sbPtr->increment; + if (dvalue < sbPtr->fromValue) { + if (sbPtr->wrap) { + dvalue = sbPtr->toValue; + } else { + dvalue = sbPtr->fromValue; + } + } else if (dvalue > sbPtr->toValue) { + /* + * It's possible that when pressing down, we are + * still greater than the toValue, because the + * user may have manipulated the value by hand. + */ + dvalue = sbPtr->toValue; + } + } + } + sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue); + EntryValueChanged(entryPtr, sbPtr->formatBuf); + } + } + + if (sbPtr->command != NULL) { + Tcl_DStringInit(&script); + ExpandPercents(entryPtr, sbPtr->command, type, "", 0, + VALIDATE_BUTTON, &script); + Tcl_DStringAppend(&script, "", 1); + + code = Tcl_EvalEx(interp, Tcl_DStringValue(&script), -1, + TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); + Tcl_DStringFree(&script); + + if (code != TCL_OK) { + Tcl_AddErrorInfo(interp, "\n\t(in command executed by spinbox)"); + Tcl_BackgroundError(interp); + /* + * Yes, it's an error, but a bg one, so we return OK + */ + return TCL_OK; + } + + Tcl_SetResult(interp, NULL, 0); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ComputeFormat -- + * + * This procedure is invoked to recompute the "format" fields + * of a spinbox's widget record, which determines how the value + * of the dial is converted to a string. + * + * Results: + * Tcl result code. + * + * Side effects: + * The format fields of the spinbox are modified. + * + *---------------------------------------------------------------------- + */ +static int +ComputeFormat(sbPtr) + Spinbox *sbPtr; /* Information about dial widget. */ +{ + double maxValue, x; + int mostSigDigit, numDigits, leastSigDigit, afterDecimal; + int eDigits, fDigits; + + /* + * Compute the displacement from the decimal of the most significant + * digit required for any number in the dial's range. + */ + + if (sbPtr->reqFormat) { + sbPtr->valueFormat = sbPtr->reqFormat; + return TCL_OK; + } + + maxValue = fabs(sbPtr->fromValue); + x = fabs(sbPtr->toValue); + if (x > maxValue) { + maxValue = x; + } + if (maxValue == 0) { + maxValue = 1; + } + mostSigDigit = (int) floor(log10(maxValue)); + + if (fabs(sbPtr->increment) > MIN_DBL_VAL) { + /* + * A increment was specified, so use it. + */ + leastSigDigit = (int) floor(log10(sbPtr->increment)); + } else { + leastSigDigit = 0; + } + numDigits = mostSigDigit - leastSigDigit + 1; + if (numDigits < 1) { + numDigits = 1; + } + + /* + * Compute the number of characters required using "e" format and + * "f" format, and then choose whichever one takes fewer characters. + */ + + eDigits = numDigits + 4; + if (numDigits > 1) { + eDigits++; /* Decimal point. */ + } + afterDecimal = numDigits - mostSigDigit - 1; + if (afterDecimal < 0) { + afterDecimal = 0; + } + fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal; + if (afterDecimal > 0) { + fDigits++; /* Decimal point. */ + } + if (mostSigDigit < 0) { + fDigits++; /* Zero to left of decimal point. */ + } + if (fDigits <= eDigits) { + sprintf(sbPtr->digitFormat, "%%.%df", afterDecimal); + } else { + sprintf(sbPtr->digitFormat, "%%.%de", numDigits-1); + } + sbPtr->valueFormat = sbPtr->digitFormat; + return TCL_OK; } diff --git a/generic/tkInt.h b/generic/tkInt.h index a944e38..bf85dcb 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.23 2000/04/19 01:06:51 ericm Exp $ + * RCS: $Id: tkInt.h,v 1.24 2000/05/29 01:43:14 hobbs Exp $ */ #ifndef _TKINT @@ -990,6 +990,9 @@ EXTERN int Tk_SendCmd _ANSI_ARGS_((ClientData clientData, EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tk_SpinboxObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_TextCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData, diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 7fa867f..d1238ac 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWindow.c,v 1.17 2000/04/28 00:46:04 ericm Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.18 2000/05/29 01:43:14 hobbs Exp $ */ #include "tkPort.h" @@ -145,6 +145,7 @@ static TkCmd commands[] = { {"radiobutton", NULL, Tk_RadiobuttonObjCmd, 1, 0}, {"scale", NULL, Tk_ScaleObjCmd, 1, 0}, {"scrollbar", Tk_ScrollbarCmd, NULL, 1, 1}, + {"spinbox", NULL, Tk_SpinboxObjCmd, 1, 0}, {"text", Tk_TextCmd, NULL, 1, 1}, {"toplevel", NULL, Tk_ToplevelObjCmd, 0, 1}, diff --git a/library/entry.tcl b/library/entry.tcl index a46561e..b44eaad 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk entry widgets and provides # procedures that help in implementing those bindings. # -# RCS: @(#) $Id: entry.tcl,v 1.12 2000/05/14 20:45:38 ericm Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.13 2000/05/29 01:43:14 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -336,7 +336,7 @@ proc tkEntryButton1 {w x} { set tkPriv(pressX) $x $w icursor [tkEntryClosestGap $w $x] $w selection from insert - if {[string compare [$w cget -state] "disabled"]} {focus $w} + if {[string compare "disabled" [$w cget -state]]} {focus $w} } # tkEntryMouseSelect -- @@ -406,7 +406,7 @@ proc tkEntryPaste {w x} { $w icursor [tkEntryClosestGap $w $x] catch {$w insert insert [selection get -displayof $w]} - if {[string equal [$w cget -state] "normal"]} {focus $w} + if {[string compare "disabled" [$w cget -state]]} {focus $w} } # tkEntryAutoScan -- diff --git a/library/spinbox.tcl b/library/spinbox.tcl new file mode 100644 index 0000000..b93479b --- /dev/null +++ b/library/spinbox.tcl @@ -0,0 +1,746 @@ +# spinbox.tcl -- +# +# This file defines the default bindings for Tk spinbox widgets and provides +# procedures that help in implementing those bindings. +# +# RCS: @(#) $Id: spinbox.tcl,v 1.1 2000/05/29 01:43:15 hobbs Exp $ +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1999-2000 Jeffrey Hobbs +# Copyright (c) 2000 Ajuba Solutions +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +#------------------------------------------------------------------------- +# Elements of tkPriv that are used in this file: +# +# afterId - If non-null, it means that auto-scanning is underway +# and it gives the "after" id for the next auto-scan +# command to be executed. +# mouseMoved - Non-zero means the mouse has moved a significant +# amount since the button went down (so, for example, +# start dragging out a selection). +# pressX - X-coordinate at which the mouse button was pressed. +# selectMode - The style of selection currently underway: +# char, word, or line. +# x, y - Last known mouse coordinates for scanning +# and auto-scanning. +# data - Used for Cut and Copy +#------------------------------------------------------------------------- + +# Initialize namespace +namespace eval ::tk::spinbox {} + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for entries. +#------------------------------------------------------------------------- +bind Spinbox <<Cut>> { + if {![catch {::tk::spinbox::GetSelection %W} tkPriv(data)]} { + clipboard clear -displayof %W + clipboard append -displayof %W $tkPriv(data) + %W delete sel.first sel.last + unset tkPriv(data) + } +} +bind Spinbox <<Copy>> { + if {![catch {::tk::spinbox::GetSelection %W} tkPriv(data)]} { + clipboard clear -displayof %W + clipboard append -displayof %W $tkPriv(data) + unset tkPriv(data) + } +} +bind Spinbox <<Paste>> { + global tcl_platform + catch { + if {[string compare $tcl_platform(platform) "unix"]} { + catch { + %W delete sel.first sel.last + } + } + %W insert insert [selection get -displayof %W -selection CLIPBOARD] + ::tk::spinbox::SeeInsert %W + } +} +bind Spinbox <<Clear>> { + %W delete sel.first sel.last +} +bind Spinbox <<PasteSelection>> { + if {!$tkPriv(mouseMoved) || $tk_strictMotif} { + ::tk::spinbox::Paste %W %x + } +} + +# Standard Motif bindings: + +bind Spinbox <1> { + ::tk::spinbox::ButtonDown %W %x %y +} +bind Spinbox <B1-Motion> { + ::tk::spinbox::Motion %W %x %y +} +bind Spinbox <Double-1> { + set tkPriv(selectMode) word + ::tk::spinbox::MouseSelect %W %x sel.first +} +bind Spinbox <Triple-1> { + set tkPriv(selectMode) line + ::tk::spinbox::MouseSelect %W %x 0 +} +bind Spinbox <Shift-1> { + set tkPriv(selectMode) char + %W selection adjust @%x +} +bind Spinbox <Double-Shift-1> { + set tkPriv(selectMode) word + ::tk::spinbox::MouseSelect %W %x +} +bind Spinbox <Triple-Shift-1> { + set tkPriv(selectMode) line + ::tk::spinbox::MouseSelect %W %x +} +bind Spinbox <B1-Leave> { + set tkPriv(x) %x + ::tk::spinbox::AutoScan %W +} +bind Spinbox <B1-Enter> { + tkCancelRepeat +} +bind Spinbox <ButtonRelease-1> { + ::tk::spinbox::ButtonUp %W %x %y +} +bind Spinbox <Control-1> { + %W icursor @%x +} + +bind Spinbox <Up> { + %W invoke buttonup +} +bind Spinbox <Down> { + %W invoke buttondown +} + +bind Spinbox <Left> { + ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}] +} +bind Spinbox <Right> { + ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}] +} +bind Spinbox <Shift-Left> { + ::tk::spinbox::KeySelect %W [expr {[%W index insert] - 1}] + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <Shift-Right> { + ::tk::spinbox::KeySelect %W [expr {[%W index insert] + 1}] + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <Control-Left> { + ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert] +} +bind Spinbox <Control-Right> { + ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert] +} +bind Spinbox <Shift-Control-Left> { + ::tk::spinbox::KeySelect %W [::tk::spinbox::PreviousWord %W insert] + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <Shift-Control-Right> { + ::tk::spinbox::KeySelect %W [::tk::spinbox::NextWord %W insert] + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <Home> { + ::tk::spinbox::SetCursor %W 0 +} +bind Spinbox <Shift-Home> { + ::tk::spinbox::KeySelect %W 0 + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <End> { + ::tk::spinbox::SetCursor %W end +} +bind Spinbox <Shift-End> { + ::tk::spinbox::KeySelect %W end + ::tk::spinbox::SeeInsert %W +} + +bind Spinbox <Delete> { + if {[%W selection present]} { + %W delete sel.first sel.last + } else { + %W delete insert + } +} +bind Spinbox <BackSpace> { + ::tk::spinbox::Backspace %W +} + +bind Spinbox <Control-space> { + %W selection from insert +} +bind Spinbox <Select> { + %W selection from insert +} +bind Spinbox <Control-Shift-space> { + %W selection adjust insert +} +bind Spinbox <Shift-Select> { + %W selection adjust insert +} +bind Spinbox <Control-slash> { + %W selection range 0 end +} +bind Spinbox <Control-backslash> { + %W selection clear +} +bind Spinbox <KeyPress> { + ::tk::spinbox::Insert %W %A +} + +# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Otherwise, if a widget binding for one of these is defined, the +# <KeyPress> class binding will also fire and insert the character, +# which is wrong. Ditto for Escape, Return, and Tab. + +bind Spinbox <Alt-KeyPress> {# nothing} +bind Spinbox <Meta-KeyPress> {# nothing} +bind Spinbox <Control-KeyPress> {# nothing} +bind Spinbox <Escape> {# nothing} +bind Spinbox <Return> {# nothing} +bind Spinbox <KP_Enter> {# nothing} +bind Spinbox <Tab> {# nothing} +if {[string equal $tcl_platform(platform) "macintosh"]} { + bind Spinbox <Command-KeyPress> {# nothing} +} + +# On Windows, paste is done using Shift-Insert. Shift-Insert already +# generates the <<Paste>> event, so we don't need to do anything here. +if {[string compare $tcl_platform(platform) "windows"]} { + bind Spinbox <Insert> { + catch {::tk::spinbox::Insert %W [selection get -displayof %W]} + } +} + +# Additional emacs-like bindings: + +bind Spinbox <Control-a> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W 0 + } +} +bind Spinbox <Control-b> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}] + } +} +bind Spinbox <Control-d> { + if {!$tk_strictMotif} { + %W delete insert + } +} +bind Spinbox <Control-e> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W end + } +} +bind Spinbox <Control-f> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}] + } +} +bind Spinbox <Control-h> { + if {!$tk_strictMotif} { + ::tk::spinbox::Backspace %W + } +} +bind Spinbox <Control-k> { + if {!$tk_strictMotif} { + %W delete insert end + } +} +bind Spinbox <Control-t> { + if {!$tk_strictMotif} { + ::tk::spinbox::Transpose %W + } +} +bind Spinbox <Meta-b> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert] + } +} +bind Spinbox <Meta-d> { + if {!$tk_strictMotif} { + %W delete insert [::tk::spinbox::NextWord %W insert] + } +} +bind Spinbox <Meta-f> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert] + } +} +bind Spinbox <Meta-BackSpace> { + if {!$tk_strictMotif} { + %W delete [::tk::spinbox::PreviousWord %W insert] insert + } +} +bind Spinbox <Meta-Delete> { + if {!$tk_strictMotif} { + %W delete [::tk::spinbox::PreviousWord %W insert] insert + } +} + +# A few additional bindings of my own. + +bind Spinbox <2> { + if {!$tk_strictMotif} { + %W scan mark %x + set tkPriv(x) %x + set tkPriv(y) %y + set tkPriv(mouseMoved) 0 + } +} +bind Spinbox <B2-Motion> { + if {!$tk_strictMotif} { + if {abs(%x-$tkPriv(x)) > 2} { + set tkPriv(mouseMoved) 1 + } + %W scan dragto %x + } +} + +# ::tk::spinbox::Invoke -- +# Invoke an element of the spinbox +# +# Arguments: +# w - The spinbox window. +# elem - Element to invoke + +proc ::tk::spinbox::Invoke {w elem} { + global tkPriv + + if {![info exists tkPriv(outsideElement)]} { + $w invoke $elem + incr tkPriv(repeated) + } + set delay [$w cget -repeatinterval] + if {$delay > 0} { + set tkPriv(afterId) [after $delay \ + [list ::tk::spinbox::Invoke $w $elem]] + } +} + +# ::tk::spinbox::ClosestGap -- +# Given x and y coordinates, this procedure finds the closest boundary +# between characters to the given coordinates and returns the index +# of the character just after the boundary. +# +# Arguments: +# w - The spinbox window. +# x - X-coordinate within the window. + +proc ::tk::spinbox::ClosestGap {w x} { + set pos [$w index @$x] + set bbox [$w bbox $pos] + if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { + return $pos + } + incr pos +} + +# ::tk::spinbox::ButtonDown -- +# This procedure is invoked to handle button-1 presses in spinbox +# widgets. It moves the insertion cursor, sets the selection anchor, +# and claims the input focus. +# +# Arguments: +# w - The spinbox window in which the button was pressed. +# x - The x-coordinate of the button press. + +proc ::tk::spinbox::ButtonDown {w x y} { + global tkPriv + + # Get the element that was clicked in. If we are not directly over + # the spinbox, default to entry. This is necessary for spinbox grabs. + # + set tkPriv(element) [$w identify $x $y] + if {$tkPriv(element) eq ""} { + set tkPriv(element) "entry" + } + + switch -exact $tkPriv(element) { + "buttonup" - "buttondown" { + if {[string compare "disabled" [$w cget -state]]} { + $w selection element $tkPriv(element) + set tkPriv(repeated) 0 + set tkPriv(relief) [$w cget -$tkPriv(element)relief] + after cancel $tkPriv(afterId) + set delay [$w cget -repeatdelay] + if {$delay > 0} { + set tkPriv(afterId) [after $delay \ + [list ::tk::spinbox::Invoke $w $tkPriv(element)]] + } + if {[info exists tkPriv(outsideElement)]} { + unset tkPriv(outsideElement) + } + } + } + "entry" { + set tkPriv(selectMode) char + set tkPriv(mouseMoved) 0 + set tkPriv(pressX) $x + $w icursor [::tk::spinbox::ClosestGap $w $x] + $w selection from insert + if {[string compare "disabled" [$w cget -state]]} {focus $w} + $w selection clear + } + default { + return -code error "unknown spinbox element \"$tkPriv(element)\"" + } + } +} + +# ::tk::spinbox::ButtonUp -- +# This procedure is invoked to handle button-1 releases in spinbox +# widgets. +# +# Arguments: +# w - The spinbox window in which the button was pressed. +# x - The x-coordinate of the button press. + +proc ::tk::spinbox::ButtonUp {w x y} { + global tkPriv + + tkCancelRepeat + + # tkPriv(relief) may not exist if the ButtonUp is not paired with + # a preceding ButtonDown + if {[info exists tkPriv(element)] && [info exists tkPriv(relief)] && \ + [string match "button*" $tkPriv(element)]} { + if {[info exists tkPriv(repeated)] && !$tkPriv(repeated)} { + $w invoke $tkPriv(element) + } + $w configure -$tkPriv(element)relief $tkPriv(relief) + $w selection element none + } +} + +# ::tk::spinbox::MouseSelect -- +# This procedure is invoked when dragging out a selection with +# the mouse. Depending on the selection mode (character, word, +# line) it selects in different-sized units. This procedure +# ignores mouse motions initially until the mouse has moved from +# one character to another or until there have been multiple clicks. +# +# Arguments: +# w - The spinbox window in which the button was pressed. +# x - The x-coordinate of the mouse. +# cursor - optional place to set cursor. + +proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { + global tkPriv + + if {[string compare "entry" $tkPriv(element)]} { + if {[string compare "none" $tkPriv(element)] && \ + [string compare "ignore" $cursor]} { + $w selection element none + $w invoke $tkPriv(element) + $w selection element $tkPriv(element) + } + return + } + set cur [::tk::spinbox::ClosestGap $w $x] + set anchor [$w index anchor] + if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} { + set tkPriv(mouseMoved) 1 + } + switch $tkPriv(selectMode) { + char { + if {$tkPriv(mouseMoved)} { + if {$cur < $anchor} { + $w selection range $cur $anchor + } elseif {$cur > $anchor} { + $w selection range $anchor $cur + } else { + $w selection clear + } + } + } + word { + if {$cur < [$w index anchor]} { + set before [tcl_wordBreakBefore [$w get] $cur] + set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]] + } else { + set before [tcl_wordBreakBefore [$w get] $anchor] + set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]] + } + if {$before < 0} { + set before 0 + } + if {$after < 0} { + set after end + } + $w selection range $before $after + } + line { + $w selection range 0 end + } + } + if {[string compare $cursor {}] && [string compare $cursor "ignore"]} { + catch {$w icursor $cursor} + } + update idletasks +} + +# ::tk::spinbox::Paste -- +# This procedure sets the insertion cursor to the current mouse position, +# pastes the selection there, and sets the focus to the window. +# +# Arguments: +# w - The spinbox window. +# x - X position of the mouse. + +proc ::tk::spinbox::Paste {w x} { + global tkPriv + + $w icursor [::tk::spinbox::ClosestGap $w $x] + catch {$w insert insert [selection get -displayof $w]} + if {[string equal "disabled" [$w cget -state]]} {focus $w} +} + +# ::tk::spinbox::Motion -- +# This procedure is invoked when the mouse moves in a spinbox window +# with button 1 down. +# +# Arguments: +# w - The spinbox window. + +proc ::tk::spinbox::Motion {w x y} { + global tkPriv + + if {![info exists tkPriv(element)]} { + set tkPriv(element) [$w identify $x $y] + } + + set tkPriv(x) $x + if {[string equal "entry" $tkPriv(element)]} { + ::tk::spinbox::MouseSelect $w $x ignore + } elseif {[string compare [$w identify $x $y] $tkPriv(element)]} { + if {![info exists tkPriv(outsideElement)]} { + # We've wandered out of the spin button + # setting outside element will cause ::tk::spinbox::Invoke to + # loop without doing anything + set tkPriv(outsideElement) "" + $w selection element none + } + } elseif {[info exists tkPriv(outsideElement)]} { + unset tkPriv(outsideElement) + $w selection element $tkPriv(element) + } +} + +# ::tk::spinbox::AutoScan -- +# This procedure is invoked when the mouse leaves an spinbox window +# with button 1 down. It scrolls the window left or right, +# depending on where the mouse is, and reschedules itself as an +# "after" command so that the window continues to scroll until the +# mouse moves back into the window or the mouse button is released. +# +# Arguments: +# w - The spinbox window. + +proc ::tk::spinbox::AutoScan {w} { + global tkPriv + + set x $tkPriv(x) + if {$x >= [winfo width $w]} { + $w xview scroll 2 units + ::tk::spinbox::MouseSelect $w $x ignore + } elseif {$x < 0} { + $w xview scroll -2 units + ::tk::spinbox::MouseSelect $w $x ignore + } + set tkPriv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]] +} + +# ::tk::spinbox::KeySelect -- +# This procedure is invoked when stroking out selections using the +# keyboard. It moves the cursor to a new position, then extends +# the selection to that position. +# +# Arguments: +# w - The spinbox window. +# new - A new position for the insertion cursor (the cursor hasn't +# actually been moved to this position yet). + +proc ::tk::spinbox::KeySelect {w new} { + if {![$w selection present]} { + $w selection from insert + $w selection to $new + } else { + $w selection adjust $new + } + $w icursor $new +} + +# ::tk::spinbox::Insert -- +# Insert a string into an spinbox at the point of the insertion cursor. +# If there is a selection in the spinbox, and it covers the point of the +# insertion cursor, then delete the selection before inserting. +# +# Arguments: +# w - The spinbox window in which to insert the string +# s - The string to insert (usually just a single character) + +proc ::tk::spinbox::Insert {w s} { + if {$s == ""} { + return + } + catch { + set insert [$w index insert] + if {([$w index sel.first] <= $insert) \ + && ([$w index sel.last] >= $insert)} { + $w delete sel.first sel.last + } + } + $w insert insert $s + ::tk::spinbox::SeeInsert $w +} + +# ::tk::spinbox::Backspace -- +# Backspace over the character just before the insertion cursor. +# If backspacing would move the cursor off the left edge of the +# window, reposition the cursor at about the middle of the window. +# +# Arguments: +# w - The spinbox window in which to backspace. + +proc ::tk::spinbox::Backspace w { + if {[$w selection present]} { + $w delete sel.first sel.last + } else { + set x [expr {[$w index insert] - 1}] + if {$x >= 0} {$w delete $x} + if {[$w index @0] >= [$w index insert]} { + set range [$w xview] + set left [lindex $range 0] + set right [lindex $range 1] + $w xview moveto [expr {$left - ($right - $left)/2.0}] + } + } +} + +# ::tk::spinbox::SeeInsert -- +# Make sure that the insertion cursor is visible in the spinbox window. +# If not, adjust the view so that it is. +# +# Arguments: +# w - The spinbox window. + +proc ::tk::spinbox::SeeInsert w { + set c [$w index insert] + if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} { + $w xview $c + } +} + +# ::tk::spinbox::SetCursor - +# Move the insertion cursor to a given position in an spinbox. Also +# clears the selection, if there is one in the spinbox, and makes sure +# that the insertion cursor is visible. +# +# Arguments: +# w - The spinbox window. +# pos - The desired new position for the cursor in the window. + +proc ::tk::spinbox::SetCursor {w pos} { + $w icursor $pos + $w selection clear + ::tk::spinbox::SeeInsert $w +} + +# ::tk::spinbox::Transpose - +# This procedure implements the "transpose" function for spinbox widgets. +# It tranposes the characters on either side of the insertion cursor, +# unless the cursor is at the end of the line. In this case it +# transposes the two characters to the left of the cursor. In either +# case, the cursor ends up to the right of the transposed characters. +# +# Arguments: +# w - The spinbox window. + +proc ::tk::spinbox::Transpose w { + set i [$w index insert] + if {$i < [$w index end]} { + incr i + } + set first [expr {$i-2}] + if {$first < 0} { + return + } + set data [$w get] + set new [string index $data [expr {$i-1}]][string index $data $first] + $w delete $first $i + $w insert insert $new + ::tk::spinbox::SeeInsert $w +} + +# ::tk::spinbox::NextWord -- +# Returns the index of the next word position after a given position in the +# spinbox. The next word is platform dependent and may be either the next +# end-of-word position or the next start-of-word position after the next +# end-of-word position. +# +# Arguments: +# w - The spinbox window in which the cursor is to move. +# start - Position at which to start search. + +if {[string equal $tcl_platform(platform) "windows"]} { + proc ::tk::spinbox::NextWord {w start} { + set pos [tcl_endOfWord [$w get] [$w index $start]] + if {$pos >= 0} { + set pos [tcl_startOfNextWord [$w get] $pos] + } + if {$pos < 0} { + return end + } + return $pos + } +} else { + proc ::tk::spinbox::NextWord {w start} { + set pos [tcl_endOfWord [$w get] [$w index $start]] + if {$pos < 0} { + return end + } + return $pos + } +} + +# ::tk::spinbox::PreviousWord -- +# +# Returns the index of the previous word position before a given +# position in the spinbox. +# +# Arguments: +# w - The spinbox window in which the cursor is to move. +# start - Position at which to start search. + +proc ::tk::spinbox::PreviousWord {w start} { + set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] + if {$pos < 0} { + return 0 + } + return $pos +} + +# ::tk::spinbox::GetSelection -- +# +# Returns the selected text of the spinbox. +# +# Arguments: +# w - The spinbox window from which the text to get + +proc ::tk::spinbox::GetSelection {w} { + return [string range [$w get] [$w index sel.first] \ + [expr {[$w index sel.last] - 1}]] +} diff --git a/library/tk.tcl b/library/tk.tcl index cdf52ac..12ac1ba 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,7 +3,7 @@ # Initialization script normally executed in the interpreter for each # Tk-based application. Arranges class bindings for widgets. # -# RCS: @(#) $Id: tk.tcl,v 1.21 2000/05/03 00:18:36 hobbs Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.22 2000/05/29 01:43:15 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -313,6 +313,7 @@ if {[string compare $tcl_platform(platform) "macintosh"] && \ source [file join $tk_library menu.tcl] source [file join $tk_library scale.tcl] source [file join $tk_library scrlbar.tcl] + source [file join $tk_library spinbox.tcl] source [file join $tk_library text.tcl] } diff --git a/tests/entry.test b/tests/entry.test index a44d1d4..ecaf4f3 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -6,20 +6,12 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: entry.test,v 1.9 2000/05/17 22:23:26 ericm Exp $ +# RCS: @(#) $Id: entry.test,v 1.10 2000/05/29 01:43:15 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {[lsearch [image types] test] < 0} { - puts "This application hasn't been compiled with the \"test\"" - puts "image, so I can't run this test. Are you sure you're using" - puts "tktest instead of wish?" - ::tcltest::cleanupTests - return -} - foreach i [winfo children .] { destroy $i } @@ -78,6 +70,8 @@ foreach test { {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} {-insertontime 100 100 3.2 {expected integer but got "3.2"}} + {-invalidcommand "any string" "any string" {} {}} + {-invcmd "any string" "any string" {} {}} {-justify right right bogus {bad justification "bogus": must be left, right, or center}} {-readonlybackground green green non-existent {unknown color name "non-existent"}} @@ -444,7 +438,7 @@ test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} { .e select to 5 .e select range 4 4 list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in entry}} +} {1 {selection isn't in widget .e}} test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} { .e delete 0 end .e insert end 0123456789 @@ -952,7 +946,7 @@ test entry-8.7 {DeleteChars procedure} { .e select to 8 .e delete 1 8 list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in entry}} +} {1 {selection isn't in widget .e}} test entry-8.8 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde @@ -971,7 +965,7 @@ test entry-8.9 {DeleteChars procedure} { .e select to 8 .e delete 3 8 list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in entry}} +} {1 {selection isn't in widget .e}} test entry-8.10 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde @@ -1080,7 +1074,7 @@ test entry-10.2 {EntrySetValue procedure, updating selection} { .e selection range 4 10 set x "a" list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in entry}} +} {1 {selection isn't in widget .e}} test entry-10.3 {EntrySetValue procedure, updating selection} { catch {destroy .e} entry .e -textvariable x @@ -1212,7 +1206,7 @@ test entry-13.10 {GetEntryIndex procedure} {unixOnly} { # selection range is reset. list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in entry}} +} {1 {selection isn't in widget .e}} test entry-13.11 {GetEntryIndex procedure} {macOrPc} { # On mac and pc, when selection is cleared, entry widget remembers # last selected range. When selection ownership is restored to @@ -1222,7 +1216,7 @@ test entry-13.11 {GetEntryIndex procedure} {macOrPc} { } {1 1} test entry-13.12 {GetEntryIndex procedure} {unixOnly} { list [catch {.e index sbogus} msg] $msg -} {1 {selection isn't in entry}} +} {1 {selection isn't in widget .e}} test entry-13.13 {GetEntryIndex procedure} {macOrPc} { list [catch {.e index sbogus} msg] $msg } {1 {bad entry index "sbogus"}} @@ -1383,7 +1377,7 @@ test entry-17.4 {EntryUpdateScrollbar procedure} { } {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" while executing "thisisnotacommand 0 1" - (horizontal scrolling command executed by entry)}} + (horizontal scrolling command executed by .e)}} set l [interp hidden] eval destroy [winfo children .] diff --git a/tests/spinbox.test b/tests/spinbox.test new file mode 100644 index 0000000..1a42d06 --- /dev/null +++ b/tests/spinbox.test @@ -0,0 +1,1577 @@ +# This file is a Tcl script to test spinbox widgets in Tk. It is +# organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1998-2000 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: spinbox.test,v 1.1 2000/05/29 01:43:15 hobbs Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +foreach i [winfo children .] { + destroy $i +} +wm geometry . {} +raise . + +proc scroll args { + global scrollInfo + set scrollInfo $args +} + +# Create additional widget that's used to hold the selection at times. + +spinbox .sel +.sel insert end "This is some sample text" + +# Font names + +set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1 +set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1 + +# Create entries in the option database to be sure that geometry options +# like border width have predictable values. + +option add *Spinbox.borderWidth 2 +option add *Spinbox.highlightThickness 2 +option add *Spinbox.font {Helvetica -12} + +spinbox .e -bd 2 -relief sunken +pack .e +update + +set i 1 +foreach test { + {-activebackground #ff0000 #ff0000 non-existent + {unknown color name "non-existent"}} + {-background #ff0000 #ff0000 non-existent + {unknown color name "non-existent"}} + {-bd 4 4 badValue {bad screen distance "badValue"}} + {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} + {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} + {-buttonbackground #ff0000 #ff0000 non-existent + {unknown color name "non-existent"}} + {-buttoncursor arrow arrow badValue {bad cursor spec "badValue"}} + {-command {a command} {a command} {} {}} + {-cursor arrow arrow badValue {bad cursor spec "badValue"}} + {-disabledbackground green green non-existent + {unknown color name "non-existent"}} + {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}} + {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} + {-fg #110022 #110022 bogus {unknown color name "bogus"}} + {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {} + {font "" doesn't exist}} + {-foreground #110022 #110022 bogus {unknown color name "bogus"}} + {-format %0.5f %0.5f %d {bad spinbox format specifier "%d"}} + {-from -10 -10.0 bogus {expected floating-point number but got "bogus"}} + {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}} + {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} + {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} + {-highlightthickness -2 0 {} {}} + {-increment 1.0 1.0 bogus {expected floating-point number but got "bogus"}} + {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}} + {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} + {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} + {-insertontime 100 100 3.2 {expected integer but got "3.2"}} + {-invalidcommand "a command" "a command" {} {}} + {-invcmd "a command" "a command" {} {}} + {-justify right right bogus {bad justification "bogus": must be left, right, or center}} + {-readonlybackground green green non-existent + {unknown color name "non-existent"}} + {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} + {-repeatdelay 500 500 3p {expected integer but got "3p"}} + {-repeatinterval -500 -500 3p {expected integer but got "3p"}} + {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} + {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} + {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} + {-state n normal bogus {bad state "bogus": must be disabled, normal, or readonly}} + {-takefocus "any string" "any string" {} {}} + {-textvariable i i {} {}} + {-to 14.9 14.9 bogus {expected floating-point number but got "bogus"}} + {-validate "key" "key" "bogus" {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}} + {-validatecommand "a command" "a command" {} {}} + {-values {mon tue wed thur} {mon tue wed thur} {bad {}list} {list element in braces followed by "list" instead of space}} + {-vcmd "a command" "a command" {} {}} + {-width 402 402 3p {expected integer but got "3p"}} + {-wrap yes 1 xyzzy {expected boolean value but got "xyzzy"}} + {-xscrollcommand {Some command} {Some command} {} {}} +} { + set name [lindex $test 0] + test spinbox-1.$i {configuration options} { + .e configure $name [lindex $test 1] + list [lindex [.e configure $name] 4] [.e cget $name] + } [list [lindex $test 2] [lindex $test 2]] + incr i + if {[lindex $test 3] != ""} { + test spinbox-1.$i {configuration options} { + list [catch {.e configure $name [lindex $test 3]} msg] $msg + } [list 1 [lindex $test 4]] + } + .e configure $name [lindex [.e configure $name] 3] + incr i +} + +test spinbox-2.1 {Tk_SpinboxCmd procedure} { + list [catch {spinbox} msg] $msg +} {1 {wrong # args: should be "spinbox pathName ?options?"}} +test spinbox-2.2 {Tk_SpinboxCmd procedure} { + list [catch {spinbox gorp} msg] $msg +} {1 {bad window path name "gorp"}} +test spinbox-2.3 {Tk_SpinboxCmd procedure} { + catch {destroy .e} + spinbox .e + list [winfo exists .e] [winfo class .e] [info commands .e] +} {1 Spinbox .e} +test spinbox-2.4 {Tk_SpinboxCmd procedure} { + catch {destroy .e} + list [catch {spinbox .e -gorp foo} msg] $msg [winfo exists .e] \ + [info commands .e] +} {1 {unknown option "-gorp"} 0 {}} +test spinbox-2.5 {Tk_SpinboxCmd procedure} { + catch {destroy .e} + spinbox .e +} {.e} + +catch {destroy .e} +spinbox .e -font $fixed +pack .e +update + +set cx [font measure $fixed a] +set cy [font metrics $fixed -linespace] +set ux [font measure $fixed \u4e4e] + +test spinbox-3.1 {SpinboxWidgetCmd procedure} { + list [catch {.e} msg] $msg +} {1 {wrong # args: should be ".e option ?arg arg ...?"}} +test spinbox-3.2 {SpinboxWidgetCmd procedure, "bbox" widget command} { + list [catch {.e bbox} msg] $msg +} {1 {wrong # args: should be ".e bbox index"}} +test spinbox-3.3 {SpinboxWidgetCmd procedure, "bbox" widget command} { + list [catch {.e bbox a b} msg] $msg +} {1 {wrong # args: should be ".e bbox index"}} +test spinbox-3.4 {SpinboxWidgetCmd procedure, "bbox" widget command} { + list [catch {.e bbox bogus} msg] $msg +} {1 {bad spinbox index "bogus"}} +test spinbox-3.5 {SpinboxWidgetCmd procedure, "bbox" widget command} { + .e delete 0 end + .e bbox 0 +} [list 5 5 0 $cy] +test spinbox-3.6 {SpinboxWidgetCmd procedure, "bbox" widget command} { + # Tcl_UtfAtIndex(): no utf chars + + .e delete 0 end + .e insert 0 "abc" + list [.e bbox 3] [.e bbox end] +} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"] +test spinbox-3.7 {SpinboxWidgetCmd procedure, "bbox" widget command} { + # Tcl_UtfAtIndex(): utf at end + .e delete 0 end + .e insert 0 "ab\u4e4e" + .e bbox end +} "[expr 5+2*$cx] 5 $ux $cy" +test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} { + # Tcl_UtfAtIndex(): utf before index + .e delete 0 end + .e insert 0 "ab\u4e4ec" + .e bbox 3 +} "[expr 5+2*$cx+$ux] 5 $cx $cy" +test spinbox-3.9 {SpinboxWidgetCmd procedure, "bbox" widget command} { + # Tcl_UtfAtIndex(): no chars + .e delete 0 end + .e bbox end +} "5 5 0 $cy" +test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} { + .e delete 0 end + .e insert 0 "abcdefghij\u4e4eklmnop" + list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end] +} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"] +test spinbox-3.11 {SpinboxWidgetCmd procedure, "cget" widget command} { + list [catch {.e cget} msg] $msg +} {1 {wrong # args: should be ".e cget option"}} +test spinbox-3.12 {SpinboxWidgetCmd procedure, "cget" widget command} { + list [catch {.e cget a b} msg] $msg +} {1 {wrong # args: should be ".e cget option"}} +test spinbox-3.13 {SpinboxWidgetCmd procedure, "cget" widget command} { + list [catch {.e cget -gorp} msg] $msg +} {1 {unknown option "-gorp"}} +test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} { + .e configure -bd 4 + .e cget -bd +} {4} +test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} { + llength [.e configure] +} {49} +test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} { + list [catch {.e configure -foo} msg] $msg +} {1 {unknown option "-foo"}} +test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} { + .e configure -bd 4 + .e configure -bg #ffffff + lindex [.e configure -bd] 4 +} {4} +test spinbox-3.18 {SpinboxWidgetCmd procedure, "delete" widget command} { + list [catch {.e delete} msg] $msg +} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} +test spinbox-3.19 {SpinboxWidgetCmd procedure, "delete" widget command} { + list [catch {.e delete a b c} msg] $msg +} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} +test spinbox-3.20 {SpinboxWidgetCmd procedure, "delete" widget command} { + list [catch {.e delete foo} msg] $msg +} {1 {bad spinbox index "foo"}} +test spinbox-3.21 {SpinboxWidgetCmd procedure, "delete" widget command} { + list [catch {.e delete 0 bar} msg] $msg +} {1 {bad spinbox index "bar"}} +test spinbox-3.22 {SpinboxWidgetCmd procedure, "delete" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e delete 2 4 + .e get +} {014567890} +test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e delete 6 + .e get +} {0123457890} +test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} { + # UTF + set x {} + .e delete 0 end + .e insert end "01234\u4e4e67890" + .e delete 6 + lappend x [.e get] + .e delete 0 end + .e insert end "012345\u4e4e7890" + .e delete 6 + lappend x [.e get] + .e delete 0 end + .e insert end "0123456\u4e4e890" + .e delete 6 + lappend x [.e get] +} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] +test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e delete 6 5 + .e get +} {01234567890} +test spinbox-3.26 {SpinboxWidgetCmd procedure, "delete" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e configure -state disabled + .e delete 2 8 + .e configure -state normal + .e get +} {01234567890} +test spinbox-3.27 {SpinboxWidgetCmd procedure, "get" widget command} { + list [catch {.e get foo} msg] $msg +} {1 {wrong # args: should be ".e get"}} +test spinbox-3.28 {SpinboxWidgetCmd procedure, "icursor" widget command} { + list [catch {.e icursor} msg] $msg +} {1 {wrong # args: should be ".e icursor pos"}} +test spinbox-3.29 {SpinboxWidgetCmd procedure, "icursor" widget command} { + list [catch {.e icursor foo} msg] $msg +} {1 {bad spinbox index "foo"}} +test spinbox-3.30 {SpinboxWidgetCmd procedure, "icursor" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e icursor 4 + .e index insert +} {4} +test spinbox-3.31 {SpinboxWidgetCmd procedure, "index" widget command} { + list [catch {.e in} msg] $msg +} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}} +test spinbox-3.32 {SpinboxWidgetCmd procedure, "index" widget command} { + list [catch {.e index} msg] $msg +} {1 {wrong # args: should be ".e index string"}} +test spinbox-3.33 {SpinboxWidgetCmd procedure, "index" widget command} { + list [catch {.e index foo} msg] $msg +} {1 {bad spinbox index "foo"}} +test spinbox-3.34 {SpinboxWidgetCmd procedure, "index" widget command} { + list [catch {.e index 0} msg] $msg +} {0 0} +test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} { + # UTF + .e delete 0 end + .e insert 0 abc\u4e4e\u0153def + list [.e index 3] [.e index 4] [.e index end] +} {3 4 8} +test spinbox-3.36 {SpinboxWidgetCmd procedure, "insert" widget command} { + list [catch {.e insert a} msg] $msg +} {1 {wrong # args: should be ".e insert index text"}} +test spinbox-3.37 {SpinboxWidgetCmd procedure, "insert" widget command} { + list [catch {.e insert a b c} msg] $msg +} {1 {wrong # args: should be ".e insert index text"}} +test spinbox-3.38 {SpinboxWidgetCmd procedure, "insert" widget command} { + list [catch {.e insert foo Text} msg] $msg +} {1 {bad spinbox index "foo"}} +test spinbox-3.39 {SpinboxWidgetCmd procedure, "insert" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e insert 3 xxx + .e get +} {012xxx34567890} +test spinbox-3.40 {SpinboxWidgetCmd procedure, "insert" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e configure -state disabled + .e insert 3 xxx + .e configure -state normal + .e get +} {01234567890} +test spinbox-3.41 {SpinboxWidgetCmd procedure, "insert" widget command} { + list [catch {.e insert a b c} msg] $msg +} {1 {wrong # args: should be ".e insert index text"}} +test spinbox-3.42 {SpinboxWidgetCmd procedure, "scan" widget command} { + list [catch {.e scan a} msg] $msg +} {1 {wrong # args: should be ".e scan mark|dragto x"}} +test spinbox-3.43 {SpinboxWidgetCmd procedure, "scan" widget command} { + list [catch {.e scan a b c} msg] $msg +} {1 {wrong # args: should be ".e scan mark|dragto x"}} +test spinbox-3.44 {SpinboxWidgetCmd procedure, "scan" widget command} { + list [catch {.e scan foobar 20} msg] $msg +} {1 {bad scan option "foobar": must be mark or dragto}} +test spinbox-3.45 {SpinboxWidgetCmd procedure, "scan" widget command} { + list [catch {.e scan mark 20.1} msg] $msg +} {1 {expected integer but got "20.1"}} +# This test is non-portable because character sizes vary. + +test spinbox-3.46 {SpinboxWidgetCmd procedure, "scan" widget command} {fonts} { + .e delete 0 end + update + .e insert end "This is quite a long string, in fact a " + .e insert end "very very long string" + .e scan mark 30 + .e scan dragto 28 + .e index @0 +} {2} +test spinbox-3.47 {SpinboxWidgetCmd procedure, "select" widget command} { + list [catch {.e select} msg] $msg +} {1 {wrong # args: should be ".e selection option ?index?"}} +test spinbox-3.48 {SpinboxWidgetCmd procedure, "select" widget command} { + list [catch {.e select foo} msg] $msg +} {1 {bad selection option "foo": must be adjust, clear, element, from, present, range, or to}} +test spinbox-3.49 {SpinboxWidgetCmd procedure, "select clear" widget command} { + list [catch {.e select clear gorp} msg] $msg +} {1 {wrong # args: should be ".e selection clear"}} +test spinbox-3.50 {SpinboxWidgetCmd procedure, "select clear" widget command} { + .e delete 0 end + .e insert end "0123456789" + .e select from 1 + .e select to 4 + update + .e select clear + list [catch {selection get} msg] $msg [selection own] +} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e} +test spinbox-3.51 {SpinboxWidgetCmd procedure, "selection present" widget command} { + list [catch {.e selection present foo} msg] $msg +} {1 {wrong # args: should be ".e selection present"}} +test spinbox-3.52 {SpinboxWidgetCmd procedure, "selection present" widget command} { + .e delete 0 end + .e insert end 0123456789 + .e select from 3 + .e select to 6 + .e selection present +} {1} +test spinbox-3.53 {SpinboxWidgetCmd procedure, "selection present" widget command} { + .e delete 0 end + .e insert end 0123456789 + .e select from 3 + .e select to 6 + .e configure -exportselection false + .e selection present +} {1} +.e configure -exportselection true +test spinbox-3.54 {SpinboxWidgetCmd procedure, "selection present" widget command} { + .e delete 0 end + .e insert end 0123456789 + .e select from 3 + .e select to 6 + .e delete 0 end + .e selection present +} {0} +test spinbox-3.55 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { + list [catch {.e select adjust x} msg] $msg +} {1 {bad spinbox index "x"}} +test spinbox-3.56 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { + list [catch {.e select adjust 2 3} msg] $msg +} {1 {wrong # args: should be ".e selection adjust index"}} +test spinbox-3.57 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { + .e delete 0 end + .e insert end "0123456789" + .e select from 1 + .e select to 5 + update + .e select adjust 4 + selection get +} {123} +test spinbox-3.58 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { + .e delete 0 end + .e insert end "0123456789" + .e select from 1 + .e select to 5 + update + .e select adjust 2 + selection get +} {234} +test spinbox-3.59 {SpinboxWidgetCmd procedure, "selection from" widget command} { + list [catch {.e select from 2 3} msg] $msg +} {1 {wrong # args: should be ".e selection from index"}} +test spinbox-3.60 {SpinboxWidgetCmd procedure, "selection range" widget command} { + list [catch {.e select range 2} msg] $msg +} {1 {wrong # args: should be ".e selection range start end"}} +test spinbox-3.61 {SpinboxWidgetCmd procedure, "selection range" widget command} { + list [catch {.e selection range 2 3 4} msg] $msg +} {1 {wrong # args: should be ".e selection range start end"}} +test spinbox-3.62 {SpinboxWidgetCmd procedure, "selection range" widget command} { + .e delete 0 end + .e insert end 0123456789 + .e select from 1 + .e select to 5 + .e select range 4 4 + list [catch {.e index sel.first} msg] $msg +} {1 {selection isn't in widget .e}} +test spinbox-3.63 {SpinboxWidgetCmd procedure, "selection range" widget command} { + .e delete 0 end + .e insert end 0123456789 + .e select from 3 + .e select to 7 + .e select range 2 9 + list [.e index sel.first] [.e index sel.last] [.e index anchor] +} {2 9 3} +.e delete 0 end +.e insert end "This is quite a long text string, so long that it " +.e insert end "runs off the end of the window quite a bit." +test spinbox-3.64 {SpinboxWidgetCmd procedure, "selection to" widget command} { + list [catch {.e select to 2 3} msg] $msg +} {1 {wrong # args: should be ".e selection to index"}} +test spinbox-3.65 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview 5 + .e xview +} {0.0537634 0.268817} +test spinbox-3.66 {SpinboxWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview gorp} msg] $msg +} {1 {bad spinbox index "gorp"}} +test spinbox-3.67 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview 0 + .e icursor 10 + .e xview insert + .e xview +} {0.107527 0.322581} +test spinbox-3.68 {SpinboxWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview moveto foo bar} msg] $msg +} {1 {wrong # args: should be ".e xview moveto fraction"}} +test spinbox-3.69 {SpinboxWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview moveto foo} msg] $msg +} {1 {expected floating-point number but got "foo"}} +test spinbox-3.70 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview moveto 0.5 + .e xview +} {0.505376 0.72043} +test spinbox-3.71 {SpinboxWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview scroll 24} msg] $msg +} {1 {wrong # args: should be ".e xview scroll number units|pages"}} +test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview scroll gorp units} msg] $msg +} {1 {expected integer but got "gorp"}} +test spinbox-3.73 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview moveto 0 + .e xview scroll 1 pages + .e xview +} {0.193548 0.408602} +test spinbox-3.74 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview moveto .9 + update + .e xview scroll -2 p + .e xview +} {0.397849 0.612903} +test spinbox-3.75 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview 30 + update + .e xview scroll 2 units + .e index @0 +} {32} +test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview 30 + update + .e xview scroll -1 units + .e index @0 +} {29} +test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview scroll 23 foobars} msg] $msg +} {1 {bad argument "foobars": must be units or pages}} +test spinbox-3.78 {SpinboxWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview eat 23 hamburgers} msg] $msg +} {1 {unknown option "eat": must be moveto or scroll}} +test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview 0 + update + .e xview -4 + .e index @0 +} {0} +test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} { + .e xview 300 + .e index @0 +} {73} +.e insert 10 \u4e4e +test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} { + # UTF + # If Tcl_NumUtfChars wasn't used, wrong answer would be: + # 0.106383 0.117021 0.117021 + + set x {} + .e xview moveto .1 + lappend x [lindex [.e xview] 0] + .e xview moveto .11 + lappend x [lindex [.e xview] 0] + .e xview moveto .12 + lappend x [lindex [.e xview] 0] +} {0.0957447 0.106383 0.117021} +test spinbox-3.82 {SpinboxWidgetCmd procedure} { + list [catch {.e gorp} msg] $msg +} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}} + +frame .f -width 200 -height 50 -relief raised -bd 2 +pack .f -side right +test spinbox-5.1 {ConfigureSpinbox procedure, -textvariable} { + catch {destroy .e} + set x 12345 + spinbox .e -textvariable x + .e get +} {12345} +test spinbox-5.2 {ConfigureSpinbox procedure, -textvariable} { + catch {destroy .e} + set x 12345 + spinbox .e -textvariable x + set y abcde + .e configure -textvariable y + set x 54321 + .e get +} {abcde} +test spinbox-5.3 {ConfigureSpinbox procedure, -textvariable} { + catch {destroy .e} + catch {unset x} + spinbox .e + .e insert 0 "Some text" + .e configure -textvariable x + set x +} {Some text} +test spinbox-5.4 {ConfigureSpinbox procedure, -textvariable} { + proc override args { + global x + set x 12345 + } + catch {destroy .e} + catch {unset x} + trace variable x w override + spinbox .e + .e insert 0 "Some text" + .e configure -textvariable x + set result [list $x [.e get]] + unset x; rename override {} + set result +} {12345 12345} +test spinbox-5.5 {ConfigureSpinbox procedure} { + catch {destroy .e} + spinbox .e -exportselection false + pack .e + .e insert end "0123456789" + .sel select from 0 + .sel select to 10 + set x {} + lappend x [selection get] + .e select from 1 + .e select to 5 + lappend x [selection get] + .e configure -exportselection 1 + lappend x [selection get] + set x +} {{This is so} {This is so} 1234} +test spinbox-5.6 {ConfigureSpinbox procedure} { + catch {destroy .e} + spinbox .e + pack .e + .e insert end "0123456789" + .e select from 1 + .e select to 5 + .e configure -exportselection 0 + list [catch {selection get} msg] $msg [.e index sel.first] \ + [.e index sel.last] +} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5} +test spinbox-5.7 {ConfigureSpinbox procedure} { + catch {destroy .e} + spinbox .e -font $fixed -width 4 -xscrollcommand scroll + pack .e + .e insert end "01234567890" + update + .e configure -width 5 + set scrollInfo +} {0 0.363636} +test spinbox-5.8 {ConfigureSpinbox procedure} {fonts} { + catch {destroy .e} + spinbox .e -width 0 + pack .e + .e insert end "0123" + update + .e configure -font $big + update + winfo geom .e +} {79x37+0+0} +test spinbox-5.9 {ConfigureSpinbox procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $fixed -bd 2 -relief raised + pack .e + .e insert end "0123" + update + list [.e index @10] [.e index @11] [.e index @12] [.e index @13] +} {0 0 1 1} +test spinbox-5.10 {ConfigureSpinbox procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $fixed -bd 2 -relief flat + pack .e + .e insert end "0123" + update + list [.e index @10] [.e index @11] [.e index @12] [.e index @13] +} {0 0 1 1} +test spinbox-5.11 {ConfigureSpinbox procedure} { + # If "0" in selected font had 0 width, caused divide-by-zero error. + + catch {destroy .e} + pack [spinbox .e -font {{open look glyph}}] + .e scan dragto 30 + update +} {} + +# No tests for DisplaySpinbox. + +test spinbox-6.1 {SpinboxComputeGeometry procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3 + pack .e + .e insert end 012\t45 + update + list [.e index @61] [.e index @62] +} {3 4} +test spinbox-6.2 {SpinboxComputeGeometry procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify center \ + -highlightthickness 3 + pack .e + .e insert end 012\t45 + update + list [.e index @96] [.e index @97] +} {3 4} +test spinbox-6.3 {SpinboxComputeGeometry procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify right \ + -highlightthickness 3 + pack .e + .e insert end 012\t45 + update + list [.e index @131] [.e index @132] +} {3 4} +test spinbox-6.4 {SpinboxComputeGeometry procedure} { + catch {destroy .e} + spinbox .e -font $fixed -bd 2 -relief raised -width 5 + pack .e + .e insert end "01234567890" + update + .e xview 6 + .e index @0 +} {6} +test spinbox-6.5 {SpinboxComputeGeometry procedure} { + catch {destroy .e} + spinbox .e -font $fixed -bd 2 -relief raised -width 5 + pack .e + .e insert end "01234567890" + update + .e xview 7 + .e index @0 +} {6} +test spinbox-6.6 {SpinboxComputeGeometry procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $fixed -bd 2 -relief raised -width 10 + pack .e + .e insert end "01234\t67890" + update + .e xview 3 + list [.e index @39] [.e index @40] +} {5 6} +test spinbox-6.7 {SpinboxComputeGeometry procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $big -bd 3 -relief raised -width 5 + pack .e + .e insert end "01234567" + update + list [winfo reqwidth .e] [winfo reqheight .e] +} {94 39} +test spinbox-6.8 {SpinboxComputeGeometry procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $big -bd 3 -relief raised -width 0 + pack .e + .e insert end "01234567" + update + list [winfo reqwidth .e] [winfo reqheight .e] +} {133 39} +test spinbox-6.9 {SpinboxComputeGeometry procedure} {fonts} { + catch {destroy .e} + spinbox .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2 + pack .e + update + list [winfo reqwidth .e] [winfo reqheight .e] +} {42 39} + +catch {destroy .e} +spinbox .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll +pack .e +focus .e +test spinbox-7.1 {InsertChars procedure} { + .e delete 0 end + .e insert 0 abcde + .e insert 2 XXX + update + list [.e get] $contents $scrollInfo +} {abXXXcde abXXXcde {0 1}} +test spinbox-7.2 {InsertChars procedure} { + .e delete 0 end + .e insert 0 abcde + .e insert 500 XXX + update + list [.e get] $contents $scrollInfo +} {abcdeXXX abcdeXXX {0 1}} +test spinbox-7.3 {InsertChars procedure} { + .e delete 0 end + .e insert 0 0123456789 + .e select from 2 + .e select to 6 + .e insert 2 XXX + set x "[.e index sel.first] [.e index sel.last]" + .e select to 8 + lappend x [.e index sel.first] [.e index sel.last] +} {5 9 5 8} +test spinbox-7.4 {InsertChars procedure} { + .e delete 0 end + .e insert 0 0123456789 + .e select from 2 + .e select to 6 + .e insert 3 XXX + set x "[.e index sel.first] [.e index sel.last]" + .e select to 8 + lappend x [.e index sel.first] [.e index sel.last] +} {2 9 2 8} +test spinbox-7.5 {InsertChars procedure} { + .e delete 0 end + .e insert 0 0123456789 + .e select from 2 + .e select to 6 + .e insert 5 XXX + set x "[.e index sel.first] [.e index sel.last]" + .e select to 8 + lappend x [.e index sel.first] [.e index sel.last] +} {2 9 2 8} +test spinbox-7.6 {InsertChars procedure} { + .e delete 0 end + .e insert 0 0123456789 + .e select from 2 + .e select to 6 + .e insert 6 XXX + set x "[.e index sel.first] [.e index sel.last]" + .e select to 5 + lappend x [.e index sel.first] [.e index sel.last] +} {2 6 2 5} +test spinbox-7.7 {InsertChars procedure} { + .e delete 0 end + .e insert 0 0123456789 + .e icursor 4 + .e insert 4 XXX + .e index insert +} {7} +test spinbox-7.8 {InsertChars procedure} { + .e delete 0 end + .e insert 0 0123456789 + .e icursor 4 + .e insert 5 XXX + .e index insert +} {4} +test spinbox-7.9 {InsertChars procedure} { + .e delete 0 end + .e insert 0 "This is a very long string" + update + .e xview 4 + .e insert 3 XXX + .e index @0 +} {7} +test spinbox-7.10 {InsertChars procedure} { + .e delete 0 end + .e insert 0 "This is a very long string" + update + .e xview 4 + .e insert 4 XXX + .e index @0 +} {4} +.e configure -width 0 +test spinbox-7.11 {InsertChars procedure} {fonts} { + .e delete 0 end + .e insert 0 "xyzzy" + update + .e insert 2 00 + winfo reqwidth .e +} {70} + +.e configure -width 10 +test spinbox-8.1 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 abcde + .e delete 2 4 + update + list [.e get] $contents $scrollInfo +} {abe abe {0 1}} +test spinbox-8.2 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 abcde + .e delete -2 2 + update + list [.e get] $contents $scrollInfo +} {cde cde {0 1}} +test spinbox-8.3 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 abcde + .e delete 3 1000 + update + list [.e get] $contents $scrollInfo +} {abc abc {0 1}} +test spinbox-8.4 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e select from 3 + .e select to 8 + .e delete 1 3 + update + set x "[.e index sel.first] [.e index sel.last]" + .e select to 5 + lappend x [.e index sel.first] [.e index sel.last] +} {1 6 1 5} +test spinbox-8.5 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e select from 3 + .e select to 8 + .e delete 1 4 + update + set x "[.e index sel.first] [.e index sel.last]" + .e select to 4 + lappend x [.e index sel.first] [.e index sel.last] +} {1 5 1 4} +test spinbox-8.6 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e select from 3 + .e select to 8 + .e delete 1 7 + update + set x "[.e index sel.first] [.e index sel.last]" + .e select to 5 + lappend x [.e index sel.first] [.e index sel.last] +} {1 2 1 5} +test spinbox-8.7 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e select from 3 + .e select to 8 + .e delete 1 8 + list [catch {.e index sel.first} msg] $msg +} {1 {selection isn't in widget .e}} +test spinbox-8.8 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e select from 3 + .e select to 8 + .e delete 3 7 + update + set x "[.e index sel.first] [.e index sel.last]" + .e select to 8 + lappend x [.e index sel.first] [.e index sel.last] +} {3 4 3 8} +test spinbox-8.9 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e select from 3 + .e select to 8 + .e delete 3 8 + list [catch {.e index sel.first} msg] $msg +} {1 {selection isn't in widget .e}} +test spinbox-8.10 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e select from 8 + .e select to 3 + .e delete 5 8 + update + set x "[.e index sel.first] [.e index sel.last]" + .e select to 8 + lappend x [.e index sel.first] [.e index sel.last] +} {3 5 5 8} +test spinbox-8.11 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e select from 8 + .e select to 3 + .e delete 8 10 + update + set x "[.e index sel.first] [.e index sel.last]" + .e select to 4 + lappend x [.e index sel.first] [.e index sel.last] +} {3 8 4 8} +test spinbox-8.12 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e icursor 4 + .e delete 1 4 + .e index insert +} {1} +test spinbox-8.13 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e icursor 4 + .e delete 1 5 + .e index insert +} {1} +test spinbox-8.14 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 0123456789abcde + .e icursor 4 + .e delete 4 6 + .e index insert +} {4} +test spinbox-8.15 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 "This is a very long string" + .e xview 4 + .e delete 1 4 + .e index @0 +} {1} +test spinbox-8.16 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 "This is a very long string" + .e xview 4 + .e delete 1 5 + .e index @0 +} {1} +test spinbox-8.17 {DeleteChars procedure} { + .e delete 0 end + .e insert 0 "This is a very long string" + .e xview 4 + .e delete 4 6 + .e index @0 +} {4} +.e configure -width 0 +test spinbox-8.18 {DeleteChars procedure} {fonts} { + .e delete 0 end + .e insert 0 "xyzzy" + update + .e delete 2 4 + winfo reqwidth .e +} {42} + +test spinbox-9.1 {SpinboxValueChanged procedure} { + catch {destroy .e} + proc override args { + global x + set x 12345 + } + catch {unset x} + trace variable x w override + spinbox .e -textvariable x + .e insert 0 foo + set result [list $x [.e get]] + unset x; rename override {} + set result +} {12345 12345} + +catch {destroy .e} +spinbox .e +pack .e +.e configure -width 0 +test spinbox-10.1 {SpinboxSetValue procedure} {fonts} { + set x abcde + set y ab + .e configure -textvariable x + update + .e configure -textvariable y + update + list [.e get] [winfo reqwidth .e] +} {ab 35} +test spinbox-10.2 {SpinboxSetValue procedure, updating selection} { + catch {destroy .e} + spinbox .e -textvariable x + .e insert 0 "abcdefghjklmnopqrstu" + .e selection range 4 10 + set x "a" + list [catch {.e index sel.first} msg] $msg +} {1 {selection isn't in widget .e}} +test spinbox-10.3 {SpinboxSetValue procedure, updating selection} { + catch {destroy .e} + spinbox .e -textvariable x + .e insert 0 "abcdefghjklmnopqrstu" + .e selection range 4 10 + set x "abcdefg" + list [.e index sel.first] [.e index sel.last] +} {4 7} +test spinbox-10.4 {SpinboxSetValue procedure, updating selection} { + catch {destroy .e} + spinbox .e -textvariable x + .e insert 0 "abcdefghjklmnopqrstu" + .e selection range 4 10 + set x "abcdefghijklmn" + list [.e index sel.first] [.e index sel.last] +} {4 10} +test spinbox-10.5 {SpinboxSetValue procedure, updating display position} { + catch {destroy .e} + spinbox .e -width 10 -font $fixed -textvariable x + pack .e + .e insert 0 "abcdefghjklmnopqrstuvwxyz" + .e xview 10 + update + set x "abcdefg" + update + .e index @0 +} {0} +test spinbox-10.6 {SpinboxSetValue procedure, updating display position} { + catch {destroy .e} + spinbox .e -width 10 -font $fixed -textvariable x + pack .e + .e insert 0 "abcdefghjklmnopqrstuvwxyz" + .e xview 10 + update + set x "1234567890123456789012" + update + .e index @0 +} {10} +test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} { + catch {destroy .e} + spinbox .e -width 10 -font $fixed -textvariable x + pack .e + .e insert 0 "abcdefghjklmnopqrstuvwxyz" + .e icursor 5 + set x "123" + .e index insert +} {3} +test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} { + catch {destroy .e} + spinbox .e -width 10 -font $fixed -textvariable x + pack .e + .e insert 0 "abcdefghjklmnopqrstuvwxyz" + .e icursor 5 + set x "123456" + .e index insert +} {5} + +test spinbox-11.1 {SpinboxEventProc procedure} { + catch {destroy .e} + spinbox .e + .e insert 0 abcdefg + destroy .e + update +} {} +test spinbox-11.2 {SpinboxEventProc procedure} { + eval destroy [winfo children .] + spinbox .e1 -fg #112233 + rename .e1 .e2 + set x {} + lappend x [winfo children .] + lappend x [.e2 cget -fg] + destroy .e1 + lappend x [info command .e*] [winfo children .] +} {.e1 #112233 {} {}} + +test spinbox-12.1 {SpinboxCmdDeletedProc procedure} { + eval destroy [winfo children .] + button .e1 -text "xyz_123" + rename .e1 {} + list [info command .e*] [winfo children .] +} {{} {}} + +catch {destroy .e} +spinbox .e -font $fixed -width 5 -bd 2 -relief sunken +pack .e +.e insert 0 012345678901234567890 +.e xview 4 +update +test spinbox-13.1 {GetSpinboxIndex procedure} { + .e index end +} {21} +test spinbox-13.2 {GetSpinboxIndex procedure} { + list [catch {.e index abogus} msg] $msg +} {1 {bad spinbox index "abogus"}} +test spinbox-13.3 {GetSpinboxIndex procedure} { + .e select from 1 + .e select to 6 + .e index anchor +} {1} +test spinbox-13.4 {GetSpinboxIndex procedure} { + .e select from 4 + .e select to 1 + .e index anchor +} {4} +test spinbox-13.5 {GetSpinboxIndex procedure} { + .e select from 3 + .e select to 15 + .e select adjust 4 + .e index anchor +} {15} +test spinbox-13.6 {GetSpinboxIndex procedure} { + list [catch {.e index ebogus} msg] $msg +} {1 {bad spinbox index "ebogus"}} +test spinbox-13.7 {GetSpinboxIndex procedure} { + .e icursor 2 + .e index insert +} {2} +test spinbox-13.8 {GetSpinboxIndex procedure} { + list [catch {.e index ibogus} msg] $msg +} {1 {bad spinbox index "ibogus"}} +test spinbox-13.9 {GetSpinboxIndex procedure} { + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +} {1 6} +selection clear .e +test spinbox-13.10 {GetSpinboxIndex procedure} {unixOnly} { + # On unix, when selection is cleared, spinbox widget's internal + # selection range is reset. + + list [catch {.e index sel.first} msg] $msg +} {1 {selection isn't in widget .e}} +test spinbox-13.11 {GetSpinboxIndex procedure} {macOrPc} { + # On mac and pc, when selection is cleared, spinbox widget remembers + # last selected range. When selection ownership is restored to + # spinbox, the old range will be rehighlighted. + + list [catch {selection get}] [.e index sel.first] +} {1 1} +test spinbox-13.12 {GetSpinboxIndex procedure} {unixOnly} { + list [catch {.e index sbogus} msg] $msg +} {1 {selection isn't in widget .e}} +test spinbox-13.13 {GetSpinboxIndex procedure} {macOrPc} { + list [catch {.e index sbogus} msg] $msg +} {1 {bad spinbox index "sbogus"}} +test spinbox-13.14 {GetSpinboxIndex procedure} {macOrPc} { + list [catch {selection get}] [catch {.e index sbogus}] +} {1 1} +test spinbox-13.15 {GetSpinboxIndex procedure} { + list [catch {.e index @xyz} msg] $msg +} {1 {bad spinbox index "@xyz"}} +test spinbox-13.16 {GetSpinboxIndex procedure} {fonts} { + .e index @4 +} {4} +test spinbox-13.17 {GetSpinboxIndex procedure} {fonts} { + .e index @11 +} {4} +test spinbox-13.18 {GetSpinboxIndex procedure} {fonts} { + .e index @12 +} {5} +test spinbox-13.19 {GetSpinboxIndex procedure} {fonts} { + # 11 is the minimum button width + .e index @[expr [winfo width .e] - 6 - 11] +} {8} +test spinbox-13.20 {GetSpinboxIndex procedure} {fonts} { + .e index @[expr [winfo width .e] - 5] +} {9} +test spinbox-13.21 {GetSpinboxIndex procedure} { + .e index @1000 +} {9} +test spinbox-13.22 {GetSpinboxIndex procedure} { + list [catch {.e index 1xyz} msg] $msg +} {1 {bad spinbox index "1xyz"}} +test spinbox-13.23 {GetSpinboxIndex procedure} { + .e index -10 +} {0} +test spinbox-13.24 {GetSpinboxIndex procedure} { + .e index 12 +} {12} +test spinbox-13.25 {GetSpinboxIndex procedure} { + .e index 49 +} {21} + +# XXX Still need to write tests for SpinboxScanTo and SpinboxSelectTo. + +set x {} +for {set i 1} {$i <= 500} {incr i} { + append x "This is line $i, out of 500\n" +} +test spinbox-14.1 {SpinboxFetchSelection procedure} { + catch {destroy .e} + spinbox .e + .e insert end "This is a test string" + .e select from 1 + .e select to 18 + selection get +} {his is a test str} +test spinbox-14.3 {SpinboxFetchSelection procedure} { + catch {destroy .e} + spinbox .e + .e insert end $x + .e select from 0 + .e select to end + string compare [selection get] $x +} 0 + +test spinbox-15.1 {SpinboxLostSelection} { + catch {destroy .e} + spinbox .e + .e insert 0 "Text" + .e select from 0 + .e select to 4 + set result [selection get] + selection clear + .e select from 0 + .e select to 4 + lappend result [selection get] +} {Text Text} + +# No tests for EventuallyRedraw. + +catch {destroy .e} +spinbox .e -width 10 -xscrollcommand scroll +pack .e +update + +test spinbox-16.1 {SpinboxVisibleRange procedure} {fonts} { + .e delete 0 end + .e insert 0 ............................. + .e xview +} {0 0.827586} +test spinbox-15.4 {SpinboxVisibleRange procedure} { + .e delete 0 end + .e xview +} {0 1} + +catch {destroy .e} +spinbox .e -width 10 -xscrollcommand scroll -font $fixed +pack .e +update +test spinbox-17.1 {SpinboxUpdateScrollbar procedure} { + .e delete 0 end + .e insert 0 123 + update + set scrollInfo +} {0 1} +test spinbox-17.2 {SpinboxUpdateScrollbar procedure} { + .e delete 0 end + .e insert 0 0123456789abcdef + .e xview 3 + update + set scrollInfo +} {0.1875 0.8125} +test spinbox-17.3 {SpinboxUpdateScrollbar procedure} { + .e delete 0 end + .e insert 0 abcdefghijklmnopqrs + .e xview 6 + update + set scrollInfo +} {0.315789 0.842105} +test spinbox-17.4 {SpinboxUpdateScrollbar procedure} { + destroy .e + proc bgerror msg { + global x + set x $msg + } + spinbox .e -width 5 -xscrollcommand thisisnotacommand + pack .e + update + rename bgerror {} + list $x $errorInfo +} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" + while executing +"thisisnotacommand 0 1" + (horizontal scrolling command executed by .e)}} + +set l [interp hidden] +eval destroy [winfo children .] + +test spinbox-18.1 {Spinbox widget vs hiding} { + destroy .e + spinbox .e + interp hide {} .e + destroy .e + list [winfo children .] [interp hidden] +} [list {} $l] + +## +## Spinbox widget VALIDATION tests +## + +destroy .e +catch {unset ::e} +catch {unset ::vVals} +spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white +pack .e +proc doval {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 1 +} + +# The validation tests build each one upon the previous, so cascading +# failures aren't good +# +test spinbox-19.1 {spinbox widget validation} { + .e insert 0 a + set ::vVals +} {.e 1 0 a {} a all key} +test spinbox-19.2 {spinbox widget validation} { + .e insert 1 b + set ::vVals +} {.e 1 1 ab a b all key} +test spinbox-19.3 {spinbox widget validation} { + .e insert end c + set ::vVals +} {.e 1 2 abc ab c all key} +test spinbox-19.4 {spinbox widget validation} { + .e insert 1 123 + list $::vVals $::e +} {{.e 1 1 a123bc abc 123 all key} a123bc} +test spinbox-19.5 {spinbox widget validation} { + .e delete 2 + set ::vVals +} {.e 0 2 a13bc a123bc 2 all key} +test spinbox-19.6 {spinbox widget validation} { + .e configure -validate key + .e delete 1 3 + set ::vVals +} {.e 0 1 abc a13bc 13 key key} +test spinbox-19.7 {spinbox widget validation} { + set ::vVals {} + .e configure -validate focus + .e insert end d + set ::vVals +} {} +test spinbox-19.8 {spinbox widget validation} { + focus -force .e + # update necessary to process FocusIn event + update + set ::vVals +} {.e -1 -1 abcd abcd {} focus focusin} +test spinbox-19.9 {spinbox widget validation} { + focus -force . + # update necessary to process FocusOut event + update + set ::vVals +} {.e -1 -1 abcd abcd {} focus focusout} +.e configure -validate all +test spinbox-19.10 {spinbox widget validation} { + focus -force .e + # update necessary to process FocusIn event + update + set ::vVals +} {.e -1 -1 abcd abcd {} all focusin} +test spinbox-19.11 {spinbox widget validation} { + focus -force . + # update necessary to process FocusOut event + update + set ::vVals +} {.e -1 -1 abcd abcd {} all focusout} +.e configure -validate focusin +test spinbox-19.12 {spinbox widget validation} { + focus -force .e + # update necessary to process FocusIn event + update + set ::vVals +} {.e -1 -1 abcd abcd {} focusin focusin} +test spinbox-19.13 {spinbox widget validation} { + set ::vVals {} + focus -force . + # update necessary to process FocusOut event + update + set ::vVals +} {} +.e configure -validate focuso +test spinbox-19.14 {spinbox widget validation} { + focus -force .e + # update necessary to process FocusIn event + update + set ::vVals +} {} +test spinbox-19.15 {spinbox widget validation} { + focus -force . + # update necessary to process FocusOut event + update + set ::vVals +} {.e -1 -1 abcd abcd {} focusout focusout} +test spinbox-19.16 {spinbox widget validation} { + list [.e validate] $::vVals +} {1 {.e -1 -1 abcd abcd {} all forced}} +test spinbox-19.17 {spinbox widget validation} { + set ::e newdata + list [.e cget -validate] $::vVals +} {focusout {.e -1 -1 newdata abcd {} focusout forced}} + +proc doval {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 0 +} +.e configure -validate all + +test spinbox-19.18 {spinbox widget validation} { + set ::e nextdata + list [.e cget -validate] $::vVals +} {none {.e -1 -1 nextdata newdata {} all forced}} + +proc doval {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + set ::e mydata + return 1 +} +.e configure -validate all + +## This sets validate to none because it shows that we prevent a possible +## loop condition in the validation, when the spinbox textvar is also set +test spinbox-19.19 {spinbox widget validation} { + .e validate + list [.e cget -validate] [.e get] $::vVals +} {none mydata {.e -1 -1 nextdata nextdata {} all forced}} + +.e configure -validate all + +## This leaves validate alone because we trigger validation through the +## textvar (a write trace), and the write during validation triggers +## nothing (by definition of avoiding loops on var traces). This is +## one of those "dangerous" conditions where the user will have a +## different value in the spinbox widget shown as is in the textvar. +test spinbox-19.20 {spinbox widget validation} { + set ::e testdata + list [.e cget -validate] [.e get] $::e $::vVals +} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} + +# A format specifier is allowed to be of the form %[-+ 0]{0,1}\d.?\d?f +# +destroy .e +spinbox .e +test spinbox-20.1 {spinbox config, -format specifier} { + list [catch {.e config -format %2f} msg] $msg +} {0 {}} +test spinbox-20.2 {spinbox config, -format specifier} { + list [catch {.e config -format %2.2f} msg] $msg +} {0 {}} +test spinbox-20.3 {spinbox config, -format specifier} { + list [catch {.e config -format %.2f} msg] $msg +} {0 {}} +test spinbox-20.4 {spinbox config, -format specifier} { + list [catch {.e config -format %2.f} msg] $msg +} {0 {}} +test spinbox-20.5 {spinbox config, -format specifier} { + list [catch {.e config -format %2e-1f} msg] $msg +} {1 {bad spinbox format specifier "%2e-1f"}} +test spinbox-20.6 {spinbox config, -format specifier} { + list [catch {.e config -format 2.2} msg] $msg +} {1 {bad spinbox format specifier "2.2"}} +test spinbox-20.7 {spinbox config, -format specifier} { + list [catch {.e config -format %2.-2f} msg] $msg +} {1 {bad spinbox format specifier "%2.-2f"}} +test spinbox-20.8 {spinbox config, -format specifier} { + list [catch {.e config -format %-2.02f} msg] $msg +} {0 {}} +test spinbox-20.9 {spinbox config, -format specifier} { + list [catch {.e config -format "% 2.02f"} msg] $msg +} {0 {}} +test spinbox-20.10 {spinbox config, -format specifier} { + list [catch {.e config -format "% -2.200f"} msg] $msg +} {0 {}} +test spinbox-20.11 {spinbox config, -format specifier} { + list [catch {.e config -format "%09.200f"} msg] $msg +} {0 {}} +test spinbox-20.12 {spinbox config, -format specifier does something} { + set out {} + .e config -format "%02.f" + .e config -values {} -from 0 -to 10 -increment 1 + lappend out [.e set 0]; # set currently doesn't force format + .e invoke buttonup + lappend out [.e set]; # but after invoke it should be formatted + lappend out [.e set 3]; # set currently doesn't force format + .e config -format "%03.f" + lappend out [.e set]; # changing -format should cause formatting +} {0 01 3 003} + +test spinbox-21.1 {spinbox button, out of range checking} { + destroy .e + spinbox .e -from -10 -to 20 -increment 2 + set out {} + lappend out [.e get]; # -10 + .e delete 0 end + .e insert 0 25; # set outside of range + .e invoke buttondown; # should constrain + lappend out [.e get]; # 20 + .e delete 0 end + .e insert 0 25; # set outside of range + .e invoke buttonup; # should constrain + lappend out [.e get]; # 20 + .e delete 0 end + .e insert 0 -100; # set outside of range + .e invoke buttonup; # should constrain + lappend out [.e get]; # -10 + .e delete 0 end + .e insert 0 -100; # set outside of range + .e invoke buttondown; # should constrain + lappend out [.e get]; # -10 + .e delete 0 end + .e insert 0 bogus; # set to a bogus value + .e invoke buttondown; # should use fromValue + lappend out [.e get]; # -10 + .e delete 0 end + .e insert 0 19; # set just inside of range + .e invoke buttonup; # no wrap + lappend out [.e get]; # 20 + .e invoke buttonup; # no wrap + lappend out [.e get]; # 20 + .e invoke buttondown + lappend out [.e get]; # 18 + .e delete 0 end + .e insert 0 -9; # set just inside of range + .e invoke buttondown; # no wrap + lappend out [.e get]; # -10 + .e invoke buttondown; # no wrap + lappend out [.e get]; # -10 + .e invoke buttonup; # no wrap + lappend out [.e get]; # -8 + + .e configure -wrap 1 + .e delete 0 end + .e insert 0 19; # set just inside of range + .e invoke buttonup; # wrap + lappend out [.e get]; # -10 + .e invoke buttonup + lappend out [.e get]; # -8 + .e invoke buttondown + lappend out [.e get]; # -10 + .e delete 0 end + .e insert 0 -9; # set just inside of range + .e invoke buttondown; # wrap + lappend out [.e get]; # 20 + .e invoke buttondown + lappend out [.e get]; # 18 + .e invoke buttonup; # no wrap + lappend out [.e get]; # 20 + +} {-10 20 20 -10 -10 -10 20 20 18 -10 -10 -8 -10 -8 -10 20 18 20} + +destroy .e +catch {unset ::e ::vVals} + +## +## End validation tests +## + +# XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc, +# and SpinboxTextVarProc. + +option clear + +# cleanup +::tcltest::cleanupTests +return |